mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-29 07:58:21 +00:00
Code

Merge branch 'master' of orgmode.org:org-mode

Browse Source
This commit is contained in:
Luis Anaya 2012-08-15 16:06:47 -04:00
commit 08c6b3d2e3
103 changed files with 6064 additions and 4058 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
Makefile
View File

@ -28,39 +28,20 @@ help helpall::
$(info make all - ditto)
$(info make compile - build Org ELisp files)
$(info make autoloads - create org-install.el to load Org in-place)
$(info make check - build Org ELisp files and run test suite)
$(info make test - build Org ELisp files and run test suite)
helpall::
$(info make test - ditto)
$(info make compile-dirty - build only stale Org ELisp files)
$(info make test-dirty - check without building first)
$(info make compile-dirty - build only stale Org ELisp files)
$(info make compile-single - build using one Emacs process per file)
$(info )
$(info Compatibility)
$(info =============)
$(info make oldorg - what the old make did: compile autoloads info)
$(info )
$(info Convenience)
$(info ===========)
$(info make up0 - pull from upstream)
$(info make up1 - pull from upstream, build and check)
$(info make up2 - pull from upstream, build, check and install)
$(info make update - pull from upstream and build)
$(info make update2 - pull from upstream, build and install)
$(info make uncompiled - combine cleanlisp and autoloads)
$(info make local.mk - create new local.mk as template for adaptation)
$(info )
$(info Cleaning)
$(info ========)
$(info make clean - remove built Org ELisp files and documentation)
$(info make cleanall - remove everything that can be built and all remnants)
$(info make cleandirs - clean in etc/, lisp/ and doc/)
$(info make cleancontrib - remove remnants in contrib/)
$(info make cleantesting - remove remnants in testing/)
$(info make cleanutils - remove remnants in UTILITIES/)
$(info make cleandoc - remove built documentation)
$(info make cleandocs - ditto)
$(info make cleanlisp - remove built Org ELisp files)
$(info make cleanelc - ditto)
$(info make cleantest - remove test directory)
$(info make clean-install - remove previous Org installation)
$(info )
$(info Configuration Check)
@ -72,7 +53,6 @@ helpall::
$(info make config-exe - check executables configuration)
$(info make config-cmd - check command configuration)
$(info make config-all - check all configuration)
$(info make config-eol - check all configuration, mark end-of-line)
$(info )
$(info Documentation)
$(info =============)
@ -96,6 +76,16 @@ helpall::
$(info make install-etc - build and install files in /etc)
$(info make install-lisp - build and install Org Elisp files)
$(info make install-info - build and install Info documentation)
$(info )
$(info Convenience)
$(info ===========)
$(info make up0 - pull from upstream)
$(info make up1 - pull from upstream, build and check)
$(info make up2 - pull from upstream, build, check and install)
$(info make update - pull from upstream and build)
$(info make update2 - pull from upstream, build and install)
$(info make uncompiled - combine cleanlisp and autoloads)
$(info make local.mk - create new local.mk as template for adaptation)
help helpall::
@echo ""

94
contrib/lisp/org-e-beamer.el
View File

@ -379,55 +379,63 @@ used as a communication channel."
"Format HEADLINE as a frame.
CONTENTS holds the contents of the headline. INFO is a plist
used as a communication channel."
(concat "\\begin{frame}"
;; Overlay specification, if any. If is 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-e-beamer--normalize-argument action 'defaction))
(t (org-e-beamer--normalize-argument action 'action))))
;; Options, if any.
(let ((options
;; Collect options from default value and headline's
;; properties. Also add a label for links.
(append
(org-split-string org-e-beamer-frame-default-options
",")
(let ((opt (org-element-property :beamer-opt headline)))
(and opt (org-split-string
;; Remove square brackets if user
;; provided them.
(and (string-match "^\\[?\\(.*\\)\\]?$" opt)
(match-string 1 opt))
",")))
(list
(format "label=sec-%s"
(mapconcat
'number-to-string
(org-export-get-headline-number headline info)
"-"))))))
;; Change options list into a string. FRAGILEP is non-nil
;; when HEADLINE contains an element among
;; `org-e-beamer-verbatim-elements'.
(let ((fragilep (org-element-map
headline org-e-beamer-verbatim-elements 'identity
info 'first-match)))
(let ((fragilep
;; FRAGILEP is non-nil when HEADLINE contains an element
;; among `org-e-beamer-verbatim-elements'.
(org-element-map headline org-e-beamer-verbatim-elements 'identity
info 'first-match)))
(concat "\\begin{frame}"
;; Overlay specification, if any. If is 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-e-beamer--normalize-argument action 'defaction))
(t (org-e-beamer--normalize-argument action 'action))))
;; Options, if any.
(let ((options
;; Collect options from default value and headline's
;; properties. Also add a label for links.
(append
(org-split-string org-e-beamer-frame-default-options
",")
(let ((opt (org-element-property :beamer-opt headline)))
(and opt (org-split-string
;; Remove square brackets if user
;; provided them.
(and (string-match "^\\[?\\(.*\\)\\]?$" opt)
(match-string 1 opt))
",")))
(list
(format "label=sec-%s"
(mapconcat
'number-to-string
(org-export-get-headline-number headline info)
"-"))))))
;; Change options list into a string.
(org-e-beamer--normalize-argument
(mapconcat
'identity
(if (or (not fragilep) (member "fragile" options)) options
(cons "fragile" options))
",")
'option)))
;; Title.
(format "{%s}"
(org-export-data (org-element-property :title headline)
info))
"\n"
contents
"\\end{frame}"))
'option))
;; Title.
(format "{%s}"
(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*" "\\& " contents))
"\\end{frame}")))
(defun org-e-beamer--format-block (headline contents info)
"Format HEADLINE as a block.

52
contrib/lisp/org-e-publish.el
View File

@ -328,8 +328,9 @@ You could use brackets to delimit on what part the link will be.
(format "%s" (or pub-func ""))))
(concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
(defun org-e-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir)
"Return t if FILENAME should be published in PUB-DIR using PUB-FUNC.
(defun org-e-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.
@ -338,17 +339,18 @@ file name the file will be stored - the publishing function can
still decide about that independently."
(let ((rtn (if (not org-e-publish-use-timestamps-flag) t
(org-e-publish-cache-file-needs-publishing
filename pub-dir pub-func))))
filename pub-dir pub-func base-dir))))
(if rtn (message "Publishing file %s using `%s'" filename pub-func)
(when org-e-publish-list-skipped-files
(message "Skipping unmodified file %s" filename)))
rtn))
(defun org-e-publish-update-timestamp (filename &optional pub-dir pub-func)
(defun org-e-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-e-publish-timestamp-filename filename pub-dir pub-func))
(stamp (org-e-publish-cache-ctime-of-src filename)))
(stamp (org-e-publish-cache-ctime-of-src filename base-dir)))
(org-e-publish-cache-set key stamp)))
(defun org-e-publish-remove-all-timestamps ()
@ -705,15 +707,16 @@ See `org-e-publish-projects'."
(if (listp publishing-function)
;; allow chain of publishing functions
(mapc (lambda (f)
(when (org-e-publish-needed-p filename pub-dir f tmp-pub-dir)
(when (org-e-publish-needed-p
filename pub-dir f tmp-pub-dir base-dir)
(funcall f project-plist filename tmp-pub-dir)
(org-e-publish-update-timestamp filename pub-dir f)))
(org-e-publish-update-timestamp filename pub-dir f base-dir)))
publishing-function)
(when (org-e-publish-needed-p filename pub-dir publishing-function
tmp-pub-dir)
(when (org-e-publish-needed-p
filename pub-dir publishing-function tmp-pub-dir base-dir)
(funcall publishing-function project-plist filename tmp-pub-dir)
(org-e-publish-update-timestamp
filename pub-dir publishing-function)))
filename pub-dir publishing-function base-dir)))
(unless no-cache (org-e-publish-write-cache-file))))
(defun org-e-publish-projects (projects)
@ -1070,8 +1073,7 @@ If FREE-CACHE, empty the cache."
"Initialize the projects cache if not initialized yet and return it."
(unless project-name
(error "%s%s" "Cannot initialize `org-e-publish-cache' without projects name"
" in `org-e-publish-initialize-cache'"))
(error "Cannot initialize `org-e-publish-cache' without projects name in `org-e-publish-initialize-cache'"))
(unless (file-exists-p org-e-publish-timestamp-directory)
(make-directory org-e-publish-timestamp-directory t))
@ -1105,7 +1107,7 @@ If FREE-CACHE, empty the cache."
(setq org-e-publish-cache nil))
(defun org-e-publish-cache-file-needs-publishing
(filename &optional pub-dir pub-func)
(filename &optional pub-dir pub-func base-dir)
"Check the timestamp of the last publishing of FILENAME.
Non-nil if the file needs publishing. The function also checks
if any included files have been more recently published, so that
@ -1126,13 +1128,14 @@ the file including them will be republished as well."
(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-e-publish-cache-ctime-of-src included-file) t))))
(add-to-list
'included-files-ctime
(org-e-publish-cache-ctime-of-src included-file base-dir)
t))))
;; FIXME: don't kill current buffer.
(unless visiting (kill-buffer buf)))
(if (null pstamp)
t
(let ((ctime (org-e-publish-cache-ctime-of-src filename)))
(if (null pstamp) t
(let ((ctime (org-e-publish-cache-ctime-of-src filename base-dir)))
(or (< pstamp ctime)
(when included-files-ctime
(not (null (delq nil (mapcar (lambda(ct) (< ctime ct))
@ -1184,15 +1187,12 @@ Returns value on success, else nil."
(error "`org-e-publish-cache-set' called, but no cache present"))
(puthash key value org-e-publish-cache))
(defun org-e-publish-cache-ctime-of-src (filename)
(defun org-e-publish-cache-ctime-of-src (f base-dir)
"Get the FILENAME ctime as an integer."
(let* ((symlink-maybe (or (file-symlink-p filename) filename))
(src-attr
(file-attributes
(if (file-name-absolute-p symlink-maybe) symlink-maybe
(expand-file-name symlink-maybe (file-name-directory filename))))))
(+ (lsh (car (nth 5 src-attr)) 16)
(cadr (nth 5 src-attr)))))
(let ((attr (file-attributes
(expand-file-name (or (file-symlink-p f) f) base-dir))))
(+ (lsh (car (nth 5 attr)) 16)
(cadr (nth 5 attr)))))
(provide 'org-e-publish)

1848
contrib/lisp/org-e-texinfo.el Normal file
View File

File diff suppressed because it is too large Load Diff

7
default.mk
View File

@ -131,10 +131,3 @@ SUDO = sudo
# Name of the program to install info files
# INSTALL_INFO = ginstall-info # Debian: avoid harmless warning message
INSTALL_INFO = install-info
# target variant for 'compile'
# _COMPILE_ = single # one Emacs process per compilation
# _COMPILE_ = source # ditto, but remove compiled file immediately
# _COMPILE_ = slint1 # possibly elicit more warnings
# _COMPILE_ = slint2 # possibly elicit even more warnings
_COMPILE_ = dirall

30
lisp/Makefile
View File

@ -7,31 +7,23 @@ endif
LISPV = org-version.el
LISPI = org-install.el
LISPA = $(LISPV) $(LISPI)
LISPF = $(filter-out $(LISPA),$(sort $(wildcard *.el)))
LISPF = $(filter-out $(LISPA),$(wildcard *.el))
LISPC = $(filter-out $(LISPN:%el=%elc),$(LISPF:%el=%elc))
.PHONY: all compile compile-dirty \
compile-single compile-source compile-slint1 compile-slint2 \
autoloads \
install clean cleanauto cleanall cleanelc clean-install
.PHONY: all compile compile-dirty compile-single \
autoloads \
install clean cleanauto cleanall clean-install
# do not clean here, done in toplevel make
all compile compile-dirty:: autoloads
$(MAKE) compile-$(_COMPILE_)
compile-dirall:
@$(ELCDIR)
compile-single: $(LISPC)
compile-source: cleanelc
all compile:: autoloads
all compile compile-dirty:: $(LISPI) $(LISPV)
$(ELCDIR)
compile-single: clean autoloads $(LISPC)
compile-source: clean autoloads
@$(foreach elc,$(LISPC),$(MAKE) $(elc) && $(RM) $(elc);)
compile-slint1: compile-dirall
@$(foreach elc,$(LISPC),$(RM) $(elc); $(MAKE) $(elc);)
compile-slint2:
$(MAKE) compile-source compile-slint1
%.elc: %.el
@$(info Compiling single $(abspath $<)...)
-@$(ELC) $<
-$(ELC) $(<)
autoloads: cleanauto $(LISPI) $(LISPV)
@ -53,7 +45,7 @@ install: $(LISPF) compile
cleanauto clean cleanall::
$(RM) $(LISPA) $(LISPA:%el=%elc)
clean cleanall cleanelc::
clean cleanall::
$(RM) *.elc
clean-install:

38
lisp/ob-C.el
View File

@ -61,7 +61,7 @@ is currently being evaluated.")
(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
"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)))
@ -116,8 +116,8 @@ or `org-babel-execute:C++'."
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
(org-babel-trim
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(defun org-babel-C-expand (body params)
"Expand a block of C or C++ code with org-babel according to
@ -129,22 +129,22 @@ it's header arguments."
(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")))
(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."

7
lisp/ob-R.el
View File

@ -80,8 +80,7 @@
(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))
(setq ess-local-process-name (match-string 1 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."
@ -289,7 +288,7 @@ current code buffer."
(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
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(value
@ -316,7 +315,7 @@ last statement in BODY, as elisp."
(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
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(value

2
lisp/ob-asymptote.el
View File

@ -128,7 +128,7 @@ a variable of the same value."
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
a string. Otherwise, it is either `real', if some elements are
floats, or `int'."
(let* ((type 'int)
find-type ; for byte-compiler

2
lisp/ob-calc.el
View File

@ -71,7 +71,7 @@
(cond
((numberp res) res)
((math-read-number res) (math-read-number res))
((listp res) (error "calc error \"%s\" on input \"%s\""
((listp res) (error "Calc error \"%s\" on input \"%s\""
(cadr res) line))
(t (replace-regexp-in-string
"'" ""

8
lisp/ob-comint.el
View File

@ -51,7 +51,7 @@ executed inside the protection of `save-excursion' and
`(save-excursion
(save-match-data
(unless (org-babel-comint-buffer-livep ,buffer)
(error "buffer %s doesn't exist or has no process" ,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))
@ -144,10 +144,10 @@ statement (not large blocks of code)."
(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
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 doesn't exist or has no process" 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)
@ -156,7 +156,7 @@ FILE exists at end of evaluation."
(if (file-remote-p default-directory)
(let (v)
(with-parsed-tramp-file-name default-directory nil
(tramp-flush-directory-property v ""))))
(tramp-flush-directory-property v ""))))
(while (not (file-exists-p file)) (sit-for (or period 0.25))))
(provide 'ob-comint)

2
lisp/ob-css.el
View File

@ -34,7 +34,7 @@
(defun org-babel-execute:css (body params)
"Execute a block of CSS code.
This function is called by `org-babel-execute-src-block'."
body)
body)
(defun org-babel-prep-session:css (session params)
"Return an error if the :session header argument is set.

12
lisp/ob-emacs-lisp.el
View File

@ -41,12 +41,12 @@
(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 "(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))

4
lisp/ob-eval.el
View File

@ -64,8 +64,8 @@ STDERR with `org-babel-eval-error-notify'."
(buffer-string)))
(defun org-babel-shell-command-on-region (start end command
&optional output-buffer replace
error-buffer display-error-buffer)
&optional output-buffer replace
error-buffer display-error-buffer)
"Execute COMMAND in an inferior shell with region as input.
Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'

2
lisp/ob-exp.el
View File

@ -194,7 +194,7 @@ this template."
org-babel-default-lob-header-args
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(org-no-properties
(concat ":var results="
(mapconcat #'identity
(butlast lob-info)

50
lisp/ob-fortran.el
View File

@ -72,8 +72,8 @@
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
(org-babel-trim
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(defun org-babel-expand-body:fortran (body params)
"Expand a block of fortran or fortran code with org-babel according to
@ -85,42 +85,42 @@ it's header arguments."
(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")))
(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)
(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"))
(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"))
(error "Fortran is a compiled languages -- no support for sessions"))
;; helper functions

2
lisp/ob-haskell.el
View File

@ -130,7 +130,7 @@ then create one. Return the initialized session."
(format "let %s = %s"
(car pair)
(org-babel-haskell-var-to-haskell (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(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.

14
lisp/ob-io.el
View File

@ -22,7 +22,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Currently only supports the external execution. No session support yet.
;; Currently only supports the external execution. No session support yet.
;; :results output -- runs in scripting mode
;; :results output repl -- runs in repl mode
@ -85,11 +85,11 @@ Emacs-lisp table, otherwise return the results as a string."
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 supported for Io. Yet."))
(when session (error "Sessions are not supported for Io. Yet."))
(case result-type
(output
(output
(if (member "repl" result-params)
(org-babel-eval org-babel-io-command body)
(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
@ -104,14 +104,14 @@ in BODY as elisp."
(org-babel-eval
(concat org-babel-io-command " " src-file) ""))))))
(defun org-babel-prep-session:io (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not supported for Io. Yet."))
(error "Sessions are not supported for Io. Yet."))
(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
then create. Return the initialized session. Sessions are not
supported in Io."
nil)

4
lisp/ob-js.el
View File

@ -152,9 +152,9 @@ then create. Return the initialized session."
(sit-for .5)
(org-babel-js-initiate-session session))))
((string= "node" org-babel-js-cmd )
(error "session evaluation with node.js is not supported"))
(error "Session evaluation with node.js is not supported"))
(t
(error "sessions are only supported with mozrepl add \":cmd mozrepl\"")))))
(error "Sessions are only supported with mozrepl add \":cmd mozrepl\"")))))
(provide 'ob-js)

2
lisp/ob-latex.el
View File

@ -132,7 +132,7 @@ This function is called by `org-babel-execute-src-block'."
(when (file-exists-p transient-pdf-file)
(delete-file transient-pdf-file))))))
((string-match "\\.\\([^\\.]+\\)$" out-file)
(error "can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
(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))

4
lisp/ob-ledger.el
View File

@ -52,8 +52,8 @@ called by `org-babel-execute-src-block'."
(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))
" -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)

26
lisp/ob-lilypond.el
View File

@ -54,14 +54,14 @@ 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")
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")
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")
@ -77,28 +77,28 @@ the midi file is not automatically played. Default value is t")
(defvar ly-win32-midi-path "")
(defvar ly-gen-png nil
"Image generation (png) can be turned on by default by setting
"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
"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
"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
"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
"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
to t. In Arrange mode the following settings are altered
from default...
:tangle yes, :noweb yes
:results silent :comments yes.
@ -133,7 +133,7 @@ Depending on whether we are in arrange mode either:
(defun ly-tangle ()
"ob-lilypond specific tangle, attempts to invoke
=ly-execute-tangled-ly= if tangle is successful. Also passes
=ly-execute-tangled-ly= if tangle is successful. Also passes
specific arguments to =org-babel-tangle="
(interactive)
(if (org-babel-tangle nil "yes" "lilypond")
@ -413,8 +413,8 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
(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"
source block. These depend upon whether we are in arrange
mode i.e. ARRANGE-MODE is t"
(cond (mode
'((:tangle . "yes")
(:noweb . "yes")

4
lisp/ob-lisp.el
View File

@ -85,8 +85,8 @@ current directory string."
(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)))
(cdr (assoc :dir params))
default-directory)))
(format
(if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)")
(buffer-substring-no-properties

4
lisp/ob-lob.el
View File

@ -105,7 +105,7 @@ if so then run the appropriate source block from the Library."
(beginning-of-line 1)
(when (looking-at org-babel-lob-one-liner-regexp)
(append
(mapcar #'org-babel-clean-text-properties
(mapcar #'org-no-properties
(list
(format "%s%s(%s)%s"
(funcall nonempty 3 12)
@ -124,7 +124,7 @@ if so then run the appropriate source block from the Library."
org-babel-default-header-args
(org-babel-params-from-properties)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(org-no-properties
(concat ":var results="
(mapconcat #'identity (butlast info) " "))))))
(pre-info (funcall mkinfo pre-params))

34
lisp/ob-maxima.el
View File

@ -48,21 +48,21 @@
(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")))
(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
@ -110,8 +110,8 @@ of the same value."
(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))))
(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."

6
lisp/ob-mscgen.el
View File

@ -24,7 +24,7 @@
;;; Commentary:
;;
;; This software provides EMACS org-babel export support for message
;; sequence charts. The mscgen utility is used for processing the
;; 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
@ -64,13 +64,13 @@
(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
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"))
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

12
lisp/ob-ocaml.el
View File

@ -72,7 +72,7 @@
(progn (setq out nil) line)
(when (string-match re line)
(progn (setq out t) nil))))
(mapcar #'org-babel-trim (reverse raw))))))))
(mapcar #'org-babel-trim (reverse raw))))))))
(org-babel-reassemble-table
(org-babel-ocaml-parse-output (org-babel-trim clean))
(org-babel-pick-name
@ -131,11 +131,11 @@ Emacs-lisp table, otherwise return the results as a string."
"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)))))
(org-babel-script-escape
(replace-regexp-in-string
"\\[|" "[" (replace-regexp-in-string
"|\\]" "]" (replace-regexp-in-string
"; " "," results)))))
(provide 'ob-ocaml)

12
lisp/ob-octave.el
View File

@ -52,7 +52,7 @@
to a non-nil value.")
(defvar org-babel-matlab-emacs-link-wrapper-method
"%s
"%s
if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid);
else, save -ascii %s ans
end
@ -147,13 +147,13 @@ specifying a variable of the same value."
(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."
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."
create. Return the initialized session."
(if matlabp (require 'matlab) (require 'octave-inf))
(unless (string= session "none")
(let ((session (or session
@ -225,9 +225,9 @@ value of the last statement in BODY, as elisp."
(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
;; make *matlab* buffer contents easily
;; available, so :results output currently
;; won't work
(org-babel-comint-with-output
(session
(if matlabp

4
lisp/ob-perl.el
View File

@ -47,7 +47,7 @@ This function is called by `org-babel-execute-src-block'."
(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)))
(session (org-babel-perl-initiate-session session)))
(org-babel-reassemble-table
(org-babel-perl-evaluate session full-body result-type)
(org-babel-pick-name
@ -82,7 +82,7 @@ specifying a var of the same value."
(defun org-babel-perl-initiate-session (&optional session params)
"Return nil because sessions are not supported by perl."
nil)
nil)
(defvar org-babel-perl-wrapper-method
"

6
lisp/ob-picolisp.el
View File

@ -25,16 +25,16 @@
;;; Commentary:
;; This library enables the use of PicoLisp in the multi-language
;; programming framework Org-Babel. PicoLisp is a minimal yet
;; 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
;; 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
;; 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).

2
lisp/ob-plantuml.el
View File

@ -52,7 +52,7 @@
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")))
(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)) ""))

4
lisp/ob-python.el
View File

@ -201,7 +201,7 @@ open('%s', 'w').write( pprint.pformat(main()) )")
(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
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
((lambda (raw)
(if (or (member "code" result-params)
@ -236,7 +236,7 @@ last statement in BODY, as elisp."
(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
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

166
lisp/ob-ref.el
View File

@ -120,89 +120,89 @@ the variable."
(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)))))))
(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.

10
lisp/ob-ruby.el
View File

@ -64,12 +64,12 @@ This function is called by `org-babel-execute-src-block'."
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))
(require 'rcodetools)
(insert full-body)
(xmp (cdr (assoc :xmp-option params)))
(buffer-string))
(org-babel-ruby-evaluate
session full-body result-type result-params))))
session full-body result-type result-params))))
(org-babel-reassemble-table
result
(org-babel-pick-name (cdr (assoc :colname-names params))

12
lisp/ob-scala.el
View File

@ -22,7 +22,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Currently only supports the external execution. No session support yet.
;; Currently only supports the external execution. No session support yet.
;;; Requirements:
;; - Scala language :: http://www.scala-lang.org/
@ -84,14 +84,14 @@ Emacs-lisp table, otherwise return the results as a string."
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 supported for Scala. Yet."))
(when session (error "Sessions are not supported for Scala. Yet."))
(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
(value
(let* ((src-file (org-babel-temp-file "scala-"))
(wrapper (format org-babel-scala-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
@ -102,14 +102,14 @@ in BODY as elisp."
(org-babel-eval
(concat org-babel-scala-command " " src-file) ""))))))
(defun org-babel-prep-session:scala (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not supported for Scala. Yet."))
(error "Sessions are not supported for Scala. Yet."))
(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
then create. Return the initialized session. Sessions are not
supported in Scala."
nil)

12
lisp/ob-screen.el
View File

@ -23,7 +23,7 @@
;;; Commentary:
;; Org-Babel support for interactive terminals. Mostly shell scripts.
;; Org-Babel support for interactive terminals. Mostly shell scripts.
;; Heavily inspired by 'eev' from Eduardo Ochs
;;
;; Adding :cmd and :terminal as header arguments
@ -64,8 +64,8 @@ In case you want to use a different screen than one selected by your $PATH")
(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))
"-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
@ -81,8 +81,8 @@ In case you want to use a different screen than one selected by your $PATH")
(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"))))))
,(concat "readreg z " tmpfile)
"paste z"))))))
(defun org-babel-screen-session-socketname (session)
"Check if SESSION exists by parsing output of \"screen -ls\"."
@ -137,7 +137,7 @@ The terminal should shortly flicker."
(message (concat "org-babel-screen: Setup "
(if (string-match random-string tmp-string)
"WORKS."
"DOESN'T work.")))))
"DOESN'T work.")))))
(provide 'ob-screen)

2
lisp/ob-sh.el
View File

@ -57,7 +57,7 @@ This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-sh-initiate-session
(cdr (assoc :session params))))
(stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string
(org-babel-ref-resolve stdin))))
(org-babel-ref-resolve stdin))))
(cdr (assoc :stdin params))))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:sh params))))

14
lisp/ob-sql.el
View File

@ -90,10 +90,10 @@ This function is called by `org-babel-execute-src-block'."
(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)))))
(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)
@ -148,8 +148,8 @@ This function is called by `org-babel-execute-src-block'."
(with-temp-file data-file
(insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el)
el
(format "%S" el)))))))
el
(format "%S" el)))))))
data-file)
(org-babel-temp-file "sql-data-"))
(if (stringp val) val (format "%S" val))))
@ -160,7 +160,7 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-prep-session:sql (session params)
"Raise an error because Sql sessions aren't implemented."
(error "sql sessions not yet implemented"))
(error "SQL sessions not yet implemented"))
(provide 'ob-sql)

8
lisp/ob-sqlite.el
View File

@ -128,8 +128,8 @@ This function is called by `org-babel-execute-src-block'."
(with-temp-file data-file
(insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el)
el
(format "%S" el)))))))
el
(format "%S" el)))))))
data-file)
(org-babel-temp-file "sqlite-data-"))
(if (stringp val) val (format "%S" val))))
@ -155,9 +155,9 @@ This function is called by `org-babel-execute-src-block'."
table))
(defun org-babel-prep-session:sqlite (session params)
"Raise an error because support for sqlite sessions isn't implemented.
"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"))
(error "SQLite sessions not yet implemented"))
(provide 'ob-sqlite)

2
lisp/ob-table.el
View File

@ -99,7 +99,7 @@ as shown in the example below.
(prog1 nil (setq quote t))
(prog1 (if quote
(format "\"%s\"" el)
(org-babel-clean-text-properties el))
(org-no-properties el))
(setq quote nil))))
(cdr var)))))
variables)))

12
lisp/ob-tangle.el
View File

@ -156,7 +156,7 @@ This function exports the source code using
(> (funcall age file) (funcall age exported-file)))
(org-babel-tangle-file file exported-file "emacs-lisp"))
(load-file exported-file)
(message "loaded %s" exported-file)))
(message "Loaded %s" exported-file)))
;;;###autoload
(defun org-babel-tangle-file (file &optional target-file lang)
@ -268,7 +268,7 @@ exported source code blocks by language."
(add-to-list 'path-collector file-name)))))
specs)))
(org-babel-tangle-collect-blocks lang))
(message "tangled %d code block%s from %s" block-counter
(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)))))
@ -374,7 +374,7 @@ code blocks by language."
(link ((lambda (link)
(and (string-match org-bracket-link-regexp link)
(match-string 1 link)))
(org-babel-clean-text-properties
(org-no-properties
(org-store-link nil))))
(source-name
(intern (or (nth 4 info)
@ -441,7 +441,7 @@ code blocks by language."
(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-babel-clean-text-properties
(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)
@ -474,7 +474,7 @@ which enable the original code blocks to be found."
(org-babel-update-block-body new-body)))
(setq counter (+ 1 counter)))
(goto-char end))
(prog1 counter (message "detangled %d code blocks" counter)))))
(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."
@ -497,7 +497,7 @@ which enable the original code blocks to be found."
" ends here") nil t)
(setq end (point-at-bol))))))))
(unless (and start (< start mid) (< mid end))
(error "not in tangled code"))
(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))))

625
lisp/ob.el
View File

@ -27,6 +27,7 @@
(require 'cl))
(require 'ob-eval)
(require 'org-macs)
(require 'org-compat)
(defconst org-babel-exeext
(if (memq system-type '(windows-nt cygwin))
@ -50,7 +51,7 @@
(&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" (use-markers &rest body))
(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" ())
@ -113,9 +114,9 @@ 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))
: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)))
@ -253,7 +254,7 @@ Returns a list
(nth 2 info)
(org-babel-parse-header-arguments (match-string 1)))))
(when (looking-at org-babel-src-name-w-name-regexp)
(setq name (org-babel-clean-text-properties (match-string 3)))
(setq name (org-no-properties (match-string 3)))
(when (and (match-string 5) (> (length (match-string 5)) 0))
(setf (nth 2 info) ;; merge functional-syntax vars and header-args
(org-babel-merge-params
@ -419,9 +420,9 @@ then run `org-babel-pop-to-session'."
(noweb-sep . :any)
(padline . ((yes no)))
(results . ((file list vector table scalar verbatim)
(raw org html latex code pp wrap)
(replace silent append prepend)
(output value)))
(raw org html latex code pp wrap)
(replace silent append prepend)
(output value)))
(rownames . ((no yes)))
(sep . :any)
(session . :any)
@ -464,8 +465,8 @@ be saved in the second match data.")
"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
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
@ -540,8 +541,9 @@ block."
(indent (car (last info)))
result cmd)
(unwind-protect
(org-flet ((call-process-region (&rest args)
(apply 'org-babel-tramp-handle-call-process-region args)))
(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)))))
@ -601,7 +603,7 @@ arguments and pop open the results in a preview buffer."
(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)))))))
(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))))
@ -624,15 +626,15 @@ arguments and pop open the results in a preview buffer."
(number-sequence 1 (1+ l1)))))
(in (lambda (i j) (aref (aref dist i) j)))
(mmin (lambda (&rest lst) (apply #'min (remove nil lst)))))
(setf (aref (aref dist 0) 0) 0)
(dolist (i (number-sequence 1 l1))
(dolist (j (number-sequence 1 l2))
(setf (aref (aref dist i) j)
(+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
(funcall mmin (funcall in (1- i) j)
(funcall in i (1- j))
(funcall in (1- i) (1- j)))))))
(funcall in l1 l2)))
(setf (aref (aref dist 0) 0) 0)
(dolist (i (number-sequence 1 l1))
(dolist (j (number-sequence 1 l2))
(setf (aref (aref dist i) j)
(+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
(funcall mmin (funcall in (1- i) j)
(funcall in i (1- j))
(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."
@ -659,13 +661,13 @@ arguments and pop open the results in a preview buffer."
(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-babel-clean-text-properties
(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\""
(error "Supplied header \"%S\" is suspiciously close to \"%S\""
header name))))
(message "No suspicious header arguments found.")))
@ -679,10 +681,10 @@ arguments and pop open the results in a preview buffer."
org-babel-common-header-args-w-values
(if (boundp lang-headers) (eval lang-headers) nil)))
(arg (org-icompleting-read
"Header Arg: "
(mapcar
(lambda (header-spec) (symbol-name (car header-spec)))
headers))))
"Header Arg: "
(mapcar
(lambda (header-spec) (symbol-name (car header-spec)))
headers))))
(insert ":" arg)
(let ((vals (cdr (assoc (intern arg) headers))))
(when vals
@ -755,7 +757,7 @@ session."
"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."
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))
@ -782,7 +784,7 @@ the session. Copy the body of the code block to the kill ring."
;;;###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
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")
@ -803,10 +805,10 @@ with a prefix argument then this is passed on to
(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)))
(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.
@ -1023,11 +1025,11 @@ the current subtree."
(setf (nth 2 info)
(sort (copy-sequence (nth 2 info))
(lambda (a b) (string< (car a) (car b)))))
(org-labels ((rm (lst)
(let* ((rm (lambda (lst)
(dolist (p '("replace" "silent" "append" "prepend"))
(setq lst (remove p lst)))
lst)
(norm (arg)
lst))
(norm (lambda (arg)
(let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
(copy-sequence (cdr arg))
(cdr arg))))
@ -1037,19 +1039,19 @@ the current subtree."
(cond
((and (listp v) ; lists are sorted
(member (car arg) '(:result-params)))
(sort (rm v) #'string<))
(sort (funcall rm v) #'string<))
((and (stringp v) ; strings are sorted
(member (car arg) '(:results :exports)))
(mapconcat #'identity (sort (rm (split-string v))
(mapconcat #'identity (sort (funcall rm (split-string v))
#'string<) " "))
(t v))))))
(t v)))))))
((lambda (hash)
(when (org-called-interactively-p 'interactive) (message hash)) hash)
(let ((it (format "%s-%s"
(mapconcat
#'identity
(delq nil (mapcar (lambda (arg)
(let ((normalized (norm arg)))
(let ((normalized (funcall norm arg)))
(when normalized
(format "%S" normalized))))
(nth 2 info))) ":")
@ -1059,7 +1061,7 @@ the current subtree."
(defun org-babel-current-result-hash ()
"Return the current in-buffer hash."
(org-babel-where-is-src-block-result)
(org-babel-clean-text-properties (match-string 3)))
(org-no-properties (match-string 3)))
(defun org-babel-set-current-result-hash (hash)
"Set the current in-buffer hash to HASH."
@ -1221,10 +1223,10 @@ may be specified in the properties of the current outline entry."
(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-babel-clean-text-properties (match-string 2)))
(lang (org-no-properties (match-string 2)))
(lang-headers (intern (concat "org-babel-default-header-args:" lang)))
(switches (match-string 3))
(body (org-babel-clean-text-properties
(body (org-no-properties
(let* ((body (match-string 5))
(sub-length (- (length body) 1)))
(if (and (> sub-length 0)
@ -1246,23 +1248,23 @@ may be specified in the properties of the current outline entry."
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties (or (match-string 4) ""))))
(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-babel-clean-text-properties (match-string 2)))
(let* ((lang (org-no-properties (match-string 2)))
(lang-headers (intern (concat "org-babel-default-header-args:" lang))))
(list lang
(org-babel-strip-protective-commas
(org-babel-clean-text-properties (match-string 5)) lang)
(org-no-properties (match-string 5)) lang)
(org-babel-merge-params
org-babel-default-inline-header-args
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties (or (match-string 4) "")))))))
(org-no-properties (or (match-string 4) "")))))))
(defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS.
@ -1299,15 +1301,15 @@ instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
(defun org-babel-join-splits-near-ch (ch list)
"Join splits where \"=\" is on either end of the split."
(org-flet ((last= (str) (= ch (aref str (1- (length str)))))
(first= (str) (= ch (aref str 0))))
(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 (last= head) (first= el)))
(cons (concat head el) (cdr acc))
(cons el acc))))
list :initial-value nil))))
(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."
@ -1396,20 +1398,20 @@ names."
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. Note: this function removes any hlines in TABLE."
(org-flet ((trans (table) (apply #'mapcar* #'list table)))
(let* ((width (apply 'max
(mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
(table (trans (mapcar (lambda (row)
(if (not (equal row 'hline))
row
(setq row '())
(dotimes (n width)
(setq row (cons 'hline row)))
row))
table))))
(cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
(trans (cdr table)))
(remove 'hline (car table))))))
(let* ((trans (lambda (table) (apply #'mapcar* #'list table)))
(width (apply 'max
(mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
(table (funcall trans (mapcar (lambda (row)
(if (not (equal row 'hline))
row
(setq row '())
(dotimes (n width)
(setq row (cons 'hline row)))
row))
table))))
(cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
(funcall trans (cdr table)))
(remove 'hline (car table)))))
(defun org-babel-put-colnames (table colnames)
"Add COLNAMES to TABLE if they exist."
@ -1513,7 +1515,7 @@ If the point is not on a source block then return nil."
"Go to the beginning of the current code block."
(interactive)
((lambda (head)
(if head (goto-char head) (error "not currently in a code block")))
(if head (goto-char head) (error "Not currently in a code block")))
(org-babel-where-is-src-block-head)))
;;;###autoload
@ -1555,7 +1557,7 @@ If the point is not on a source block then return nil."
(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
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)
@ -1712,7 +1714,7 @@ following the source block."
(beginning-of-line 1)
(looking-at org-babel-lob-one-liner-regexp)))
(inlinep (when (org-babel-get-inline-src-block-matches)
(match-end 0)))
(match-end 0)))
(name (if on-lob-line
(mapconcat #'identity (butlast (org-babel-lob-get-info)) "")
(nth 4 (or info (org-babel-get-src-block-info 'light)))))
@ -1821,7 +1823,7 @@ 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-babel-clean-text-properties (match-string 1))))
(org-no-properties (match-string 1))))
(type (and (string-match org-link-types-re raw)
(match-string 1 raw))))
(cond
@ -1833,17 +1835,13 @@ If the path of the link is a file path it is expanded using
(defun org-babel-format-result (result &optional sep)
"Format RESULT for writing to file."
(org-flet ((echo-res (result)
(if (stringp result) result (format "%S" result))))
(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))
result (list :sep (or sep "\t") :fmt echo-res))
;; scalar result
(echo-res result))))
(funcall echo-res result))))
(defun org-babel-insert-result
(result &optional result-params info hash indent lang)
@ -1893,7 +1891,7 @@ code ---- the results are extracted in the syntax of the source
optional LANG argument."
(if (stringp result)
(progn
(setq result (org-babel-clean-text-properties result))
(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))
@ -1940,12 +1938,12 @@ code ---- the results are extracted in the syntax of the source
((member "prepend" result-params)))) ; already there
(setq results-switches
(if results-switches (concat " " results-switches) ""))
(org-flet ((wrap (start finish)
(goto-char end) (insert (concat finish "\n"))
(goto-char beg) (insert (concat start "\n"))
(goto-char end) (goto-char (point-at-eol))
(setq end (point-marker)))
(proper-list-p (it) (and (listp it) (null (cdr (last it))))))
(let ((wrap (lambda (start finish)
(goto-char end) (insert (concat finish "\n"))
(goto-char beg) (insert (concat start "\n"))
(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
@ -1962,7 +1960,7 @@ code ---- the results are extracted in the syntax of the source
'(:splicep nil :istart "- " :iend "\n")))
"\n"))
;; assume the result is a table if it's not a string
((proper-list-p result)
((funcall proper-list-p result)
(goto-char beg)
(insert (concat (orgtbl-to-orgtbl
(if (or (eq 'hline (car result))
@ -1971,33 +1969,33 @@ code ---- the results are extracted in the syntax of the source
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 (proper-list-p result)))
((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 (proper-list-p result) (goto-char (org-table-end)))
(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")))
(wrap (concat "#+BEGIN_" name) (concat "#+END_" name))))
(funcall wrap (concat "#+BEGIN_" name) (concat "#+END_" name))))
((member "html" result-params)
(wrap "#+BEGIN_HTML" "#+END_HTML"))
(funcall wrap "#+BEGIN_HTML" "#+END_HTML"))
((member "latex" result-params)
(wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
(funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
((member "code" result-params)
(wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
"#+END_SRC"))
(funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
"#+END_SRC"))
((member "org" result-params)
(wrap "#+BEGIN_ORG" "#+END_ORG"))
(funcall wrap "#+BEGIN_ORG" "#+END_ORG"))
((member "raw" result-params)
(goto-char beg) (if (org-at-table-p) (org-cycle)))
((member "wrap" result-params)
(wrap ":RESULTS:" ":END:"))
((and (not (proper-list-p result))
(funcall wrap ":RESULTS:" ":END:"))
((and (not (funcall proper-list-p result))
(not (member "file" result-params)))
(org-babel-examplize-region beg end results-switches)
(setq end (point)))))
@ -2065,12 +2063,12 @@ file's directory then expand relative links."
(defun org-babel-examplize-region (beg end &optional results-switches)
"Comment out region using the inline '==' or ': ' org example quote."
(interactive "*r")
(org-flet ((chars-between (b e)
(not (string-match "^[\\s]*$" (buffer-substring b e))))
(maybe-cap (str) (if org-babel-capitalize-examplize-region-markers
(upcase str) str)))
(if (or (chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
(chars-between end (save-excursion (goto-char end) (point-at-eol))))
(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 "=%s=" (prog1 (buffer-substring beg end)
@ -2086,16 +2084,16 @@ file's directory then expand relative links."
(goto-char beg)
(insert (if results-switches
(format "%s%s\n"
(maybe-cap "#+begin_example")
(funcall maybe-cap "#+begin_example")
results-switches)
(maybe-cap "#+begin_example\n")))
(funcall maybe-cap "#+begin_example\n")))
(if (markerp end) (goto-char end) (forward-char (- end beg)))
(insert (maybe-cap "#+end_example\n")))))))))
(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 source block")
(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)))
@ -2105,107 +2103,108 @@ file's directory then expand relative links."
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)
params results exports tangle noweb cache vars shebang comments padline)
(org-flet ((e-merge (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)))
(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))
(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))
(prog1 (setf (cddr (nth variable-index vars))
(concat (symbol-name
(car (nth variable-index vars)))
"=" (cdr pair)))
(incf variable-index))
(error "variable \"%s\" must be assigned a default value"
(cdr pair))))))
(:results
(setq results (e-merge results-exclusive-groups
results
(split-string
(let ((r (cdr pair)))
(if (stringp r) r (eval r)))))))
(:file
(when (cdr pair)
(setq results (e-merge results-exclusive-groups
results '("file")))
(unless (or (member "both" exports)
(member "none" exports)
(member "code" exports))
(setq exports (e-merge exports-exclusive-groups
exports '("results"))))
(setq params (cons pair (assq-delete-all (car pair) params)))))
(:exports
(setq exports (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 (e-merge
'(("yes" "no" "tangle" "no-export"
"strip-export" "eval"))
noweb
(split-string (or (cdr pair) "")))))
(:cache
(setq cache (e-merge '(("yes" "no")) cache
(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)
(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))
(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))
(prog1 (setf (cddr (nth variable-index vars))
(concat (symbol-name
(car (nth variable-index vars)))
"=" (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) "")))))
(:padline
(setq padline (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 (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))
(: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)))
(mapc
@ -2225,16 +2224,17 @@ 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."
(org-labels ((intersect (as bs)
(when as
(if (member (car as) bs)
(car as)
(intersect (cdr as) bs)))))
(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)) "")))))
(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.
@ -2273,101 +2273,97 @@ block but are passed literally to the \"example-block\"."
(comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
(rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
":noweb-ref[ \t]+" "\\)"))
(new-body "") index source-name evaluate prefix blocks-in-buffer)
(org-flet ((nb-add (text) (setq new-body (concat new-body text)))
(c-wrap (text)
(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)))))
(with-temp-buffer
(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))
(nb-add (buffer-substring index (point)))
(goto-char (match-end 0))
(setq index (point))
(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
((lambda (cs)
(concat (c-wrap (car cs)) "\n"
body "\n"
(c-wrap (cadr cs))))
(org-babel-tangle-comment-links i))
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
((lambda (cs)
(concat (c-wrap (car cs)) "\n"
body "\n"
(c-wrap (cadr cs))))
(org-babel-tangle-comment-links i))
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))))))
(nb-add (buffer-substring index (point-max)))))
index source-name evaluate prefix blocks-in-buffer)
(with-temp-buffer
(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
((lambda (cs)
(concat (funcall c-wrap (car cs)) "\n"
body "\n"
(funcall c-wrap (cadr cs))))
(org-babel-tangle-comment-links i))
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
((lambda (cs)
(concat (funcall c-wrap (car cs)) "\n"
body "\n"
(funcall c-wrap (cadr cs))))
(org-babel-tangle-comment-links i))
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-clean-text-properties (text)
"Strip all properties from text return."
(when text
(set-text-properties 0 (length text) nil text) text))
(defun org-babel-strip-protective-commas (body &optional lang)
"Strip protective commas from bodies of source blocks."
(with-temp-buffer
@ -2464,7 +2460,7 @@ If the table is trivial, then return it as a scalar."
(setq result (mapcar (lambda (row)
(mapcar #'org-babel-string-read row))
(org-table-to-lisp))))
(error (message "error reading results: %s" err) nil)))
(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)))
@ -2505,7 +2501,7 @@ of the string."
(defvar org-babel-org-babel-call-process-region-original nil)
(defun org-babel-tramp-handle-call-process-region
(start end program &optional delete buffer display &rest args)
"Use tramp to handle call-process-region.
"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 "")))
@ -2517,7 +2513,7 @@ Fixes a bug in `tramp-handle-call-process-region'."
(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
;; 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)))
@ -2527,17 +2523,16 @@ Fixes a bug in `tramp-handle-call-process-region'."
(if (file-remote-p file)
(let (localname)
(with-parsed-tramp-file-name file nil
localname))
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'"
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'"
((lambda (f) (if no-quote-p f (shell-quote-argument f)))
(expand-file-name (org-babel-local-file-name name))))

580
lisp/org-agenda.el
View File

@ -29,15 +29,15 @@
;; 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
;; 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:
;; 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
;; 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
;; 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.
@ -46,6 +46,7 @@
;;; Code:
(require 'org)
(require 'org-macs)
(eval-when-compile
(require 'cl))
@ -80,6 +81,8 @@
(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))
(defvar calendar-mode-map)
(defvar org-clock-current-task) ; defined in org-clock.el
@ -128,9 +131,9 @@ addresses the separator between the current and the previous block."
(string)))
(defgroup org-agenda-export nil
"Options concerning exporting agenda views in Org-mode."
:tag "Org Agenda Export"
:group 'org-agenda)
"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."
@ -229,9 +232,9 @@ you can \"misuse\" it to also add other text to the header. However,
:type 'boolean)
(defgroup org-agenda-custom-commands nil
"Options concerning agenda views in Org-mode."
:tag "Org Agenda Custom Commands"
:group 'org-agenda)
"Options concerning agenda views in Org-mode."
:tag "Org Agenda Custom Commands"
:group 'org-agenda)
(defconst org-sorting-choice
'(choice
@ -250,116 +253,116 @@ you can \"misuse\" it to also add other text to the header. However,
;; the new variable `org-agenda-tag-filter-preset'.
(if (fboundp 'defvaralias)
(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
(defvaralias 'org-agenda-filter 'org-agenda-tag-filter))
(defvaralias 'org-agenda-filter 'org-agenda-tag-filter))
(defconst org-agenda-custom-commands-local-options
`(repeat :tag "Local settings for this command. Remember to quote values"
`(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 "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 "Set daily/weekly entry types"
(const org-agenda-entry-types)
(list
(const :format "" quote)
(set :greedy t :value (:deadline :scheduled :timestamp :sexp)
(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)
(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 "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 "Set daily/weekly entry types"
(const org-agenda-entry-types)
(list
(const :format "" quote)
(set :greedy t :value (:deadline :scheduled :timestamp :sexp)
(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
(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)"))))
: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'.")
@ -437,69 +440,69 @@ should provide a description for the prefix, like
: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)))
(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 ")))))
(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.
@ -553,9 +556,9 @@ this one will be used."
(const :tag "equal" "=")))
(defgroup org-agenda-skip nil
"Options concerning skipping parts of agenda files."
:tag "Org Agenda Skip"
:group 'org-agenda)
"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.
@ -639,11 +642,11 @@ 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
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
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.
@ -677,7 +680,7 @@ all Don't show any scheduled entries in the global todo list.
t Same as `all', for backward compatibility.
This variable can also have an integer as a value. See
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'.
@ -718,7 +721,7 @@ 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
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'.
@ -878,12 +881,14 @@ N days, just insert a special line indicating the size of the gap."
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-column display (see `org-agenda-menu-two-column')."
you want to use two-columns display (see `org-agenda-menu-two-columns')."
:group 'org-agenda
:version "24.1"
:type 'boolean)
(defcustom org-agenda-menu-two-column nil
(make-obsolete-variable 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.2")
(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."
@ -994,11 +999,11 @@ option will be ignored."
:type 'boolean)
(defcustom org-agenda-ndays nil
"Number of days to include in overview display.
"Number of days to include in overview display.
Should be 1 or 7.
Obsolete, see `org-agenda-span'."
:group 'org-agenda-daily/weekly
:type 'integer)
:group 'org-agenda-daily/weekly
:type 'integer)
(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
@ -1698,7 +1703,7 @@ determines if it is a foreground or a background color."
(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
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
@ -2039,7 +2044,7 @@ The following commands are available:
(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)))
(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)
@ -2163,7 +2168,7 @@ The following commands are available:
["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)
@ -2185,7 +2190,7 @@ The following commands are available:
["Go To (this window)" org-agenda-switch-to 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]
; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
"--"
("TODO"
["Cycle TODO" org-agenda-todo t]
@ -2208,7 +2213,7 @@ The following commands are available:
["Mark matching regexp" org-agenda-bulk-mark-regexp t]
["Unmark entry" org-agenda-bulk-unmark t]
["Unmark all entries" org-agenda-bulk-unmark-all :active t :keys "C-u s"])
["Act on all marked" org-agenda-bulk-action t]
["Act on all marked" org-agenda-bulk-action t]
"--"
("Tags and Properties"
["Show all Tags" org-agenda-show-tags t]
@ -2542,7 +2547,7 @@ Agenda views are separated by `org-agenda-block-separator'."
(erase-buffer)
(insert (eval-when-compile
(let ((header
"Press key for an agenda command: < Buffer, subtree/region restriction
"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
@ -2633,7 +2638,7 @@ s Search for keywords * Toggle sticky agenda views
prefixes))
;; Check if we should display in two columns
(if org-agenda-menu-two-column
(if org-agenda-menu-two-columns
(progn
(setq n (length lines)
n1 (+ (/ n 2) (mod n 2))
@ -2745,19 +2750,19 @@ s Search for keywords * Toggle sticky agenda views
'(call-interactively 'org-todo-list)))
((eq type 'search)
(org-let2 gprops lprops
'(org-search-view current-prefix-arg match nil)))
'(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)))
'(org-tags-view current-prefix-arg match)))
((eq type 'tags-todo)
(org-let2 gprops lprops
'(org-tags-view '(4) match)))
'(org-tags-view '(4) match)))
((eq type 'todo)
(org-let2 gprops lprops
'(org-todo-list match)))
'(org-todo-list match)))
((fboundp type)
(org-let2 gprops lprops
'(funcall type match)))
@ -3334,6 +3339,7 @@ generating a new one."
(org-set-local 'org-agenda-name name)))
(setq buffer-read-only nil)))
(defvar org-agenda-overriding-columns-format) ; From org-colview.el
(defun org-finalize-agenda ()
"Finishing touch for the agenda buffer, called just before displaying it."
(unless org-agenda-multi
@ -3390,7 +3396,7 @@ generating a new one."
(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")))))))
"The clock is running in this item")))))))
(defun org-agenda-fontify-priorities ()
"Make highest priority lines bold, and lowest italic."
@ -3684,7 +3690,7 @@ 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)
dates dates1 date day day1 day2 ts1 ts2 pos)
(if force-today
(setq dates (list (org-today))))
(save-excursion
@ -3723,7 +3729,7 @@ When EMPTY is non-nil, also include days without any entries."
;;; Agenda Daily/Weekly
(defvar org-agenda-start-day nil ; dynamically scoped parameter
"Start day for the agenda view.
"Start day for the agenda view.
Custom commands can set this variable in the options section.")
(defvar org-starting-day nil) ; local variable in the agenda buffer
(defvar org-agenda-current-span nil
@ -3976,6 +3982,7 @@ given in `org-agenda-start-on-weekday'."
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))
@ -4510,7 +4517,7 @@ that can be put into `org-agenda-skip-function' for the duration of a command."
(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
`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))
@ -4727,7 +4734,7 @@ Needed to avoid empty dates which mess up holiday display."
;;;###autoload
(defun org-diary (&rest args)
"Return diary information from org-files.
"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
@ -5105,7 +5112,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq marker (org-agenda-new-marker beg)
category (org-get-category beg)
org-category-pos (get-text-property beg 'org-category-position)
tags (save-excursion (org-backward-heading-same-level 0) (org-get-tags))
tags (save-excursion (org-backward-heading-same-level 0)
(org-get-tags-at))
todo-state (org-get-todo-state))
(dolist (r (if (stringp result)
@ -5284,8 +5292,8 @@ please use `org-class' instead."
(setq txt (org-agenda-format-item
(cond
(closedp "Closed: ")
(statep (concat "State: (" state ")"))
(t (concat "Clocked: (" clocked ")")))
(statep (concat "State: (" state ")"))
(t (concat "Clocked: (" clocked ")")))
txt category tags timestr)))
(setq priority 100000)
(org-add-props txt props
@ -5369,7 +5377,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
;; 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))
(/ (- ts tlend) 60))
face (or (plist-get pl :gap-face) face))))
(t nil)))
(setq tlend (or te tlend) tlstart (or ts tlstart))
@ -5452,7 +5460,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
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))
org-agenda-repeating-timestamp-show-all))
d2 (org-time-string-to-absolute
(match-string 1) d1 'past show-all
(current-buffer) pos)
@ -5544,8 +5552,8 @@ FRACTION is what fraction of the head-warning time has passed."
mm
(deadline-position-alist
(mapcar (lambda (a) (and (setq mm (get-text-property
0 'org-hd-marker a))
(cons (marker-position mm) a)))
0 'org-hd-marker a))
(cons (marker-position mm) a)))
deadline-results))
d2 diff pos pos1 category org-category-pos tags donep
ee txt head pastschedp todo-state face timestr s habitp show-all
@ -5746,7 +5754,7 @@ The flag is set if the currently compiled format contains a `%e'.")
(when (org-string-match-p (car entry) category)
(if (listp (cadr entry))
(return (cadr entry))
(return (apply 'create-image (cdr entry)))))))
(return (apply 'create-image (cdr entry)))))))
(defun org-agenda-format-item (extra txt &optional category tags dotime
remove-re habitp)
@ -5948,7 +5956,7 @@ The modified list may contain inherited tags, and tags matched by
x))
tags ":")
(if have-i "::" ":"))))))
txt)
txt)
(defun org-downcase-keep-props (s)
(let ((props (text-properties-at 0 s)))
@ -6075,23 +6083,23 @@ HH:MM."
(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)))))
(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.
@ -6432,12 +6440,12 @@ If ERROR is non-nil, throw an error, otherwise just return nil."
(not (one-window-p))
(delete-window)))
(with-current-buffer buf
(bury-buffer)
(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-pre-agenda-window-conf
(set-window-configuration org-pre-agenda-window-conf))))
(set-window-configuration org-pre-agenda-window-conf))))
(org-agenda-Quit))))
(defun org-agenda-exit ()
@ -6522,11 +6530,11 @@ The category is that of the current line."
(defun org-find-top-category (&optional pos)
(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))))))
(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-category nil)
@ -6758,7 +6766,7 @@ If the line does not have an effort defined, return nil."
(defun org-agenda-filter-hide-line (type)
(let (ov)
(setq ov (make-overlay (max (point-min) (1- (point-at-bol)))
(point-at-eol)))
(point-at-eol)))
(overlay-put ov 'invisible t)
(overlay-put ov 'type type)
(if (eq type 'tag)
@ -6774,7 +6782,7 @@ If the line does not have an effort defined, return nil."
(goto-char pos)
(if (< (overlay-start ov) (point-at-eol))
(move-overlay ov (point-at-eol)
(overlay-end ov)))))))
(overlay-end ov)))))))
(defun org-agenda-filter-show-all-tag nil
(mapc 'delete-overlay org-agenda-tag-filter-overlays)
@ -6979,7 +6987,7 @@ SPAN may be `day', `week', `month', `year'."
(if (and (not n) (equal org-agenda-current-span span))
(error "Viewing span is already \"%s\"" span))
(let* ((sd (or (org-get-at-bol 'day)
org-starting-day))
org-starting-day))
(sd (org-agenda-compute-starting-span sd span n))
(org-agenda-overriding-arguments
(or org-agenda-overriding-arguments
@ -7217,7 +7225,7 @@ When called with a prefix argument, include all archive files as well."
'help-echo "Category used in filtering"))
"")
(if (or org-agenda-tag-filter (get 'org-agenda-tag-filter
:preset-filter))
:preset-filter))
'(:eval (org-propertize
(concat " {"
(mapconcat
@ -7347,27 +7355,27 @@ Point is in the buffer where the item originated.")
(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"))
(org-remove-subtree-entries-from-agenda buffer dbeg dend)
(with-current-buffer buffer (delete-region dbeg dend))
(message "Agenda item and source killed"))))
(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"))
(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)
(defun org-agenda-archive-default ()
@ -8194,7 +8202,7 @@ ARG is passed through to `org-deadline'."
(goto-char pos)
(setq ts (org-deadline arg time)))
(org-agenda-show-new-time marker ts "D"))
(message "Deadline for this item set to %s" ts)))
(message "Deadline for this item set to %s" ts)))
(defun org-agenda-action ()
"Select entry for agenda action, or execute an agenda action.
@ -8407,12 +8415,12 @@ the resulting entry will not be shown. When TEXT is empty, switch to
(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)))))
(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)
@ -8564,14 +8572,14 @@ the cursor position."
;; 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))))
(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."
@ -8718,11 +8726,11 @@ This is a command that has to be installed in `calendar-mode-map'."
(t (message "No entry to unmark here")))))
(defun org-agenda-bulk-toggle ()
"Toggle marking the entry at point for bulk action."
(interactive)
(if (org-agenda-bulk-marked-p)
(org-agenda-bulk-unmark)
(org-agenda-bulk-mark)))
"Toggle marking the entry 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.

16
lisp/org-archive.el
View File

@ -101,14 +101,14 @@ 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)))
(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."

94
lisp/org-ascii.el
View File

@ -146,7 +146,7 @@ command to convert it."
(save-window-excursion
(if (derived-mode-p 'org-mode)
(setq ascii (org-export-region-as-ascii
beg end t 'string))
beg end t 'string))
(setq reg (buffer-substring beg end)
buf (get-buffer-create "*Org tmp*"))
(with-current-buffer buf
@ -154,7 +154,7 @@ command to convert it."
(insert reg)
(org-mode)
(setq ascii (org-export-region-as-ascii
(point-min) (point-max) t 'string)))
(point-min) (point-max) t 'string)))
(kill-buffer buf)))
(delete-region beg end)
(insert ascii)))
@ -193,7 +193,7 @@ in a window. A non-interactive call will only return the buffer."
;;;###autoload
(defun org-export-as-ascii (arg &optional hidden ext-plist
to-buffer body-only pub-dir)
to-buffer body-only pub-dir)
"Export the outline as a pretty ASCII file.
If there is an active region, export only the region.
The prefix ARG specifies how many levels of the outline should become
@ -373,54 +373,54 @@ publishing directory."
(push (concat (make-string (string-width (nth 3 lang-words)) ?=)
"\n") thetoc)
(mapc #'(lambda (line)
(if (string-match org-todo-line-regexp
line)
;; This is a headline
(progn
(setq have-headings t)
(setq level (- (match-end 1) (match-beginning 1)
level-offset)
level (org-tr-level level)
txt (match-string 3 line)
todo
(or (and org-export-mark-todo-in-toc
(match-beginning 2)
(not (member (match-string 2 line)
org-done-keywords)))
(if (string-match org-todo-line-regexp
line)
;; This is a headline
(progn
(setq have-headings t)
(setq level (- (match-end 1) (match-beginning 1)
level-offset)
level (org-tr-level level)
txt (match-string 3 line)
todo
(or (and org-export-mark-todo-in-toc
(match-beginning 2)
(not (member (match-string 2 line)
org-done-keywords)))
; TODO, not DONE
(and org-export-mark-todo-in-toc
(= level umax-toc)
(org-search-todo-below
line lines level))))
(setq txt (org-html-expand-for-ascii txt))
(and org-export-mark-todo-in-toc
(= level umax-toc)
(org-search-todo-below
line lines level))))
(setq txt (org-html-expand-for-ascii txt))
(while (string-match org-bracket-link-regexp txt)
(setq txt
(replace-match
(match-string (if (match-end 2) 3 1) txt)
t t txt)))
(while (string-match org-bracket-link-regexp txt)
(setq txt
(replace-match
(match-string (if (match-end 2) 3 1) txt)
t t txt)))
(if (and (memq org-export-with-tags '(not-in-toc nil))
(string-match
(org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
txt))
(setq txt (replace-match "" t t txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt 1)))
(if (and (memq org-export-with-tags '(not-in-toc nil))
(string-match
(org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
txt))
(setq txt (replace-match "" t t txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt 1)))
(if org-export-with-section-numbers
(setq txt (concat (org-section-number level)
" " txt)))
(if (<= level umax-toc)
(progn
(push
(concat
(make-string
(* (max 0 (- level org-min-level)) 4) ?\ )
(format (if todo "%s (*)\n" "%s\n") txt))
thetoc)
(setq org-last-level level))
))))
(if org-export-with-section-numbers
(setq txt (concat (org-section-number level)
" " txt)))
(if (<= level umax-toc)
(progn
(push
(concat
(make-string
(* (max 0 (- level org-min-level)) 4) ?\ )
(format (if todo "%s (*)\n" "%s\n") txt))
thetoc)
(setq org-last-level level))
))))
lines)
(setq thetoc (if have-headings (nreverse thetoc) nil))))

10
lisp/org-attach.el
View File

@ -162,7 +162,7 @@ i Make children of the current entry inherit its attachment directory.")))
((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)))
(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))
@ -259,9 +259,9 @@ This checks for the existence of a \".git\" directory in that directory."
(shell-command "git add .")
(shell-command "git ls-files --deleted" t)
(mapc #'(lambda (file)
(unless (string= file "")
(shell-command
(concat "git rm \"" file "\""))))
(unless (string= file "")
(shell-command
(concat "git rm \"" file "\""))))
(split-string (buffer-string) "\n"))
(shell-command "git commit -m 'Synchronized attachments'")))))
@ -429,7 +429,7 @@ If IN-EMACS is non-nil, force opening in Emacs."
(file (if (= (length files) 1)
(car files)
(org-icompleting-read "Open attachment: "
(mapcar 'list files) nil t))))
(mapcar 'list files) nil t))))
(org-open-file (expand-file-name file attach-dir) in-emacs)))
(defun org-attach-open-in-emacs ()

2
lisp/org-bbdb.el
View File

@ -109,7 +109,7 @@
(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))
(&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))

22
lisp/org-beamer.el
View File

@ -87,7 +87,7 @@ BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}."
(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.")
"The column widths that should be installed as allowed property values.")
(defconst org-beamer-transitions
"\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC"
@ -118,7 +118,7 @@ These are just a completion help.")
These are the defaults - for user definitions, see
`org-beamer-environments-extra'.
\"normal\" is a special fake environment, which emit the heading as
normal text. It is needed when an environment should be surrounded
normal text. It is needed when an environment should be surrounded
by normal text. Since beamer export converts nodes into environments,
you need to have a node to end the environment.
For example
@ -495,13 +495,13 @@ The effect is that these values will be accessible during export."
(if (and (not (assoc "BEAMER_env" props))
(looking-at ".*?:B_\\(note\\(NH\\)?\\):"))
(push (cons "BEAMER_env" (match-string 1)) props))
(when (org-bound-and-true-p org-beamer-inherited-properties)
(mapc (lambda (p)
(unless (assoc p props)
(let ((v (org-entry-get nil p 'inherit)))
(and v (push (cons p v) props)))))
org-beamer-inherited-properties))
(put-text-property (point-at-bol) (point-at-eol) 'org-props props)))
(when (org-bound-and-true-p org-beamer-inherited-properties)
(mapc (lambda (p)
(unless (assoc p props)
(let ((v (org-entry-get nil p 'inherit)))
(and v (push (cons p v) props)))))
org-beamer-inherited-properties))
(put-text-property (point-at-bol) (point-at-eol) 'org-props props)))
(setq org-export-latex-options-plist
(plist-put org-export-latex-options-plist :tags nil))))))
@ -533,7 +533,7 @@ This function will run in the final LaTeX document."
:group 'org-beamer
:version "24.1"
:type '(string :tag "Outline frame title")
)
)
(defcustom org-beamer-outline-frame-options nil
"Outline frame options appended after \\begin{frame}.
@ -542,7 +542,7 @@ include square brackets."
:group 'org-beamer
:version "24.1"
:type '(string :tag "Outline frame options")
)
)
(defun org-beamer-fix-toc ()
"Fix the table of contents by removing the vspace line."

163
lisp/org-bibtex.el
View File

@ -111,6 +111,7 @@
(require 'bibtex)
(eval-when-compile
(require 'cl))
(require 'org-compat)
(defvar org-bibtex-description nil) ; dynamically scoped from org.el
(defvar org-id-locations)
@ -184,26 +185,26 @@
"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.")
'((: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.")
(: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.")
(: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.")
(: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.")
(: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.")
@ -229,7 +230,7 @@ For example setting to 'BIB_' would allow interoperability with fireforg."
(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
the property. If this value is t, `org-bibtex-check' will ignore
a missing title field."
:group 'org-bibtex
:version "24.1"
@ -247,7 +248,7 @@ not placed in the exported bibtex entry."
(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
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
@ -263,12 +264,12 @@ IDs must be unique."
(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
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
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
@ -277,7 +278,7 @@ not be exported."
(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."
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)))
@ -309,72 +310,72 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
(defun org-bibtex-headline ()
"Return a bibtex entry of the given headline as a string."
(org-labels
((val (key lst) (cdr (assoc key lst)))
(to (string) (intern (concat ":" string)))
(from (key) (substring (symbol-name key) 1))
(flatten (&rest lsts)
(apply #'append (mapcar
(lambda (e)
(if (listp e) (apply #'flatten e) (list e)))
lsts))))
(let ((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)) (val (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))
val))))
(org-entry-properties nil 'standard))
(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 (field)
(let ((value (or (org-bibtex-get (from field))
(and (equal :title field)
(nth 4 (org-heading-components))))))
(when value (cons (from field) value))))
(flatten
(val :required (val (to type) org-bibtex-types))
(val :optional (val (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)))))))
(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))
(error "Field:%s is not known" field))
(save-window-excursion
(let* ((name (substring (symbol-name field) 1))
(buf-name (format "*Bibtex Help %s*" name)))
@ -549,7 +550,7 @@ Headlines are exported using `org-bibtex-export-headline'."
(error (throw 'bib (point)))))))))
(with-temp-file filename
(insert (mapconcat #'identity bibtex-entries "\n")))
(message "Successfully exported %d bibtex entries to %s"
(message "Successfully exported %d BibTeX entries to %s"
(length bibtex-entries) filename) nil))))
(defun org-bibtex-check (&optional optional)
@ -581,7 +582,7 @@ If nonew is t, add data to the headline of the entry at point."
(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))
(error "Type:%s is not known" type))
(if nonew
(org-back-to-heading)
(org-insert-heading)
@ -662,7 +663,7 @@ This uses `bibtex-parse-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"))))
(error "Yanked text does not appear to contain a BibTeX entry"))))
(defun org-bibtex-export-to-kill-ring ()
"Export current headline to kill ring as bibtex entry."

205
lisp/org-capture.el
View File

@ -101,7 +101,7 @@ 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
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
@ -184,11 +184,11 @@ properties are:
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
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
after the new item. Overrides :empty-lines for the
number of lines inserted after.
:clock-in Start the clock in this item.
@ -276,71 +276,71 @@ calendar | %:type %:date"
: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 " :empty-lines) (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 " :kill-buffer) (const t))))))))
(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 " :empty-lines) (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 " :kill-buffer) (const t))))))))
(defcustom org-capture-before-finalize-hook nil
"Hook that is run right before a capture process is finalized.
@ -352,7 +352,7 @@ widened to the entire buffer."
(defcustom org-capture-after-finalize-hook nil
"Hook that is run right after a capture process is finalized.
Suitable for window cleanup"
Suitable for window cleanup."
:group 'org-capture
:version "24.1"
:type 'hook)
@ -430,6 +430,14 @@ for a capture buffer.")
;;; The main commands
;;;###autoload
(defvar org-capture-initial nil)
(defun org-capture-string (string &optional keys)
(interactive "sInitial text: \n")
(let ((org-capture-initial string)
(entry (org-capture-select-template keys)))
(org-capture)))
;;;###autoload
(defun org-capture (&optional goto keys)
"Capture something.
@ -462,9 +470,11 @@ bypassed."
org-capture-link-is-already-stored)
(plist-get org-store-link-plist :annotation)
(ignore-errors (org-store-link nil))))
(initial (and (org-region-active-p)
(buffer-substring (point) (mark))))
(entry (org-capture-select-template keys)))
(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)
@ -703,8 +713,8 @@ already gone. Any prefix argument will be passed to the refile command."
(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
;; 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)))
@ -1289,8 +1299,7 @@ Lisp programs can force the template by setting KEYS to 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))
(remove-text-properties 0 (length initial) '(read-only t) 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))
@ -1334,7 +1343,7 @@ The template may still contain \"%?\" for cursor positioning."
v-a))
(v-n user-full-name)
(v-k (if (marker-buffer org-clock-marker)
(org-substring-no-properties org-clock-heading)))
(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))
@ -1378,15 +1387,7 @@ The template may still contain \"%?\" for cursor positioning."
(error (insert (format "%%![Couldn't insert %s: %s]"
filename error)))))))
;; %() embedded elisp
(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 ((result (org-eval (read (current-buffer)))))
(delete-region template-start (point))
(insert result)))))
(org-capture-expand-embedded-elisp)
;; The current time
(goto-char (point-min))
@ -1454,7 +1455,7 @@ The template may still contain \"%?\" for cursor positioning."
(setq ins (mapconcat 'identity
(org-split-string
ins (org-re "[^[:alnum:]_@#%]+"))
":"))
":"))
(when (string-match "\\S-" ins)
(or (equal (char-before) ?:) (insert ":"))
(insert ins)
@ -1475,7 +1476,7 @@ The template may still contain \"%?\" for cursor positioning."
'(clipboards . 1)
(car clipboards))))))
((equal char "p")
(org-set-property (org-substring-no-properties prompt) nil))
(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))
@ -1520,6 +1521,34 @@ The template may still contain \"%?\" for cursor positioning."
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 ((result (org-eval (read (current-buffer)))))
(delete-region template-start (point))
(insert result))))))
(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'."

574
lisp/org-clock.el
View File

@ -975,18 +975,18 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(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)))))))))))
(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."
@ -1076,7 +1076,7 @@ make this the default behavior.)"
(org-clocking-p)))
ts selected-task target-pos (msg-extra "")
(leftover (and (not org-clock-resolving-clocks)
org-clock-leftover-time)))
org-clock-leftover-time)))
(when (and org-clock-auto-clock-resolution
(or (not interrupting)
@ -1147,9 +1147,9 @@ make this the default behavior.)"
(or interrupting (move-marker org-clock-interrupted-task nil))
(save-excursion
(forward-char) ;; make sure the marker is not at the
;; beginning of the heading, since the
;; user is liking to insert stuff here
;; manually
;; beginning of the heading, since the
;; user is liking to insert stuff here
;; manually
(org-clock-history-push))
(org-clock-set-current)
(cond ((functionp org-clock-in-switch-to-state)
@ -1388,7 +1388,7 @@ line and position cursor in that line."
(if (and (>= (org-get-indentation) ind-last)
(org-at-item-p))
(when (and (>= (org-get-indentation) ind-last)
(org-at-item-p))
(org-at-item-p))
(let ((struct (org-list-struct)))
(goto-char (org-list-get-bottom-point struct)))))
(insert ":END:\n")
@ -1590,7 +1590,7 @@ UPDOWN tells whether to change 'up or 'down."
(interactive)
(when (not (org-clocking-p))
(setq global-mode-string
(delq 'org-mode-line-string 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"))
@ -1995,13 +1995,13 @@ the returned times will be formatted strings."
(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)
((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)
@ -2012,12 +2012,12 @@ the returned times will be formatted strings."
((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.")
(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))
(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))
@ -2031,27 +2031,27 @@ the returned times will be formatted strings."
((memq key '(month thismonth))
(setq d 1 h 0 m 0 d1 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
; 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))
(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))))
(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)))
@ -2107,62 +2107,62 @@ the currently selected interval size."
((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)))))
(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)))))
(defun org-dblock-write:clocktable (params)
"Write the standard clocktable."
@ -2291,196 +2291,196 @@ from the dynamic block definition."
(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))))
(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 (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 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))))
(when block
;; Get the range text for the header
(setq range-text (nth 2 (org-clock-special-range block nil t))))
;; Compute the total time
(setq total-time (apply '+ (mapcar 'cadr tables)))
;; Compute the total time
(setq total-time (apply '+ (mapcar 'cadr tables)))
;; Now we need to output this tsuff
(goto-char ipos)
;; Now we need to output this tsuff
(goto-char ipos)
;; Insert the text *before* the actual table
;; Insert the text *before* the actual table
(insert-before-markers
(or header
;; Format the standard header
(concat
(nth 9 lwords) " ["
(substring
(format-time-string (cdr org-time-stamp-formats))
1 -1)
"]"
(if block (concat ", for " range-text ".") "")
"\n\n")))
;; Insert the narrowing line
(when (and narrow (integerp narrow) (not narrow-cut-p))
(insert-before-markers
(or header
;; Format the standard header
(concat
(nth 9 lwords) " ["
(substring
(format-time-string (cdr org-time-stamp-formats))
1 -1)
"]"
(if block (concat ", for " range-text ".") "")
"\n\n")))
"|" ; 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 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 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-hh:mm-string (or total-time 0))) ; the time
"|\n") ; close line
;; 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-hh:mm-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))
;; 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-hh:mm-string (nth 1 tbl))))) ; the time
(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-hh:mm-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))) ?|)
;; 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-hh:mm-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))
hlc (org-minutes-to-hh:mm-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)
@ -2634,13 +2634,13 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(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))))
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))))
@ -2704,7 +2704,7 @@ The details of what will be saved are regulated by the variable
(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
;; Store clocked task history. Tasks are stored reversed to make
;; reading simpler
(when (and (memq org-clock-persist '(t history))
org-clock-history)

53
lisp/org-colview-xemacs.el
View File

@ -305,10 +305,9 @@ This is the compiled version of the format.")
(and (looking-at "\\(\\**\\)\\(\\* \\)")
(org-get-level-face 2))))
(item (save-match-data
(org-no-properties
(org-remove-tabs
(buffer-substring-no-properties
(point-at-bol) (point-at-eol))))))
(org-remove-tabs
(buffer-substring-no-properties
(point-at-bol) (point-at-eol)))))
(color (if (featurep 'xemacs)
(save-excursion
(beginning-of-line 1)
@ -600,26 +599,26 @@ Where possible, use the standard interface for changing this line."
(setq eval '(org-with-point-at pom (org-edit-headline))))
((equal key "TODO")
(setq eval '(org-with-point-at
pom
(call-interactively 'org-todo))))
pom
(call-interactively 'org-todo))))
((equal key "PRIORITY")
(setq eval '(org-with-point-at pom
(call-interactively 'org-priority))))
(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)))))
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))))
pom
(call-interactively 'org-deadline))))
((equal key "SCHEDULED")
(setq eval '(org-with-point-at
pom
(call-interactively 'org-schedule))))
pom
(call-interactively 'org-schedule))))
(t
(setq allowed (org-property-get-allowed-values pom key 'table))
(if allowed
@ -935,8 +934,8 @@ interactive function `org-columns-new'.
(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))
(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))
@ -1519,7 +1518,7 @@ and tailing newline characters."
(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)
cache maxwidths m p a d fmt)
(cond
((and (boundp 'org-agenda-overriding-columns-format)
org-agenda-overriding-columns-format)
@ -1552,7 +1551,7 @@ and tailing newline characters."
(setq p (org-entry-properties m))
(when (or (not (setq a (assoc org-effort-property p)))
(not (string-match "\\S-" (or (cdr a) ""))))
(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)))
@ -1636,7 +1635,7 @@ This will add overlays to the date lines, to show the summary for each day."
(t "")))
(put-text-property 0 (length lsum) 'face 'bold lsum)
(unless (eq calc 'identity)
(put-text-property 0 (length lsum) 'org-computed t lsum))
(put-text-property 0 (length lsum) 'org-computed t lsum))
(cons prop lsum))))
fmt))
(org-columns-display-here props)
@ -1673,12 +1672,12 @@ This will add overlays to the date lines, to show the summary for each day."
(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))
(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)

115
lisp/org-colview.el
View File

@ -189,15 +189,13 @@ This is the compiled version of the format.")
;; we'll clean it later…
(if (derived-mode-p 'org-mode)
(save-match-data
(org-no-properties
(org-remove-tabs
(buffer-substring-no-properties
(point-at-bol) (point-at-eol)))))
(org-remove-tabs
(buffer-substring-no-properties
(point-at-bol) (point-at-eol))))
;; In agenda, just get the `txt' property
(org-no-properties
(or (org-get-at-bol 'txt)
(buffer-substring
(point) (progn (end-of-line) (point)))))))
(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)
@ -241,20 +239,20 @@ This is the compiled version of the format.")
(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)))
;; 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")))))
@ -305,7 +303,7 @@ for the duration of the command.")
(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-columns-hscoll-title)
(org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local)))
(defun org-columns-hscoll-title ()
@ -443,8 +441,8 @@ Where possible, use the standard interface for changing this line."
(org-edit-headline))))
((equal key "TODO")
(setq eval '(org-with-point-at
pom
(call-interactively 'org-todo))))
pom
(call-interactively 'org-todo))))
((equal key "PRIORITY")
(setq eval '(org-with-point-at pom
(call-interactively 'org-priority))))
@ -666,27 +664,38 @@ around it."
(org-open-link-from-string value arg)))
(defun org-columns-get-format-and-top-level ()
(let (fmt)
(when (condition-case nil (org-back-to-heading) (error nil))
(setq fmt (org-entry-get nil "COLUMNS" t)))
(setq fmt (or fmt org-columns-default-format))
(org-set-local 'org-columns-current-fmt fmt)
(org-columns-compile-format fmt)
(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)))
(let ((fmt (org-columns-get-format)))
(org-columns-goto-top-level)
fmt))
(defun org-columns ()
"Turn on column view on an org-mode file."
(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)))))
(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)
(setq fmt (org-columns-get-format-and-top-level))
(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))
@ -1229,13 +1238,15 @@ PARAMS is a property list of parameters:
: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."
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 (move-marker (make-marker) (point)))
(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)
@ -1265,7 +1276,7 @@ PARAMS is a property list of parameters:
(save-restriction
(widen)
(goto-char (or view-pos (point)))
(org-columns)
(org-columns columns-fmt)
(setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
(setq nfields (length (car tbl)))
(org-columns-quit))))
@ -1352,7 +1363,7 @@ and tailing newline characters."
(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)
cache maxwidths m p a d fmt)
(cond
((and (boundp 'org-agenda-overriding-columns-format)
org-agenda-overriding-columns-format)
@ -1385,7 +1396,7 @@ and tailing newline characters."
(setq p (org-entry-properties m))
(when (or (not (setq a (assoc org-effort-property p)))
(not (string-match "\\S-" (or (cdr a) ""))))
(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)))
@ -1513,12 +1524,12 @@ This will add overlays to the date lines, to show the summary for each day."
(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))
(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)
@ -1536,10 +1547,10 @@ 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 ((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)))))

16
lisp/org-compat.el
View File

@ -111,15 +111,6 @@ any other entries, and any resulting duplicates will be removed entirely."
t)))
;;; cl macros no longer available in the trunk
(defalias 'org-flet (if (org-version-check "24.1.50" "cl" :predicate)
'cl-flet*
'flet))
(defalias 'org-labels (if (org-version-check "24.1.50" "cl" :predicate)
'cl-labels
'labels))
;;;; Emacs/XEmacs compatibility
;; Keys
@ -335,11 +326,6 @@ Works on both Emacs and XEmacs."
string)
(apply 'propertize string properties)))
(defun org-substring-no-properties (string &optional from to)
(if (featurep 'xemacs)
(org-no-properties (substring string (or from 0) to))
(substring-no-properties string from to)))
(defmacro org-find-library-dir (library)
`(file-name-directory (locate-library ,library)))
@ -398,7 +384,7 @@ TIME defaults to the current time."
(save-match-data
(apply 'looking-at args))))
; XEmacs does not have `looking-back'.
; XEmacs does not have `looking-back'.
(if (fboundp 'looking-back)
(defalias 'org-looking-back 'looking-back)
(defun org-looking-back (regexp &optional limit greedy)

10
lisp/org-crypt.el
View File

@ -130,13 +130,13 @@ See `org-crypt-disable-auto-save'."
(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? ")))
(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.
; 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."))
(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.")
(add-hook 'auto-save-hook
@ -222,7 +222,7 @@ See `org-crypt-disable-auto-save'."
;; 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
;; 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

46
lisp/org-ctags.el
View File

@ -26,18 +26,18 @@
;; Synopsis
;; ========
;;
;; Allows org-mode to make use of the Emacs `etags' system. Defines tag
;; Allows org-mode to make use of the Emacs `etags' system. Defines tag
;; destinations in org-mode files as any text between <<double angled
;; brackets>>. 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
;; destinations are found. Plain [[links]] in org mode files which do not have
;; <<matching destinations>> 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
;; 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
;; 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.
;;
@ -82,25 +82,25 @@
;; =====
;;
;; When you click on a link "[[foo]]" and org cannot find a matching "<<foo>>"
;; in the current buffer, the tags facility will take over. The file TAGS in
;; 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
;; "<<foo>>" in any other files. If it does, the matching file will be opened
;; "<<foo>>" in any other files. If it does, the matching file will be opened
;; and the cursor will jump to the position of "<<foo>>" 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:
;; 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
;; 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'.
;; 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 "<M-kp-multiply>") 'pop-tag-mark)
;;
@ -116,8 +116,8 @@
;; 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.
;; 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
@ -126,7 +126,7 @@
;;
;; 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
;; in .emacs. However this can cause a pause of several seconds if ctags has
;; to scan lots of files.
;;
;; (progn
@ -248,7 +248,7 @@ buffer position where the tag is found."
((re-search-backward " \n\\(.*\\),[0-9]+\n")
(list (match-string 1) line pos))
(t ; can't find a file name preceding the matched
; tag??
; tag??
(error "Malformed TAGS file: %s" (buffer-name))))))
(t ; tag not found
nil))))))
@ -412,7 +412,7 @@ asked before creating a new file."
(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
Append a new toplevel heading to the end of the current buffer. The
heading contains NAME surrounded by <<angular brackets>>, thus making
the heading a destination for the tag `NAME'."
(interactive "sTopic: ")
@ -457,12 +457,12 @@ to rebuild (update) the TAGS file."
"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)
(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))
@ -534,7 +534,7 @@ a new topic."
(t
;; New tag
(run-hook-with-args-until-success
'org-open-link-functions tag))))))
'org-open-link-functions tag))))))
(org-ctags-enable)

83
lisp/org-datetree.el
View File

@ -38,6 +38,15 @@ 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.2"
: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.
@ -119,7 +128,7 @@ tree can be found."
(org-datetree-insert-line year month day)))))
(defun org-datetree-insert-line (year &optional month day)
(let ((pos (point)))
(let ((pos (point)) ts-type)
(skip-chars-backward " \t\n")
(delete-region (point) pos)
(insert "\n" (make-string org-datetree-base-level ?*) " \n")
@ -136,6 +145,10 @@ tree can be found."
(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)
@ -155,42 +168,42 @@ before running this command, even though the command tries to be smart."
(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))
(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))
(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
(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)))))))
;; 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)

16
lisp/org-docbook.el
View File

@ -1018,11 +1018,11 @@ publishing directory."
(t
;; This line either is list item or end a list.
(when (when (get-text-property 0 'list-item line)
(setq line (org-export-docbook-list-line
line
(get-text-property 0 'list-item line)
(get-text-property 0 'list-struct line)
(get-text-property 0 'list-prevs line)))))
(setq line (org-export-docbook-list-line
line
(get-text-property 0 'list-item line)
(get-text-property 0 'list-struct line)
(get-text-property 0 'list-prevs line)))))
;; Empty lines start a new paragraph. If hand-formatted lists
;; are not fully interpreted, lines starting with "-", "+", "*"
@ -1066,7 +1066,7 @@ publishing directory."
(if (eq major-mode (default-value 'major-mode))
(nxml-mode)))
;; Remove empty paragraphs. Replace them with a newline.
;; Remove empty paragraphs. Replace them with a newline.
(goto-char (point-min))
(while (re-search-forward
"[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t)
@ -1355,10 +1355,10 @@ that need to be preserved in later phase of DocBook exporting."
(concat replaced line)))
(defun org-export-docbook-list-line (line pos struct prevs)
"Insert list syntax in export buffer. Return LINE, maybe modified.
"Insert list syntax in export buffer. Return LINE, maybe modified.
POS is the item position or line position the line had before
modifications to buffer. STRUCT is the list structure. PREVS is
modifications to buffer. STRUCT is the list structure. PREVS is
the alist of previous items."
(let* ((get-type
(function

94
lisp/org-element.el
View File

@ -123,23 +123,36 @@
;; process.
(defconst org-element-paragraph-separate
(concat "^[ \t]*$" "\\|"
;; Headlines and inlinetasks.
org-outline-regexp-bol "\\|"
;; Comments, blocks (any type), keywords and babel calls.
"^[ \t]*#\\+" "\\|" "^#\\(?: \\|$\\)" "\\|"
;; Lists.
(org-item-beginning-re) "\\|"
;; Fixed-width, drawers (any type) and tables.
"^[ \t]*[:|]" "\\|"
;; Footnote definitions.
org-footnote-definition-re "\\|"
;; Horizontal rules.
"^[ \t]*-\\{5,\\}[ \t]*$" "\\|"
;; LaTeX environments.
"^[ \t]*\\\\\\(begin\\|end\\)" "\\|"
;; Planning and Clock lines.
org-planning-or-clock-line-re)
(concat "^\\(?:"
;; Headlines, inlinetasks.
org-outline-regexp "\\|"
;; Footnote definitions.
"\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
"[ \t]*\\(?:"
;; Empty lines.
"$" "\\|"
;; Comments, blocks (any type), keywords, Babel calls,
;; drawers (any type) and tables.
"[|#]" "\\|"
;; Fixed width areas.
":\\(?:[ \t]\\|$\\)" "\\|"
;; Horizontal rules.
"-\\{5,\\}[ \t]*$" "\\|"
;; LaTeX environments.
"\\\\\\(begin\\|end\\)" "\\|"
;; 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
(t "[.)]") (?\) ")") (?. "\\.") (otherwise "[.)]")))
(alpha (and org-alphabetical-lists "\\|[A-Za-z]")))
(concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
"\\(?:[ \t]\\|$\\)"))
"\\)\\)")
"Regexp to separate paragraphs in an Org buffer.")
(defconst org-element-all-elements
@ -2139,7 +2152,7 @@ CONTENTS is verse block contents."
;;
;; 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'
;; 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
@ -2197,8 +2210,6 @@ CONTENTS is the contents of the object."
LIMIT bounds the search.
LIMIT bounds the search.
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."
@ -2848,8 +2859,8 @@ LIMIT bounds the search.
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 limit t)
(cons 'radio-target (match-beginning 0)))))
(when (re-search-forward org-radio-target-regexp limit t)
(cons 'radio-target (match-beginning 0)))))
;;;; Statistics Cookie
@ -3081,8 +3092,8 @@ LIMIT bounds the search.
Return value is a cons cell whose CAR is `target' and CDR is
beginning position."
(save-excursion
(when (re-search-forward org-target-regexp limit t)
(cons 'target (match-beginning 0)))))
(when (re-search-forward org-target-regexp limit t)
(cons 'target (match-beginning 0)))))
;;;; Timestamp
@ -3800,7 +3811,7 @@ OBJECTS is the previous candidates alist."
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
Optional argument PARENT is used for recursive calls. It contains
the element or object containing data, or nil.
Return Org syntax as a string."
@ -4103,8 +4114,9 @@ first element of current section."
;; return that element instead.
(and (= cend origin)
(memq type
'(center-block drawer dynamic-block inlinetask
quote-block special-block))))
'(center-block
drawer dynamic-block inlinetask item
plain-list quote-block special-block))))
(throw 'exit (if keep-trail trail element))
(setq parent element)
(case type
@ -4253,21 +4265,19 @@ end of ELEM-A."
(org-indent-to-column ind-B))
(insert body-A)
;; Restore ex ELEM-A overlays.
(mapc (lambda (ov)
(move-overlay
(car ov)
(+ (nth 1 ov) (- beg-B beg-A))
(+ (nth 2 ov) (- beg-B beg-A))))
(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) (- beg-A beg-B))
(+ (nth 2 ov) (- beg-A beg-B))))
(cdr 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)))))

38
lisp/org-entities.el
View File

@ -502,25 +502,25 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
(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")))
(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)))

18
lisp/org-eshell.el
View File

@ -37,18 +37,18 @@
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 (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)))
(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

110
lisp/org-exp-blocks.el
View File

@ -199,7 +199,7 @@ which defaults to the value of `org-export-blocks-witheld'."
(decf balanced)
(incf balanced)))
(when (not (zerop balanced))
(error "unbalanced begin/end_%s blocks with %S"
(error "Unbalanced begin/end_%s blocks with %S"
type (buffer-substring match-start (point))))
(setq match-end (copy-marker (match-end 0)))
(unless preserve-indent
@ -243,14 +243,14 @@ which defaults to the value of `org-export-blocks-witheld'."
;;--------------------------------------------------------------------------------
;; ditaa: create images from ASCII art using the ditaa utility
(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")))))))
"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)
@ -283,29 +283,29 @@ passed to the ditaa utility as command line arguments."
(org-split-string body "\n")
"\n")))
(prog1
(cond
((member org-export-current-backend '(html latex docbook))
(unless (file-exists-p out-file)
(mapc ;; remove old hashed versions of this file
(lambda (file)
(when (and (string-match (concat (regexp-quote (car out-file-parts))
"_\\([[:alnum:]]+\\)\\."
(regexp-quote (cdr out-file-parts)))
file)
(= (length (match-string 1 out-file)) 40))
(delete-file (expand-file-name file
(file-name-directory out-file)))))
(directory-files (or (file-name-directory out-file)
default-directory)))
(with-temp-file data-file (insert body))
(message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
(shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
(format "\n[[file:%s]]\n" out-file))
(t (concat
"\n#+BEGIN_EXAMPLE\n"
body (if (string-match "\n$" body) "" "\n")
"#+END_EXAMPLE\n")))
(message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
(cond
((member org-export-current-backend '(html latex docbook))
(unless (file-exists-p out-file)
(mapc ;; remove old hashed versions of this file
(lambda (file)
(when (and (string-match (concat (regexp-quote (car out-file-parts))
"_\\([[:alnum:]]+\\)\\."
(regexp-quote (cdr out-file-parts)))
file)
(= (length (match-string 1 out-file)) 40))
(delete-file (expand-file-name file
(file-name-directory out-file)))))
(directory-files (or (file-name-directory out-file)
default-directory)))
(with-temp-file data-file (insert body))
(message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
(shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
(format "\n[[file:%s]]\n" out-file))
(t (concat
"\n#+BEGIN_EXAMPLE\n"
body (if (string-match "\n$" body) "" "\n")
"#+END_EXAMPLE\n")))
(message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
;;--------------------------------------------------------------------------------
;; dot: create graphs using the dot graphing language
@ -342,29 +342,29 @@ digraph data_relationships {
(cons raw-out-file "png")))
(out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
(prog1
(cond
((member org-export-current-backend '(html latex docbook))
(unless (file-exists-p out-file)
(mapc ;; remove old hashed versions of this file
(lambda (file)
(when (and (string-match (concat (regexp-quote (car out-file-parts))
"_\\([[:alnum:]]+\\)\\."
(regexp-quote (cdr out-file-parts)))
file)
(= (length (match-string 1 out-file)) 40))
(delete-file (expand-file-name file
(file-name-directory out-file)))))
(directory-files (or (file-name-directory out-file)
default-directory)))
(with-temp-file data-file (insert body))
(message (concat "dot " data-file " " args " -o " out-file))
(shell-command (concat "dot " data-file " " args " -o " out-file)))
(format "\n[[file:%s]]\n" out-file))
(t (concat
"\n#+BEGIN_EXAMPLE\n"
body (if (string-match "\n$" body) "" "\n")
"#+END_EXAMPLE\n")))
(message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
(cond
((member org-export-current-backend '(html latex docbook))
(unless (file-exists-p out-file)
(mapc ;; remove old hashed versions of this file
(lambda (file)
(when (and (string-match (concat (regexp-quote (car out-file-parts))
"_\\([[:alnum:]]+\\)\\."
(regexp-quote (cdr out-file-parts)))
file)
(= (length (match-string 1 out-file)) 40))
(delete-file (expand-file-name file
(file-name-directory out-file)))))
(directory-files (or (file-name-directory out-file)
default-directory)))
(with-temp-file data-file (insert body))
(message (concat "dot " data-file " " args " -o " out-file))
(shell-command (concat "dot " data-file " " args " -o " out-file)))
(format "\n[[file:%s]]\n" out-file))
(t (concat
"\n#+BEGIN_EXAMPLE\n"
body (if (string-match "\n$" body) "" "\n")
"#+END_EXAMPLE\n")))
(message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
;;--------------------------------------------------------------------------------
;; comment: export comments in author-specific css-stylable divs

146
lisp/org-exp.el
View File

@ -641,7 +641,7 @@ table.el tables."
(defvar org-export-current-backend nil
"During export, this will be bound to a symbol such as 'html,
'latex, 'docbook, 'ascii, etc, indicating which of the export
backends is in use. Otherwise it has the value nil. Users
backends is in use. Otherwise it has the value nil. Users
should not attempt to change the value of this variable
directly, but it can be used in code to test whether export is
in progress, and if so, what the backend is.")
@ -720,7 +720,7 @@ Each element is a list of 3 items:
2. The string that can be used in the OPTION lines to set this option,
or nil if this option cannot be changed in this way
3. The customization variable that sets the default for this option."
)
)
(defun org-default-export-plist ()
"Return the property list with default settings for the export variables."
@ -1202,7 +1202,7 @@ on this string to produce the exported version."
(when (plist-get parameters :footnotes)
(org-footnote-normalize nil parameters))
;; Change lists ending. Other parts of export may insert blank
;; Change lists ending. Other parts of export may insert blank
;; lines and lists' structure could be altered.
(org-export-mark-list-end)
@ -1424,53 +1424,53 @@ the current file."
(goto-char (point-min))
(while (re-search-forward org-bracket-link-regexp nil t)
(org-if-unprotected-at (1+ (match-beginning 0))
(let* ((org-link-search-must-match-exact-headline t)
(md (match-data))
(desc (match-end 2))
(link (org-link-unescape (match-string 1)))
(slink (org-solidify-link-text link))
found props pos cref
(target
(cond
((= (string-to-char link) ?#)
;; user wants exactly this link
link)
((cdr (assoc slink target-alist))
(or (cdr (assoc (assoc slink target-alist)
org-export-preferred-target-alist))
(cdr (assoc slink target-alist))))
((and (string-match "^id:" link)
(cdr (assoc (substring link 3) target-alist))))
((string-match "^(\\(.*\\))$" link)
(setq cref (match-string 1 link))
(concat "coderef:" cref))
((string-match org-link-types-re link) nil)
((or (file-name-absolute-p link)
(string-match "^\\." link))
nil)
(t
(let ((org-link-search-inhibit-query t))
(save-excursion
(setq found (condition-case nil (org-link-search link)
(error nil)))
(when (and found
(or (org-at-heading-p)
(not (eq found 'dedicated))))
(or (get-text-property (point) 'target)
(get-text-property
(max (point-min)
(1- (or (previous-single-property-change
(point) 'target) 0)))
'target)))))))))
(when target
(set-match-data md)
(goto-char (match-beginning 1))
(setq props (text-properties-at (point)))
(delete-region (match-beginning 1) (match-end 1))
(setq pos (point))
(insert target)
(unless desc (insert "][" link))
(add-text-properties pos (point) props))))))
(let* ((org-link-search-must-match-exact-headline t)
(md (match-data))
(desc (match-end 2))
(link (org-link-unescape (match-string 1)))
(slink (org-solidify-link-text link))
found props pos cref
(target
(cond
((= (string-to-char link) ?#)
;; user wants exactly this link
link)
((cdr (assoc slink target-alist))
(or (cdr (assoc (assoc slink target-alist)
org-export-preferred-target-alist))
(cdr (assoc slink target-alist))))
((and (string-match "^id:" link)
(cdr (assoc (substring link 3) target-alist))))
((string-match "^(\\(.*\\))$" link)
(setq cref (match-string 1 link))
(concat "coderef:" cref))
((string-match org-link-types-re link) nil)
((or (file-name-absolute-p link)
(string-match "^\\." link))
nil)
(t
(let ((org-link-search-inhibit-query t))
(save-excursion
(setq found (condition-case nil (org-link-search link)
(error nil)))
(when (and found
(or (org-at-heading-p)
(not (eq found 'dedicated))))
(or (get-text-property (point) 'target)
(get-text-property
(max (point-min)
(1- (or (previous-single-property-change
(point) 'target) 0)))
'target)))))))))
(when target
(set-match-data md)
(goto-char (match-beginning 1))
(setq props (text-properties-at (point)))
(delete-region (match-beginning 1) (match-end 1))
(setq pos (point))
(insert target)
(unless desc (insert "][" link))
(add-text-properties pos (point) props))))))
(defun org-export-remember-html-container-classes ()
"Store the HTML_CONTAINER_CLASS properties in a text property."
@ -1550,8 +1550,8 @@ removed as well."
select-tags "\\|")
"\\):"))
(re-excl (concat ":\\(" (mapconcat 'regexp-quote
exclude-tags "\\|")
"\\):"))
exclude-tags "\\|")
"\\):"))
beg end cont)
(goto-char (point-min))
(when (and select-tags
@ -1612,8 +1612,8 @@ When it is a list of strings, keep only tasks with these TODO keywords."
org-todo-keywords-1))))
"\\|")
"\\)\\($\\|[ \t]\\)"))
(case-fold-search nil)
beg)
(case-fold-search nil)
beg)
(goto-char (point-min))
(while (re-search-forward re nil t)
(org-if-unprotected
@ -1759,7 +1759,7 @@ from the buffer."
(add-text-properties
(point-at-bol) (min (1+ (point-at-eol)) (point-max))
`(org-protected t original-indentation ,ind org-native-text t)))))
;; Delete #+ATTR_BACKEND: stuff of another backend. Those
;; Delete #+ATTR_BACKEND: stuff of another backend. Those
;; matching the current backend will be taken care of by
;; `org-export-attach-captions-and-attributes'
(goto-char (point-min))
@ -1837,9 +1837,9 @@ These special cookies will later be interpreted by the backend."
(replace-match ""))
(unless (bolp) (insert "\n"))
;; As org-list-end is inserted at column 0, it would end
;; by indentation any list. It can be problematic when
;; by indentation any list. It can be problematic when
;; there are lists within lists: the inner list end would
;; also become the outer list end. To avoid this, text
;; also become the outer list end. To avoid this, text
;; property `original-indentation' is added, as
;; `org-list-struct' pays attention to it when reading a
;; list.
@ -1856,7 +1856,7 @@ These special properties will later be interpreted by the backend."
;; Mark a list with 3 properties: `list-item' which is
;; position at beginning of line, `list-struct' which is
;; list structure, and `list-prevs' which is the alist of
;; item and its predecessor. Leave point at list ending.
;; item and its predecessor. Leave point at list ending.
(lambda (ctxt)
(let* ((struct (org-list-struct))
(top (org-list-get-top-point struct))
@ -1884,9 +1884,9 @@ These special properties will later be interpreted by the backend."
'list-struct struct
'list-prevs prevs)))
poi)
;; Take care of bottom point. As babel may have inserted
;; Take care of bottom point. As babel may have inserted
;; a new list in buffer, list ending isn't always
;; marked. Now mark every list ending and add properties
;; marked. Now mark every list ending and add properties
;; useful to line processing exporters.
(goto-char bottom)
(when (or (looking-at "^ORG-LIST-END-MARKER\n")
@ -1896,8 +1896,8 @@ These special properties will later be interpreted by the backend."
(unless (bolp) (insert "\n"))
(insert
(org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom
'list-struct struct
'list-prevs prevs)))
'list-struct struct
'list-prevs prevs)))
;; Following property is used by LaTeX exporter.
(add-text-properties top (point) (list 'list-context ctxt)))))))
;; Mark lists except for backends not interpreting them.
@ -2165,8 +2165,8 @@ can work correctly."
(goto-char (point-min))
(while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
(org-if-unprotected-at (match-beginning 1)
(replace-match "\\1 \\3")
(goto-char (match-beginning 0)))))
(replace-match "\\1 \\3")
(goto-char (match-beginning 0)))))
(defun org-export-concatenate-multiline-emphasis ()
"Find multi-line emphasis and put it all into a single line.
@ -2391,7 +2391,7 @@ TYPE must be a string, any of:
(if (stringp val) val (format "%s" val))
"\n")
(concat "\n" ind-str)))))
;; Eventually do the replacement, if VAL isn't nil. Move
;; Eventually do the replacement, if VAL isn't nil. Move
;; point at beginning of macro for recursive expansions.
(when val
(replace-match val t t)
@ -2508,7 +2508,7 @@ include only those lines."
0)))
(dotimes (level (- (+ parentlevel addlevel) inclevel))
(org-map-region 'org-demote (point-min) (point-max)))))
(buffer-string)))
(buffer-string)))
(defun org-get-and-remove-property (listvar prop)
"Check if the value of LISTVAR contains PROP as a property.
@ -2593,10 +2593,10 @@ in the list) and remove property and value from the list in LISTVAR."
The CODE is marked up in `org-export-current-backend' format.
Check if a function by name
\"org-<backend>-format-source-code-or-example\" is bound. If yes,
use it as the custom formatter. Otherwise, use the default
formatter. Default formatters are provided for docbook, html,
latex and ascii backends. For example, use
\"org-<backend>-format-source-code-or-example\" is bound. If yes,
use it as the custom formatter. Otherwise, use the default
formatter. Default formatters are provided for docbook, html,
latex and ascii backends. For example, use
`org-html-format-source-code-or-example' to provide a custom
formatter for export to \"html\".
@ -2817,7 +2817,7 @@ backend-specific lines pre-pended or appended to the original
source block.
NUMBER is non-nil if the literal example specifies \"+n\" or
\"-n\" switch. If NUMBER is non-nil add line numbers.
\"-n\" switch. If NUMBER is non-nil add line numbers.
CONT is non-nil if the literal example specifies \"+n\" switch.
If CONT is nil, start numbering this block from 1. Otherwise
@ -2867,7 +2867,7 @@ block numbering. When non-nil do the following:
(fm
(cond
((eq org-export-current-backend 'html) (format "<span class=\"linenr\">%s</span>"
fmt))
fmt))
((eq org-export-current-backend 'ascii) fmt)
((eq org-export-current-backend 'latex) fmt)
((eq org-export-current-backend 'docbook) fmt)
@ -2945,7 +2945,7 @@ block numbering. When non-nil do the following:
(setq lv (- (match-end 1) (match-beginning 1))
todo (and (match-beginning 2)
(not (member (match-string 2 line)
org-done-keywords))))
org-done-keywords))))
; TODO, not DONE
(if (<= lv level) (throw 'exit nil))
(if todo (throw 'exit t))))))))

36
lisp/org-faces.el
View File

@ -388,8 +388,8 @@ determines if it is a foreground or a background color."
(cons
(string :tag "Keyword")
(choice :tag "Face "
(string :tag "Color")
(sexp :tag "Face")))))
(string :tag "Color")
(sexp :tag "Face")))))
(defcustom org-priority-faces nil
"Faces for specific Priorities.
@ -405,8 +405,8 @@ determines if it is a foreground or a background color."
(cons
(character :tag "Priority")
(choice :tag "Face "
(string :tag "Color")
(sexp :tag "Face")))))
(string :tag "Color")
(sexp :tag "Face")))))
(defvar org-tags-special-faces-re nil)
(defun org-set-tag-faces (var value)
@ -446,8 +446,8 @@ changes."
(cons
(string :tag "Tag ")
(choice :tag "Face"
(string :tag "Foreground color")
(sexp :tag "Face")))))
(string :tag "Foreground color")
(sexp :tag "Face")))))
(defface org-table ;; originally copied from font-lock-function-name-face
(org-compatible-face nil
@ -556,9 +556,9 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
:version "22.1")
(org-copy-face 'org-block 'org-quote
"Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.")
"Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.")
(org-copy-face 'org-block 'org-verse
"Face for #+BEGIN_VERSE ... #+END_VERSE blocks.")
"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.
@ -581,8 +581,8 @@ content of these blocks will still be treated as Org syntax."
(((class color) (min-colors 8))
(:background "cyan" :foreground "black"))
(t (:inverse-video t))))
"Basic face for displaying the secondary selection."
:group 'org-faces)
"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
@ -609,7 +609,7 @@ content of these blocks will still be treated as Org syntax."
"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)
:weight 'bold)
(defface org-scheduled
(org-compatible-face nil
@ -734,8 +734,8 @@ month and 365.24 days for a year)."
(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
))
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.
@ -745,14 +745,14 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
:group 'org-faces)
(defcustom org-cycle-level-faces t
"Non-nil means level styles cycle after level `org-n-level-faces'.
"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)
:group 'org-appearance
:group 'org-faces
:version "24.1"
:type 'boolean)
(defface org-latex-and-export-specials
(let ((font (cond ((assq :inherit custom-face-attributes)

122
lisp/org-feed.el
View File

@ -100,6 +100,10 @@
(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"
@ -179,34 +183,34 @@ Here are the keyword-value pair allows in `org-feed-alist'.
: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"))
)))))
(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.
@ -225,12 +229,14 @@ 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>"
%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"))
@ -251,7 +257,7 @@ of the file pointed to by the URL."
(const :tag "Externally with wget" wget)
(function :tag "Function")))
(defcustom org-feed-before-adding-hook nil
(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."
@ -450,8 +456,8 @@ Switch to that buffer, and return the position of that headline."
nil t)
(goto-char (match-beginning 0))
(goto-char (point-max))
(insert "\n\n* " heading "\n\n")
(org-back-to-heading t))
(insert "\n\n* " heading "\n\n")
(org-back-to-heading t))
(point))
(defun org-feed-read-previous-status (pos drawer)
@ -506,9 +512,10 @@ This will find DRAWER and extract the alist."
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 fmt tmp indent time name
(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")
@ -527,20 +534,35 @@ If that property is already present, nothing changes."
""))
(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)
(setq name (match-string 1))
(cond
((member name '("h" "t" "T" "u" "U" "a"))
(replace-match (symbol-value (intern (concat "v-" name))) t t))
((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))))))
(replace-match tmp t 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))))))

2
lisp/org-footnote.el
View File

@ -892,7 +892,7 @@ If LABEL is non-nil, delete that footnote instead."
(label (cond
;; LABEL is provided as argument.
(label)
;; Footnote reference at point. If the footnote is
;; Footnote reference at point. If the footnote is
;; anonymous, delete it and exit instead.
((setq x (org-footnote-at-reference-p))
(or (car x)

90
lisp/org-freemind.el
View File

@ -60,7 +60,7 @@
(require 'xml)
(require 'org)
;(require 'rx)
;(require 'rx)
(require 'org-exp)
(eval-when-compile (require 'cl))
@ -139,7 +139,7 @@ NOT READY YET."
;;;###autoload
(defun org-export-as-freemind (&optional hidden ext-plist
to-buffer body-only pub-dir)
to-buffer body-only pub-dir)
"Export the current buffer as a Freemind file.
If there is an active region, export only the region. HIDDEN is
obsolete and does nothing. EXT-PLIST is a property list with
@ -258,22 +258,22 @@ The characters \"&<> will be escaped."
;;(org-freemind-unescape-str-to-org "&#x6d;A&#x224C;B&lt;C&#x3C;&#x3D;")
;;(org-freemind-unescape-str-to-org "&#x3C;&lt;")
(defun org-freemind-unescape-str-to-org (fm-str)
"Do some html-unescaping of FM-STR and return the result.
"Do some html-unescaping of FM-STR and return the result.
This is the opposite of `org-freemind-escape-str-from-org' but it
will also unescape &#nn;."
(let ((org-str fm-str))
(setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
(setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
(setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
(setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
(setq org-str (replace-regexp-in-string
"&#x\\([a-f0-9]\\{2,4\\}\\);"
(lambda (m)
(char-to-string
(+ (string-to-number (match-string 1 m) 16)
0 ;?\x800 ;; What is this for? Encoding?
)))
org-str))))
(let ((org-str fm-str))
(setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
(setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
(setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
(setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
(setq org-str (replace-regexp-in-string
"&#x\\([a-f0-9]\\{2,4\\}\\);"
(lambda (m)
(char-to-string
(+ (string-to-number (match-string 1 m) 16)
0 ;?\x800 ;; What is this for? Encoding?
)))
org-str))))
;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
;; (str2 (org-freemind-escape-str-from-org str1))
@ -291,7 +291,7 @@ MATCHED is the link just matched."
(is-img (and (image-type-from-file-name link)
(let ((url-type (substring link 0 col-pos)))
(member url-type '("file" "http" "https")))))
)
)
(if is-img
;; Fix-me: I can't find a way to get the border to "shrink
;; wrap" around the image using <div>.
@ -380,7 +380,7 @@ MATCHED is the link just matched."
(dolist (cc (append matched nil))
(if (= 32 cc)
;;(setq res (concat res "&nbsp;"))
;; We need to use the numerical version. Otherwise Freemind
;; We need to use the numerical version. Otherwise Freemind
;; ver 0.9.0 RC9 can not export to html/javascript.
(progn
(if (< 0 bi)
@ -410,7 +410,7 @@ MATCHED is the link just matched."
(defcustom org-freemind-node-css-style
"p { margin-top: 3px; margin-bottom: 3px; }"
"CSS style for Freemind nodes."
;; Fix-me: I do not understand this. It worked to export from Freemind
;; Fix-me: I do not understand this. It worked to export from Freemind
;; with this setting now, but not before??? Was this perhaps a java
;; bug or is it a windows xp bug (some resource gets exhausted if you
;; use sticky keys which I do).
@ -466,10 +466,10 @@ DRAWERS-REGEXP are converted to freemind notes."
(if (= 0 (length org-freemind-node-css-style))
""
(concat
"<style type=\"text/css\">\n"
"<!--\n"
"<style type=\"text/css\">\n"
"<!--\n"
org-freemind-node-css-style
"-->\n"
"-->\n"
"</style>\n"))
"</head>\n"
"<body>\n"))
@ -519,12 +519,12 @@ DRAWERS-REGEXP are converted to freemind notes."
(list node-res note-res))))
(defun org-freemind-write-node (mm-buffer drawers-regexp
num-left-nodes base-level
current-level next-level this-m2
this-node-end
this-children-visible
next-node-start
next-has-some-visible-child)
num-left-nodes base-level
current-level next-level this-m2
this-node-end
this-children-visible
next-node-start
next-has-some-visible-child)
(let* (this-icons
this-bg-color
this-m2-escaped
@ -783,15 +783,15 @@ Otherwise give an error say the file exists."
;;; (unless (if node-at-line-last
;;; (>= (point) node-at-line-last)
;;; nil)
;; Write last node:
(setq this-m2 next-m2)
(setq current-level next-level)
(setq next-node-start (if node-at-line-last
(1+ node-at-line-last)
(point-max)))
(setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child))
(with-current-buffer mm-buffer (insert "</node>\n"))
;)
;; Write last node:
(setq this-m2 next-m2)
(setq current-level next-level)
(setq next-node-start (if node-at-line-last
(1+ node-at-line-last)
(point-max)))
(setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child))
(with-current-buffer mm-buffer (insert "</node>\n"))
;)
)
(with-current-buffer mm-buffer
(while (> current-level base-level)
@ -1031,7 +1031,7 @@ PATH should be a list of steps, where each step has the form
(let* ((child-attr-list (cadr child))
(step-attr-copy (copy-sequence step-attr-list)))
(dolist (child-attr child-attr-list)
;; Compare attr names:
;; Compare attr names:
(when (org-freemind-symbols= (caar step-attr-copy) (car child-attr))
;; Compare values:
(let ((step-val (cdar step-attr-copy))
@ -1065,12 +1065,12 @@ PATH should be a list of steps, where each step has the form
(defun org-freemind-test-get-tree-text ()
(let ((node '(p nil "\n"
(a
((href . "link"))
"text")
"\n"
(b nil "hej")
"\n")))
(a
((href . "link"))
"text")
"\n"
(b nil "hej")
"\n")))
(org-freemind-get-tree-text node)))
;; (org-freemind-test-get-tree-text)
@ -1180,7 +1180,7 @@ PATH should be a list of steps, where each step has the form
(org-freemind-node-to-org child (1+ level) skip-levels)))))
;; Fix-me: put back special things, like drawers that are stored in
;; the notes. Should maybe all notes contents be put in drawers?
;; the notes. Should maybe all notes contents be put in drawers?
;;;###autoload
(defun org-freemind-to-org-mode (mm-file org-file)
"Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."

14
lisp/org-gnus.el
View File

@ -101,9 +101,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(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)
"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)
@ -233,9 +233,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(setq group (match-string 1 path)
article (match-string 3 path))
(when group
(setq group (org-substring-no-properties group)))
(setq group (org-no-properties group)))
(when article
(setq article (org-substring-no-properties article)))
(setq article (org-no-properties article)))
(org-gnus-follow-link group article)))
(defun org-gnus-follow-link (&optional group article)
@ -244,9 +244,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(funcall (cdr (assq 'gnus org-link-frame-setup)))
(if gnus-other-frame-object (select-frame gnus-other-frame-object))
(when group
(setq group (org-substring-no-properties group)))
(setq group (org-no-properties group)))
(when article
(setq article (org-substring-no-properties article)))
(setq article (org-no-properties article)))
(cond ((and group article)
(gnus-activate-group group)
(condition-case nil

2
lisp/org-habit.el
View File

@ -67,7 +67,7 @@ relative to the current effective date."
:group 'org-habit
:type 'boolean)
(defcustom org-habit-show-all-today nil
(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

336
lisp/org-html.el
View File

@ -99,7 +99,7 @@ not be modified."
:type 'boolean)
(defconst org-export-html-scripts
"<script type=\"text/javascript\">
"<script type=\"text/javascript\">
<!--/*--><![CDATA[/*><!--*/
function CodeHighlightOn(elem, id)
{
@ -121,10 +121,10 @@ not be modified."
}
/*]]>*///-->
</script>"
"Basic JavaScript that is needed by HTML files produced by Org-mode.")
"Basic JavaScript that is needed by HTML files produced by Org-mode.")
(defconst org-export-html-style-default
"<style type=\"text/css\">
"<style type=\"text/css\">
<!--/*--><![CDATA[/*><!--*/
html { font-family: Times, serif; font-size: 12pt; }
.title { text-align: center; }
@ -255,16 +255,16 @@ You can also customize this for each buffer, using something like
:group 'org-export-html
:version "24.1"
: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))))
(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))))
(defun org-export-html-mathjax-config (template options in-buffer)
"Insert the user setup into the matchjax template."
@ -803,51 +803,51 @@ in a window. A non-interactive call will only return the buffer."
;;; org-html-cvt-link-fn
(defconst org-html-cvt-link-fn
nil
"Function to convert link URLs to exportable URLs.
nil
"Function to convert link URLs to exportable URLs.
Takes two arguments, TYPE and PATH.
Returns exportable url as (TYPE PATH), or nil to signal that it
didn't handle this case.
Intended to be locally bound around a call to `org-export-as-html'." )
(defun org-html-cvt-org-as-html (opt-plist type path)
"Convert an org filename to an equivalent html filename.
"Convert an org filename to an equivalent html filename.
If TYPE is not file, just return `nil'.
See variable `org-export-html-link-org-files-as-html'"
(save-match-data
(and
org-export-html-link-org-files-as-html
(string= type "file")
(string-match "\\.org$" path)
(progn
(list
"file"
(concat
(substring path 0 (match-beginning 0))
"."
(plist-get opt-plist :html-extension)))))))
(save-match-data
(and
org-export-html-link-org-files-as-html
(string= type "file")
(string-match "\\.org$" path)
(progn
(list
"file"
(concat
(substring path 0 (match-beginning 0))
"."
(plist-get opt-plist :html-extension)))))))
;;; org-html-should-inline-p
(defun org-html-should-inline-p (filename descp)
"Return non-nil if link FILENAME should be inlined.
"Return non-nil if link FILENAME should be inlined.
The decision to inline the FILENAME link is based on the current
settings. DESCP is the boolean of whether there was a link
description. See variables `org-export-html-inline-images' and
`org-export-html-inline-image-extensions'."
(declare (special
org-export-html-inline-images
org-export-html-inline-image-extensions))
(and (or (eq t org-export-html-inline-images)
(and org-export-html-inline-images (not descp)))
(org-file-image-p
filename org-export-html-inline-image-extensions)))
(declare (special
org-export-html-inline-images
org-export-html-inline-image-extensions))
(and (or (eq t org-export-html-inline-images)
(and org-export-html-inline-images (not descp)))
(org-file-image-p
filename org-export-html-inline-image-extensions)))
;;; org-html-make-link
(defun org-html-make-link (opt-plist type path fragment desc attr
may-inline-p)
"Make an HTML link.
may-inline-p)
"Make an HTML link.
OPT-PLIST is an options list.
TYPE is the device-type of the link (THIS://foo.html).
PATH is the path of the link (http://THIS#location).
@ -856,80 +856,80 @@ DESC is the link description, if any.
ATTR is a string of other attributes of the \"a\" element.
MAY-INLINE-P allows inlining it as an image."
(declare (special org-par-open))
(save-match-data
(let* ((filename path)
;;First pass. Just sanity stuff.
(components-1
(cond
((string= type "file")
(list
type
;;Substitute just if original path was absolute.
;;(Otherwise path must remain relative)
(if (file-name-absolute-p path)
(concat "file://" (expand-file-name path))
path)))
((string= type "")
(list nil path))
(t (list type path))))
(declare (special org-par-open))
(save-match-data
(let* ((filename path)
;;First pass. Just sanity stuff.
(components-1
(cond
((string= type "file")
(list
type
;;Substitute just if original path was absolute.
;;(Otherwise path must remain relative)
(if (file-name-absolute-p path)
(concat "file://" (expand-file-name path))
path)))
((string= type "")
(list nil path))
(t (list type path))))
;;Second pass. Components converted so they can refer
;;to a remote site.
(components-2
(or
(and org-html-cvt-link-fn
(apply org-html-cvt-link-fn
opt-plist components-1))
(apply #'org-html-cvt-org-as-html
opt-plist components-1)
components-1))
(type (first components-2))
(thefile (second components-2)))
;;Second pass. Components converted so they can refer
;;to a remote site.
(components-2
(or
(and org-html-cvt-link-fn
(apply org-html-cvt-link-fn
opt-plist components-1))
(apply #'org-html-cvt-org-as-html
opt-plist components-1)
components-1))
(type (first components-2))
(thefile (second components-2)))
;;Third pass. Build final link except for leading type
;;spec.
(cond
((or
(not type)
(string= type "http")
(string= type "https")
(string= type "file")
(string= type "coderef"))
(if fragment
(setq thefile (concat thefile "#" fragment))))
;;Third pass. Build final link except for leading type
;;spec.
(cond
((or
(not type)
(string= type "http")
(string= type "https")
(string= type "file")
(string= type "coderef"))
(if fragment
(setq thefile (concat thefile "#" fragment))))
(t))
(t))
;;Final URL-build, for all types.
(setq thefile
;;Final URL-build, for all types.
(setq thefile
(let
((str (org-export-html-format-href thefile)))
((str (org-export-html-format-href thefile)))
(if (and type (not (or (string= "file" type)
(string= "coderef" type))))
(concat type ":" str)
str)))
str)))
(if (and
may-inline-p
;;Can't inline a URL with a fragment.
(not fragment))
(progn
(message "image %s %s" thefile org-par-open)
(org-export-html-format-image thefile org-par-open))
(concat
"<a href=\"" thefile "\"" (if attr (concat " " attr)) ">"
(org-export-html-format-desc desc)
"</a>")))))
(if (and
may-inline-p
;;Can't inline a URL with a fragment.
(not fragment))
(progn
(message "image %s %s" thefile org-par-open)
(org-export-html-format-image thefile org-par-open))
(concat
"<a href=\"" thefile "\"" (if attr (concat " " attr)) ">"
(org-export-html-format-desc desc)
"</a>")))))
(defun org-html-handle-links (org-line opt-plist)
"Return ORG-LINE with markup of Org mode links.
OPT-PLIST is the export options list."
(let ((start 0)
(current-dir (if buffer-file-name
(file-name-directory buffer-file-name)
default-directory))
(file-name-directory buffer-file-name)
default-directory))
(link-validate (plist-get opt-plist :link-validation-function))
type id-file fnc
rpl path attr desc descp desc1 desc2 link)
@ -1395,12 +1395,12 @@ PUB-DIR is set, use this as the publishing directory."
(insert "\n</div>\n"))
(t
(setq html-pre-real-contents
(format-spec
(or (cadr (assoc (nth 0 lang-words)
org-export-html-preamble-format))
(cadr (assoc "en" org-export-html-preamble-format)))
`((?t . ,title) (?a . ,author)
(?d . ,date) (?e . ,email))))))
(format-spec
(or (cadr (assoc (nth 0 lang-words)
org-export-html-preamble-format))
(cadr (assoc "en" org-export-html-preamble-format)))
`((?t . ,title) (?a . ,author)
(?d . ,date) (?e . ,email))))))
;; don't output an empty preamble DIV
(unless (and (functionp html-pre)
(equal html-pre-real-contents ""))
@ -1482,9 +1482,9 @@ PUB-DIR is set, use this as the publishing directory."
;; Check for targets
(while (string-match org-any-target-regexp org-line)
(setq org-line (replace-match
(concat "@<span class=\"target\">"
(match-string 1 org-line) "@</span> ")
t t org-line)))
(concat "@<span class=\"target\">"
(match-string 1 org-line) "@</span> ")
t t org-line)))
(while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
(setq txt (replace-match "" t t txt)))
(setq href
@ -1604,8 +1604,8 @@ PUB-DIR is set, use this as the publishing directory."
(let ((i (org-get-string-indentation org-line)))
(if (> i 0)
(setq org-line (concat (mapconcat 'identity
(make-list (* 2 i) "\\nbsp") "")
" " (org-trim org-line))))
(make-list (* 2 i) "\\nbsp") "")
" " (org-trim org-line))))
(unless (string-match "\\\\\\\\[ \t]*$" org-line)
(setq org-line (concat org-line "\\\\")))))
@ -1618,25 +1618,25 @@ PUB-DIR is set, use this as the publishing directory."
(setq start (match-end 1)))
((match-end 2)
(setq org-line (replace-match
(format
"@<a name=\"%s\" id=\"%s\">@</a>"
(org-solidify-link-text (match-string 1 org-line))
(org-solidify-link-text (match-string 1 org-line)))
t t org-line)))
(format
"@<a name=\"%s\" id=\"%s\">@</a>"
(org-solidify-link-text (match-string 1 org-line))
(org-solidify-link-text (match-string 1 org-line)))
t t org-line)))
((and org-export-with-toc (equal (string-to-char org-line) ?*))
;; FIXME: NOT DEPENDENT on TOC?????????????????????
(setq org-line (replace-match
(concat "@<span class=\"target\">"
(match-string 1 org-line) "@</span> ")
;; (concat "@<i>" (match-string 1 org-line) "@</i> ")
t t org-line)))
(concat "@<span class=\"target\">"
(match-string 1 org-line) "@</span> ")
;; (concat "@<i>" (match-string 1 org-line) "@</i> ")
t t org-line)))
(t
(setq org-line (replace-match
(concat "@<a name=\""
(org-solidify-link-text (match-string 1 org-line))
"\" class=\"target\">" (match-string 1 org-line)
"@</a> ")
t t org-line)))))
(concat "@<a name=\""
(org-solidify-link-text (match-string 1 org-line))
"\" class=\"target\">" (match-string 1 org-line)
"@</a> ")
t t org-line)))))
(setq org-line (org-html-handle-time-stamps org-line))
@ -1744,10 +1744,10 @@ PUB-DIR is set, use this as the publishing directory."
;; This line either is list item or end a list.
(when (get-text-property 0 'list-item org-line)
(setq org-line (org-html-export-list-line
org-line
(get-text-property 0 'list-item org-line)
(get-text-property 0 'list-struct org-line)
(get-text-property 0 'list-prevs org-line))))
org-line
(get-text-property 0 'list-item org-line)
(get-text-property 0 'list-struct org-line)
(get-text-property 0 'list-prevs org-line))))
;; Horizontal line
(when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line)
@ -1773,12 +1773,12 @@ PUB-DIR is set, use this as the publishing directory."
(let ((n (match-string 1 org-line)))
(setq org-par-open t
org-line (replace-match
(format
(concat "<p class=\"footnote\">"
(format org-export-html-footnote-format
(concat
"<a class=\"footnum\" name=\"" footnote-def-prefix ".%s\" href=\"#" footnote-ref-prefix ".%s\">%s</a>")))
n n n) t t org-line)))))
(format
(concat "<p class=\"footnote\">"
(format org-export-html-footnote-format
(concat
"<a class=\"footnum\" name=\"" footnote-def-prefix ".%s\" href=\"#" footnote-ref-prefix ".%s\">%s</a>")))
n n n) t t org-line)))))
;; Check if the line break needs to be conserved
(cond
((string-match "\\\\\\\\[ \t]*$" org-line)
@ -1857,7 +1857,7 @@ PUB-DIR is set, use this as the publishing directory."
(when (plist-get opt-plist :time-stamp-file)
(insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n"))
(when (and (plist-get opt-plist :author-info) author)
(insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n"))
(insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n"))
(when (and (plist-get opt-plist :email-info) email)
(insert "<p class=\"email\">" email "</p>\n"))
(when (plist-get opt-plist :creator-info)
@ -1966,21 +1966,21 @@ PUB-DIR is set, use this as the publishing directory."
(label (org-find-text-property-in-string 'org-label src)))
(setq caption (and caption (org-html-do-expand caption)))
(concat
(if caption
(format "%s<div %sclass=\"figure\">
(if caption
(format "%s<div %sclass=\"figure\">
<p>"
(if org-par-open "</p>\n" "")
(if label (format "id=\"%s\" " (org-solidify-link-text label)) "")))
(format "<img src=\"%s\"%s />"
src
(if (string-match "\\<alt=" (or attr ""))
(concat " " attr )
(concat " " attr " alt=\"" src "\"")))
(if caption
(format "</p>%s
(if org-par-open "</p>\n" "")
(if label (format "id=\"%s\" " (org-solidify-link-text label)) "")))
(format "<img src=\"%s\"%s />"
src
(if (string-match "\\<alt=" (or attr ""))
(concat " " attr )
(concat " " attr " alt=\"" src "\"")))
(if caption
(format "</p>%s
</div>%s"
(concat "\n<p>" caption "</p>")
(if org-par-open "\n<p>" ""))))))))
(concat "\n<p>" caption "</p>")
(if org-par-open "\n<p>" ""))))))))
(defun org-export-html-get-bibliography ()
"Find bibliography, cut it out and return it."
@ -1996,7 +1996,7 @@ PUB-DIR is set, use this as the publishing directory."
(and (looking-at ">") (forward-char 1))
(setq bib (buffer-substring beg (point)))
(delete-region beg (point))
(throw 'exit bib))))
(throw 'exit bib))))
nil))))
(defvar org-table-number-regexp) ; defined in org-table.el
@ -2145,7 +2145,7 @@ for formatting. This is required for the DocBook exporter."
;; DocBook XML file valid.
(push (format "<caption>%s</caption>" (or caption "")) html)
(when label
(setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label)))))
(setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label)))))
(push html-table-tag html))
(setq html (mapcar
(lambda (x)
@ -2183,8 +2183,8 @@ This conversion does *not* use `table-generate-source' from table.el.
This has the advantage that Org-mode's HTML conversions can be used.
But it has the disadvantage, that no cell- or row-spanning is allowed."
(let (org-line field-buffer
(head org-export-highlight-first-table-line)
fields html empty i)
(head org-export-highlight-first-table-line)
fields html empty i)
(setq html (concat html-table-tag "\n"))
(while (setq org-line (pop lines))
(setq empty "&nbsp;")
@ -2365,7 +2365,7 @@ is nil, return nil."
l (match-string 0 string)
string (substring string (match-end 0)))
(push (org-html-do-expand s) res)
(push l res))
(push l res))
(push (org-html-do-expand string) res)
(apply 'concat (nreverse res)))))
@ -2496,22 +2496,22 @@ When TITLE is nil, just close all open levels."
(when title
;; If title is nil, this means this function is called to close
;; all levels, so the rest is done only if title is given
(when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
(setq title (replace-match
(if org-export-with-tags
(save-match-data
(concat
"&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
(mapconcat
(lambda (x)
(format "<span class=\"%s\">%s</span>"
(org-export-html-get-tag-class-name x)
x))
(org-split-string (match-string 1 title) ":")
"&nbsp;")
"</span>"))
"")
t t title)))
(when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
(setq title (replace-match
(if org-export-with-tags
(save-match-data
(concat
"&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
(mapconcat
(lambda (x)
(format "<span class=\"%s\">%s</span>"
(org-export-html-get-tag-class-name x)
x))
(org-split-string (match-string 1 title) ":")
"&nbsp;")
"</span>"))
"")
t t title)))
(if (> level umax)
(progn
(if (aref org-levels-open (1- level))
@ -2581,10 +2581,10 @@ Replaces invalid characters with \"_\" and then prepends a prefix."
(insert "</ul>\n")))
(defun org-html-export-list-line (org-line pos struct prevs)
"Insert list syntax in export buffer. Return ORG-LINE, maybe modified.
"Insert list syntax in export buffer. Return ORG-LINE, maybe modified.
POS is the item position or org-line position the org-line had before
modifications to buffer. STRUCT is the list structure. PREVS is
modifications to buffer. STRUCT is the list structure. PREVS is
the alist of previous items."
(let* ((get-type
(function

14
lisp/org-icalendar.el
View File

@ -360,7 +360,7 @@ When COMBINE is non nil, add the category to each line."
(or (org-id-get) (org-id-new)))
categories (org-export-get-categories)
alarm-time (org-entry-get nil "APPT_WARNTIME")
alarm-time (when alarm-time (string-to-number alarm-time))
alarm-time (if alarm-time (string-to-number alarm-time) 0)
alarm ""
deadlinep nil scheduledp nil)
(if (looking-at re2)
@ -527,7 +527,7 @@ END:VEVENT\n"
due (and (member 'todo-due org-icalendar-use-deadline)
(org-entry-get nil "DEADLINE"))
start (and (member 'todo-start org-icalendar-use-scheduled)
(org-entry-get nil "SCHEDULED"))
(org-entry-get nil "SCHEDULED"))
categories (org-export-get-categories)
uid (if org-icalendar-store-UID
(org-id-get-create)
@ -590,10 +590,10 @@ characters."
(if (not s)
nil
(if is-body
(let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
(re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
(while (string-match re s) (setq s (replace-match "" t t s)))
(while (string-match re2 s) (setq s (replace-match "" t t s))))
(let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
(re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
(while (string-match re s) (setq s (replace-match "" t t s)))
(while (string-match re2 s) (setq s (replace-match "" t t s))))
(setq s (replace-regexp-in-string "[[:space:]]+" " " s)))
(let ((start 0))
(while (string-match "\\([,;]\\)" s start)
@ -682,7 +682,7 @@ a time), or the day by one (if it does not contain a time)."
(replace-regexp-in-string "%Z"
org-icalendar-timezone
org-icalendar-date-time-format)
";VALUE=DATE:%Y%m%d"))
";VALUE=DATE:%Y%m%d"))
(concat keyword (format-time-string fmt time
(and (org-icalendar-use-UTC-date-timep)
have-time))))))

4
lisp/org-id.el
View File

@ -427,7 +427,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(if (symbolp org-id-extra-files)
(symbol-value org-id-extra-files)
org-id-extra-files)
;; Files associated with live org-mode buffers
;; Files associated with live org-mode buffers
(delq nil
(mapcar (lambda (b)
(with-current-buffer b
@ -506,7 +506,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(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."
(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))))

136
lisp/org-indent.el
View File

@ -160,75 +160,75 @@ 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
((org-bound-and-true-p org-inhibit-startup)
(setq org-indent-mode nil))
((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))
(make-local-variable 'filter-buffer-substring-functions)
(add-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
(funcall fun start end delete))))
(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)
(cond
((org-bound-and-true-p org-inhibit-startup)
(setq org-indent-mode nil))
((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))
(make-local-variable 'filter-buffer-substring-functions)
(add-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
(funcall fun start end delete))))
(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)
(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))))
(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...")
(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.")))
@ -420,12 +420,12 @@ This function is meant to be called by `after-change-functions'."
(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))
(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)))))

4
lisp/org-info.el
View File

@ -49,8 +49,8 @@
(when (eq major-mode 'Info-mode)
(let (link desc)
(setq link (concat "info:"
(file-name-nondirectory Info-current-file)
"#" Info-current-node))
(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

144
lisp/org-inlinetask.el
View File

@ -90,7 +90,7 @@
(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
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,
@ -338,75 +338,75 @@ Either remove headline and meta data, or do special formatting."
(end (copy-marker (save-excursion
(org-inlinetask-goto-end) (point))))
content)
;; Delete SCHEDULED, DEADLINE...
(while (re-search-forward keywords-re end t)
(delete-region (point-at-bol) (1+ (point-at-eol))))
(goto-char beg)
;; Delete drawers
(while (re-search-forward org-drawer-regexp end t)
(when (save-excursion (re-search-forward org-property-end-re nil t))
(delete-region beg (1+ (match-end 0)))))
;; Get CONTENT, if any.
(goto-char beg)
(forward-line 1)
(unless (= (point) end)
(setq content (buffer-substring (point)
(save-excursion (goto-char end)
(forward-line -1)
(point)))))
;; Remove the task.
(goto-char beg)
(delete-region beg end)
(when (and org-inlinetask-export
(assq org-export-current-backend
org-inlinetask-export-templates))
;; Format CONTENT, if appropriate.
(setq content
(if (not (and content (string-match "\\S-" content)))
""
;; Ensure CONTENT has minimal indentation, a single
;; newline character at its boundaries, and isn't
;; protected.
(when (string-match "\\`\\([ \t]*\n\\)+" content)
(setq content (substring content (match-end 0))))
(when (string-match "[ \t\n]+\\'" content)
(setq content (substring content 0 (match-beginning 0))))
(org-add-props
(concat "\n\n" (org-remove-indentation content) "\n\n")
'(org-protected nil org-native-text nil))))
;; Delete SCHEDULED, DEADLINE...
(while (re-search-forward keywords-re end t)
(delete-region (point-at-bol) (1+ (point-at-eol))))
(goto-char beg)
;; Delete drawers
(while (re-search-forward org-drawer-regexp end t)
(when (save-excursion (re-search-forward org-property-end-re nil t))
(delete-region beg (1+ (match-end 0)))))
;; Get CONTENT, if any.
(goto-char beg)
(forward-line 1)
(unless (= (point) end)
(setq content (buffer-substring (point)
(save-excursion (goto-char end)
(forward-line -1)
(point)))))
;; Remove the task.
(goto-char beg)
(delete-region beg end)
(when (and org-inlinetask-export
(assq org-export-current-backend
org-inlinetask-export-templates))
;; Format CONTENT, if appropriate.
(setq content
(if (not (and content (string-match "\\S-" content)))
""
;; Ensure CONTENT has minimal indentation, a single
;; newline character at its boundaries, and isn't
;; protected.
(when (string-match "\\`\\([ \t]*\n\\)+" content)
(setq content (substring content (match-end 0))))
(when (string-match "[ \t\n]+\\'" content)
(setq content (substring content 0 (match-beginning 0))))
(org-add-props
(concat "\n\n" (org-remove-indentation content) "\n\n")
'(org-protected nil org-native-text nil))))
(when (string-match org-complex-heading-regexp headline)
(let* ((nil-to-str
(function
;; Change nil arguments into empty strings.
(lambda (el) (or (eval el) ""))))
;; Set up keywords provided to templates.
(todo (or (match-string 2 headline) ""))
(class (or (and (eq "" todo) "")
(if (member todo org-done-keywords) "done" "todo")))
(priority (or (match-string 3 headline) ""))
(heading (or (match-string 4 headline) ""))
(tags (or (match-string 5 headline) ""))
;; Read `org-inlinetask-export-templates'.
(backend-spec (assq org-export-current-backend
org-inlinetask-export-templates))
(format-str (org-add-props (nth 1 backend-spec)
'(org-protected t org-native-text t)))
(tokens (cadr (nth 2 backend-spec)))
;; Build export string. Ensure it won't break
;; surrounding lists by giving it arbitrary high
;; indentation.
(export-str (org-add-props
(eval (append '(format format-str)
(mapcar nil-to-str tokens)))
'(original-indentation 1000))))
;; Ensure task starts a new paragraph.
(unless (or (bobp)
(save-excursion (forward-line -1)
(looking-at "[ \t]*$")))
(insert "\n"))
(insert export-str)
(unless (bolp) (insert "\n")))))))))
(when (string-match org-complex-heading-regexp headline)
(let* ((nil-to-str
(function
;; Change nil arguments into empty strings.
(lambda (el) (or (eval el) ""))))
;; Set up keywords provided to templates.
(todo (or (match-string 2 headline) ""))
(class (or (and (eq "" todo) "")
(if (member todo org-done-keywords) "done" "todo")))
(priority (or (match-string 3 headline) ""))
(heading (or (match-string 4 headline) ""))
(tags (or (match-string 5 headline) ""))
;; Read `org-inlinetask-export-templates'.
(backend-spec (assq org-export-current-backend
org-inlinetask-export-templates))
(format-str (org-add-props (nth 1 backend-spec)
'(org-protected t org-native-text t)))
(tokens (cadr (nth 2 backend-spec)))
;; Build export string. Ensure it won't break
;; surrounding lists by giving it arbitrary high
;; indentation.
(export-str (org-add-props
(eval (append '(format format-str)
(mapcar nil-to-str tokens)))
'(original-indentation 1000))))
;; Ensure task starts a new paragraph.
(unless (or (bobp)
(save-excursion (forward-line -1)
(looking-at "[ \t]*$")))
(insert "\n"))
(insert export-str)
(unless (bolp) (insert "\n")))))))))
(defun org-inlinetask-get-current-indentation ()
"Get the indentation of the last non-while line above this one."
@ -432,10 +432,10 @@ Either remove headline and meta data, or do special formatting."
(1- (* 2 (or org-inlinetask-min-level 200)))
(or org-inlinetask-min-level 200)))
(re (concat "^\\(\\*\\)\\(\\*\\{"
(format "%d" (- nstars 3))
",\\}\\)\\(\\*\\* .*\\)"))
(format "%d" (- nstars 3))
",\\}\\)\\(\\*\\* .*\\)"))
;; Virtual indentation will add the warning face on the first
;; star. Thus, in that case, only hide it.
;; 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

78
lisp/org-irc.el
View File

@ -81,10 +81,10 @@
"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")))))
((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.
@ -102,8 +102,8 @@ attributes that are found."
(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))))
((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.
@ -140,9 +140,9 @@ result is a cons of the filename and search string."
(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)))))))
(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.
@ -164,27 +164,27 @@ the session itself."
: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")))))
(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)))
erc-session-port))
(link (concat erc-session-server ":" session-port)))
(concat link "/"
(if (and (erc-default-target)
(erc-channel-p (erc-default-target))
@ -192,19 +192,19 @@ the session itself."
;; we can get a nick
(let ((nick (car (get-text-property (point) 'erc-data))))
(concat (erc-default-target) "/" nick))
(erc-default-target)))))
(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)))
((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."
@ -242,13 +242,13 @@ default."
(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))))
(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)

120
lisp/org-jsinfo.el
View File

@ -99,8 +99,8 @@ means to use the maximum value consistent with other options."
(lambda (x)
(list 'cons (list 'const (car x))
'(choice
(symbol :tag "Publishing/Export property")
(string :tag "Value"))))
(symbol :tag "Publishing/Export property")
(string :tag "Value"))))
org-infojs-opts-table)))
(defcustom org-infojs-template
@ -127,67 +127,67 @@ Option settings will replace the %MANAGER-OPTIONS cookie."
exp-plist
;; We do want to use the script, set it up
(let ((template org-infojs-template)
(ptoc (plist-get exp-plist :table-of-contents))
(hlevels (plist-get exp-plist :headline-levels))
tdepth sdepth s v e opt var val table default)
(setq sdepth hlevels
tdepth hlevels)
(if (integerp ptoc) (setq tdepth (min ptoc tdepth)))
(setq v (plist-get exp-plist :infojs-opt)
table org-infojs-opts-table)
(while (setq e (pop table))
(setq opt (car e) var (nth 1 e)
default (cdr (assoc opt org-infojs-options)))
(and (symbolp default) (not (memq default '(t nil)))
(setq default (plist-get exp-plist default)))
(if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v))
(setq val (match-string 1 v))
(setq val default))
(cond
((eq opt 'path)
(and (string-match "%SCRIPT_PATH" template)
(setq template (replace-match val t t template))))
((eq opt 'sdepth)
(if (integerp (read val))
(setq sdepth (min (read val) hlevels))))
((eq opt 'tdepth)
(if (integerp (read val))
(setq tdepth (min (read val) hlevels))))
(t
(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) s))))
(ptoc (plist-get exp-plist :table-of-contents))
(hlevels (plist-get exp-plist :headline-levels))
tdepth sdepth s v e opt var val table default)
(setq sdepth hlevels
tdepth hlevels)
(if (integerp ptoc) (setq tdepth (min ptoc tdepth)))
(setq v (plist-get exp-plist :infojs-opt)
table org-infojs-opts-table)
(while (setq e (pop table))
(setq opt (car e) var (nth 1 e)
default (cdr (assoc opt org-infojs-options)))
(and (symbolp default) (not (memq default '(t nil)))
(setq default (plist-get exp-plist default)))
(if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v))
(setq val (match-string 1 v))
(setq val default))
(cond
((eq opt 'path)
(and (string-match "%SCRIPT_PATH" template)
(setq template (replace-match val t t template))))
((eq opt 'sdepth)
(if (integerp (read val))
(setq sdepth (min (read val) hlevels))))
((eq opt 'tdepth)
(if (integerp (read val))
(setq tdepth (min (read val) hlevels))))
(t
(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) s))))
;; 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 :table-of-contents sdepth))
;; 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 :table-of-contents sdepth))
;; The table of contents should not show more sections then we generate
(setq tdepth (min tdepth sdepth))
(push (cons "TOC_DEPTH" tdepth) s)
;; The table of contents should not show more sections then we generate
(setq tdepth (min tdepth sdepth))
(push (cons "TOC_DEPTH" tdepth) s)
(setq s (mapconcat
(lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
(car x) (cdr x)))
s "\n"))
(when (and s (> (length s) 0))
(and (string-match "%MANAGER_OPTIONS" template)
(setq s (replace-match s t t template))
(setq exp-plist
(plist-put
exp-plist :style-extra
(concat (or (plist-get exp-plist :style-extra) "") "\n" s)))))
;; This script absolutely needs the table of contents, to we change that
;; setting
(if (not (plist-get exp-plist :table-of-contents))
(setq exp-plist (plist-put exp-plist :table-of-contents t)))
;; Return the modified property list
exp-plist)))
(setq s (mapconcat
(lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
(car x) (cdr x)))
s "\n"))
(when (and s (> (length s) 0))
(and (string-match "%MANAGER_OPTIONS" template)
(setq s (replace-match s t t template))
(setq exp-plist
(plist-put
exp-plist :style-extra
(concat (or (plist-get exp-plist :style-extra) "") "\n" s)))))
;; This script absolutely needs the table of contents, to we change that
;; setting
(if (not (plist-get exp-plist :table-of-contents))
(setq exp-plist (plist-put exp-plist :table-of-contents t)))
;; Return the modified property list
exp-plist)))
(defun org-infojs-options-inbuffer-template ()
(format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s"

446
lisp/org-latex.el
View File

@ -557,9 +557,9 @@ pygmentize -L lexers
"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
\\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,
value. For example,
(setq org-export-latex-listings-options
'((\"basicstyle\" \"\\small\")
@ -581,9 +581,9 @@ languages."
"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
\\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,
value. For example,
(setq org-export-latex-minted-options
'((\"bgcolor\" \"bg\") (\"frame\" \"lines\")))
@ -592,7 +592,7 @@ will result in src blocks being exported with
\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
as the start of the minted environment. Note that the same
as the start of the minted environment. Note that the same
options will be applied to blocks of all languages."
:group 'org-export-latex
:version "24.1"
@ -604,7 +604,7 @@ options will be applied to blocks of all languages."
(defvar org-export-latex-custom-lang-environments nil
"Association list mapping languages to language-specific latex
environments used during export of src blocks by the listings
and minted latex packages. For example,
and minted latex packages. For example,
(setq org-export-latex-custom-lang-environments
'((python \"pythoncode\")))
@ -719,28 +719,28 @@ This function should accept the file name as its single argument."
(string :tag "Shell command"))
(const :tag "2 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 "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"))
"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"))
"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"))
"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"))
"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"))
"bibtex %b"
"xelatex -interaction nonstopmode -output-directory %o %f"
"xelatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "texi2dvi"
("texi2dvi -p -b -c -V %f"))
(const :tag "rubber"
@ -1043,7 +1043,7 @@ when PUB-DIR is set, use this as the publishing directory."
(when (and text (not (eq to-buffer 'string)))
(insert (org-export-latex-content
text '(lists tables fixed-width keywords))
"\n\n"))
"\n\n"))
;; insert lines before the first headline
(unless (or skip (string-match "^\\*" first-lines))
@ -1537,9 +1537,9 @@ OPT-PLIST is the options plist for current buffer."
org-export-latex-date-format)))
;; add some hyperref options
(format org-export-latex-hyperref-options-format
(org-export-latex-fontify-headline keywords)
(org-export-latex-fontify-headline description)
(org-version))
(org-export-latex-fontify-headline keywords)
(org-export-latex-fontify-headline description)
(org-version))
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title command
@ -1633,7 +1633,7 @@ links, keywords, lists, tables, fixed-width"
(unless (memq 'fixed-width exclude-list)
(org-export-latex-fixed-width
(plist-get org-export-latex-options-plist :fixed-width)))
;; return string
;; return string
(buffer-substring (point-min) (point-max))))
(defun org-export-latex-protect-string (s)
@ -1755,13 +1755,13 @@ links, keywords, lists, tables, fixed-width"
(let ((org-display-custom-times org-export-latex-display-custom-times))
(while (re-search-forward org-ts-regexp-both nil t)
(org-if-unprotected-at (1- (point))
(replace-match
(org-export-latex-protect-string
(format (if (string= "<" (substring (match-string 0) 0 1))
org-export-latex-timestamp-markup
org-export-latex-timestamp-inactive-markup)
(substring (org-translate-time (match-string 0)) 1 -1)))
t t)))))
(replace-match
(org-export-latex-protect-string
(format (if (string= "<" (substring (match-string 0) 0 1))
org-export-latex-timestamp-markup
org-export-latex-timestamp-inactive-markup)
(substring (org-translate-time (match-string 0)) 1 -1)))
t t)))))
(defun org-export-latex-quotation-marks ()
"Export quotation marks depending on language conventions."
@ -1940,19 +1940,19 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t)
(unless (get-text-property (point) 'org-example)
(if opt
(progn (goto-char (match-beginning 0))
(insert "\\begin{verbatim}\n")
(while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
(replace-match (concat (match-string 1)
(match-string 2)) t t)
(forward-line))
(insert "\\end{verbatim}\n"))
(progn (goto-char (match-beginning 0))
(while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
(replace-match (concat "%" (match-string 1)
(match-string 2)) t t)
(forward-line)))))))
(if opt
(progn (goto-char (match-beginning 0))
(insert "\\begin{verbatim}\n")
(while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
(replace-match (concat (match-string 1)
(match-string 2)) t t)
(forward-line))
(insert "\\end{verbatim}\n"))
(progn (goto-char (match-beginning 0))
(while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
(replace-match (concat "%" (match-string 1)
(match-string 2)) t t)
(forward-line)))))))
(defvar org-table-last-alignment) ; defined in org-table.el
(defvar org-table-last-column-widths) ; defined in org-table.el
@ -2112,9 +2112,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
%s\\multicolumn{%d}{r}{Continued on next page}\\
\\endfoot
\\endlastfoot"
org-export-latex-tables-hline
org-export-latex-tables-hline
(length org-table-last-alignment))
org-export-latex-tables-hline
org-export-latex-tables-hline
(length org-table-last-alignment))
nil)))
(if (not longtblp) (format "\n\\end{%s}" tabular-env))
(if longtblp "\n" (if org-export-latex-tables-centered
@ -2455,7 +2455,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
;; Compute string to insert (FNOTE), and protect the outside
;; macro from further transformation. When footnote at
;; point is referring to a previously defined footnote, use
;; \footnotemark. Otherwise, use \footnote.
;; \footnotemark. Otherwise, use \footnote.
(let ((fnote (if (member lbl org-export-latex-footmark-seen)
(org-export-latex-protect-string
(format "\\footnotemark[%s]" lbl))
@ -2680,7 +2680,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(defun org-export-latex-lists ()
"Convert plain text lists in current buffer into LaTeX lists."
;; `org-list-end-re' output has changed since preprocess from
;; org-exp.el. Make sure it is taken into account.
;; org-exp.el. Make sure it is taken into account.
(let ((org-list-end-re "^ORG-LIST-END-MARKER\n"))
(mapc
(lambda (e)
@ -2711,181 +2711,181 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(append org-list-export-context '(nil)))))
(defconst org-latex-entities
'("\\!"
"\\'"
"\\+"
"\\,"
"\\-"
"\\:"
"\\;"
"\\<"
"\\="
"\\>"
"\\Huge"
"\\LARGE"
"\\Large"
"\\Styles"
"\\\\"
"\\`"
"\\\""
"\\addcontentsline"
"\\address"
"\\addtocontents"
"\\addtocounter"
"\\addtolength"
"\\addvspace"
"\\alph"
"\\appendix"
"\\arabic"
"\\author"
"\\begin{array}"
"\\begin{center}"
"\\begin{description}"
"\\begin{enumerate}"
"\\begin{eqnarray}"
"\\begin{equation}"
"\\begin{figure}"
"\\begin{flushleft}"
"\\begin{flushright}"
"\\begin{itemize}"
"\\begin{list}"
"\\begin{minipage}"
"\\begin{picture}"
"\\begin{quotation}"
"\\begin{quote}"
"\\begin{tabbing}"
"\\begin{table}"
"\\begin{tabular}"
"\\begin{thebibliography}"
"\\begin{theorem}"
"\\begin{titlepage}"
"\\begin{verbatim}"
"\\begin{verse}"
"\\bf"
"\\bf"
"\\bibitem"
"\\bigskip"
"\\cdots"
"\\centering"
"\\circle"
"\\cite"
"\\cleardoublepage"
"\\clearpage"
"\\cline"
"\\closing"
"\\dashbox"
"\\date"
"\\ddots"
"\\dotfill"
"\\em"
"\\fbox"
"\\flushbottom"
"\\fnsymbol"
"\\footnote"
"\\footnotemark"
"\\footnotesize"
"\\footnotetext"
"\\frac"
"\\frame"
"\\framebox"
"\\hfill"
"\\hline"
"\\hrulespace"
"\\hspace"
"\\huge"
"\\hyphenation"
"\\include"
"\\includeonly"
"\\indent"
"\\input"
"\\it"
"\\kill"
"\\label"
"\\large"
"\\ldots"
"\\line"
"\\linebreak"
"\\linethickness"
"\\listoffigures"
"\\listoftables"
"\\location"
"\\makebox"
"\\maketitle"
"\\mark"
"\\mbox"
"\\medskip"
"\\multicolumn"
"\\multiput"
"\\newcommand"
"\\newcounter"
"\\newenvironment"
"\\newfont"
"\\newlength"
"\\newline"
"\\newpage"
"\\newsavebox"
"\\newtheorem"
"\\nocite"
"\\nofiles"
"\\noindent"
"\\nolinebreak"
"\\nopagebreak"
"\\normalsize"
"\\onecolumn"
"\\opening"
"\\oval"
"\\overbrace"
"\\overline"
"\\pagebreak"
"\\pagenumbering"
"\\pageref"
"\\pagestyle"
"\\par"
"\\parbox"
"\\put"
"\\raggedbottom"
"\\raggedleft"
"\\raggedright"
"\\raisebox"
"\\ref"
"\\rm"
"\\roman"
"\\rule"
"\\savebox"
"\\sc"
"\\scriptsize"
"\\setcounter"
"\\setlength"
"\\settowidth"
"\\sf"
"\\shortstack"
"\\signature"
"\\sl"
"\\small"
"\\smallskip"
"\\sqrt"
"\\tableofcontents"
"\\telephone"
"\\thanks"
"\\thispagestyle"
"\\tiny"
"\\title"
"\\tt"
"\\twocolumn"
"\\typein"
"\\typeout"
"\\underbrace"
"\\underline"
"\\usebox"
"\\usecounter"
"\\value"
"\\vdots"
"\\vector"
"\\verb"
"\\vfill"
"\\vline"
"\\vspace")
"A list of LaTeX commands to be protected when performing conversion.")
'("\\!"
"\\'"
"\\+"
"\\,"
"\\-"
"\\:"
"\\;"
"\\<"
"\\="
"\\>"
"\\Huge"
"\\LARGE"
"\\Large"
"\\Styles"
"\\\\"
"\\`"
"\\\""
"\\addcontentsline"
"\\address"
"\\addtocontents"
"\\addtocounter"
"\\addtolength"
"\\addvspace"
"\\alph"
"\\appendix"
"\\arabic"
"\\author"
"\\begin{array}"
"\\begin{center}"
"\\begin{description}"
"\\begin{enumerate}"
"\\begin{eqnarray}"
"\\begin{equation}"
"\\begin{figure}"
"\\begin{flushleft}"
"\\begin{flushright}"
"\\begin{itemize}"
"\\begin{list}"
"\\begin{minipage}"
"\\begin{picture}"
"\\begin{quotation}"
"\\begin{quote}"
"\\begin{tabbing}"
"\\begin{table}"
"\\begin{tabular}"
"\\begin{thebibliography}"
"\\begin{theorem}"
"\\begin{titlepage}"
"\\begin{verbatim}"
"\\begin{verse}"
"\\bf"
"\\bf"
"\\bibitem"
"\\bigskip"
"\\cdots"
"\\centering"
"\\circle"
"\\cite"
"\\cleardoublepage"
"\\clearpage"
"\\cline"
"\\closing"
"\\dashbox"
"\\date"
"\\ddots"
"\\dotfill"
"\\em"
"\\fbox"
"\\flushbottom"
"\\fnsymbol"
"\\footnote"
"\\footnotemark"
"\\footnotesize"
"\\footnotetext"
"\\frac"
"\\frame"
"\\framebox"
"\\hfill"
"\\hline"
"\\hrulespace"
"\\hspace"
"\\huge"
"\\hyphenation"
"\\include"
"\\includeonly"
"\\indent"
"\\input"
"\\it"
"\\kill"
"\\label"
"\\large"
"\\ldots"
"\\line"
"\\linebreak"
"\\linethickness"
"\\listoffigures"
"\\listoftables"
"\\location"
"\\makebox"
"\\maketitle"
"\\mark"
"\\mbox"
"\\medskip"
"\\multicolumn"
"\\multiput"
"\\newcommand"
"\\newcounter"
"\\newenvironment"
"\\newfont"
"\\newlength"
"\\newline"
"\\newpage"
"\\newsavebox"
"\\newtheorem"
"\\nocite"
"\\nofiles"
"\\noindent"
"\\nolinebreak"
"\\nopagebreak"
"\\normalsize"
"\\onecolumn"
"\\opening"
"\\oval"
"\\overbrace"
"\\overline"
"\\pagebreak"
"\\pagenumbering"
"\\pageref"
"\\pagestyle"
"\\par"
"\\parbox"
"\\put"
"\\raggedbottom"
"\\raggedleft"
"\\raggedright"
"\\raisebox"
"\\ref"
"\\rm"
"\\roman"
"\\rule"
"\\savebox"
"\\sc"
"\\scriptsize"
"\\setcounter"
"\\setlength"
"\\settowidth"
"\\sf"
"\\shortstack"
"\\signature"
"\\sl"
"\\small"
"\\smallskip"
"\\sqrt"
"\\tableofcontents"
"\\telephone"
"\\thanks"
"\\thispagestyle"
"\\tiny"
"\\title"
"\\tt"
"\\twocolumn"
"\\typein"
"\\typeout"
"\\underbrace"
"\\underline"
"\\usebox"
"\\usecounter"
"\\value"
"\\vdots"
"\\vector"
"\\verb"
"\\vfill"
"\\vline"
"\\vspace")
"A list of LaTeX commands to be protected when performing conversion.")
(defconst org-latex-entities-regexp
(let (names rest)

116
lisp/org-list.el
View File

@ -256,16 +256,16 @@ 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 "Bullet" bullet)
(const :tag "Checkbox" checkbox)
(const :tag "Indent" indent))
:value-type
(boolean :tag "Activate" :value t)))
:group 'org-plain-lists
:version "24.1"
:type '(alist :tag "Sets of rules"
:key-type
(choice
(const :tag "Bullet" bullet)
(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.
@ -692,7 +692,7 @@ Assume point is at an item."
(forward-line -1))
((looking-at "^[ \t]*$")
(forward-line -1))
;; From there, point is not at an item. Interpret
;; 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
@ -1623,7 +1623,7 @@ as returned by `org-list-prevs-alist'."
(if (> ascii 90)
(throw 'exit nil)
(setq item (org-list-get-next-item item struct prevs)))))
;; All items checked. All good.
;; All items checked. All good.
t))))
(defun org-list-inc-bullet-maybe (bullet)
@ -1873,10 +1873,10 @@ Initial position of cursor is restored after the changes."
(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
;; a. Replace bullet
(unless (equal old-bul new-bul)
(replace-match new-bul nil nil nil 1))
;; b. Replace checkbox.
;; b. Replace checkbox.
(cond
((equal (match-string 3) new-box))
((and (match-string 3) new-box)
@ -1887,7 +1887,7 @@ Initial position of cursor is restored after the changes."
(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.
;; c. Indent item to appropriate column.
(unless (= new-ind old-ind)
(delete-region (goto-char (point-at-bol))
(progn (skip-chars-forward " \t") (point)))
@ -2361,13 +2361,13 @@ in subtree, ignoring drawers."
(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))))
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))
@ -2817,8 +2817,8 @@ COMPARE-FUNC to compare entries."
((= dcst ?t) '<)
(t nil)))
(next-record (lambda ()
(skip-chars-forward " \r\t\n")
(beginning-of-line)))
(skip-chars-forward " \r\t\n")
(beginning-of-line)))
(end-record (lambda ()
(goto-char (org-list-get-item-end-before-blank
(point) struct))))
@ -2932,7 +2932,7 @@ Point is left at list end."
(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
;; Get counter number. For alphabetic counter, get
;; its position in the alphabet.
(counter (let ((c (org-list-get-counter e struct)))
(cond
@ -3138,7 +3138,7 @@ items."
((and counter (eq type 'ordered))
(concat (eval icount) "%s"))
(t (concat (eval istart) "%s")))
(eval iend)))
(eval iend)))
(first (car item)))
;; Replace checkbox if any is found.
(cond
@ -3195,21 +3195,21 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}"
:ustart "\\begin{itemize}\n" :uend "\\end{itemize}"
:dstart "\\begin{description}\n" :dend "\\end{description}"
:dtstart "[" :dtend "] "
:istart "\\item " :iend "\n"
:icount (let ((enum (nth depth '("i" "ii" "iii" "iv"))))
(if enum
;; LaTeX increments counter just before
;; using it, so set it to the desired
;; value, minus one.
(format "\\setcounter{enum%s}{%s}\n\\item "
enum (1- counter))
"\\item "))
:csep "\n"
:cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}"
:cbtrans "\\texttt{[-]}")
:ustart "\\begin{itemize}\n" :uend "\\end{itemize}"
:dstart "\\begin{description}\n" :dend "\\end{description}"
:dtstart "[" :dtend "] "
:istart "\\item " :iend "\n"
:icount (let ((enum (nth depth '("i" "ii" "iii" "iv"))))
(if enum
;; LaTeX increments counter just before
;; using it, so set it to the desired
;; value, minus one.
(format "\\setcounter{enum%s}{%s}\n\\item "
enum (1- counter))
"\\item "))
:csep "\n"
:cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}"
:cbtrans "\\texttt{[-]}")
params)))
(defun org-list-to-html (list &optional params)
@ -3220,15 +3220,15 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice nil :ostart "<ol>\n" :oend "\n</ol>"
:ustart "<ul>\n" :uend "\n</ul>"
:dstart "<dl>\n" :dend "\n</dl>"
:dtstart "<dt>" :dtend "</dt>\n"
:ddstart "<dd>" :ddend "</dd>"
:istart "<li>" :iend "</li>"
:icount (format "<li value=\"%s\">" counter)
:isep "\n" :lsep "\n" :csep "\n"
:cbon "<code>[X]</code>" :cboff "<code>[ ]</code>"
:cbtrans "<code>[-]</code>")
:ustart "<ul>\n" :uend "\n</ul>"
:dstart "<dl>\n" :dend "\n</dl>"
:dtstart "<dt>" :dtend "</dt>\n"
:ddstart "<dd>" :ddend "</dd>"
:istart "<li>" :iend "</li>"
:icount (format "<li value=\"%s\">" counter)
:isep "\n" :lsep "\n" :csep "\n"
:cbon "<code>[X]</code>" :cboff "<code>[ ]</code>"
:cbtrans "<code>[-]</code>")
params)))
(defun org-list-to-texinfo (list &optional params)
@ -3239,14 +3239,14 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize"
:ustart "@enumerate\n" :uend "@end enumerate"
:dstart "@table @asis\n" :dend "@end table"
:dtstart " " :dtend "\n"
:istart "@item\n" :iend "\n"
:icount "@item\n"
:csep "\n"
:cbon "@code{[X]}" :cboff "@code{[ ]}"
:cbtrans "@code{[-]}")
:ustart "@enumerate\n" :uend "@end enumerate"
:dstart "@table @asis\n" :dend "@end table"
:dtstart " " :dtend "\n"
:istart "@item\n" :iend "\n"
:icount "@item\n"
:csep "\n"
:cbon "@code{[X]}" :cboff "@code{[ ]}"
:cbtrans "@code{[-]}")
params)))
(defun org-list-to-subtree (list &optional params)

58
lisp/org-lparse.el
View File

@ -89,9 +89,9 @@ emacs --batch
No file is created. The prefix ARG is passed through to
`org-lparse'."
(let ((tempbuf (format "*Org %s Export*" (upcase backend))))
(org-lparse backend backend arg nil nil tempbuf)
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window tempbuf))))
(org-lparse backend backend arg nil nil tempbuf)
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window tempbuf))))
;;;###autoload
(defun org-replace-region-by (backend beg end)
@ -145,16 +145,16 @@ in a window. A non-interactive call will only return the buffer."
(defvar org-lparse-par-open nil)
(defun org-lparse-should-inline-p (filename descp)
"Return non-nil if link FILENAME should be inlined.
"Return non-nil if link FILENAME should be inlined.
The decision to inline the FILENAME link is based on the current
settings. DESCP is the boolean of whether there was a link
description. See variables `org-export-html-inline-images' and
`org-export-html-inline-image-extensions'."
(let ((inline-images (org-lparse-get 'INLINE-IMAGES))
(inline-image-extensions
(org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
(and (or (eq t inline-images) (and inline-images (not descp)))
(org-file-image-p filename inline-image-extensions))))
(let ((inline-images (org-lparse-get 'INLINE-IMAGES))
(inline-image-extensions
(org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
(and (or (eq t inline-images) (and inline-images (not descp)))
(org-file-image-p filename inline-image-extensions))))
(defun org-lparse-format-org-link (line opt-plist)
"Return LINE with markup of Org mode links.
@ -565,7 +565,7 @@ and then converted to \"doc\" then org-lparse-backend is set to
(defun org-do-lparse (arg &optional hidden ext-plist
to-buffer body-only pub-dir)
"Export the outline to various formats.
See `org-lparse' for more information. This function is a
See `org-lparse' for more information. This function is a
html-agnostic version of the `org-export-as-html' function in 7.5
version."
;; Make sure we have a file name when we need it.
@ -771,7 +771,7 @@ version."
;; collection
org-lparse-collect-buffer
(org-lparse-collect-count 0) ; things will get haywire if
; collections are chained. Use
; collections are chained. Use
; this variable to assert this
; pre-requisite
org-lparse-toc
@ -1157,7 +1157,7 @@ version."
(defun org-lparse-table-get-colalign-info (lines)
(let ((col-cookies (org-find-text-property-in-string
'org-col-cookies (car lines))))
'org-col-cookies (car lines))))
(when (and col-cookies org-table-clean-did-remove-column)
(setq col-cookies
(mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies)))
@ -1236,9 +1236,9 @@ for formatting. This is required for the DocBook exporter."
short-caption)))
(defun org-lparse-insert-list-table (lines &optional splice
caption label attributes head
org-lparse-table-colalign-info
short-caption)
caption label attributes head
org-lparse-table-colalign-info
short-caption)
(or (featurep 'org-table) ; required for
(require 'org-table)) ; `org-table-number-regexp'
(let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0)
@ -1326,9 +1326,9 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
(defvar table-source-languages) ; defined in table.el
(defun org-lparse-format-table-table-using-table-generate-source (backend
lines
&optional
spanned-only)
lines
&optional
spanned-only)
"Format a table into BACKEND, using `table-generate-source' from table.el.
Use SPANNED-ONLY to suppress exporting of simple table.el tables.
@ -1359,9 +1359,9 @@ for further information."
(set-buffer " org-tmp2 ")
(buffer-substring (point-min) (point-max)))
(t
;; table.el doesn't support the given backend. Currently this
;; table.el doesn't support the given backend. Currently this
;; happens in case of odt export. Strip the table from the
;; generated document. A better alternative would be to embed
;; generated document. A better alternative would be to embed
;; the table as ascii text in the output document.
(org-lparse-warn
(concat
@ -1877,7 +1877,7 @@ See `org-xhtml-entity-format-callbacks-alist' for more information."
(replace-match
(let ((org-lparse-encode-pending t))
(org-lparse-format 'FONTIFY
(match-string 1 line) "target"))
(match-string 1 line) "target"))
t t line)))
(when (string-match
(org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
@ -2042,8 +2042,8 @@ When TITLE is nil, just close all open levels."
(defvar org-lparse-outline-text-open)
(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags
target extra-targets
extra-class)
target extra-targets
extra-class)
(org-lparse-begin
'OUTLINE level1 snumber title tags target extra-targets extra-class)
(org-lparse-begin-outline-text level1 snumber extra-class))
@ -2093,7 +2093,7 @@ When TITLE is nil, just close all open levels."
;; 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
;; 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.
;;
@ -2238,11 +2238,11 @@ Replaces invalid characters with \"_\"."
(defun org-lparse-format-extra-targets (extra-targets)
(if (not extra-targets) ""
(mapconcat (lambda (x)
(setq x (org-solidify-link-text
(if (org-uuidgen-p x) (concat "ID-" x) x)))
(org-lparse-format 'ANCHOR "" x))
extra-targets "")))
(mapconcat (lambda (x)
(setq x (org-solidify-link-text
(if (org-uuidgen-p x) (concat "ID-" x) x)))
(org-lparse-format 'ANCHOR "" x))
extra-targets "")))
(defun org-lparse-format-org-tags (tags)
(if (not tags) ""

90
lisp/org-mac-message.el
View File

@ -84,15 +84,15 @@ This will use the command `open' with the message URL."
(do-applescript
(concat
"tell application \"Mail\"\n"
"set theLinkList to {}\n"
"set theSelection to selection\n"
"repeat with theMessage in theSelection\n"
"set theID to message id of theMessage\n"
"set theSubject to subject of theMessage\n"
"set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
"copy theLink to end of theLinkList\n"
"end repeat\n"
"return theLinkList as string\n"
"set theLinkList to {}\n"
"set theSelection to selection\n"
"repeat with theMessage in theSelection\n"
"set theID to message id of theMessage\n"
"set theSubject to subject of theMessage\n"
"set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
"copy theLink to end of theLinkList\n"
"end repeat\n"
"return theLinkList as string\n"
"end tell")))
(defun as-get-flagged-mail ()
@ -101,47 +101,47 @@ This will use the command `open' with the message URL."
(concat
;; Is Growl installed?
"tell application \"System Events\"\n"
"set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
"if (count of growlHelpers) > 0 then\n"
"set growlHelperApp to item 1 of growlHelpers\n"
"else\n"
"set growlHelperApp to \"\"\n"
"end if\n"
"set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
"if (count of growlHelpers) > 0 then\n"
"set growlHelperApp to item 1 of growlHelpers\n"
"else\n"
"set growlHelperApp to \"\"\n"
"end if\n"
"end tell\n"
;; Get links
"tell application \"Mail\"\n"
"set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
"set theLinkList to {}\n"
"repeat with aMailbox in theMailboxes\n"
"set theSelection to (every message in aMailbox whose flagged status = true)\n"
"repeat with theMessage in theSelection\n"
"set theID to message id of theMessage\n"
"set theSubject to subject of theMessage\n"
"set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
"copy theLink to end of theLinkList\n"
"set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
"set theLinkList to {}\n"
"repeat with aMailbox in theMailboxes\n"
"set theSelection to (every message in aMailbox whose flagged status = true)\n"
"repeat with theMessage in theSelection\n"
"set theID to message id of theMessage\n"
"set theSubject to subject of theMessage\n"
"set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
"copy theLink to end of theLinkList\n"
;; Report progress through Growl
;; This "double tell" idiom is described in detail at
;; http://macscripter.net/viewtopic.php?id=24570 The
;; script compiler needs static knowledge of the
;; growlHelperApp. Hmm, since we're compiling
;; on-the-fly here, this is likely to be way less
;; portable than I'd hoped. It'll work when the name
;; is still "GrowlHelperApp", though.
"if growlHelperApp is not \"\" then\n"
"tell application \"GrowlHelperApp\"\n"
"tell application growlHelperApp\n"
"set the allNotificationsList to {\"FlaggedMail\"}\n"
"set the enabledNotificationsList to allNotificationsList\n"
"register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
"notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
"end tell\n"
"end tell\n"
"end if\n"
"end repeat\n"
"end repeat\n"
"return theLinkList as string\n"
;; Report progress through Growl
;; This "double tell" idiom is described in detail at
;; http://macscripter.net/viewtopic.php?id=24570 The
;; script compiler needs static knowledge of the
;; growlHelperApp. Hmm, since we're compiling
;; on-the-fly here, this is likely to be way less
;; portable than I'd hoped. It'll work when the name
;; is still "GrowlHelperApp", though.
"if growlHelperApp is not \"\" then\n"
"tell application \"GrowlHelperApp\"\n"
"tell application growlHelperApp\n"
"set the allNotificationsList to {\"FlaggedMail\"}\n"
"set the enabledNotificationsList to allNotificationsList\n"
"register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
"notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
"end tell\n"
"end tell\n"
"end if\n"
"end repeat\n"
"end repeat\n"
"return theLinkList as string\n"
"end tell")))
(defun org-mac-message-get-links (&optional select-or-flag)

57
lisp/org-macs.el
View File

@ -54,22 +54,22 @@
(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))))
`(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)))
(when (and (not (fboundp 'with-silent-modifications))
(or (< emacs-major-version 23)
(and (= emacs-major-version 23)
(< emacs-minor-version 2))))
(defmacro with-silent-modifications (&rest body)
`(org-unmodified ,@body))
(def-edebug-spec with-silent-modifications (body)))
(or (< emacs-major-version 23)
(and (= emacs-major-version 23)
(< emacs-minor-version 2))))
(defmacro with-silent-modifications (&rest body)
`(org-unmodified ,@body))
(def-edebug-spec with-silent-modifications (body)))
(defmacro org-bound-and-true-p (var)
"Return the value of symbol VAR if it is bound, else nil."
@ -130,15 +130,15 @@ Also, do not record undo information."
`(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))
(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
;; 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
@ -239,10 +239,15 @@ We use a macro so that the test can happen at compilation time."
s)
(match-string-no-properties num string)))
(defsubst org-no-properties (s)
(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)
(remove-text-properties 0 (length s) org-rm-props 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)
@ -364,9 +369,9 @@ point nowhere."
(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
"Execute body while temporarily widening the buffer."
`(save-excursion
(save-restriction
(widen)
,@body)))
(def-edebug-spec org-with-wide-buffer (body))
@ -405,12 +410,12 @@ The number of levels is controlled by `org-inlinetask-min-level'"
(defun org-make-parameter-alist (flat)
"Return alist based on FLAT.
FLAT is a list with alternating symbol names and values. The
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)))))
(org-make-parameter-alist (cddr flat)))))
(provide 'org-macs)

24
lisp/org-mhe.el
View File

@ -100,7 +100,7 @@ supported by MH-E."
: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-remove-angle-brackets message-id)))
(org-add-link-props :link link :description desc)
link))))
@ -179,17 +179,17 @@ you have a better idea of how to do this then please let us know."
(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))))
(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.

178
lisp/org-mobile.el
View File

@ -406,7 +406,7 @@ agenda view showing the flagged items."
(error "Cannot write to encryption tempfile %s"
org-mobile-encryption-tempfile))
(unless (executable-find "openssl")
(error "openssl is needed to encrypt files"))))
(error "OpenSSL is needed to encrypt files"))))
(defun org-mobile-create-index-file ()
"Write the index file in the WebDAV directory."
@ -593,7 +593,7 @@ The table of checksums is written to the file mobile-checksums."
(setq settings
(cons (list 'org-agenda-title-append
(concat "<after>KEYS=" gkey "#" (number-to-string
(setq cnt (1+ cnt)))
(setq cnt (1+ cnt)))
" TITLE: " gdesc " " match "</after>"))
settings))
(push (list type match settings) new)))))
@ -829,90 +829,90 @@ If BEG and END are given, only do this in that region."
(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)
(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)))))
(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)
@ -973,8 +973,8 @@ is currently a noop.")
(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?
; 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)))
@ -1077,8 +1077,8 @@ be returned that indicates what went wrong."
(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))
(org-paste-subtree 1)))
(org-cut-subtree))
((eq what 'delete)
(org-cut-subtree))

254
lisp/org-mouse.el
View File

@ -260,7 +260,7 @@ after the current heading."
(interactive)
(case (org-mouse-line-position)
(:beginning (beginning-of-line)
(org-insert-heading))
(org-insert-heading))
(t (org-mouse-next-heading)
(org-insert-heading))))
@ -293,19 +293,19 @@ 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))
(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."
@ -407,8 +407,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(> (match-end 0) point))))))
(defun org-mouse-priority-list ()
(loop for priority from ?A to org-lowest-priority
collect (char-to-string priority)))
(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."
@ -461,12 +461,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(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 ???")))
('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
@ -485,8 +485,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
" ")
nil nil nil 1)
(when (functionp ',function) (funcall ',function)))
:style 'toggle
:selected (and (member name options) t)))))
:style 'toggle
:selected (and (member name options) t)))))
(defun org-mouse-clip-text (text maxlength)
(if (> (length text) maxlength)
@ -529,18 +529,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
,@(org-mouse-keyword-menu
(mapcar 'car org-agenda-custom-commands)
#'(lambda (key)
(eval `(org-agenda nil (string-to-char ,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))))
(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)]
@ -605,9 +605,9 @@ This means, between the beginning of line and the point."
(defun org-mouse-match-closure (function)
(let ((match (match-data t)))
`(lambda (&rest rest)
(save-match-data
(set-match-data ',match)
(apply ',function rest)))))
(save-match-data
(set-match-data ',match)
(apply ',function rest)))))
(defun org-mouse-yank-link (click)
(interactive "e")
@ -864,55 +864,55 @@ This means, between the beginning of line and the point."
(mouse-drag-region event)))
(add-hook 'org-mode-hook
#'(lambda ()
(setq org-mouse-context-menu-function 'org-mouse-context-menu)
#'(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 '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-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-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))
(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))))))
(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")
@ -932,42 +932,42 @@ This means, between the beginning of line and the point."
(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)
(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))
(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))
(setq level (1+ level)))
(org-paste-subtree level)
(save-excursion
(outline-end-of-subtree)
(when (bolp) (delete-char -1))))))))))
(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 ()
@ -990,7 +990,7 @@ This means, between the beginning of line and the point."
(defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'.
(defun org-mouse-do-remotely (command)
; (org-agenda-check-no-diary)
; (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))
@ -1087,20 +1087,20 @@ This means, between the beginning of line and the point."
(if (< (car startxy) (car endxy)) :right :left)))
; (setq org-agenda-mode-hook nil)
; (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)))))))
#'(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)

30
lisp/org-odt.el
View File

@ -211,7 +211,7 @@ heuristically based on the values of `org-odt-lib-dir' and
org-odt-styles-dir-list)
nil)))
(unless styles-dir
(error "Error (org-odt): Cannot find factory styles files. Aborting."))
(error "Error (org-odt): Cannot find factory styles files. Aborting."))
styles-dir)
"Directory that holds auxiliary XML files used by the ODT exporter.
@ -283,7 +283,7 @@ Valid values are one of:
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
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
@ -569,7 +569,7 @@ PUB-DIR is set, use this as the publishing directory."
(delete-region (match-beginning 0) (point-max)))
;; Following variable is let bound when `org-do-lparse' is in
;; progress. See org-html.el.
;; progress. See org-html.el.
(defvar org-lparse-toc)
(defun org-odt-format-toc ()
(if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n")))
@ -840,7 +840,7 @@ PUB-DIR is set, use this as the publishing directory."
(org-lparse-begin-list-item list-type)))
;; Following variables are let bound when table emission is in
;; progress. See org-lparse.el.
;; progress. See org-lparse.el.
(defvar org-lparse-table-begin-marker)
(defvar org-lparse-table-ncols)
(defvar org-lparse-table-rowgrp-open)
@ -974,7 +974,7 @@ 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
Use this to generate automatic names and style-names. See
`org-odt-add-automatic-style'.")
(defun org-odt-write-automatic-styles ()
@ -1128,7 +1128,7 @@ styles congruent with the ODF-1.2 specification."
;; 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
;; richer. Unfortunately it is NOT amenable to easy configuration
;; by hand.
(let* ((template-name (nth 1 style-spec))
@ -1278,7 +1278,7 @@ styles congruent with the ODF-1.2 specification."
(+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))))
(insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n")))
;; Following variable is let bound during 'ORG-LINK callback. See
;; Following variable is let bound during 'ORG-LINK callback. See
;; org-html.el
(defvar org-lparse-link-description-is-image nil)
(defun org-odt-format-link (desc href &optional attr)
@ -1769,7 +1769,7 @@ ATTR is a string of other attributes of the a element."
(concat
(org-lparse-format 'EXTRA-TARGETS extra-targets)
;; No need to generate section numbers. They are auto-generated by
;; No need to generate section numbers. They are auto-generated by
;; the application
;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ")
@ -2025,7 +2025,7 @@ ATTR is a string of other attributes of the a element."
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 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-export-odt-max-image-size '(17.0 . 20.0)
"Limiting dimensions for an embedded image.")
@ -2074,7 +2074,7 @@ ATTR is a string of other attributes of the a element."
until size
do (setq size (org-odt-do-image-size
probe-method file dpi embed-as)))
(or size (error "Cannot determine Image size. Aborting ..."))
(or size (error "Cannot determine Image size. Aborting ..."))
(setq width (car size) height (cdr size)))
(cond
(scale
@ -2433,12 +2433,12 @@ visually."
;; Update styles.xml - take care of outline numbering
(with-current-buffer
(find-file-noselect (expand-file-name "styles.xml") t)
;; Don't make automatic backup of styles.xml file. This setting
;; 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
;; 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
;; 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.
@ -2704,7 +2704,7 @@ Do this when translation to MathML fails."
"" (org-add-props label '(org-protected t)))) t t)))))
;; process latex fragments as part of
;; `org-export-preprocess-after-blockquote-hook'. Note that this hook
;; `org-export-preprocess-after-blockquote-hook'. Note that this hook
;; is the one that is closest and well before the call to
;; `org-export-attach-captions-and-attributes' in
;; `org-export-preprocess-string'. The above arrangement permits
@ -2739,7 +2739,7 @@ Do this when translation to MathML fails."
members))
(defun org-odt-copy-styles-file (&optional styles-file)
;; Non-availability of styles.xml is not a critical error. For now
;; Non-availability of styles.xml is not a critical error. For now
;; throw an error purely for aesthetic reasons.
(setq styles-file (or styles-file
org-export-odt-styles-file

44
lisp/org-pcomplete.el
View File

@ -186,19 +186,19 @@ When completing for #+STARTUP, for example, this function returns
(pcomplete/org-mode/file-option/x "OPTIONS"))
(defun pcomplete/org-mode/file-option/title ()
"Complete arguments for the #+TITLE file option."
"Complete arguments for the #+TITLE file option."
(pcomplete/org-mode/file-option/x "TITLE"))
(defun pcomplete/org-mode/file-option/author ()
"Complete arguments for the #+AUTHOR file option."
"Complete arguments for the #+AUTHOR file option."
(pcomplete/org-mode/file-option/x "AUTHOR"))
(defun pcomplete/org-mode/file-option/email ()
"Complete arguments for the #+EMAIL file option."
"Complete arguments for the #+EMAIL file option."
(pcomplete/org-mode/file-option/x "EMAIL"))
(defun pcomplete/org-mode/file-option/date ()
"Complete arguments for the #+DATE file option."
"Complete arguments for the #+DATE file option."
(pcomplete/org-mode/file-option/x "DATE"))
(defun pcomplete/org-mode/file-option/bind ()
@ -236,16 +236,16 @@ When completing for #+STARTUP, for example, this function returns
"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) t)
tbl))
(pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1))))
(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) t)
tbl))
(pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1))))
(defvar org-tag-alist)
(defun pcomplete/org-mode/tag ()
@ -289,14 +289,14 @@ This needs more work, to handle headings with lots of spaces in them."
(match-string 1)))
(cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
(pcomplete-here cpllist
(substring pcomplete-stub 1)
(unless (or (not (delete
nil
(mapcar (lambda(x)
(string-match (substring pcomplete-stub 1) x))
cpllist)))
(looking-at "[ \t]*\n.*:END:"))
(save-excursion (insert "\n" spc ":END:"))))))
(substring pcomplete-stub 1)
(unless (or (not (delete
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.

2
lisp/org-plot.el
View File

@ -211,7 +211,7 @@ manner suitable for prepending to a user-specified script."
('grid "splot")))
(script "reset")
; ats = add-to-script
(ats (lambda (line) (setf script (format "%s\n%s" script line))))
(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)))

94
lisp/org-protocol.el
View File

@ -187,7 +187,7 @@ 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.
where module-name is an arbitrary name. All the values are strings.
Possible properties are:
@ -195,7 +195,7 @@ Possible properties are:
: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
: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.
@ -236,21 +236,21 @@ protocol - protocol to detect in a filename without trailing colon and slashes.
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
`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
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'.
`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
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.
@ -322,32 +322,32 @@ 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
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)))
(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:
@ -356,7 +356,7 @@ 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)))
(append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
(list l))))
@ -364,7 +364,7 @@ This function transforms it into a flat list."
(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
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:
@ -373,7 +373,7 @@ The location for a browser's bookmark has to look like this:
encodeURIComponent(location.href)
encodeURIComponent(document.title)+'/'+ \\
Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
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
@ -383,7 +383,7 @@ The sub-protocol used to reach this function is set in
(title (cadr splitparts))
orglink)
(if (boundp 'org-stored-links)
(setq org-stored-links (cons (list uri title) 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]")
@ -535,7 +535,7 @@ This is, how the matching is done:
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
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
@ -554,7 +554,7 @@ as filename."
(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.")
(message "Greedy org-protocol handler. Killing client.")
(server-edit))
(when (fboundp func)
(unless greedy
@ -572,7 +572,7 @@ as filename."
(client (ad-get-arg 1)))
(catch 'greedy
(dolist (var flist)
;; `\' to `/' on windows. FIXME: could this be done any better?
;; `\' 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))
@ -595,14 +595,14 @@ most of the work."
(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?"
(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
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)
@ -631,19 +631,19 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse
(setq strip-suffix
(read-string
(concat "Extension to strip from published URLs (" strip-suffix "): ")
strip-suffix nil strip-suffix t))
strip-suffix nil strip-suffix t))
(setq working-suffix
(read-string
(concat "Extension of editable files (" working-suffix "): ")
working-suffix nil working-suffix t))
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))
: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))))

108
lisp/org-publish.el
View File

@ -105,7 +105,7 @@ 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
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
@ -315,7 +315,7 @@ You could use brackets to delimit on what part the link will be.
(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)
(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir)
"Return t 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
@ -325,7 +325,7 @@ function can still decide about that independently."
(let ((rtn
(if org-publish-use-timestamps-flag
(org-publish-cache-file-needs-publishing
filename pub-dir pub-func)
filename pub-dir pub-func base-dir)
;; don't use timestamps, always return t
t)))
(if rtn
@ -334,11 +334,11 @@ function can still decide about that independently."
(message "Skipping unmodified file %s" filename)))
rtn))
(defun org-publish-update-timestamp (filename &optional pub-dir pub-func)
(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)))
(stamp (org-publish-cache-ctime-of-src filename base-dir)))
(org-publish-cache-set key stamp)))
(defun org-publish-remove-all-timestamps ()
@ -418,22 +418,22 @@ This splices all the components into the list."
(setq retval (if org-sitemap-ignore-case
(not (string-lessp (upcase B) (upcase A)))
(not (string-lessp B A))))))
((or (equal org-sitemap-sort-files 'chronologically)
(equal org-sitemap-sort-files 'anti-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 (equal org-sitemap-sort-files 'chronologically)
(<= A B)
(>= A B)))))))
((or (equal org-sitemap-sort-files 'chronologically)
(equal org-sitemap-sort-files 'anti-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 (equal org-sitemap-sort-files 'chronologically)
(<= A B)
(>= A B)))))))
;; Directory-wise wins:
(when org-sitemap-sort-folders
;; a is directory, b not:
(cond
((and (file-directory-p a) (not (file-directory-p b)))
(setq retval (equal org-sitemap-sort-folders 'first)))
;; a is not a directory, but b is:
;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b))
(setq retval (equal org-sitemap-sort-folders 'last))))))
retval))
@ -506,7 +506,7 @@ matching filenames."
(setq org-publish-temp-files nil)
(if org-sitemap-requested
(pushnew (expand-file-name (concat base-dir sitemap-filename))
org-publish-temp-files))
org-publish-temp-files))
(org-publish-get-base-files-1 base-dir recurse match
;; FIXME distinguish exclude regexp
;; for skip-file and skip-dir?
@ -536,14 +536,14 @@ matching filenames."
(xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
(when
(or
(and
(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)))
(and
(not (and e (string-match e filename)))
(string-match xm filename)))
(setq project-name (car prj))
(throw 'p-found project-name))))))
(when up
@ -600,10 +600,10 @@ PUB-DIR is the publishing directory."
(defmacro org-publish-with-aux-preprocess-maybe (&rest body)
"Execute BODY with a modified hook to preprocess for index."
`(let ((org-export-preprocess-after-headline-targets-hook
(if (plist-get project-plist :makeindex)
(cons 'org-publish-aux-preprocess
org-export-preprocess-after-headline-targets-hook)
org-export-preprocess-after-headline-targets-hook)))
(if (plist-get project-plist :makeindex)
(cons 'org-publish-aux-preprocess
org-export-preprocess-after-headline-targets-hook)
org-export-preprocess-after-headline-targets-hook)))
,@body))
(def-edebug-spec org-publish-with-aux-preprocess-maybe (body))
@ -624,7 +624,7 @@ See `org-publish-org-to' to the list of arguments."
"Publish an org file to HTML.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
(org-publish-org-to "html" plist filename pub-dir)))
(org-publish-org-to "html" plist filename pub-dir)))
(defun org-publish-org-to-org (plist filename pub-dir)
"Publish an org file to HTML.
@ -635,19 +635,19 @@ See `org-publish-org-to' to the list of arguments."
"Publish an org file to ASCII.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
(org-publish-org-to "ascii" plist filename pub-dir)))
(org-publish-org-to "ascii" plist filename pub-dir)))
(defun org-publish-org-to-latin1 (plist filename pub-dir)
"Publish an org file to Latin-1.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
(org-publish-org-to "latin1" plist filename pub-dir)))
(org-publish-org-to "latin1" plist filename pub-dir)))
(defun org-publish-org-to-utf8 (plist filename pub-dir)
"Publish an org file to UTF-8.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
(org-publish-org-to "utf8" plist filename pub-dir)))
(org-publish-org-to "utf8" plist filename pub-dir)))
(defun org-publish-attachment (plist filename pub-dir)
"Publish a file with no transformation of any kind.
@ -705,15 +705,14 @@ See `org-publish-projects'."
(if (listp publishing-function)
;; allow chain of publishing functions
(mapc (lambda (f)
(when (org-publish-needed-p filename pub-dir f tmp-pub-dir)
(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)))
(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)
(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)))
filename pub-dir publishing-function base-dir)))
(unless no-cache (org-publish-write-cache-file))))
(defun org-publish-projects (projects)
@ -733,9 +732,9 @@ If :makeindex is set, also produce a file theindex.org."
(sitemap-function (or (plist-get project-plist :sitemap-function)
'org-publish-org-sitemap))
(org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
org-publish-sitemap-date-format))
org-publish-sitemap-date-format))
(org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
org-publish-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)) file)
@ -751,7 +750,7 @@ If :makeindex is set, also produce a file theindex.org."
(plist-get project-plist :base-directory))
project t))
(when completion-function (run-hooks 'completion-function))
(org-publish-write-cache-file)))
(org-publish-write-cache-file)))
(org-publish-expand-projects projects)))
(defun org-publish-org-sitemap (project &optional sitemap-filename)
@ -767,9 +766,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(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))))
(concat "Sitemap for project " (car project))))
(sitemap-style (or (plist-get project-plist :sitemap-style)
'tree))
'tree))
(sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension))
(visiting (find-buffer-visiting sitemap-filename))
(ifn (file-name-nondirectory sitemap-filename))
@ -833,10 +832,10 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(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-sitemap-date-format
(org-publish-find-date file)))
(?a . ,(or (plist-get project-plist :author) user-full-name)))))
`((?t . ,(org-publish-find-title file t))
(?d . ,(format-time-string org-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."
@ -902,7 +901,7 @@ It returns time in `current-time' format."
;; If this function is called in batch mode,
;; project is still a string here.
(list (assoc project org-publish-project-alist))
(list project))))))
(list project))))))
;;;###autoload
(defun org-publish-all (&optional force)
@ -1033,12 +1032,12 @@ the project."
;; Create theindex.org if it doesn't exist already
(let ((index-file (expand-file-name "theindex.org" directory)))
(unless (file-exists-p index-file)
(setq ibuffer (find-file-noselect index-file))
(with-current-buffer ibuffer
(erase-buffer)
(insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n")
(save-buffer))
(kill-buffer ibuffer)))))
(setq ibuffer (find-file-noselect index-file))
(with-current-buffer ibuffer
(erase-buffer)
(insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n")
(save-buffer))
(kill-buffer ibuffer)))))
;; Caching functions:
@ -1103,7 +1102,7 @@ If FREE-CACHE, empty the cache."
(clrhash org-publish-cache))
(setq org-publish-cache nil))
(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func)
(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 `t', if the file needs publishing. The function also
checks if any included files have been more recently published,
@ -1123,12 +1122,12 @@ so that the file including them will be republished as well."
(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))))
(org-publish-cache-ctime-of-src included-file base-dir) t))))
;; FIXME don't kill current buffer
(unless visiting (kill-buffer buf)))
(if (null pstamp)
t
(let ((ctime (org-publish-cache-ctime-of-src filename)))
(let ((ctime (org-publish-cache-ctime-of-src filename base-dir)))
(or (< pstamp ctime)
(when included-files-ctime
(not (null (delq nil (mapcar (lambda(ct) (< ctime ct))
@ -1183,9 +1182,10 @@ Returns value on success, else nil."
(error "`org-publish-cache-set' called, but no cache present"))
(puthash key value org-publish-cache))
(defun org-publish-cache-ctime-of-src (f)
(defun org-publish-cache-ctime-of-src (f base-dir)
"Get the FILENAME ctime as an integer."
(let ((attr (file-attributes (expand-file-name (or (file-symlink-p f) f)))))
(let ((attr (file-attributes
(expand-file-name (or (file-symlink-p f) f) base-dir))))
(+ (lsh (car (nth 5 attr)) 16)
(cadr (nth 5 attr)))))

39
lisp/org-remember.el
View File

@ -189,22 +189,22 @@ calendar | %:type %:date"
(character :tag "Selection Key")
(string :tag "Template")
(choice :tag "Destination file"
(file :tag "Specify")
(function :tag "Function")
(const :tag "Use `org-default-notes-file'" nil))
(file :tag "Specify")
(function :tag "Function")
(const :tag "Use `org-default-notes-file'" nil))
(choice :tag "Destin. headline"
(string :tag "Specify")
(function :tag "Function")
(const :tag "Use `org-remember-default-headline'" nil)
(const :tag "At beginning of file" top)
(const :tag "At end of file" bottom)
(const :tag "In a date tree" date-tree))
(string :tag "Specify")
(function :tag "Function")
(const :tag "Use `org-remember-default-headline'" nil)
(const :tag "At beginning of file" top)
(const :tag "At end of file" bottom)
(const :tag "In a date tree" date-tree))
(choice :tag "Context"
(const :tag "Use in all contexts" nil)
(const :tag "Use in all contexts" t)
(repeat :tag "Use only if in major mode"
(symbol :tag "Major mode"))
(function :tag "Perform a check against function")))))
(const :tag "Use in all contexts" nil)
(const :tag "Use in all contexts" t)
(repeat :tag "Use only if in major mode"
(symbol :tag "Major mode"))
(function :tag "Perform a check against function")))))
(defcustom org-remember-delete-empty-lines-at-end t
"Non-nil means clean up final empty lines in remember buffer."
@ -294,7 +294,7 @@ conventions in Org-mode. This function returns such a link."
(org-store-link nil))
(defconst org-remember-help
"Select a destination location for the note.
"Select a destination location for the note.
UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store
RET on headline -> Store as sublevel entry to current headline
RET at beg-of-buf -> Append to file as level 2 headline
@ -398,8 +398,7 @@ RET at beg-of-buf -> Append to file as level 2 headline
This function should be placed into `remember-mode-hook' and in fact requires
to be run from that hook to function properly."
(when (and (boundp 'initial) (stringp initial))
(setq initial (org-no-properties initial))
(remove-text-properties 0 (length initial) '(read-only t) initial))
(setq initial (org-no-properties initial)))
(if org-remember-templates
(let* ((entry (org-select-remember-template use-char))
(ct (or org-overriding-default-time (org-current-time)))
@ -446,7 +445,7 @@ to be run from that hook to function properly."
v-a))
(v-n user-full-name)
(v-k (if (marker-buffer org-clock-marker)
(org-substring-no-properties org-clock-heading)))
(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))
@ -598,7 +597,7 @@ to be run from that hook to function properly."
(car clipboards))))))
((equal char "p")
(let*
((prop (org-substring-no-properties prompt))
((prop (org-no-properties prompt))
(pall (concat prop "_ALL"))
(allowed
(with-current-buffer
@ -994,7 +993,7 @@ See also the variable `org-reverse-note-order'."
(cond
((and fastp (memq heading '(top bottom)))
(setq spos org-goto-start-pos
exitcmd (if (eq heading 'top) 'left nil)))
exitcmd (if (eq heading 'top) 'left nil)))
(fastp (setq spos org-goto-start-pos
exitcmd 'return))
((eq org-remember-interactive-interface 'outline)

10
lisp/org-src.el
View File

@ -130,7 +130,7 @@ 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,
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."
@ -455,10 +455,10 @@ the fragment in the Org-mode 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))
'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)

167
lisp/org-table.el
View File

@ -109,7 +109,7 @@ table, obtained by prompting the user."
(defcustom org-table-default-size "5x2"
"The default size for newly created tables, Columns x Rows."
:group 'org-table-settings
:type 'string)
:type 'string)
(defcustom org-table-number-regexp
"^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$"
@ -224,13 +224,13 @@ t accept as input and present for editing"
(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
)
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
@ -375,8 +375,8 @@ available parameters."
"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
"@\\([-+]?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
@ -706,7 +706,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(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)))
(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)))
@ -743,7 +743,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
;; Get the data fields by splitting the lines.
(setq fields (mapcar
(lambda (l)
(org-split-string l " *| *"))
(org-split-string l " *| *"))
(delq nil (copy-sequence lines))))
;; How many fields in the longest line?
(condition-case nil
@ -775,7 +775,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(> (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))))
(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)
(error "Cannot narrow field starting with wide link \"%s\""
@ -1330,8 +1330,8 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(while (< i ll)
(if (>= (aref org-table-dlines i) line)
(throw 'exit i))
(setq i (1+ i)))))
nil))
(setq i (1+ i)))))
nil))
(defun org-table-delete-column ()
"Delete a column from the table."
@ -1638,8 +1638,8 @@ with `org-table-paste-rectangle'."
(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)))
region cols
(rpl (if cut " " nil)))
(goto-char beg)
(org-table-check-inside-data-field)
(setq l01 (org-current-line)
@ -2246,8 +2246,8 @@ For all numbers larger than LIMIT, shift them by DELTA."
(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))))
(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)
@ -2304,8 +2304,8 @@ Will be filled automatically during use.")
'((" " . "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.")
("!" . "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.")))
@ -2501,8 +2501,7 @@ not overwrite the stored one."
(setq orig (or (get-text-property 1 :orig-formula formula) "?"))
(while (> ndown 0)
(setq fields (org-split-string
(org-no-properties
(buffer-substring (point-at-bol) (point-at-eol)))
(buffer-substring-no-properties (point-at-bol) (point-at-eol))
" *| *"))
;; replace fields with duration values if relevant
(if duration
@ -2683,7 +2682,7 @@ in the buffer and column1 and column2 are table column numbers."
(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))
; (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))
@ -2898,7 +2897,7 @@ known that the table will be realigned a little later anyway."
(if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
(nth 2 a))))
(when (member name1 seen-fields)
(error "Several field/range formulas try to set %s" name1))
(error "Several field/range formulas try to set %s" name1))
(push name1 seen-fields)
(and (not a)
@ -2990,25 +2989,25 @@ with the prefix ARG."
;;;###autoload
(defun org-table-iterate-buffer-tables ()
"Iterate all tables in the buffer, to converge inter-table dependencies."
(interactive)
(let* ((imax 10)
(checksum (md5 (buffer-string)))
(interactive)
(let* ((imax 10)
(checksum (md5 (buffer-string)))
c1
(i imax))
(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)))
(error "No convergence after %d iterations" imax))))))
c1
(i imax))
(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)))
(error "No convergence after %d iterations" imax))))))
(defun org-table-expand-lhs-ranges (equations)
"Expand list of formulas.
@ -3287,8 +3286,8 @@ 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)))
(setq n (+ (* n 26) (string-to-char s) (- ?A) 1)
s (substring s 1)))
n))
(defun org-number-to-letters (n)
@ -3308,23 +3307,23 @@ If S is a string representing a number, keep this number."
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))))
((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)
@ -3591,7 +3590,7 @@ With prefix ARG, apply the new formulas to the table."
(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)))))
(marker-buffer pos)))))
(goto-char pos)
(org-table-force-dataline)
(when dest
@ -3996,37 +3995,37 @@ to execute outside of tables."
;; Special treatment needed for TAB and RET
(org-defkey orgtbl-mode-map [(return)]
(orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
(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)]))
(orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
(org-defkey orgtbl-mode-map [(tab)]
(orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
(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)]))
(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"))
(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")))
(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"))
(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)]))
(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"))
(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)
@ -4199,7 +4198,7 @@ overwritten, and the table is not marked as requiring realignment."
(setq a (assoc last-input-event function-key-map))
(cdr a))
(vector last-input-event)))
'self-insert-command)))
'self-insert-command)))
(call-interactively cmd)
(if (and org-self-insert-cluster-for-undo
(eq cmd 'self-insert-command))
@ -4349,7 +4348,7 @@ this table."
(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" ""))
ntbl (if (> ntbl 1) "s" ""))
(if (> ntbl 0)
ntbl
nil))))
@ -4373,9 +4372,9 @@ First element has index 0, or I0 if given."
(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 (error "Not at an org table")))))
(cond ((looking-at re1) t)
((looking-at re2) nil)
(t (error "Not at an org table")))))
(re (if commented re1 re2))
beg end)
(save-excursion

82
lisp/org-taskjuggler.el
View File

@ -29,7 +29,7 @@
;;
;; This library implements a TaskJuggler exporter for org-mode.
;; TaskJuggler uses a text format to define projects, tasks and
;; resources, so it is a natural fit for org-mode. It can produce all
;; resources, so it is a natural fit for org-mode. It can produce all
;; sorts of reports for tasks or resources in either HTML, CSV or PDF.
;; The current version of TaskJuggler requires KDE but the next
;; version is implemented in Ruby and should therefore run on any
@ -42,7 +42,7 @@
;;
;; Instead the TaskJuggler exporter looks for a tree that defines the
;; tasks and a optionally tree that defines the resources for this
;; project. It then creates a TaskJuggler file based on these trees
;; project. It then creates a TaskJuggler file based on these trees
;; and the attributes defined in all the nodes.
;;
;; * Installation
@ -60,8 +60,8 @@
;;
;; * Tasks
;;
;; Let's illustrate the usage with a small example. Create your tasks
;; as you usually do with org-mode. Assign efforts to each task using
;; Let's illustrate the usage with a small example. Create your tasks
;; as you usually do with org-mode. Assign efforts to each task using
;; properties (it's easiest to do this in the column view). You should
;; end up with something similar to the example by Peter Jones in
;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org.
@ -75,7 +75,7 @@
;; * Resources
;;
;; Next you can define resources and assign those to work on specific
;; tasks. You can group your resources hierarchically. Tag the top
;; tasks. You can group your resources hierarchically. Tag the top
;; node of the resources with "taskjuggler_resource" (or whatever you
;; customized `org-export-taskjuggler-resource-tag' to). You can
;; optionally assign an identifier (named "resource_id") to the
@ -84,8 +84,8 @@
;; picks the first word of the headline as the identifier as long as
;; it is unique, see the documentation of
;; `org-taskjuggler-get-unique-id'). Using that identifier you can
;; then allocate resources to tasks. This is again done with the
;; "allocate" property on the tasks. Do this in column view or when on
;; then allocate resources to tasks. This is again done with the
;; "allocate" property on the tasks. Do this in column view or when on
;; the task type
;;
;; C-c C-x p allocate RET <resource_id> RET
@ -110,13 +110,13 @@
;; The exporter will handle dependencies that are defined in the tasks
;; either with the ORDERED attribute (see TODO dependencies in the Org
;; mode manual) or with the BLOCKER attribute (see org-depend.el) or
;; alternatively with a depends attribute. Both the BLOCKER and the
;; alternatively with a depends attribute. Both the BLOCKER and the
;; depends attribute can be either "previous-sibling" or a reference
;; to an identifier (named "task_id") which is defined for another
;; task in the project. BLOCKER and the depends attribute can define
;; multiple dependencies separated by either space or comma. You can
;; task in the project. BLOCKER and the depends attribute can define
;; multiple dependencies separated by either space or comma. You can
;; also specify optional attributes on the dependency by simply
;; appending it. The following examples should illustrate this:
;; appending it. The following examples should illustrate this:
;;
;; * Training material
;; :PROPERTIES:
@ -144,7 +144,7 @@
;; org-global-properties-fixed
;; - What about property inheritance and org-property-inherit-p?
;; - Use TYPE_TODO as an way to assign resources
;; - Make sure multiple dependency definitions (i.e. BLOCKER on
;; - Make sure multiple dependency definitions (i.e. BLOCKER on
;; previous-sibling and on a specific task_id) in multiple
;; attributes are properly exported.
;;
@ -211,7 +211,7 @@ with `org-export-taskjuggler-project-tag'"
hideresource 1
loadunit shortauto
}"
"resourcereport \"Resource Graph\" {
"resourcereport \"Resource Graph\" {
headline \"Resource Allocation Graph\"
columns no, name, utilization, freeload, chart
loadunit shortauto
@ -228,10 +228,10 @@ with `org-export-taskjuggler-project-tag'"
workinghours wed, thu, fri off
}
"
"Default global properties for the project. Here you typically
"Default global properties for the project. Here you typically
define global properties such as shifts, accounts, rates,
vacation, macros and flags. Any property that is allowed within
the TaskJuggler file can be inserted. You could for example
vacation, macros and flags. Any property that is allowed within
the TaskJuggler file can be inserted. You could for example
include another TaskJuggler file.
The global properties are inserted after the project declaration
@ -255,12 +255,12 @@ but before any resource and task declarations."
"Export parts of the current buffer as a TaskJuggler file.
The exporter looks for a tree with tag, property or todo that
matches `org-export-taskjuggler-project-tag' and takes this as
the tasks for this project. The first node of this tree defines
the tasks for this project. The first node of this tree defines
the project properties such as project name and project period.
If there is a tree with tag, property or todo that matches
`org-export-taskjuggler-resource-tag' this three is taken as
resources for the project. If no resources are specified, a
default resource is created and allocated to the project. Also
resources for the project. If no resources are specified, a
default resource is created and allocated to the project. Also
the taskjuggler project will be created with default reports as
defined in `org-export-taskjuggler-default-reports'."
(interactive)
@ -352,7 +352,7 @@ with the TaskJuggler GUI."
(defun org-taskjuggler-parent-is-ordered-p ()
"Return true if the parent of the current node has a property
\"ORDERED\". Return nil otherwise."
\"ORDERED\". Return nil otherwise."
(save-excursion
(and (org-up-heading-safe) (org-entry-get (point) "ORDERED"))))
@ -373,7 +373,7 @@ information, all the properties, etc."
(defun org-taskjuggler-assign-task-ids (tasks)
"Given a list of tasks return the same list assigning a unique id
and the full path to each task. Taskjuggler takes hierarchical ids.
and the full path to each task. Taskjuggler takes hierarchical ids.
For that reason we have to make ids locally unique and we have to keep
a path to the current task."
(let ((previous-level 0)
@ -406,7 +406,7 @@ a path to the current task."
(defun org-taskjuggler-compute-task-leafiness (tasks)
"Figure out if each task is a leaf by looking at it's level,
and the level of its successor. If the successor is higher (ie
and the level of its successor. If the successor is higher (ie
deeper), then it's not a leaf."
(let (new-list)
(while (car tasks)
@ -452,8 +452,8 @@ unique id to each resource."
(and depends (org-taskjuggler-tokenize-dependencies depends))
(and blocker (org-taskjuggler-tokenize-dependencies blocker)))
tasks))
previous-sibling)
; update previous sibling info
previous-sibling)
; update previous sibling info
(cond
((< previous-level level)
(dotimes (tmp (- level previous-level))
@ -466,11 +466,11 @@ unique id to each resource."
(pop siblings))
(setq previous-sibling (car siblings))
(setcar siblings task)))
; insert a dependency on previous sibling if the parent is
; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling"
; insert a dependency on previous sibling if the parent is
; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling"
(when (or (and previous-sibling parent-ordered) blocked-on-previous)
(push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies))
; store dependency information
; store dependency information
(when dependencies
(push (cons "depends" (mapconcat 'identity dependencies ", ")) task))
(setq previous-level level)
@ -480,7 +480,7 @@ unique id to each resource."
"Split a dependency property value DEPENDENCIES into the
individual dependencies and return them as a list while keeping
the optional arguments (such as gapduration) for the
dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'."
dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'."
(cond
((string-match "^ *$" dependencies) nil)
((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies)
@ -493,7 +493,7 @@ dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'."
"For each dependency in DEPENDENCIES try to find a
corresponding task with a matching property \"task_id\" in TASKS.
Return a list containing the resolved links for all DEPENDENCIES
where a matching tasks was found. If the dependency is
where a matching tasks was found. If the dependency is
\"previous-sibling\" it is ignored (as this is dealt with in
`org-taskjuggler-resolve-dependencies'). If there is no matching
task the dependency is ignored and a warning is displayed ."
@ -523,7 +523,7 @@ task the dependency is ignored and a warning is displayed ."
(org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))))))
(defun org-taskjuggler-find-task-with-id (id tasks)
"Find ID in tasks. If found return the path of task. Otherwise
"Find ID in tasks. If found return the path of task. Otherwise
return nil."
(let ((task-id (cdr (assoc "task_id" (car tasks))))
(path (cdr (assoc "path" (car tasks)))))
@ -541,10 +541,10 @@ finally add more underscore characters (\"_\")."
(let* ((headline (cdr (assoc "headline" item)))
(parts (split-string headline))
(id (org-taskjuggler-clean-id (downcase (pop parts)))))
; try to add more parts of the headline to make it unique
; try to add more parts of the headline to make it unique
(while (and (member id unique-ids) (car parts))
(setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts))))))
; if its still not unique add "_"
; if its still not unique add "_"
(while (member id unique-ids)
(setq id (concat id "_")))
id))
@ -559,8 +559,8 @@ finally add more underscore characters (\"_\")."
(replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id))))
(defun org-taskjuggler-open-project (project)
"Insert the beginning of a project declaration. All valid
attributes from the PROJECT alist are inserted. If no end date is
"Insert the beginning of a project declaration. All valid
attributes from the PROJECT alist are inserted. If no end date is
specified it is calculated
`org-export-taskjuggler-default-project-duration' days from now."
(let* ((unique-id (cdr (assoc "unique-id" project)))
@ -580,9 +580,9 @@ with separator \"\n\"."
(and filtered-items (mapconcat 'identity filtered-items "\n"))))
(defun org-taskjuggler-get-attributes (item attributes)
"Return all attribute as a single formatted string. ITEM is an
alist representing either a resource or a task. ATTRIBUTES is a
list of symbols. Only entries from ITEM are considered that are
"Return all attribute as a single formatted string. ITEM is an
alist representing either a resource or a task. ATTRIBUTES is a
list of symbols. Only entries from ITEM are considered that are
listed in ATTRIBUTES."
(org-taskjuggler-filter-and-join
(mapcar
@ -603,10 +603,10 @@ If the ATTRIBUTE is not in ITEM return nil."
(t (org-taskjuggler-get-attribute (cdr item) attribute))))
(defun org-taskjuggler-open-resource (resource)
"Insert the beginning of a resource declaration. All valid
attributes from the RESOURCE alist are inserted. If the RESOURCE
"Insert the beginning of a resource declaration. All valid
attributes from the RESOURCE alist are inserted. If the RESOURCE
defines a property \"resource_id\" it will be used as the id for
this resource. Otherwise it will use the ID property. If neither
this resource. Otherwise it will use the ID property. If neither
is defined it will calculate a unique id for the resource using
`org-taskjuggler-get-unique-id'."
(let ((id (org-taskjuggler-clean-id
@ -622,7 +622,7 @@ is defined it will calculate a unique id for the resource using
(defun org-taskjuggler-clean-effort (effort)
"Translate effort strings into a format acceptable to taskjuggler,
i.e. REAL UNIT. A valid effort string can be anything that is
i.e. REAL UNIT. A valid effort string can be anything that is
accepted by `org-duration-string-to-minutes´."
(cond
((null effort) effort)

112
lisp/org-timer.el
View File

@ -82,7 +82,7 @@ nil current timer is not displayed"
"Hook run before relative timer is paused.")
(defvar org-timer-continue-hook nil
"Hook run after relative timer is continued.")
"Hook run after relative timer is continued.")
(defvar org-timer-set-hook nil
"Hook run after countdown timer is set.")
@ -199,7 +199,7 @@ it in the buffer."
(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: ")
"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
@ -295,7 +295,7 @@ VALUE can be `on', `off', or `pause'."
(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))
(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)))))
@ -314,17 +314,17 @@ VALUE can be `on', `off', or `pause'."
(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)))))
(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)
@ -394,48 +394,48 @@ replace any running timer."
(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) t)
(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"))))))
(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) t)
(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)

4
lisp/org-vm.el
View File

@ -85,8 +85,8 @@
(date-to-time date))))
folder desc link)
(if (vm-imap-folder-p)
(let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
(setq folder (vm-imap-folder-for-spec spec)))
(let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
(setq folder (vm-imap-folder-for-spec spec)))
(progn
(setq folder (abbreviate-file-name buffer-file-name))
(if (and vm-folder-directory

8
lisp/org-wl.el
View File

@ -34,9 +34,9 @@
(require 'org)
(defgroup org-wl nil
"Options concerning the Wanderlust link."
:tag "Org Startup"
:group 'org-link)
"Options concerning the Wanderlust link."
:tag "Org Startup"
:group 'org-link)
(defcustom org-wl-link-to-refile-destination t
"Create a link to the refile destination if the message is marked as refile."
@ -309,7 +309,7 @@ for namazu index."
article))
(or (wl-summary-jump-to-msg (string-to-number article))
(error "No such message: %s" article)))
(wl-summary-redisplay))))))
(wl-summary-redisplay))))))
(provide 'org-wl)

2
lisp/org-xoxo.el
View File

@ -49,7 +49,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
(with-current-buffer (get-buffer buffer)
(let* ((pos (point))
(opt-plist (org-combine-plists (org-default-export-plist)
(org-infile-export-plist)))
(org-infile-export-plist)))
(filename (concat (file-name-as-directory
(org-export-directory :xoxo opt-plist))
(file-name-sans-extension

1430
lisp/org.el
View File

File diff suppressed because it is too large Load Diff

23
targets.mk
View File

@ -28,7 +28,7 @@ endif
cleancontrib cleantesting cleanutils
cleanrel clean-install cleanelc cleandirs \
cleanlisp cleandoc cleandocs cleantest \
compile compile-dirty uncompiled \
compile compile-single compile-source compile-dirty uncompiled \
config config-test config-exe config-all config-eol
CONF_BASE = EMACS DESTDIR
@ -75,7 +75,7 @@ local.mk:
all compile::
$(foreach dir, doc lisp, $(MAKE) -C $(dir) clean;)
compile compile-dirty::
compile compile-dirty compile-single compile-source::
$(MAKE) -C lisp $@
all clean-install::
$(foreach dir, $(SUBDIRS), $(MAKE) -C $(dir) $@;)
@ -118,25 +118,26 @@ clean: cleanrel
$(MAKE) -C lisp clean
$(MAKE) -C doc clean
cleanall: cleandirs cleantest
cleanall: cleandirs cleantest cleancontrib cleantesting cleanutils
-$(FIND) . -name \*~ -o -name \*# -o -name .#\* -exec $(RM) {} \;
-$(FIND) contrib testing UTILITIES -name \*~ -o -name \*.elc -exec $(RM) {} \;
cleancontrib cleantesting cleanUTILITIES:
-$(FIND) $(@:clean%=%) -name \*~ -o -name \*.elc -exec $(RM) {} \;
cleancontrib:
-$(FIND) contrib -name \*~ -o -name \*.elc -exec $(RM) {} \;
cleanutils: cleanUTILITIES
cleantesting:
-$(FIND) testing -name \*~ -o -name \*.elc -exec $(RM) {} \;
cleanutils:
-$(FIND) UTILITIES -name \*~ -o -name \*.elc -exec $(RM) {} \;
cleanrel:
$(RMR) RELEASEDIR
$(RMR) org-7.*
$(RMR) org-7*zip org-7*tar.gz
cleanelc:
$(MAKE) -C lisp $@
cleanlisp:
cleanelc cleanlisp:
$(MAKE) -C lisp clean
-$(FIND) lisp -name \*~ -exec $(RM) {} \;
cleandoc cleandocs:
$(MAKE) -C doc clean

Some files were not shown because too many files have changed in this diff Show More