ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

This commit is contained in:
Carsten Dominik 2011-10-27 18:13:33 +02:00
parent 1432e4bc79 71f1c1bed4
commit 23b8111ffa
38 changed files with 1054 additions and 740 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
BUGFIXING/org-log.el
View File

@ -21,7 +21,7 @@
(and delete-other-windows (delete-other-windows))
(widen)
(goto-char pos)
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(org-show-context 'agenda)
(save-excursion
(and (outline-next-heading)
@ -54,7 +54,7 @@
(switch-to-buffer-other-window buffer)
(widen)
(goto-char pos)
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(org-show-context 'agenda)
(save-excursion
(and (outline-next-heading)

196
contrib/babel/langs/ob-picolisp.el Normal file
View File

@ -0,0 +1,196 @@
;;; ob-picolisp.el --- org-babel functions for picolisp evaluation
;; Copyright (C) 2011 Thorsten Jolitz
;; Authors: Thorsten Jolitz and Eric Schulte
;; Keywords: literate programming, reproducible research,
;; Homepage: http://orgmode.org
;; Version: 1.0
;;;; Contact:
;; For comments, bug reports, questions, etc, you can contact the
;; first author via email to
;; (concat "t" "jolitz") at gmail dot com
;; or post a question in the org-newsgroup (see homepage) with prefix
;; [babel] in the header.
;; This file is NOT (yet) part of GNU Emacs
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This library enables the use of PicoLisp in the multi-language
;; programming framework Org-Babel. PicoLisp is a minimal yet
;; fascinating lisp dialect and a highly productive application
;; framework for web-based client-server applications on top of
;; object-oriented databases. A good way to learn PicoLisp is to first
;; read Paul Grahams essay "The hundred year language"
;; (http://www.paulgraham.com/hundred.html) and then study the various
;; documents and essays published in the PicoLisp wiki
;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some
;; GNU/Linux Distributions, and can be downloaded here:
;; http://software-lab.de/down.html. It ships with a picolisp-mode and
;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/
;; directory).
;; Although it might seem more natural to use Emacs Lisp for most
;; Lisp-based programming tasks inside Org-Mode, an Emacs library
;; written in Emacs Lisp, PicoLisp has at least two outstanding
;; features that make it a valuable addition to Org-Babel:
;; PicoLisp _is_ an object-oriented database with a Prolog-based query
;; language implemented in PicoLisp (Pilog). Database objects are
;; first-class members of the language.
;; PicoLisp is an extremely productive framework for the development
;; of interactive web-applications (on top of a database).
;;; Requirements:
;;; Code:
(require 'ob)
(require 'ob-eval)
;; optionally define a file extension for this language
(add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l"))
;;; interferes with settings in org-babel buffer?
;; optionally declare default header arguments for this language
;; (defvar org-babel-default-header-args:picolisp
;; '((:colnames . "no"))
;; "Default arguments for evaluating a picolisp source block.")
(defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe"
"String to indicate that evaluation has completed.")
(defcustom org-babel-picolisp-cmd "pil"
"Name of command used to evaluate picolisp blocks."
:group 'org-babel
:type 'string)
(defun org-babel-expand-body:picolisp (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(result-params (cdr (assoc :result-params params)))
(print-level nil) (print-length nil))
(if (> (length vars) 0)
(concat "(prog (let ("
(mapconcat
(lambda (var)
(format "%S '%S)"
(print (car var))
(print (cdr var))))
vars "\n ")
" \n" body ") )")
body)))
(defun org-babel-execute:picolisp (body params)
"Execute a block of Picolisp code with org-babel. This function is
called by `org-babel-execute-src-block'"
(message "executing Picolisp source code block")
(let* (
;; name of the session or "none"
(session-name (cdr (assoc :session params)))
;; set the session if the session variable is non-nil
(session (org-babel-picolisp-initiate-session session-name))
;; either OUTPUT or VALUE which should behave as described above
(result-type (cdr (assoc :result-type params)))
;; expand the body with `org-babel-expand-body:picolisp'
(full-body (org-babel-expand-body:picolisp body params))
;; wrap body appropriately for the type of evaluation and results
(wrapped-body
(cond
((or (member "code" result-params)
(member "pp" result-params))
(format "(pretty (out \"/dev/null\" %s))" full-body))
((and (member "value" result-params) (not session))
(format "(print (out \"/dev/null\" %s))" full-body))
((member "value" result-params)
(format "(out \"/dev/null\" %s)" full-body))
(t full-body))))
((lambda (result)
(if (or (member "verbatim" result-params)
(member "scalar" result-params)
(member "output" result-params)
(member "code" result-params)
(member "pp" result-params)
(= (length result) 0))
result
(read result)))
(if (not (string= session-name "none"))
;; session based evaluation
(mapconcat ;; <- joins the list back together into a single string
#'identity
(butlast ;; <- remove the org-babel-picolisp-eoe line
(delq nil
(mapcar
(lambda (line)
(org-babel-chomp ;; remove trailing newlines
(when (> (length line) 0) ;; remove empty lines
(cond
;; remove leading "-> " from return values
((and (>= (length line) 3)
(string= "-> " (subseq line 0 3)))
(subseq line 3))
;; remove trailing "-> <<return-value>>" on the
;; last line of output
((and (member "output" result-params)
(string-match-p "->" line))
(subseq line 0 (string-match "->" line)))
(t line)
)
;; (if (and (>= (length line) 3) ;; remove leading "<- "
;; (string= "-> " (subseq line 0 3)))
;; (subseq line 3)
;; line)
)))
;; returns a list of the output of each evaluated expression
(org-babel-comint-with-output (session org-babel-picolisp-eoe)
(insert wrapped-body) (comint-send-input)
(insert "'" org-babel-picolisp-eoe) (comint-send-input)))))
"\n")
;; external evaluation
(let ((script-file (org-babel-temp-file "picolisp-script-")))
(with-temp-file script-file
(insert (concat wrapped-body "(bye)")))
(org-babel-eval
(format "%s %s"
org-babel-picolisp-cmd
(org-babel-process-file-name script-file))
""))))))
(defun org-babel-picolisp-initiate-session (&optional session-name)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session."
(unless (string= session-name "none")
(require 'inferior-picolisp)
;; provide a reasonable default session name
(let ((session (or session-name "*inferior-picolisp*")))
;; check if we already have a live session by this name
(if (org-babel-comint-buffer-livep session)
(get-buffer session)
(save-window-excursion
(run-picolisp org-babel-picolisp-cmd)
(rename-buffer session-name)
(current-buffer))))))
(provide 'ob-picolisp)
;;; ob-picolisp.el ends here

2
contrib/lisp/org-annotate-file.el
View File

@ -99,7 +99,7 @@ show the relevant section"
(concat "file:" filename "::" line)
(org-annotate-file-elipsify-desc line))))
(with-current-buffer (find-file org-annotate-file-storage-file)
(unless (org-mode-p)
(unless (eq major-mode 'org-mode)
(org-mode))
(goto-char (point-min))
(widen)

4
contrib/lisp/org-contacts.el
View File

@ -157,7 +157,7 @@ If both match values are nil, return all contacts."
(dolist (file (org-contacts-files))
(org-check-agenda-file file)
(with-current-buffer (org-get-agenda-file-buffer file)
(unless (org-mode-p)
(unless (eq major-mode 'org-mode)
(error "File %s is no in `org-mode'" file))
(org-scan-tags
'(add-to-list 'markers (set-marker (make-marker) (point)))
@ -262,7 +262,7 @@ If both match values are nil, return all contacts."
(when marker
(switch-to-buffer-other-window (marker-buffer marker))
(goto-char marker)
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(org-show-context 'agenda)
(save-excursion
(and (outline-next-heading)

4
contrib/lisp/org-expiry.el
View File

@ -185,7 +185,7 @@ restart `org-mode' if necessary."
(lambda() (add-hook 'before-save-hook
'org-expiry-process-entries t t)))
;; need this to refresh org-mode hooks
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(org-mode)
(if (org-called-interactively-p)
(message "Org-expiry insinuated, `org-mode' restarted.")))))
@ -206,7 +206,7 @@ and restart `org-mode' if necessary."
'org-expiry-process-entries t t)))
(when arg
;; need this to refresh org-mode hooks
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(org-mode)
(if (org-called-interactively-p)
(message "Org-expiry de-insinuated, `org-mode' restarted.")))))

147
contrib/lisp/org-export-generic.el
View File

@ -87,7 +87,9 @@
;; *** allow different open/closing prefixes
;; * properties
;; * drawers
;; * oh my
;; * Escape camel-case for wiki exporters.
;; * Adjust to depth limits on headers --- need to roll-over from headers
;; to lists, as per other exporters
;; * optmization (many plist extracts should be in let vars)
;; * define defcustom spec for the specifier list
;; * fonts: at least monospace is not handled at all here.
@ -187,8 +189,8 @@ in this way, it will be wrapped."
; section prefixes/suffixes can be direct strings or lists as well
:body-section-prefix "<secprefix>\n"
:body-section-suffix "</secsuffix>\n"
; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n")
; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n")
; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n")
; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n")
; if preformated text should be included (eg, : prefixed)
@ -263,28 +265,28 @@ in this way, it will be wrapped."
:body-header-section-numbers 3
:body-section-prefix "\n"
; :body-section-header-prefix "\n"
; :body-section-header-format "%s\n"
; :body-section-header-suffix (?\$ ?\# ?^ ?\~ ?\= ?\-)
; :body-section-header-prefix "\n"
; :body-section-header-format "%s\n"
; :body-section-header-suffix (?\$ ?\# ?^ ?\~ ?\= ?\-)
:body-section-header-prefix ("" "" "" "* " " + " " - ")
:body-section-header-format "%s\n"
:body-section-header-suffix (?~ ?= ?- "\n" "\n" "\n")
; :body-section-marker-prefix ""
; :body-section-marker-chars (?\$ ?\# ?^ ?\~ ?\= ?\-)
; :body-section-marker-suffix "\n"
; :body-section-marker-prefix ""
; :body-section-marker-chars (?\$ ?\# ?^ ?\~ ?\= ?\-)
; :body-section-marker-suffix "\n"
:body-line-export-preformated t
:body-line-format "%s\n"
:body-line-wrap 75
; :body-text-prefix "<t>\n"
; :body-text-suffix "</t>\n"
; :body-text-prefix "<t>\n"
; :body-text-suffix "</t>\n"
:body-bullet-list-prefix (?* ?+ ?-)
; :body-bullet-list-suffix (?* ?+ ?-)
; :body-bullet-list-suffix (?* ?+ ?-)
)
;;
@ -322,47 +324,6 @@ in this way, it will be wrapped."
:body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
)
;;
;; minimal html exporter
;;
("html"
;; simple html output
:file-suffix ".html"
:key-binding ?h
:header-prefix "<body>"
:title-format "<h1>%s</h1>\n\n"
:date-export t
:date-format "<br /><b>Date:</b> <i>%s</i><br />\n\n"
:toc-export nil
:body-header-section-numbers 3
:body-section-header-prefix ("<h1>" "<h2>" "<h3>"
"<h4>" "<h5>" "<h6>")
:body-section-header-format "%s"
:body-section-header-suffix ("</h1>\n" "</h2>\n" "</h3>\n"
"</h4>\n" "</h5>\n" "</h6>\n")
:body-section-prefix "<secprefix>\n"
:body-section-suffix "</secsuffix>\n"
; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n")
; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n")
:body-line-export-preformated t
:body-line-format "%s\n"
:body-text-prefix "<p>\n"
:body-text-suffix "</p>\n"
:body-bullet-list-prefix (?* ?+ ?-)
; :body-bullet-list-suffix (?* ?+ ?-)
)
;;
;; internet-draft .xml for xml2rfc exporter
;;
@ -428,6 +389,85 @@ in this way, it will be wrapped."
:body-list-suffix "</list>\n"
:body-list-format "<t>%s</t>\n"
)
("trac-wiki"
:file-suffix ".txt"
:key-binding ?T
;; lifted from wikipedia exporter
:header-prefix ""
:header-suffix ""
:title-format "= %s =\n"
:date-export nil
:toc-export nil
:body-header-section-numbers nil
:body-section-prefix "\n"
:body-section-header-prefix (" == " " === " " ==== "
" ===== " )
:body-section-header-suffix (" ==\n\n" " ===\n\n" " ====\n\n"
" =====\n\n" " ======\n\n" " =======\n\n")
:body-line-export-preformated t ;; yes/no/maybe???
:body-line-format "%s\n"
:body-line-wrap 75
:body-line-fixed-format " %s\n"
:body-list-format " * %s\n"
:body-number-list-format " # %s\n"
;; :body-list-prefix "LISTSTART"
;; :body-list-suffix "LISTEND"
;; this is ignored! [2010/02/02:rpg]
:body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
)
("tikiwiki"
:file-suffix ".txt"
:key-binding ?U
;; lifted from wikipedia exporter
:header-prefix ""
:header-suffix ""
:title-format "-= %s =-\n"
:date-export nil
:toc-export nil
:body-header-section-numbers nil
:body-section-prefix "\n"
:body-section-header-prefix ("! " "!! " "!!! " "!!!! "
"!!!!! " "!!!!!! " "!!!!!!! ")
:body-section-header-suffix (" \n" " \n" " \n"
" \n" " \n" " \n")
:body-line-export-preformated t ;; yes/no/maybe???
:body-line-format "%s "
:body-line-wrap nil
:body-line-fixed-format " %s\n"
:body-list-format "* %s\n"
:body-number-list-format "# %s\n"
;; :body-list-prefix "LISTSTART"
;; :body-list-suffix "LISTEND"
:blockquote-start "\n^\n"
:blockquote-end "^\n\n"
:body-newline-paragraph "\n"
:bold-format "__%s__"
:italic-format "''%s''"
:underline-format "===%s==="
:strikethrough-format "--%s--"
:code-format "-+%s+-"
:verbatim-format "~pp~%s~/pp~"
)
)
"A assoc list of property lists to specify export definitions"
@ -617,6 +657,7 @@ underlined headlines. The default is 3."
(buffer-substring
(if (org-region-active-p) (region-beginning) (point-min))
(if (org-region-active-p) (region-end) (point-max))))
(org-export-current-backend 'org-export-generic)
(lines (org-split-string
(org-export-preprocess-string
region

278
contrib/lisp/org-lparse.el
View File

@ -61,19 +61,6 @@ If there is an active region, export only the region. The prefix
ARG specifies how many levels of the outline should become
headlines. The default is 3. Lower levels will become bulleted
lists."
;; (interactive "Mbackend: \nP")
(interactive
(let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
(all-backends (org-lparse-all-backends))
(target-backend
(funcall input "Export to: " all-backends nil t nil))
(native-backend
(or
;; (and (org-lparse-backend-is-native-p target-backend)
;; target-backend)
(funcall input "Use Native backend: "
(cdr (assoc target-backend all-backends)) nil t nil))))
(list target-backend native-backend current-prefix-arg)))
(let (f (file-or-buf (org-lparse target-backend native-backend
arg 'hidden)))
(when file-or-buf
@ -103,7 +90,6 @@ emacs --batch
"Call `org-lparse' with output to a temporary buffer.
No file is created. The prefix ARG is passed through to
`org-lparse'."
(interactive "Mbackend: \nP")
(let ((tempbuf (format "*Org %s Export*" (upcase backend))))
(org-lparse backend backend arg nil nil tempbuf)
(when org-export-show-temporary-export-buffer
@ -115,10 +101,9 @@ No file is created. The prefix ARG is passed through to
This can be used in any buffer. For example, you could write an
itemized list in org-mode syntax in an HTML buffer and then use
this command to convert it."
(interactive "Mbackend: \nr")
(let (reg backend-string buf pop-up-frames)
(save-window-excursion
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(setq backend-string (org-lparse-region backend beg end t 'string))
(setq reg (buffer-substring beg end)
buf (get-buffer-create "*Org tmp*"))
@ -147,9 +132,6 @@ a Lisp program could call this function in the following way:
When called interactively, the output buffer is selected, and shown
in a window. A non-interactive call will only return the buffer."
(interactive "Mbackend: \nr\nP")
(when (org-called-interactively-p 'any)
(setq buffer (format "*Org %s Export*" (upcase backend))))
(let ((transient-mark-mode t) (zmacs-regions t)
ext-plist rtn)
(setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
@ -368,43 +350,41 @@ Add BACKEND to `org-lparse-native-backends'."
org-lparse-native-backends))
(message "Unregistered backend %S" backend))
(defun org-lparse-get-other-backends (in-fmt)
"Return OUTPUT-FMT-ALIST corresponding to IN-FMT.
See `org-lparse-convert-capabilities' for definition of
OUTPUT-FMT-ALIST."
(when (org-lparse-get-converter in-fmt)
(or (ignore-errors (org-lparse-backend-get in-fmt 'OTHER-BACKENDS) )
(catch 'out-fmts
(dolist (c org-lparse-convert-capabilities)
(defun org-lparse-do-reachable-formats (in-fmt)
"Return verbose info about formats to which IN-FMT can be converted.
Return a list where each element is of the
form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See
`org-export-odt-convert-processes' for CONVERTER-PROCESS and see
`org-export-odt-convert-capabilities' for OUTPUT-FMT-ALIST."
(let (reachable-formats)
(dolist (backend org-lparse-native-backends reachable-formats)
(let* ((converter (org-lparse-backend-get
backend 'CONVERT-METHOD))
(capabilities (org-lparse-backend-get
backend 'CONVERT-CAPABILITIES)))
(when converter
(dolist (c capabilities)
(when (member in-fmt (nth 1 c))
(throw 'out-fmts (nth 2 c))))))))
(push (cons converter (nth 2 c)) reachable-formats))))))))
(defun org-lparse-get-converter (in-fmt)
"Return converter associated with IN-FMT.
See `org-lparse-convert-capabilities' for further information."
(or (ignore-errors (org-lparse-backend-get in-fmt 'CONVERT-METHOD))
org-lparse-convert-process))
(defun org-lparse-reachable-formats (in-fmt)
"Return list of formats to which IN-FMT can be converted.
The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)."
(let (l)
(mapc (lambda (e) (add-to-list 'l e))
(apply 'append (mapcar
(lambda (e) (mapcar 'car (cdr e)))
(org-lparse-do-reachable-formats in-fmt))))
l))
(defun org-lparse-all-backends ()
"Return all formats to which `org-lparse' could export to.
The return value is an alist of the form (TARGET-BACKEND
NATIVE-BACKEND-1 NATIVE-BACKEND-2 ...) with the condition that
the org file can be exported to TARGET-BACKEND via any one of
NATIVE-BACKEND-1, NATIVE-BACKEND-2 etc.
For example, an entry of the form \"(\"pdf\" \"odt\" \"xhtml\")\"
would mean that the org file could be exported to \"pdf\" format
by exporting natively either to \"xhtml\" or \"odt\" backends."
(let (all-backends)
(flet ((add (other native)
(let ((val (assoc-string other all-backends t)))
(if val (setcdr val (nconc (list native) (cdr val)))
(push (cons other (list native)) all-backends)))))
(loop for backend in org-lparse-native-backends
do (loop for other in
(mapcar #'car (org-lparse-get-other-backends backend))
do (add other backend))))
all-backends))
(defun org-lparse-reachable-p (in-fmt out-fmt)
"Return non-nil if IN-FMT can be converted to OUT-FMT."
(catch 'done
(let ((reachable-formats (org-lparse-do-reachable-formats in-fmt)))
(dolist (e reachable-formats)
(let ((out-fmt-spec (assoc out-fmt (cdr e))))
(when out-fmt-spec
(throw 'done (cons (car e) out-fmt-spec))))))))
(defun org-lparse-backend-is-native-p (backend)
(member backend org-lparse-native-backends))
@ -442,141 +422,19 @@ header and footer, simply return the content of <body>...</body>,
without even the body tags themselves.
PUB-DIR specifies the publishing directory."
(interactive
(let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
(all-backends (org-lparse-all-backends))
(target-backend
(and all-backends
(funcall input "Export to: " all-backends nil t nil)))
(native-backend
(let ((choices (if target-backend
(cdr (assoc target-backend all-backends))
(or org-lparse-native-backends
(error "No registered backends")))))
(funcall input "Use Native backend: " choices nil t nil))))
(list target-backend native-backend current-prefix-arg)))
(let* ((org-lparse-backend (intern native-backend))
(org-lparse-other-backend (and target-backend
(intern target-backend))))
(unless (org-lparse-backend-is-native-p native-backend)
(error "Don't know how to export natively to backend %s" native-backend))
(unless (or (not target-backend)
(equal target-backend native-backend)
(assoc target-backend (org-lparse-get-other-backends
native-backend)))
(unless (or (equal native-backend target-backend)
(org-lparse-reachable-p native-backend target-backend))
(error "Don't know how to export to backend %s %s" target-backend
(format "via %s" native-backend)))
(run-hooks 'org-export-first-hook)
(org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)))
(defcustom org-lparse-convert-processes
'(("BasicODConverter"
("soffice" "-norestore" "-invisible" "-headless"
"\"macro:///BasicODConverter.Main.Convert(%I,%f,%O)\""))
("unoconv"
("unoconv" "-f" "%f" "-o" "%d" "%i")))
"Specify a list of document converters and their usage.
The converters in this list are offered as choices while
customizing `org-lparse-convert-process'.
This variable is an alist where each element is of the
form (CONVERTER-NAME (CONVERTER-PROGRAM ARG1 ARG2 ...)).
CONVERTER-NAME is name of the converter. CONVERTER-PROGRAM is
the name of the executable. ARG1, ARG2 etc are command line
options that are passed to CONVERTER-PROGRAM. Format specifiers
can be used in the ARGs and they are interpreted as below:
%i input file name in full
%I input file name as a URL
%f format of the output file
%o output file name in full
%O output file name as a URL
%d output dir in full
%D output dir as a URL."
:group 'org-lparse
:type
'(choice
(const :tag "None" nil)
(alist :tag "Converters"
:key-type (string :tag "Converter Name")
:value-type (group (cons (string :tag "Executable")
(repeat (string :tag "Command line args")))))))
(defcustom org-lparse-convert-process nil
"Command to convert from an Org exported format to other formats.
During customization, the list of choices are populated from
`org-lparse-convert-processes'. Refer afore-mentioned variable
for further information."
:group 'org-lparse
:type '(choice :convert-widget
(lambda (w)
(apply 'widget-convert (widget-type w)
(eval (car (widget-get w :args)))))
`((const :tag "None" nil)
,@(mapcar (lambda (c)
`(const :tag ,(car c) ,(cadr c)))
org-lparse-convert-processes))))
(defcustom org-lparse-convert-capabilities
'(("Text"
("odt" "ott" "doc" "rtf")
(("pdf" "pdf") ("odt" "odt") ("xhtml" "html") ("rtf" "rtf")
("ott" "ott") ("doc" "doc") ("ooxml" "xml") ("html" "html")))
("Web"
("html" "xhtml") (("pdf" "pdf") ("odt" "txt") ("html" "html")))
("Spreadsheet"
("ods" "ots" "xls" "csv")
(("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv")
("ods" "ods") ("xls" "xls") ("xhtml" "xhtml") ("ooxml" "xml")))
("Presentation"
("odp" "otp" "ppt")
(("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("xhtml" "xml")
("otp" "otp") ("ppt" "ppt") ("odg" "odg") ("html" "html"))))
"Specify input and output formats of `org-lparse-convert-process'.
More correctly, specify the set of input and output formats that
the user is actually interested in.
This variable is an alist where each element is of the
form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST).
INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an
alist where each element is of the form (OUTPUT-FMT
OUTPUT-FILE-EXTENSION).
The variable is interpreted as follows:
`org-lparse-convert-process' can take any document that is in
INPUT-FMT-LIST and produce any document that is in the
OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have
OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT
serves dual purposes:
- It is used for populating completion candidates during
`org-lparse' and `org-lparse-convert' commands.
- It is used as the value of \"%f\" specifier in
`org-lparse-convert-process'.
DOCUMENT-CLASS is used to group a set of file formats in
INPUT-FMT-LIST in to a single class.
Note that this variable inherently captures how LibreOffice based
converters work. LibreOffice maps documents of various formats
to classes like Text, Web, Spreadsheet, Presentation etc and
allow document of a given class (irrespective of it's source
format) to be converted to any of the export formats associated
with that class.
See default setting of this variable for an typical
configuration."
:group 'org-lparse
:type
'(choice
(const :tag "None" nil)
(alist :key-type (string :tag "Document Class")
:value-type
(group (repeat :tag "Input formats" (string :tag "Input format"))
(alist :tag "Output formats"
:key-type (string :tag "Output format")
:value-type
(group (string :tag "Output file extension")))))))
(defcustom org-lparse-use-flashy-warning nil
"Control flashing of messages logged with `org-lparse-warn'.
When non-nil, messages are fontified with warning face and the
@ -584,44 +442,41 @@ exporter lingers for a while to catch user's attention."
:type 'boolean
:group 'org-lparse)
(defun org-lparse-convert (&optional in-file out-fmt prefix-arg)
"Convert IN-FILE to format OUT-FMT using a command line converter.
IN-FILE is the file to be converted. If unspecified, it defaults
to variable `buffer-file-name'. OUT-FMT is the desired output
format. If the backend has registered a CONVERT-METHOD as part
of it's get function then that converter is used. Otherwise
`org-lparse-convert-process' is used. If PREFIX-ARG is non-nil
then the newly converted file is opened using `org-open-file'."
(interactive
(let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
(in-file (read-file-name "File to be converted: "
nil buffer-file-name t))
(in-fmt (file-name-extension in-file))
(out-fmt-choices (org-lparse-get-other-backends in-fmt))
(out-fmt
(or (and out-fmt-choices
(funcall input "Output format: "
out-fmt-choices nil nil nil))
(error
"No known converter or no known output formats for %s files"
in-fmt))))
(list in-file out-fmt current-prefix-arg)))
(defun org-lparse-convert-read-params ()
"Return IN-FILE and OUT-FMT params for `org-lparse-do-convert'.
This is a helper routine for interactive use."
(let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
(in-file (read-file-name "File to be converted: "
nil buffer-file-name t))
(in-fmt (file-name-extension in-file))
(out-fmt-choices (org-lparse-reachable-formats in-fmt))
(out-fmt
(or (and out-fmt-choices
(funcall input "Output format: "
out-fmt-choices nil nil nil))
(error
"No known converter or no known output formats for %s files"
in-fmt))))
(list in-file out-fmt)))
(defun org-lparse-do-convert (in-file out-fmt &optional prefix-arg)
"Workhorse routine for `org-export-odt-convert'."
(require 'browse-url)
(let* ((in-file (expand-file-name (or in-file buffer-file-name)))
(dummy (or (file-readable-p in-file)
(error "Cannot read %s" in-file)))
(in-fmt (file-name-extension in-file))
(out-fmt (or out-fmt (error "Output format unspecified")))
(convert-process (org-lparse-get-converter in-fmt))
(how (or (org-lparse-reachable-p in-fmt out-fmt)
(error "Cannot convert from %s format to %s format?"
in-fmt out-fmt)))
(convert-process (car how))
(program (car convert-process))
(dummy (and (or program (error "Converter not configured"))
(or (executable-find program)
(error "Cannot find converter %s" program))))
(out-fmt-alist
(or (assoc out-fmt (org-lparse-get-other-backends in-fmt))
(error "Cannot convert from %s to %s format" in-fmt out-fmt)))
(out-file (concat (file-name-sans-extension in-file) "."
(nth 1 out-fmt-alist)))
(nth 1 (or (cdr how) out-fmt))))
(out-dir (file-name-directory in-file))
(arglist (mapcar (lambda (arg)
(format-spec
@ -1283,14 +1138,11 @@ version."
(let ((f (org-lparse-get 'SAVE-METHOD)))
(or (and f (functionp f) (funcall f filename opt-plist))
(save-buffer)))
(or (when (and (boundp 'org-lparse-other-backend)
org-lparse-other-backend
(not (equal org-lparse-backend org-lparse-other-backend)))
(let ((org-lparse-convert-process
(org-lparse-get-converter org-lparse-backend)))
(when org-lparse-convert-process
(org-lparse-convert buffer-file-name
(symbol-name org-lparse-other-backend)))))
(or (and (boundp 'org-lparse-other-backend)
org-lparse-other-backend
(not (equal org-lparse-backend org-lparse-other-backend))
(org-lparse-do-convert
buffer-file-name (symbol-name org-lparse-other-backend)))
(current-buffer)))
((eq to-buffer 'string)
(prog1 (buffer-substring (point-min) (point-max))

202
contrib/lisp/org-odt.el
View File

@ -30,6 +30,11 @@
(eval-when-compile (require 'cl))
(require 'org-lparse)
(defgroup org-export-odt nil
"Options specific for ODT export of Org-mode files."
:tag "Org Export ODT"
:group 'org-export)
(defun org-odt-end-export ()
(org-odt-fixup-label-references)
@ -209,32 +214,18 @@ a per-file basis. For example,
(defconst org-export-odt-tmpdir-prefix "odt-")
(defconst org-export-odt-bookmark-prefix "OrgXref.")
(defcustom org-export-odt-use-bookmarks-for-internal-links t
"Export Internal links as bookmarks?."
:type 'boolean
:group 'org-export-odt)
(defcustom org-export-odt-embed-images t
"Should the images be copied in to the odt file or just linked?"
:type 'boolean
:group 'org-export-odt)
(defvar org-export-odt-embed-images t
"Should the images be copied in to the odt file or just linked?")
(defcustom org-odt-export-inline-images 'maybe
"Non-nil means inline images into exported HTML pages.
This is done using an <img> tag. When nil, an anchor with href is used to
link to the image. If this option is `maybe', then images in links with
an empty description will be inlined, while images with a description will
be linked only."
:group 'org-odt-export
:type '(choice (const :tag "Never" nil)
(const :tag "Always" t)
(const :tag "When there is no description" maybe)))
(defvar org-export-odt-inline-images 'maybe) ; counterpart of
; `org-export-html-inline-images'
(defcustom org-odt-export-inline-image-extensions
(defcustom org-export-odt-inline-image-extensions
'("png" "jpeg" "jpg" "gif")
"Extensions of image files that can be inlined into HTML."
:type '(repeat (string :tag "Extension"))
:group 'org-odt-export)
:group 'org-export-odt)
(defcustom org-export-odt-pixels-per-inch display-pixels-per-inch
;; FIXME add docstring
@ -286,25 +277,19 @@ be linked only."
"Automatically post-process to this format after exporting to \"odt\".
Interactive commands `org-export-as-odt' and
`org-export-as-odt-and-open' export first to \"odt\" format and
then use an external converter to convert the resulting document
to this format.
The converter used is that specified with CONVERT-METHOD option
in `org-odt-get'. If the above option is unspecified then
`org-lparse-convert-process' is used.
The format specified here should be listed in OTHER-BACKENDS
option of `org-odt-get' or `org-lparse-convert-capabilities' as
appropriate."
:group 'org-odt
then use `org-export-odt-convert-process' to convert the
resulting document to this format. During customization of this
variable, the list of valid values are populated based on
`org-export-odt-convert-capabilities'."
:group 'org-export-odt
:type '(choice :convert-widget
(lambda (w)
(apply 'widget-convert (widget-type w)
(eval (car (widget-get w :args)))))
`((const :tag "None" nil)
,@(mapcar (lambda (c)
`(const :tag ,(car c) ,(car c)))
(org-lparse-get-other-backends "odt")))))
`(const :tag ,c ,c))
(org-lparse-reachable-formats "odt")))))
;;;###autoload
(defun org-export-as-odt-and-open (arg)
@ -1005,7 +990,7 @@ styles congruent with the ODF-1.2 specification."
((string= s "\t") (org-odt-format-tabs))
(t (org-odt-format-spaces (length s))))) line))
(defcustom org-export-odt-use-htmlfontify t
(defcustom org-export-odt-fontify-srcblocks t
"Specify whether or not source blocks need to be fontified.
Turn this option on if you want to colorize the source code
blocks in the exported file. For colorization to work, you need
@ -1029,7 +1014,7 @@ to make available an enhanced version of `htmlfontify' library."
(defun org-odt-format-source-code-or-example-plain
(lines lang caption textareap cols rows num cont rpllbl fmt)
"Format source or example blocks much like fixedwidth blocks.
Use this when `org-export-odt-use-htmlfontify' option is turned
Use this when `org-export-odt-fontify-srcblocks' option is turned
off."
(let* ((lines (org-split-string lines "[\r\n]"))
(line-count (length lines))
@ -1105,7 +1090,7 @@ based on your current display settings. It is necessary that the
styles.xml already contains needed styles for colorizing to work.
This variable is effective only if
`org-export-odt-use-htmlfontify' is turned on."
`org-export-odt-fontify-srcblocks' is turned on."
:group 'org-export-odt
:type 'boolean)
@ -1124,8 +1109,8 @@ Update styles.xml with styles that were collected as part of
(defun org-odt-format-source-code-or-example-colored
(lines lang caption textareap cols rows num cont rpllbl fmt)
"Format source or example blocks using `htmlfontify-string'.
Use this routine when `org-export-odt-use-htmlfontify' option is
turned on."
Use this routine when `org-export-odt-fontify-srcblocks' option
is turned on."
(let* ((lang-m (and lang (or (cdr (assoc lang org-src-lang-modes)) lang)))
(mode (and lang-m (intern (concat (if (symbolp lang-m)
(symbol-name lang-m)
@ -1170,11 +1155,11 @@ turned on."
"Format source or example blocks for export.
Use `org-odt-format-source-code-or-example-plain' or
`org-odt-format-source-code-or-example-colored' depending on the
value of `org-export-odt-use-htmlfontify."
value of `org-export-odt-fontify-srcblocks."
(setq lines (org-export-number-lines
lines 0 0 num cont rpllbl fmt 'preprocess)
lines (funcall
(or (and org-export-odt-use-htmlfontify
(or (and org-export-odt-fontify-srcblocks
(or (featurep 'htmlfontify)
(require 'htmlfontify))
(fboundp 'htmlfontify-string)
@ -1321,9 +1306,9 @@ MAY-INLINE-P allows inlining it as an image."
((and (member type '("file"))
(not fragment)
(org-file-image-p
filename org-odt-export-inline-image-extensions)
(or (eq t org-odt-export-inline-images)
(and org-odt-export-inline-images (not descp))))
filename org-export-odt-inline-image-extensions)
(or (eq t org-export-odt-inline-images)
(and org-export-odt-inline-images (not descp))))
(org-odt-format-inline-image thefile))
;; check for embedded formulas
((and (member type '("file"))
@ -1963,6 +1948,126 @@ visually."
(while (re-search-forward (format "%s[ \r\n\t]*%s" open close) nil t)
(replace-match ""))))
(defcustom org-export-odt-convert-processes
'(("BasicODConverter"
("soffice" "-norestore" "-invisible" "-headless"
"\"macro:///BasicODConverter.Main.Convert(%I,%f,%O)\""))
("unoconv"
("unoconv" "-f" "%f" "-o" "%d" "%i")))
"Specify a list of document converters and their usage.
The converters in this list are offered as choices while
customizing `org-export-odt-convert-process'.
This variable is an alist where each element is of the
form (CONVERTER-NAME CONVERTER-PROCESS). CONVERTER-NAME is name
of the converter. CONVERTER-PROCESS specifies the command-line
syntax of the converter and is of the form (CONVERTER-PROGRAM
ARG1 ARG2 ...). CONVERTER-PROGRAM is the name of the executable.
ARG1, ARG2 etc are command line options that are passed to
CONVERTER-PROGRAM. Format specifiers can be used in the ARGs and
they are interpreted as below:
%i input file name in full
%I input file name as a URL
%f format of the output file
%o output file name in full
%O output file name as a URL
%d output dir in full
%D output dir as a URL."
:group 'org-export-odt
:type
'(choice
(const :tag "None" nil)
(alist :tag "Converters"
:key-type (string :tag "Converter Name")
:value-type (group (cons (string :tag "Executable")
(repeat (string :tag "Command line args")))))))
(defcustom org-export-odt-convert-process nil
"Use this converter to convert from \"odt\" format to other formats.
During customization, the list of converter names are populated
from `org-export-odt-convert-processes'."
:group 'org-export-odt
:type '(choice :convert-widget
(lambda (w)
(apply 'widget-convert (widget-type w)
(eval (car (widget-get w :args)))))
`((const :tag "None" nil)
,@(mapcar (lambda (c)
`(const :tag ,(car c) ,(car c)))
org-export-odt-convert-processes))))
(defcustom org-export-odt-convert-capabilities
'(("Text"
("odt" "ott" "doc" "rtf")
(("pdf" "pdf") ("odt" "odt") ("xhtml" "html") ("rtf" "rtf")
("ott" "ott") ("doc" "doc") ("ooxml" "xml") ("html" "html")))
("Web"
("html" "xhtml") (("pdf" "pdf") ("odt" "txt") ("html" "html")))
("Spreadsheet"
("ods" "ots" "xls" "csv")
(("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv")
("ods" "ods") ("xls" "xls") ("xhtml" "xhtml") ("ooxml" "xml")))
("Presentation"
("odp" "otp" "ppt")
(("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("xhtml" "xml")
("otp" "otp") ("ppt" "ppt") ("odg" "odg") ("html" "html"))))
"Specify input and output formats of `org-export-odt-convert-process'.
More correctly, specify the set of input and output formats that
the user is actually interested in.
This variable is an alist where each element is of the
form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST).
INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an
alist where each element is of the form (OUTPUT-FMT
OUTPUT-FILE-EXTENSION).
The variable is interpreted as follows:
`org-export-odt-convert-process' can take any document that is in
INPUT-FMT-LIST and produce any document that is in the
OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have
OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT
serves dual purposes:
- It is used for populating completion candidates during
`org-export-odt-convert' commands.
- It is used as the value of \"%f\" specifier in
`org-export-odt-convert-process'.
DOCUMENT-CLASS is used to group a set of file formats in
INPUT-FMT-LIST in to a single class.
Note that this variable inherently captures how LibreOffice based
converters work. LibreOffice maps documents of various formats
to classes like Text, Web, Spreadsheet, Presentation etc and
allow document of a given class (irrespective of it's source
format) to be converted to any of the export formats associated
with that class.
See default setting of this variable for an typical
configuration."
:group 'org-export-odt
:type
'(choice
(const :tag "None" nil)
(alist :key-type (string :tag "Document Class")
:value-type
(group (repeat :tag "Input formats" (string :tag "Input format"))
(alist :tag "Output formats"
:key-type (string :tag "Output format")
:value-type
(group (string :tag "Output file extension")))))))
(defun org-export-odt-convert (&optional in-file out-fmt prefix-arg)
"Convert IN-FILE to format OUT-FMT using a command line converter.
IN-FILE is the file to be converted. If unspecified, it defaults
to variable `buffer-file-name'. OUT-FMT is the desired output
format. Use `org-export-odt-convert-process' as the converter.
If PREFIX-ARG is non-nil then the newly converted file is opened
using `org-open-file'."
(interactive
(append (org-lparse-convert-read-params) current-prefix-arg))
(org-lparse-do-convert in-file out-fmt prefix-arg))
(defun org-odt-get (what &optional opt-plist)
(case what
(BACKEND 'odt)
@ -1974,8 +2079,15 @@ visually."
(INIT-METHOD 'org-odt-init-outfile)
(FINAL-METHOD 'org-odt-finalize-outfile)
(SAVE-METHOD 'org-odt-save-as-outfile)
;; (OTHER-BACKENDS) ; see note in `org-xhtml-get'
;; (CONVERT-METHOD) ; see note in `org-xhtml-get'
(CONVERT-METHOD
(and org-export-odt-convert-process
(cadr (assoc-string org-export-odt-convert-process
org-export-odt-convert-processes t))))
(CONVERT-CAPABILITIES
(and org-export-odt-convert-process
(cadr (assoc-string org-export-odt-convert-process
org-export-odt-convert-processes t))
org-export-odt-convert-capabilities))
(TOPLEVEL-HLEVEL 1)
(SPECIAL-STRING-REGEXPS org-export-odt-special-string-regexps)
(INLINE-IMAGES 'maybe)

2
contrib/lisp/org-registry.el
View File

@ -219,7 +219,7 @@ Use with caution. This could slow down things a bit."
(defun org-registry-update ()
"Update the registry for the current Org file."
(interactive)
(unless (org-mode-p) (error "Not in org-mode"))
(unless (eq major-mode 'org-mode) (error "Not in org-mode"))
(let* ((from-file (expand-file-name (buffer-file-name)))
(new-entries (org-registry-get-entries from-file)))
(with-temp-buffer

2
contrib/lisp/org-toc.el
View File

@ -218,7 +218,7 @@ specified, then make `org-toc-recenter' use this value."
(defun org-toc-show (&optional depth position)
"Show the table of contents of the current Org-mode buffer."
(interactive "P")
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(progn (setq org-toc-base-buffer (current-buffer))
(setq org-toc-odd-levels-only org-odd-levels-only))
(if (eq major-mode 'org-toc-mode)

16
doc/org.texi
View File

@ -3172,7 +3172,13 @@ file:/myself@@some.where:papers/last.pdf @r{file, path on remote machine}
/myself@@some.where:papers/last.pdf @r{same as above}
file:sometextfile::NNN @r{file with line number to jump to}
file:projects.org @r{another Org file}
file:projects.org::some words @r{text search in Org file}
file:projects.org::some words @r{text search in Org file}@footnote{
The actual behavior of the search will depend on the value of
the variable @code{org-link-search-must-match-exact-headline}. If its value
is nil, then a fuzzy text search will be done. If it is t, then only the
exact headline will be matched. If the value is @code{'query-to-create},
then an exact headline will be searched; if it is not found, then the user
will be queried to create it.}
file:projects.org::*task title @r{heading search in Org file}
docview:papers/last.pdf::NNN @r{open file in doc-view mode at page NNN}
id:B7423F4D-2E8A-471B-8810-C40F074717E9 @r{Link to heading by ID}
@ -3191,7 +3197,7 @@ gnus:group @r{Gnus group link}
gnus:group#id @r{Gnus article link}
bbdb:R.*Stallman @r{BBDB link (with regexp)}
irc:/irc.com/#emacs/bob @r{IRC link}
info:org#External%20links @r{Info node link (with encoded space)}
info:org#External links @r{Info node link}
shell:ls *.org @r{A shell command}
elisp:org-agenda @r{Interactive Elisp command}
elisp:(find-file-other-frame "Elisp.org") @r{Elisp form to evaluate}
@ -8988,7 +8994,8 @@ further details.}. This is done with the @samp{src} block, where you also
need to specify the name of the major mode that should be used to fontify the
example@footnote{Code in @samp{src} blocks may also be evaluated either
interactively or on export. See @pxref{Working With Source Code} for more
information on evaluating code blocks.}:
information on evaluating code blocks.}, see @ref{Easy Templates} for
shortcuts to easily insert code blocks.
@cindex #+BEGIN_SRC
@example
@ -11633,7 +11640,8 @@ The following sections describe Org-mode's code block handling facilities.
@cindex code block, structure
@cindex source code, block structure
The structure of code blocks is as follows:
The structure of code blocks is as follows (empty code blocks may be inserted
using Org-mode's @ref{Easy Templates} system):
@example
#+srcname: <name>

1
lisp/ob-calc.el
View File

@ -28,7 +28,6 @@
;;; Code:
(require 'ob)
(require 'calc)
(require 'calc-store)
(unless (featurep 'xemacs)
(require 'calc-trail)
(require 'calc-store))

3
lisp/ob-shen.el
View File

@ -63,13 +63,14 @@
This function is called by `org-babel-execute-src-block'"
(require 'inf-shen)
(let* ((result-type (cdr (assoc :result-type params)))
(result-params (cdr (assoc :result-params params)))
(full-body (org-babel-expand-body:shen body params)))
((lambda (results)
(if (or (member 'scalar result-params)
(member 'verbatim result-params))
results
(condition-case nil (org-babel-script-escape results)
(error result))))
(error results))))
(with-temp-buffer
(insert full-body)
(call-interactively #'shen-eval-defun)))))

3
lisp/ob-sql.el
View File

@ -50,6 +50,9 @@
(defvar org-babel-default-header-args:sql '())
(defvar org-babel-header-arg-names:sql
'(engine out-file))
(defun org-babel-expand-body:sql (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sql-expand-vars

3
lisp/ob.el
View File

@ -181,10 +181,10 @@ Returns non-nil if match-data set"
(when (looking-at org-babel-inline-src-block-regexp)
t ))))))
(defvar org-babel-inline-lob-one-liner-regexp)
(defun org-babel-get-lob-one-liner-matches()
"Set match data if on line of an lob one liner.
Returns non-nil if match-data set"
(save-excursion
(unless (= (point) (point-at-bol)) ;; move before inline block
(re-search-backward "[ \f\t\n\r\v]" nil t))
@ -1490,7 +1490,6 @@ region is not active then the point is demarcated."
(goto-char start) (move-end-of-line 1)))))
(defvar org-babel-lob-one-liner-regexp)
(defvar org-babel-inline-lob-one-liner-regexp)
(defun org-babel-where-is-src-block-result (&optional insert info hash indent)
"Find where the current source block results begin.
Return the point at the beginning of the result of the current

192
lisp/org-agenda.el
View File

@ -2324,7 +2324,7 @@ Pressing `<' twice means to restrict to the current subtree or region
nil 'face 'org-warning)))))))
t t))
((equal keys "L")
(unless (org-mode-p)
(unless (eq major-mode 'org-mode)
(error "This is not an Org-mode file"))
(unless restriction
(put 'org-agenda-files 'org-restrict (list bfn))
@ -2359,7 +2359,7 @@ Agenda views are separated by `org-agenda-block-separator'."
"The user interface for selecting an agenda command."
(catch 'exit
(let* ((bfn (buffer-file-name (buffer-base-buffer)))
(restrict-ok (and bfn (org-mode-p)))
(restrict-ok (and bfn (eq major-mode 'org-mode)))
(region-p (org-region-active-p))
(custom org-agenda-custom-commands)
(selstring "")
@ -2905,7 +2905,7 @@ removed from the entry content. Currently only `planning' is allowed here."
(let (txt drawer-re kwd-time-re ind)
(save-excursion
(with-current-buffer (marker-buffer marker)
(if (not (org-mode-p))
(if (not (eq major-mode 'org-mode))
(setq txt "")
(save-excursion
(save-restriction
@ -3021,7 +3021,7 @@ removed from the entry content. Currently only `planning' is allowed here."
(defun org-check-for-org-mode ()
"Make sure current buffer is in org-mode. Error if not."
(or (org-mode-p)
(or (eq major-mode 'org-mode)
(error "Cannot execute org-mode agenda command on buffer in %s"
major-mode)))
@ -3804,7 +3804,7 @@ in `org-agenda-text-search-extra-files'."
(full-words org-agenda-search-view-force-full-words)
(org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
regexp rtn rtnall files file pos
marker category category-pos tags c neg re boolean
marker category org-category-pos tags c neg re boolean
ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
(unless (and (not edit-at)
(stringp string)
@ -3887,7 +3887,7 @@ in `org-agenda-text-search-extra-files'."
(if (not regexps+)
(setq regexp org-outline-regexp-bol)
(setq regexp (pop regexps+))
(if hdl-only (setq regexp (concat "^" org-outline-regexp ".*?"
(if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
regexp))))
(setq files (org-agenda-files nil 'ifmode))
(when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
@ -3908,7 +3908,7 @@ in `org-agenda-text-search-extra-files'."
file))))
(with-current-buffer buffer
(with-syntax-table (org-search-syntax-table)
(unless (org-mode-p)
(unless (eq major-mode 'org-mode)
(error "Agenda file %s is not in `org-mode'" file))
(let ((case-fold-search t))
(save-excursion
@ -3948,9 +3948,9 @@ in `org-agenda-text-search-extra-files'."
(goto-char beg)
(setq marker (org-agenda-new-marker (point))
category (org-get-category)
category-pos (get-text-property (point) 'org-category-position)
org-category-pos (get-text-property (point) 'org-category-position)
tags (org-get-tags-at (point))
txt (org-format-agenda-item
txt (org-agenda-format-item
""
(buffer-substring-no-properties
beg1 (point-at-eol))
@ -3960,7 +3960,7 @@ in `org-agenda-text-search-extra-files'."
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
'priority 1000 'org-category category
'org-category-position category-pos
'org-category-position org-category-pos
'type "search")
(push txt ee)
(goto-char (1- end))))))))))
@ -4101,7 +4101,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(format "ORG-AGENDA-ERROR: No such org-file %s" file))
rtnall (append rtnall rtn))
(with-current-buffer buffer
(unless (org-mode-p)
(unless (eq major-mode 'org-mode)
(error "Agenda file %s is not in `org-mode'" file))
(save-excursion
(save-restriction
@ -4326,7 +4326,7 @@ of what a project is and how to check if it stuck, customize the variable
(tags (nth 2 org-stuck-projects))
(tags-re (if (member "*" tags)
(concat org-outline-regexp-bol
(org-ref ".*:[[:alnum:]_@#%]+:[ \t]*$"))
(org-re ".*:[[:alnum:]_@#%]+:[ \t]*$"))
(if tags
(concat org-outline-regexp-bol
".*:\\("
@ -4400,7 +4400,7 @@ of what a project is and how to check if it stuck, customize the variable
(setq entries
(mapcar
(lambda (x)
(setq x (org-format-agenda-item "" x "Diary" nil 'time))
(setq x (org-agenda-format-item "" x "Diary" nil 'time))
;; Extend the text properties to the beginning of the line
(org-add-props x (text-properties-at (1- (length x)) x)
'type "diary" 'date date 'face 'org-agenda-diary))
@ -4545,7 +4545,7 @@ the documentation of `org-diary'."
;; If file does not exist, make sure an error message ends up in diary
(list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
(with-current-buffer buffer
(unless (org-mode-p)
(unless (eq major-mode 'org-mode)
(error "Agenda file %s is not in `org-mode'" file))
(let ((case-fold-search nil))
(save-excursion
@ -4593,18 +4593,21 @@ the documentation of `org-diary'."
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp (concat "^\\*+[ \t]+\\("
(if org-select-this-todo-keyword
(if (equal org-select-this-todo-keyword "*")
org-todo-regexp
(concat "\\<\\("
(mapconcat 'identity
(org-split-string
org-select-this-todo-keyword "|") "\\|")
"\\)\\>"))
org-not-done-regexp)
"[^\n\r]*\\)"))
marker priority category category-pos tags todo-state ee txt beg end)
(regexp (format org-heading-keyword-regexp-format
(cond
((and org-select-this-todo-keyword
(equal org-select-this-todo-keyword "*"))
org-todo-regexp)
(org-select-this-todo-keyword
(concat "\\("
(mapconcat 'identity
(org-split-string
org-select-this-todo-keyword
"|")
"\\|") "\\)"))
(t org-not-done-regexp))))
marker priority category org-category-pos tags todo-state
ee txt beg end)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@ -4616,23 +4619,23 @@ the documentation of `org-diary'."
(goto-char (1+ beg))
(or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
(throw :skip nil)))
(goto-char (match-beginning 1))
(goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category)
category-pos (get-text-property (point) 'org-category-position)
txt (match-string 1)
org-category-pos (get-text-property (point) 'org-category-position)
txt (buffer-substring (match-beginning 2) (match-end 3))
tags (org-get-tags-at (point))
txt (org-format-agenda-item "" txt category tags)
txt (org-agenda-format-item "" txt category tags)
priority (1+ (org-get-priority txt))
todo-state (org-get-todo-state))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
'priority priority 'org-category category
'org-category-position category-pos
'org-category-position org-category-pos
'type "todo" 'todo-state todo-state)
(push txt ee)
(if org-agenda-todo-list-sublevels
(goto-char (match-end 1))
(goto-char (match-end 2))
(org-end-of-subtree 'invisible))))
(nreverse ee)))
@ -4743,7 +4746,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
"\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
"\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
marker hdmarker deadlinep scheduledp clockp closedp inactivep
donep tmp priority category category-pos ee txt timestr tags
donep tmp priority category org-category-pos ee txt timestr tags
b0 b3 e3 head todo-state end-of-match show-all)
(goto-char (point-min))
(while (setq end-of-match (re-search-forward regexp nil t))
@ -4785,7 +4788,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq timestr (substring timestr 0 (match-end 0))))
(setq marker (org-agenda-new-marker b0)
category (org-get-category b0)
category-pos (get-text-property b0 'org-category-position))
org-category-pos (get-text-property b0 'org-category-position))
(save-excursion
(if (not (re-search-backward org-outline-regexp-bol nil t))
(setq txt org-agenda-no-heading-message)
@ -4794,7 +4797,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
tags (org-get-tags-at))
(looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
(setq head (or (match-string 1) ""))
(setq txt (org-format-agenda-item
(setq txt (org-agenda-format-item
(if inactivep org-agenda-inactive-leader nil)
head category tags timestr
remove-re)))
@ -4803,7 +4806,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
'org-marker marker 'org-hd-marker hdmarker)
(org-add-props txt nil 'priority priority
'org-category category 'date date
'org-category-position category-pos
'org-category-position org-category-pos
'todo-state todo-state
'type "timestamp")
(push txt ee))
@ -4820,7 +4823,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp "^&?%%(")
marker category category-pos ee txt tags entry
marker category org-category-pos ee txt tags entry
result beg b sexp sexp-entry todo-state)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@ -4838,7 +4841,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(when result
(setq marker (org-agenda-new-marker beg)
category (org-get-category beg)
category-pos (get-text-property beg 'org-category-position)
org-category-pos (get-text-property beg 'org-category-position)
todo-state (org-get-todo-state))
(dolist (r (if (stringp result)
@ -4848,12 +4851,12 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq txt r)
(setq txt "SEXP entry returned empty string"))
(setq txt (org-format-agenda-item
(setq txt (org-agenda-format-item
"" txt category tags 'time))
(org-add-props txt props 'org-marker marker)
(org-add-props txt nil
'org-category category 'date date 'todo-state todo-state
'org-category-position category-pos
'org-category-position org-category-pos
'type "sexp")
(push txt ee)))))
(nreverse ee)))
@ -4888,9 +4891,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
;; Define the` org-class' function
(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
"Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS
is any number of ISO weeks in the block period for which the item should
be skipped."
DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
SKIP-WEEKS is any number of ISO weeks in the block period for which the
item should be skipped. If any of the SKIP-WEEKS arguments is the symbol
`holidays', then any date that is known by the Emacs calendar to be a
holidy will also be skipped."
(let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
(d (calendar-absolute-from-gregorian date)))
@ -4902,6 +4907,8 @@ be skipped."
(progn
(require 'cal-iso)
(not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
(not (and (memq `holidays' skip-weeks)
(calendar-check-holidays date)))
entry)))
(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
@ -4922,6 +4929,7 @@ please use `org-class' instead."
(nth 2 date1) (car date1) (nth 1 date1)
(nth 2 date2) (car date2) (nth 1 date2)
dayname skip-weeks)))
(make-obsolete 'org-diary-class 'org-class "")
(defalias 'org-get-closed 'org-agenda-get-progress)
(defun org-agenda-get-progress ()
@ -4957,7 +4965,7 @@ please use `org-class' instead."
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11))))
(org-agenda-search-headline-for-time nil)
marker hdmarker priority category category-pos tags closedp
marker hdmarker priority category org-category-pos tags closedp
statep clockp state ee txt extra timestr rest clocked)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@ -4969,7 +4977,7 @@ please use `org-class' instead."
clockp (not (or closedp statep))
state (and statep (match-string 2))
category (org-get-category (match-beginning 0))
category-pos (get-text-property (match-beginning 0) 'org-category-position)
org-category-pos (get-text-property (match-beginning 0) 'org-category-position)
timestr (buffer-substring (match-beginning 0) (point-at-eol)))
(when (string-match "\\]" timestr)
;; substring should only run to end of time stamp
@ -5004,7 +5012,7 @@ please use `org-class' instead."
(setq txt (concat (substring txt 0 (match-beginning 1))
" - " extra " " (match-string 2 txt)))
(setq txt (concat txt " - " extra))))
(setq txt (org-format-agenda-item
(setq txt (org-agenda-format-item
(cond
(closedp "Closed: ")
(statep (concat "State: (" state ")"))
@ -5014,7 +5022,7 @@ please use `org-class' instead."
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
'priority priority 'org-category category
'org-category-position category-pos
'org-category-position org-category-pos
'type "closed" 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done)
(push txt ee))
@ -5152,7 +5160,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
(regexp org-deadline-time-regexp)
(todayp (org-agenda-todayp date)) ; DATE bound by calendar
(d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
d2 diff dfrac wdays pos pos1 category category-pos
d2 diff dfrac wdays pos pos1 category org-category-pos
tags suppress-prewarning ee txt head face s todo-state
show-all upcomingp donep timestr)
(goto-char (point-min))
@ -5200,7 +5208,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
(not (= diff 0))))
(setq txt nil)
(setq category (org-get-category)
category-pos (get-text-property (point) 'org-category-position))
org-category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-end 0))
@ -5214,7 +5222,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
(setq timestr
(concat (substring s (match-beginning 1)) " "))
(setq timestr 'time))
(setq txt (org-format-agenda-item
(setq txt (org-agenda-format-item
(if (= diff 0)
(car org-agenda-deadline-leaders)
(if (functionp
@ -5234,7 +5242,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
'priority (+ (- diff)
(org-get-priority txt))
'org-category category
'org-category-position category-pos
'org-category-position org-category-pos
'todo-state todo-state
'type (if upcomingp "upcoming-deadline" "deadline")
'date (if upcomingp date d2)
@ -5270,7 +5278,7 @@ FRACTION is what fraction of the head-warning time has passed."
0 'org-hd-marker a))
(cons (marker-position mm) a)))
deadline-results))
d2 diff pos pos1 category category-pos tags donep
d2 diff pos pos1 category org-category-pos tags donep
ee txt head pastschedp todo-state face timestr s habitp show-all)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@ -5305,7 +5313,7 @@ FRACTION is what fraction of the head-warning time has passed."
(setq habitp (and (functionp 'org-is-habit-p)
(org-is-habit-p)))
(setq category (org-get-category)
category-pos (get-text-property (point) 'org-category-position))
org-category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-end 0))
@ -5329,7 +5337,7 @@ FRACTION is what fraction of the head-warning time has passed."
(setq timestr
(concat (substring s (match-beginning 1)) " "))
(setq timestr 'time))
(setq txt (org-format-agenda-item
(setq txt (org-agenda-format-item
(if (= diff 0)
(car org-agenda-scheduled-leaders)
(format (nth 1 org-agenda-scheduled-leaders)
@ -5356,7 +5364,7 @@ FRACTION is what fraction of the head-warning time has passed."
(org-habit-get-priority habitp)
(+ 94 (- 5 diff) (org-get-priority txt)))
'org-category category
'org-category-position category-pos
'org-category-position org-category-pos
'org-habit-p habitp
'todo-state todo-state)
(push txt ee))))))
@ -5374,8 +5382,8 @@ FRACTION is what fraction of the head-warning time has passed."
(abbreviate-file-name buffer-file-name))))
(regexp org-tr-regexp)
(d0 (calendar-absolute-from-gregorian date))
marker hdmarker ee txt d1 d2 s1 s2 category todo-state tags pos
head donep)
marker hdmarker ee txt d1 d2 s1 s2 category org-category-pos
todo-state tags pos head donep)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@ -5397,7 +5405,7 @@ FRACTION is what fraction of the head-warning time has passed."
(throw :skip t))
(setq marker (org-agenda-new-marker (point)))
(setq category (org-get-category)
category-pos (get-text-property (point) 'org-category-position))
org-category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-beginning 0))
@ -5412,7 +5420,7 @@ FRACTION is what fraction of the head-warning time has passed."
"--"
"<" (regexp-quote s2) ".*?>")
nil)))
(setq txt (org-format-agenda-item
(setq txt (org-agenda-format-item
(format
(nth (if (= d1 d2) 0 1)
org-agenda-timerange-leaders)
@ -5431,7 +5439,7 @@ FRACTION is what fraction of the head-warning time has passed."
'type "block" 'date date
'todo-state todo-state
'priority (org-get-priority txt) 'org-category category
'org-category-position category-pos)
'org-category-position org-category-pos)
(push txt ee))))
(goto-char pos)))
;; Sort the entries by expiration date.
@ -5461,7 +5469,7 @@ The flag is set if the currently compiled format contains a `%e'.")
(return (cadr entry))
(return (apply 'create-image (cdr entry)))))))
(defun org-format-agenda-item (extra txt &optional category tags dotime
(defun org-agenda-format-item (extra txt &optional category tags dotime
remove-re habitp)
"Format TXT to be inserted into the agenda buffer.
In particular, it adds the prefix and corresponding text properties. EXTRA
@ -5503,7 +5511,7 @@ Any match of REMOVE-RE will be removed from TXT."
(time-of-day (and dotime (org-get-time-of-day ts)))
stamp plain s0 s1 s2 rtn srp l
duration thecategory)
(and (org-mode-p) buffer-file-name
(and (eq major-mode 'org-mode) buffer-file-name
(add-to-list 'org-agenda-contributing-files buffer-file-name))
(when (and dotime time-of-day)
;; Extract starting and ending time and move them to prefix
@ -5551,7 +5559,7 @@ Any match of REMOVE-RE will be removed from TXT."
(concat (make-string (max (- 50 (length txt)) 1) ?\ )
(match-string 2 txt))
t t txt))))
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(setq effort
(condition-case nil
(org-get-effort
@ -5681,14 +5689,14 @@ The modified list may contain inherited tags, and tags matched by
(while (setq time (pop gridtimes))
(unless (and remove (member time have))
(setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
(push (org-format-agenda-item
(push (org-agenda-format-item
nil string "" nil
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property
2 (length (car new)) 'face 'org-time-grid (car new))))
(when (and todayp org-agenda-show-current-time-in-grid)
(push (org-format-agenda-item
(push (org-agenda-format-item
nil
org-agenda-current-time-string
"" nil
@ -6829,7 +6837,7 @@ and by additional input from the age of a schedules or deadline entry."
(widen)
(push-mark)
(goto-char pos)
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(org-show-context 'agenda)
(save-excursion
(and (outline-next-heading)
@ -6858,7 +6866,7 @@ Point is in the buffer where the item originated.")
(with-current-buffer buffer
(save-excursion
(goto-char pos)
(if (and (org-mode-p) (not (member type '("sexp"))))
(if (and (eq major-mode '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)
@ -6910,7 +6918,7 @@ Point is in the buffer where the item originated.")
(pos (marker-position marker)))
(org-with-remote-undo buffer
(with-current-buffer buffer
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(if (and confirm
(not (y-or-n-p "Archive this subtree or entry? ")))
(error "Abort")
@ -7015,7 +7023,7 @@ at the text of the entry itself."
(and delete-other-windows (delete-other-windows))
(widen)
(goto-char pos)
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(org-show-context 'agenda)
(save-excursion
(and (outline-next-heading)
@ -7268,7 +7276,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
&optional fixface just-this)
"Change all lines in the agenda buffer which match HDMARKER.
The new content of the line will be NEWHEAD (as modified by
`org-format-agenda-item'). HDMARKER is checked with
`org-agenda-format-item'). HDMARKER is checked with
`equal' against all `org-hd-marker' text properties in the file.
If FIXFACE is non-nil, the face of each item is modified according to
the new TODO state.
@ -7301,7 +7309,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(save-excursion
(save-restriction
(widen)
(org-format-agenda-item (org-get-at-bol 'extra)
(org-agenda-format-item (org-get-at-bol 'extra)
newhead cat tags dotime)))))
pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
undone-face (org-get-at-bol 'undone-face)
@ -7548,7 +7556,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(or (not what) (eq what 'day))
(not (save-match-data (org-at-date-range-p))))
(setq cdate (org-parse-time-string (match-string 0) 'nodefault)
cdate (calendar-absolute-from-gregorian
cdate (calendar-absolute-from-gregorian
(list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
today (org-today))
(if (> today cdate)
@ -7902,10 +7910,10 @@ the resulting entry will not be shown. When TEXT is empty, switch to
(org-agenda-time-leading-zero t)
fmt time time2)
(if org-agenda-insert-diary-extract-time
;; Use org-format-agenda-item to parse text for a time-range and
;; Use org-agenda-format-item to parse text for a time-range and
;; remove it. FIXME: This is a hack, we should refactor
;; that function to make time extraction available separately
(setq fmt (org-format-agenda-item nil text nil nil t)
(setq fmt (org-agenda-format-item nil text nil nil t)
time (get-text-property 0 'time fmt)
time2 (if (> (length time) 0)
;; split-string removes trailing ...... if
@ -8358,7 +8366,8 @@ The prefix arg is passed through to the command if possible."
(progn (message "Skipping removed entry at %s" e)
(setq cntskip (1+ cntskip)))
(goto-char pos)
(eval cmd)
(let (org-loop-over-headlines-in-active-region)
(eval cmd))
(setq org-agenda-bulk-marked-entries
(delete e org-agenda-bulk-marked-entries))
(setq cnt (1+ cnt))))
@ -8424,7 +8433,7 @@ tag and (if present) the flagging note."
(defvar appt-time-msg-list)
;;;###autoload
(defun org-agenda-to-appt (&optional refresh filter)
(defun org-agenda-to-appt (&optional refresh filter &rest args)
"Activate appointments found in `org-agenda-files'.
With a \\[universal-argument] prefix, refresh the list of
appointments.
@ -8435,6 +8444,10 @@ expression, and filter out entries that don't match it.
If FILTER is a string, use this string as a regular expression
for filtering entries out.
If FILTER is a function, filter out entries against which
calling the function returns nil. This function takes one
argument: an entry from `org-agenda-get-day-entries'.
FILTER can also be an alist with the car of each cell being
either 'headline or 'category. For example:
@ -8442,12 +8455,18 @@ either 'headline or 'category. For example:
(category \"Work\"))
will only add headlines containing IMPORTANT or headlines
belonging to the \"Work\" category."
belonging to the \"Work\" category.
ARGS are symbols indicating what kind of entries to consider.
By default `org-agenda-to-appt' will use :deadline, :scheduled
and :timestamp entries. See the docstring of `org-diary' for
details and examples."
(interactive "P")
(if refresh (setq appt-time-msg-list nil))
(if (eq filter t)
(setq filter (read-from-minibuffer "Regexp filter: ")))
(let* ((cnt 0) ; count added events
(scope (or args '(:deadline :scheduled :timestamp)))
(org-agenda-new-buffers nil)
(org-deadline-warning-days 0)
;; Do not use `org-today' here because appt only takes
@ -8461,10 +8480,10 @@ belonging to the \"Work\" category."
(org-prepare-agenda-buffers files)
(while (setq file (pop files))
(setq entries
(append entries
(org-agenda-get-day-entries
file today :timestamp :scheduled :deadline))))
(setq entries (delq nil entries))
(delq nil
(append entries
(apply 'org-agenda-get-day-entries
file today scope)))))
;; Map thru entries and find if we should filter them out
(mapc
(lambda(x)
@ -8473,11 +8492,14 @@ belonging to the \"Work\" category."
(tod (get-text-property 1 'time-of-day x))
(ok (or (null filter)
(and (stringp filter) (string-match filter evt))
(and (functionp filter) (funcall filter x))
(and (listp filter)
(or (string-match
(cadr (assoc 'category filter)) cat)
(string-match
(cadr (assoc 'headline filter)) evt))))))
(let ((cat-filter (cadr (assoc 'category filter)))
(evt-filter (cadr (assoc 'headline filter))))
(or (and (stringp cat-filter)
(string-match cat-filter cat))
(and (stringp evt-filter)
(string-match evt-filter evt))))))))
;; FIXME: Shall we remove text-properties for the appt text?
;; (setq evt (set-text-properties 0 (length evt) nil evt))
(when (and ok tod)

4
lisp/org-archive.el
View File

@ -253,7 +253,7 @@ this heading."
(let (this-command) (org-copy-subtree 1 nil t))
(set-buffer buffer)
;; Enforce org-mode for the archive buffer
(if (not (org-mode-p))
(if (not (eq major-mode 'org-mode))
;; Force the mode for future visits.
(let ((org-insert-mode-line-in-empty-file t)
(org-inhibit-startup t))
@ -404,7 +404,7 @@ sibling does not exist, it will be created at the end of the subtree."
If the cursor is not on a headline, try all level 1 trees. If
it is on a headline, try all direct children.
When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(let ((re (concat org-outline-regexp-bol "+" org-not-done-regexp)) re1
(let ((re org-not-done-heading-regexp) re1
(rea (concat ".*:" org-archive-tag ":"))
(begm (make-marker))
(endm (make-marker))

6
lisp/org-ascii.el
View File

@ -144,7 +144,7 @@ command to convert it."
(interactive "r")
(let (reg ascii buf pop-up-frames)
(save-window-excursion
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(setq ascii (org-export-region-as-ascii
beg end t 'string))
(setq reg (buffer-substring beg end)
@ -283,7 +283,7 @@ publishing directory."
"UNTITLED"))
(email (plist-get opt-plist :email))
(language (plist-get opt-plist :language))
(quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
(quote-re0 (concat "^\\(" org-quote-string "\\)\\( +\\|[ \t]*$\\)"))
(todo nil)
(lang-words nil)
(region
@ -406,7 +406,7 @@ publishing directory."
txt))
(setq txt (replace-match "" t t txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(setq txt (replace-match "" t t txt 1)))
(if org-export-with-section-numbers
(setq txt (concat (org-section-number level)

22
lisp/org-capture.el
View File

@ -485,7 +485,7 @@ bypassed."
(error "Capture template `%s': %s"
(org-capture-get :key)
(nth 1 error))))
(if (and (org-mode-p)
(if (and (eq major-mode 'org-mode)
(org-capture-get :clock-in))
(condition-case nil
(progn
@ -575,7 +575,7 @@ captured item after finalizing."
(org-capture-empty-lines-after
(or (org-capture-get :empty-lines 'local) 0))))
;; Postprocessing: Update Statistics cookies, do the sorting
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(save-excursion
(when (ignore-errors (org-back-to-heading))
(org-update-parent-todo-statistics)
@ -723,7 +723,7 @@ already gone. Any prefix argument will be passed to the refile command."
(widen)
(let ((hd (nth 2 target)))
(goto-char (point-min))
(unless (org-mode-p)
(unless (eq major-mode 'org-mode)
(error
"Target buffer \"%s\" for file+headline should be in Org mode"
(current-buffer)))
@ -755,7 +755,7 @@ already gone. Any prefix argument will be passed to the refile command."
(goto-char (if (org-capture-get :prepend)
(match-beginning 0) (match-end 0)))
(org-capture-put :exact-position (point))
(setq target-entry-p (and (org-mode-p) (org-at-heading-p))))
(setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p))))
(error "No match for target regexp in file %s" (nth 1 target))))
((memq (car target) '(file+datetree file+datetree+prompt))
@ -789,12 +789,12 @@ already gone. Any prefix argument will be passed to the refile command."
(widen)
(funcall (nth 2 target))
(org-capture-put :exact-position (point))
(setq target-entry-p (and (org-mode-p) (org-at-heading-p))))
(setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p))))
((eq (car target) 'function)
(funcall (nth 1 target))
(org-capture-put :exact-position (point))
(setq target-entry-p (and (org-mode-p) (org-at-heading-p))))
(setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p))))
((eq (car target) 'clock)
(if (and (markerp org-clock-hd-marker)
@ -1147,11 +1147,11 @@ Point will remain at the first line after the inserted text."
(or (bolp) (newline))
(setq beg (point))
(cond
((and (eq type 'entry) (org-mode-p))
((and (eq type 'entry) (eq major-mode 'org-mode))
(org-capture-verify-tree (org-capture-get :template))
(org-paste-subtree nil template t))
((and (memq type '(item checkitem))
(org-mode-p)
(eq major-mode 'org-mode)
(save-excursion (skip-chars-backward " \t\n")
(setq pp (point))
(org-in-item-p)))
@ -1213,8 +1213,10 @@ Use PREFIX as a prefix for the name of the indirect buffer."
(setq bname (concat prefix "-" (number-to-string (incf n)) "-" base)))
(condition-case nil
(make-indirect-buffer buffer bname 'clone)
(error (make-indirect-buffer buffer bname)))))
(error
(let ((buf (make-indirect-buffer buffer bname)))
(with-current-buffer buf (org-mode))
buf)))))
(defun org-capture-verify-tree (tree)
"Throw error if TREE is not a valid tree"

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

@ -353,7 +353,7 @@ This is the compiled version of the format.")
(funcall org-columns-modify-value-for-display-function
title val))
((equal property "ITEM")
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(org-columns-cleanup-item
val org-columns-current-fmt-compiled)))
((and calc (functionp calc)
@ -657,7 +657,7 @@ Where possible, use the standard interface for changing this line."
(org-columns-eval eval))
(org-columns-display-here)))
(org-move-to-column col)
(if (and (org-mode-p)
(if (and (eq major-mode 'org-mode)
(nth 3 (assoc key org-columns-current-fmt-compiled)))
(org-columns-update key)))))))
@ -1166,7 +1166,7 @@ Don't set this, this is meant for dynamic scoping.")
(if (marker-position org-columns-begin-marker)
(goto-char org-columns-begin-marker))
(org-columns-remove-overlays)
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(call-interactively 'org-columns)
(org-agenda-redo)
(call-interactively 'org-agenda-columns)))
@ -1317,12 +1317,13 @@ of fields."
(if (featurep 'xemacs)
(save-excursion
(let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
(re-comment (concat "\\*+[ \t]+" org-comment-string "\\>"))
(re-comment (format org-heading-keyword-regexp-format
org-comment-string))
(re-archive (concat ".*:" org-archive-tag ":"))
(n (length title)) row tbl)
(goto-char (point-min))
(while (re-search-forward "^\\(\\*+\\) " nil t)
(while (re-search-forward org-heading-regexp nil t)
(catch 'next
(when (and (or (null maxlevel)
(>= maxlevel

11
lisp/org-colview.el
View File

@ -186,7 +186,7 @@ This is the compiled version of the format.")
(cons "ITEM"
;; When in a buffer, get the whole line,
;; we'll clean it later…
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(save-match-data
(org-no-properties
(org-remove-tabs
@ -497,7 +497,7 @@ Where possible, use the standard interface for changing this line."
(org-columns-eval eval))
(org-columns-display-here)))
(org-move-to-column col)
(if (and (org-mode-p)
(if (and (eq major-mode 'org-mode)
(nth 3 (assoc key org-columns-current-fmt-compiled)))
(org-columns-update key)))))))
@ -1003,7 +1003,7 @@ Don't set this, this is meant for dynamic scoping.")
(if (marker-position org-columns-begin-marker)
(goto-char org-columns-begin-marker))
(org-columns-remove-overlays)
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(call-interactively 'org-columns)
(org-agenda-redo)
(call-interactively 'org-agenda-columns)))
@ -1152,11 +1152,12 @@ containing the title row and all other rows. Each row is a list
of fields."
(save-excursion
(let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
(re-comment (concat "\\*+[ \t]+" org-comment-string "\\>"))
(re-comment (format org-heading-keyword-regexp-format
org-comment-string))
(re-archive (concat ".*:" org-archive-tag ":"))
(n (length title)) row tbl)
(goto-char (point-min))
(while (re-search-forward "^\\(\\*+\\) " nil t)
(while (re-search-forward org-heading-regexp nil t)
(catch 'next
(when (and (or (null maxlevel)
(>= maxlevel

2
lisp/org-ctags.el
View File

@ -306,7 +306,7 @@ The new topic will be titled NAME (or TITLE if supplied)."
activate compile)
"Before trying to find a tag, save our current position on org mark ring."
(save-excursion
(if (and (org-mode-p) org-ctags-enabled-p)
(if (and (eq major-mode 'org-mode) org-ctags-enabled-p)
(org-mark-ring-push))))

9
lisp/org-docbook.el
View File

@ -293,7 +293,7 @@ then use this command to convert it."
(interactive "r")
(let (reg docbook buf)
(save-window-excursion
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(setq docbook (org-export-region-as-docbook
beg end t 'string))
(setq reg (buffer-substring beg end)
@ -498,8 +498,9 @@ publishing directory."
;; We will use HTML table formatter to export tables to DocBook
;; format, so need to set html-table-tag here.
(html-table-tag (plist-get opt-plist :html-table-tag))
(quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
(quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
(quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
(quote-re (format org-heading-keyword-regexp-format
org-quote-string))
(inquote nil)
(infixed nil)
(inverse nil)
@ -969,7 +970,7 @@ publishing directory."
(push (cons num 1) footref-seen))))))
(cond
((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
;; This is a headline
(setq level (org-tr-level (- (match-end 1) (match-beginning 1)
level-offset))

14
lisp/org-exp.el
View File

@ -737,13 +737,13 @@ modified) list.")
'("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"
"MATHJAX"
"LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE"
"LATEX_HEADER" "LATEX_CLASS"
"LATEX_HEADER" "LATEX_CLASS" "LATEX_CLASS_OPTIONS"
"EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS"
"KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT")
(mapcar 'car org-export-inbuffer-options-extra))))
(case-fold-search t)
p key val text options mathjax a pr style
latex-header latex-class macros letbind
latex-header latex-class latex-class-options macros letbind
ext-setup-or-nil setup-file setup-dir setup-contents (start 0))
(while (or (and ext-setup-or-nil
(string-match re ext-setup-or-nil start)
@ -770,6 +770,8 @@ modified) list.")
(setq latex-header (concat latex-header "\n" val)))
((string-equal key "LATEX_CLASS")
(setq latex-class val))
((string-equal key "LATEX_CLASS_OPTIONS")
(setq latex-class-options val))
((string-equal key "TEXT")
(setq text (if text (concat text "\n" val) val)))
((string-equal key "OPTIONS")
@ -813,6 +815,8 @@ modified) list.")
(setq p (plist-put p :latex-header-extra (substring latex-header 1))))
(when latex-class
(setq p (plist-put p :latex-class latex-class)))
(when latex-class-options
(setq p (plist-put p :latex-class-options latex-class-options)))
(when options
(setq p (org-export-add-options-to-plist p options)))
(when mathjax
@ -1638,7 +1642,8 @@ from the buffer."
(defun org-export-protect-quoted-subtrees ()
"Mark quoted subtrees with the protection property."
(let ((org-re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")))
(let ((org-re-quote (format org-heading-keyword-regexp-format
org-quote-string)))
(goto-char (point-min))
(while (re-search-forward org-re-quote nil t)
(goto-char (match-beginning 0))
@ -1932,7 +1937,8 @@ table line. If it is a link, add it to the line containing the link."
(defun org-export-remove-comment-blocks-and-subtrees ()
"Remove the comment environment, and also commented subtrees."
(let ((re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>"))
(let ((re-commented (format org-heading-keyword-regexp-format
org-comment-string))
case-fold-search)
;; Remove comment environment
(goto-char (point-min))

22
lisp/org-footnote.el
View File

@ -209,9 +209,11 @@ positions, and the definition, when inlined."
(or (eq (char-before (match-end 0)) 58)
(/= (match-beginning 0) (point-at-bol))))
(let* ((beg (match-beginning 0))
(label (or (match-string 2) (match-string 3)
(label (or (org-match-string-no-properties 2)
(org-match-string-no-properties 3)
;; Anonymous footnotes don't have labels
(and (match-string 1) (concat "fn:" (match-string 1)))))
(and (match-string 1)
(concat "fn:" (org-match-string-no-properties 1)))))
;; Inline footnotes don't end at (match-end 0) as
;; `org-footnote-re' stops just after the second colon.
;; Find the real ending with `scan-sexps', so Org doesn't
@ -257,7 +259,7 @@ label, start, end and definition of the footnote otherwise."
"\\|^[ \t]*$") nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
(end-of-line)
(list (match-string 1)
(list (org-match-string-no-properties 1)
(match-beginning 0)
(save-match-data
;; In a message, limit search to signature.
@ -353,7 +355,7 @@ Return a non-nil value when a definition has been found."
(looking-at (format "\\[%s\\]\\|\\[%s:" label label))
(goto-char (match-end 0))
(org-show-context 'link-search)
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))
t)))
@ -481,7 +483,7 @@ or new, let the user edit the definition of the footnote."
(let ((label (org-footnote-normalize-label label)))
(cond
;; In an Org file.
((org-mode-p)
((eq major-mode 'org-mode)
;; If `org-footnote-section' is defined, find it, or create it
;; at the end of the buffer.
(when org-footnote-section
@ -543,7 +545,7 @@ or new, let the user edit the definition of the footnote."
(insert "\n[" label "] ")
;; Only notify user about next possible action when in an Org
;; buffer, as the bindings may have different meanings otherwise.
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(message
"Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
@ -701,13 +703,13 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(goto-char (point-min))
(cond
((and org-footnote-section
(org-mode-p)
(eq major-mode 'org-mode)
(re-search-forward
(concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
"[ \t]*$")
nil t))
(delete-region (match-beginning 0) (org-end-of-subtree t)))
((org-mode-p)
((eq major-mode 'org-mode)
(goto-char (point-max))
(unless (bolp) (newline)))
(t
@ -761,7 +763,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; No footnote: exit.
((not ref-table))
;; Cases when footnotes should be inserted in one place.
((or (not (org-mode-p))
((or (not (eq major-mode 'org-mode))
org-footnote-section
(not sort-only))
;; Insert again the section title, if any. Ensure that title,
@ -770,7 +772,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; separate section with a blank line, unless explicitly
;; stated in `org-blank-before-new-entry'.
(cond
((not (org-mode-p))
((not (eq major-mode 'org-mode))
(skip-chars-backward " \t\n\r")
(delete-region (point) ins-point)
(unless (bolp) (newline))

15
lisp/org-html.el
View File

@ -713,7 +713,7 @@ command to convert it."
(interactive "r")
(let (reg html buf pop-up-frames)
(save-window-excursion
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(setq html (org-export-region-as-html
beg end t 'string))
(setq reg (buffer-substring beg end)
@ -1175,8 +1175,9 @@ PUB-DIR is set, use this as the publishing directory."
(plist-get opt-plist :link-home)))
(dummy (setq opt-plist (plist-put opt-plist :title title)))
(html-table-tag (plist-get opt-plist :html-table-tag))
(quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
(quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
(quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
(quote-re (format org-heading-keyword-regexp-format
org-quote-string))
(inquote nil)
(infixed nil)
(inverse nil)
@ -1297,11 +1298,11 @@ PUB-DIR is set, use this as the publishing directory."
"%s
<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
<html xmlns=\"http://www.w3.org/1999/xhtml\"
lang=\"%s\" xml:lang=\"%s\">
<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\">
<head>
<title>%s</title>
<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
<meta name=\"title\" content=\"%s\"/>
<meta name=\"generator\" content=\"Org-mode\"/>
<meta name=\"generated\" content=\"%s\"/>
<meta name=\"author\" content=\"%s\"/>
@ -1324,7 +1325,7 @@ lang=\"%s\" xml:lang=\"%s\">
language language
title
(or charset "iso-8859-1")
date author description keywords
title date author description keywords
style
mathjax
(if (or link-up link-home)
@ -1647,7 +1648,7 @@ lang=\"%s\" xml:lang=\"%s\">
t t line))))))
(cond
((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
;; This is a headline
(setq level (org-tr-level (- (match-end 1) (match-beginning 1)
level-offset))

4
lisp/org-id.el
View File

@ -431,7 +431,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(delq nil
(mapcar (lambda (b)
(with-current-buffer b
(and (org-mode-p) (buffer-file-name))))
(and (eq major-mode 'org-mode) (buffer-file-name))))
(buffer-list)))
;; All files known to have IDs
org-id-files)))
@ -600,7 +600,7 @@ optional argument MARKERP, return the position as a new marker."
(defun org-id-store-link ()
"Store a link to the current entry, using its ID."
(interactive)
(when (and (buffer-file-name (buffer-base-buffer)) (org-mode-p))
(when (and (buffer-file-name (buffer-base-buffer)) (eq major-mode 'org-mode))
(let* ((link (org-make-link "id:" (org-id-get-create)))
(case-fold-search nil)
(desc (save-excursion

2
lisp/org-indent.el
View File

@ -222,7 +222,7 @@ during idle time." nil " Ind" nil
(defun org-indent-indent-buffer ()
"Add indentation properties to the accessible part of the buffer."
(interactive)
(if (not (org-mode-p))
(if (not (eq major-mode 'org-mode))
(error "Not in Org mode")
(message "Setting buffer indentation. It may take a few seconds...")
(org-indent-remove-properties (point-min) (point-max))

16
lisp/org-latex.el
View File

@ -723,7 +723,7 @@ then use this command to convert it."
(interactive "r")
(let (reg latex buf)
(save-window-excursion
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(setq latex (org-export-region-as-latex
beg end t 'string))
(setq reg (buffer-substring beg end)
@ -1344,7 +1344,7 @@ LEVEL indicates the default depth for export."
(save-restriction
(widen)
(goto-char (point-min))
(and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\(-[a-zA-Z]+\\)" nil t)
(and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([-a-zA-Z]+\\)" nil t)
(match-string 1))))
(plist-get org-export-latex-options-plist :latex-class)
org-export-latex-default-class)
@ -1399,7 +1399,11 @@ OPT-PLIST is the options plist for current buffer."
(email (replace-regexp-in-string
"_" "\\\\_"
(org-export-apply-macros-in-string
(plist-get opt-plist :email)))))
(plist-get opt-plist :email))))
(description (org-export-apply-macros-in-string
(plist-get opt-plist :description)))
(keywords (org-export-apply-macros-in-string
(plist-get opt-plist :keywords))))
(concat
(if (plist-get opt-plist :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
@ -1433,6 +1437,12 @@ OPT-PLIST is the options plist for current buffer."
(format-time-string
(or (plist-get opt-plist :date)
org-export-latex-date-format)))
;; add some hyperref options
;; FIXME: let's have a defcustom for this?
(format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
(org-export-latex-fontify-headline keywords)
(org-export-latex-fontify-headline description)
(concat "Emacs Org-mode version " org-version))
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title command

6
lisp/org-macs.el
View File

@ -272,10 +272,6 @@ we turn off invisibility temporarily. Use this in a `let' form."
"Make VAR local in current buffer and set it to VALUE."
(set (make-local-variable var) value))
(defsubst org-mode-p ()
"Check if the current buffer is in Org-mode."
(eq major-mode 'org-mode))
(defsubst org-last (list)
"Return the last element of LIST."
(car (last list)))
@ -388,7 +384,7 @@ point nowhere."
(defun org-get-limited-outline-regexp ()
"Return outline-regexp with limited number of levels.
The number of levels is controlled by `org-inlinetask-min-level'"
(if (or (not (org-mode-p)) (not (featurep 'org-inlinetask)))
(if (or (not (eq major-mode 'org-mode)) (not (featurep 'org-inlinetask)))
org-outline-regexp
(let* ((limit-level (1- org-inlinetask-min-level))
(nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))

11
lisp/org-mouse.el
View File

@ -615,12 +615,12 @@ This means, between the beginning of line and the point."
(beginning-of-line))
(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(org-mouse-insert-item text)
ad-do-it))
(defadvice dnd-open-file (around org-mouse-dnd-open-file activate)
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(org-mouse-insert-item uri)
ad-do-it))
@ -631,13 +631,6 @@ This means, between the beginning of line and the point."
(set-match-data ',match)
(apply ',function rest)))))
(defun org-mouse-match-todo-keyword ()
(save-excursion
(org-back-to-heading)
(if (looking-at org-outline-regexp) (goto-char (match-end 0)))
(or (looking-at (concat " +" org-todo-regexp " *"))
(looking-at " \\( *\\)"))))
(defun org-mouse-yank-link (click)
(interactive "e")
;; Give temporary modes such as isearch a chance to turn off.

2
lisp/org-publish.el
View File

@ -684,7 +684,7 @@ See `org-publish-projects'."
(pub-dir
(file-name-as-directory
(file-truename
(or (plist-get project-plist :publishing-directory)
(or (eval (plist-get project-plist :publishing-directory))
(error "Project %s does not have :publishing-directory defined"
(car project))))))
tmp-pub-dir)

4
lisp/org-remember.el
View File

@ -943,7 +943,7 @@ See also the variable `org-reverse-note-order'."
(throw 'quit t))
;; Find the file
(with-current-buffer (or visiting (find-file-noselect file))
(unless (or (org-mode-p) (member heading '(top bottom)))
(unless (or (eq major-mode 'org-mode) (member heading '(top bottom)))
(error "Target files for notes must be in Org-mode if not filing to top/bottom"))
(save-excursion
(save-restriction
@ -953,7 +953,7 @@ See also the variable `org-reverse-note-order'."
;; Find the default location
(when heading
(cond
((not (org-mode-p))
((not (eq major-mode 'org-mode))
(if (eq heading 'top)
(goto-char (point-min))
(goto-char (point-max))

8
lisp/org-src.el
View File

@ -215,7 +215,7 @@ buffer."
(case-fold-search t)
(info (org-edit-src-find-region-and-lang))
(full-info (org-babel-get-src-block-info))
(org-mode-p (or (org-mode-p) (derived-mode-p 'org-mode)))
(org-mode-p (derived-mode-p 'org-mode)) ;; derived-mode-p is reflexive
(beg (make-marker))
(end (make-marker))
(allow-write-back-p (null code))
@ -306,7 +306,7 @@ buffer."
(error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
(dolist (pair transmitted-variables)
(org-set-local (car pair) (cadr pair)))
(when org-mode-p
(when (eq major-mode 'org-mode)
(goto-char (point-min))
(while (re-search-forward "^," nil t)
(if (eq (org-current-line) line) (setq total-nindent (1+ total-nindent)))
@ -398,7 +398,7 @@ the fragment in the Org-mode buffer."
(case-fold-search t)
(msg (substitute-command-keys
"Edit, then exit with C-c ' (C-c and single quote)"))
(org-mode-p (org-mode-p))
(org-mode-p (eq major-mode 'org-mode))
(beg (make-marker))
(end (make-marker))
(preserve-indentation org-src-preserve-indentation)
@ -617,7 +617,7 @@ the language, a switch telling if the content should be in a single line."
(when (org-bound-and-true-p org-edit-src-from-org-mode)
(goto-char (point-min))
(while (re-search-forward
(if (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t)
(if (eq major-mode 'org-mode) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t)
(if (eq (org-current-line) line) (setq delta (1+ delta)))
(replace-match ",\\1")))
(when (org-bound-and-true-p org-edit-src-picture)

4
lisp/org-table.el
View File

@ -821,7 +821,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(delete-region (point) end)
(move-marker end nil)
(move-marker org-table-aligned-end-marker (point))
(when (and orgtbl-mode (not (org-mode-p)))
(when (and orgtbl-mode (not (eq major-mode 'org-mode)))
(goto-char org-table-aligned-begin-marker)
(while (org-hide-wide-columns org-table-aligned-end-marker)))
;; Try to move to the old location
@ -3803,7 +3803,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
:lighter " OrgTbl" :keymap orgtbl-mode-map
(org-load-modules-maybe)
(cond
((org-mode-p)
((eq major-mode 'org-mode)
;; Exit without error, in case some hook functions calls this
;; by accident in org-mode.
(message "Orgtbl-mode is not useful in org-mode, command ignored"))

2
lisp/org-timer.el
View File

@ -372,7 +372,7 @@ replace any running timer."
(org-show-entry)
(or (ignore-errors (org-get-heading))
(concat "File:" (file-name-nondirectory (buffer-file-name)))))))
((org-mode-p)
((eq major-mode 'org-mode)
(or (ignore-errors (org-get-heading))
(concat "File:" (file-name-nondirectory (buffer-file-name)))))
(t (error "Not in an Org buffer"))))

558
lisp/org.el
View File

@ -403,6 +403,25 @@ XEmacs user should have this variable set to nil, because
(const :tag "When outside special context" t)
(const :tag "Everywhere except timestamps" always)))
(defcustom org-loop-over-headlines-in-active-region nil
"Shall some commands act upon headlines in the active region?
When set to `t', some commands will be performed in all headlines
within the active region.
When set to a string, those commands will be performed on the
matching headlines within the active region. Such string must be
a tags/property/todo match as it is used in the agenda tags view.
The list of commands is:
- `org-schedule'
- `org-deadline'"
:type '(choice (const :tag "Don't loop" nil)
(const :tag "All headlines in active region" t)
(string :tag "Tags/Property/Todo matcher"))
:group 'org-todo
:group 'org-archive)
(defgroup org-startup nil
"Options concerning startup of Org-mode."
:tag "Org Startup"
@ -1493,9 +1512,9 @@ When nil, the link search tries to match a phrase with all words
in the search text."
:group 'org-link-follow
:type '(choice
(const :tag "Use fuzy text search" nil)
(const :tag "Use fuzzy text search" nil)
(const :tag "Match only exact headline" t)
(const :tag "Match extact headline or query to create it"
(const :tag "Match exact headline or query to create it"
query-to-create)))
(defcustom org-link-frame-setup
@ -3710,6 +3729,7 @@ Normal means, no org-mode-specific context."
(defvar calc-embedded-close-formula)
(defvar calc-embedded-open-formula)
(declare-function cdlatex-tab "ext:cdlatex" ())
(declare-function cdlatex-compute-tables "ext:cdlatex" ())
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(defvar font-lock-unfontify-region-function)
(declare-function iswitchb-read-buffer "iswitchb"
@ -3719,7 +3739,7 @@ Normal means, no org-mode-specific context."
(defvar org-agenda-tags-todo-honor-ignore-options)
(declare-function org-agenda-skip "org-agenda" ())
(declare-function
org-format-agenda-item "org-agenda"
org-agenda-format-item "org-agenda"
(extra txt &optional category tags dotime noprefix remove-re habitp))
(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
(declare-function org-agenda-change-all-lines "org-agenda"
@ -4226,6 +4246,10 @@ collapsed state."
;;; Variables for pre-computed regular expressions, all buffer local
(defvar org-heading-regexp nil
"Matches an headline.
Stars are put in group 1 and the trimmed body in group 2.")
(make-variable-buffer-local 'org-heading-regexp)
(defvar org-drawer-regexp nil
"Matches first line of a hidden block.")
(make-variable-buffer-local 'org-drawer-regexp)
@ -4249,22 +4273,28 @@ group 3: Priority cookie
group 4: True headline
group 5: Tags")
(make-variable-buffer-local 'org-complex-heading-regexp)
(defvar org-heading-keyword-regexp-format nil
"Printf format to make regexp to match an headline with some keyword.
This regexp will match the headline of any node which has the
exact keyword that is put into the format. The keyword isn't in
any group by default, but the stars and the body are.")
(make-variable-buffer-local 'org-heading-keyword-regexp-format)
(defvar org-heading-keyword-maybe-regexp-format nil
"Printf format to make regexp to match an headline with some keyword.
This regexp can match any headline with the specified keyword, or
a without a keyword. The keyword isn't in any group by default,
but the stars and the body are.")
(make-variable-buffer-local 'org-heading-keyword-maybe-regexp-format)
(defvar org-complex-heading-regexp-format nil
"Printf format to make regexp to match an exact headline.
This regexp will match the headline of any node which hase the exact
headline text that is put into the format, but may have any TODO state,
priority and tags.")
This regexp will match the headline of any node which has the
exact headline text that is put into the format, but may have any
TODO state, priority and tags.")
(make-variable-buffer-local 'org-complex-heading-regexp-format)
(defvar org-todo-line-tags-regexp nil
"Matches a headline and puts TODO state into group 2 if present.
Also put tags into group 4 if tags are present.")
(make-variable-buffer-local 'org-todo-line-tags-regexp)
(defvar org-nl-done-regexp nil
"Matches newline followed by a headline with the DONE keyword.")
(make-variable-buffer-local 'org-nl-done-regexp)
(defvar org-looking-at-done-regexp nil
"Matches the DONE keyword a point.")
(make-variable-buffer-local 'org-looking-at-done-regexp)
(defvar org-ds-keyword-length 12
"Maximum length of the Deadline and SCHEDULED keywords.")
(make-variable-buffer-local 'org-ds-keyword-length)
@ -4403,7 +4433,7 @@ means to push this value onto the list in the variable.")
(defun org-set-regexps-and-options ()
"Precompute regular expressions for current buffer."
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(org-set-local 'org-todo-kwd-alist nil)
(org-set-local 'org-todo-key-alist nil)
(org-set-local 'org-todo-key-trigger nil)
@ -4599,7 +4629,9 @@ means to push this value onto the list in the variable.")
(assoc (car e) org-tag-alist))
(push e org-tag-alist)))))
;; Compute the regular expressions and other local variables
;; Compute the regular expressions and other local variables.
;; Using `org-outline-regexp-bol' would complicate them much,
;; because of the fixed white space at the end of that string.
(if (not org-done-keywords)
(setq org-done-keywords (and org-todo-keywords-1
(list (org-last org-todo-keywords-1)))))
@ -4614,49 +4646,48 @@ means to push this value onto the list in the variable.")
org-not-done-keywords
(org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1))
org-todo-regexp
(concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1
"\\|") "\\)\\>")
(concat "\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
"\\)")
org-not-done-regexp
(concat "\\<\\("
(concat "\\("
(mapconcat 'regexp-quote org-not-done-keywords "\\|")
"\\)\\>")
"\\)")
org-heading-regexp
"^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
org-heading-keyword-regexp-format
"^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
org-heading-keyword-maybe-regexp-format
"^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
org-not-done-heading-regexp
(concat "^\\(\\*+\\)[ \t]+\\("
(mapconcat 'regexp-quote org-not-done-keywords "\\|")
"\\)[ \t]+")
(format org-heading-keyword-regexp-format org-not-done-regexp)
org-todo-line-regexp
(concat "^\\(\\*+\\)[ \t]+\\(?:\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
"\\)[ \t]+\\)?\\(.*\\)")
(format org-heading-keyword-maybe-regexp-format org-todo-regexp)
org-complex-heading-regexp
(concat "^\\(\\*+\\)[ \t]+\\(?:\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
"\\)[ \t]+\\)?"
"\\(?:\\(\\[#.\\]\\)[ \t]+\\)?"
"\\(.*?\\)"
"\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
(concat "^\\(\\*+\\)"
"\\(?: +" org-todo-regexp "\\)?"
"\\(?: +\\(\\[#.\\]\\)\\)?"
"\\(?: +\\(.*?\\)\\)?"
(org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?")
"[ \t]*$")
org-complex-heading-regexp-format
(concat "^\\(\\*+\\)[ \t]+\\(?:\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
"\\)[ \t]+\\)?"
"\\(?:\\(\\[#.\\]\\)[ \t]+\\)?"
"\\(?:\\(?:\\[[0-9%%/]+\\]\\)[ \t]+\\)?" ; stats cookie
"\\(%s\\)[ \t]*"
"\\(?:\\[[0-9%%/]+\\]\\)?" ; stats cookie
(org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?[ \t]*$"))
org-nl-done-regexp
(concat "\n\\*+[ \t]+"
"\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
"\\)" "[ \t]+")
(concat "^\\(\\*+\\)"
"\\(?: +" org-todo-regexp "\\)?"
"\\(?: +\\(\\[#.\\]\\)\\)?"
"\\(?: +"
;; Stats cookies can be sticked to body.
"\\(?:\\[[0-9%%/]+\\] *\\)?"
"\\(%s\\)"
"\\(?: *\\[[0-9%%/]+\\]\\)?"
"\\)"
(org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
"[ \t]*$")
org-todo-line-tags-regexp
(concat "^\\(\\*+\\)[ \t]+\\(?:\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
"\\)[ \t]+\\)"
(org-re "\\(.*?\\([ \t]:[[:alnum:]:_@#%]+:[ \t]*\\)?$\\)"))
org-looking-at-done-regexp
(concat "^" "\\(?:"
(mapconcat 'regexp-quote org-done-keywords "\\|") "\\)"
"[ \t]+")
(concat "^\\(\\*+\\)"
"\\(?: +" org-todo-regexp "\\)?"
"\\(?: +\\(.*?\\)\\)?"
(org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?")
"[ \t]*$")
org-deadline-regexp (concat "\\<" org-deadline-string)
org-deadline-time-regexp
(concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
@ -5707,14 +5738,17 @@ needs to be inserted at a specific position in the font-lock sequence.")
(if (memq 'footnote lk) '(org-activate-footnote-links))
'("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
'(org-hide-wide-columns (0 nil append))
;; TODO lines
(list (concat "^\\*+[ \t]+" org-todo-regexp "\\([ \t]\\|$\\)")
'(1 (org-get-todo-face 1) t))
;; TODO keyword
(list (format org-heading-keyword-regexp-format
org-todo-regexp)
'(2 (org-get-todo-face 2) t))
;; DONE
(if org-fontify-done-headline
(list (concat "^[*]+ +\\<\\("
(mapconcat 'regexp-quote org-done-keywords "\\|")
"\\)\\(.*\\)")
(list (format org-heading-keyword-regexp-format
(concat
"\\("
(mapconcat 'regexp-quote org-done-keywords "\\|")
"\\)"))
'(2 'org-headline-done t))
nil)
;; Priorities
@ -5752,8 +5786,10 @@ needs to be inserted at a specific position in the font-lock sequence.")
;; Code
'(org-activate-code (1 'org-code t))
;; COMMENT
(list (concat "^\\*+[ \t]+\\<\\(" org-comment-string
"\\|" org-quote-string "\\)\\>")
(list (format org-heading-keyword-regexp-format
(concat "\\("
org-comment-string "\\|" org-quote-string
"\\)"))
'(1 'org-special-keyword t))
'("^#.*" (0 'font-lock-comment-face t))
;; Blocks and meta lines
@ -6020,7 +6056,7 @@ in special contexts.
(and limit-level (1- (* limit-level 2)))
limit-level)))
(org-outline-regexp
(if (not (org-mode-p))
(if (not (eq major-mode 'org-mode))
outline-regexp
(concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))
(bob-special (and org-cycle-global-at-bob (not arg) (bobp)
@ -6259,7 +6295,7 @@ With \\[universal-argument] prefix arg, switch to startup visibility.
With a numeric prefix, show all headlines up to that level."
(interactive "P")
(let ((org-cycle-include-plain-lists
(if (org-mode-p) org-cycle-include-plain-lists nil)))
(if (eq major-mode 'org-mode) org-cycle-include-plain-lists nil)))
(cond
((integerp arg)
(show-all)
@ -6469,7 +6505,7 @@ open and agenda-wise Org files."
(let ((files (mapcar 'expand-file-name (org-agenda-files))))
(dolist (buf (buffer-list))
(with-current-buffer buf
(if (and (org-mode-p) (buffer-file-name))
(if (and (eq major-mode 'org-mode) (buffer-file-name))
(let ((file (expand-file-name (buffer-file-name))))
(unless (member file files)
(push file files))))))
@ -6485,7 +6521,7 @@ open and agenda-wise Org files."
(defun org-cycle-hide-drawers (state)
"Re-hide all drawers after a visibility state change."
(when (and (org-mode-p)
(when (and (eq major-mode 'org-mode)
(not (memq state '(overview folded contents))))
(save-excursion
(let* ((globalp (memq state '(contents all)))
@ -7018,6 +7054,7 @@ This is important for non-interactive uses of the command."
(let ((p (point)))
(goto-char (point-at-bol))
(and (looking-at org-complex-heading-regexp)
(match-beginning 4)
(> p (match-beginning 4)))))))
tags pos)
(cond
@ -7078,14 +7115,15 @@ When NO-TODO is non-nil, don't include TODO keywords."
(looking-at org-complex-heading-regexp)
(match-string 4))
(no-tags
(looking-at "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$")
(looking-at (concat org-outline-regexp
"\\(.*?\\)"
"\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$"))
(match-string 1))
(no-todo
(looking-at (concat "\\*+[ \t]+" org-todo-regexp " +"
"\\([^\n\r]*?[ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$"))
(match-string 2))
(t (looking-at "\\*+[ \t]+\\([^\r\n]*\\)")
(match-string 1)))))
(looking-at org-todo-line-regexp)
(match-string 3))
(t (looking-at org-heading-regexp)
(match-string 2)))))
(defun org-heading-components ()
"Return the components of the current heading.
@ -7246,9 +7284,8 @@ in the region."
The level is the number of stars at the beginning of the headline."
(save-excursion
(org-with-limited-levels
(ignore-errors
(org-back-to-heading t)
(funcall outline-level)))))
(if (ignore-errors (org-back-to-heading t))
(funcall outline-level)))))
(defun org-get-previous-line-level ()
"Return the outline depth of the last headline before the current line.
@ -8630,7 +8667,7 @@ For file links, arg negates `org-context-in-file-links'."
(setq cpltxt (concat "file:" file)
link (org-make-link cpltxt))))
((and (buffer-file-name (buffer-base-buffer)) (org-mode-p))
((and (buffer-file-name (buffer-base-buffer)) (eq major-mode 'org-mode))
(setq custom-id (org-entry-get nil "CUSTOM_ID"))
(cond
((org-in-regexp "<<\\(.*?\\)>>")
@ -8958,7 +8995,7 @@ This command can be called in any mode to insert a link in Org-mode syntax."
(org-load-modules-maybe)
(org-run-like-in-org-mode 'org-insert-link))
(defun org-insert-link (&optional complete-file link-location)
(defun org-insert-link (&optional complete-file link-location default-description)
"Insert a link. At the prompt, enter the link.
Completion can be used to insert any of the link protocol prefixes like
@ -8994,7 +9031,10 @@ called with the link target, and the result will be the default
link description.
If the LINK-LOCATION parameter is non-nil, this value will be
used as the link location instead of reading one interactively."
used as the link location instead of reading one interactively.
If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
be used as the default description."
(interactive "P")
(let* ((wcf (current-window-configuration))
(region (if (org-region-active-p)
@ -9124,6 +9164,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(if org-make-link-description-function
(setq desc (funcall org-make-link-description-function link desc)))
(if default-description (setq desc default-description))
(setq desc (read-string "Description: " desc))
(unless (string-match "\\S-" desc) (setq desc nil))
(if remove (apply 'delete-region remove))
@ -9774,12 +9815,12 @@ in all files. If AVOID-POS is given, ignore matches near that position."
((string-match "^/\\(.*\\)/$" s)
;; A regular expression
(cond
((org-mode-p)
((eq major-mode 'org-mode)
(org-occur (match-string 1 s)))
;;((eq major-mode 'dired-mode)
;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
(t (org-do-occur (match-string 1 s)))))
((and (org-mode-p) org-link-search-must-match-exact-headline)
((and (eq major-mode 'org-mode) org-link-search-must-match-exact-headline)
(and (equal (string-to-char s) ?*) (setq s (substring s 1)))
(goto-char (point-min))
(cond
@ -9847,7 +9888,7 @@ in all files. If AVOID-POS is given, ignore matches near that position."
(goto-char (match-beginning 1))
(goto-char pos)
(error "No match"))))))
(and (org-mode-p) (org-show-context 'link-search))
(and (eq major-mode 'org-mode) (org-show-context 'link-search))
type))
(defun org-search-not-self (group &rest args)
@ -10116,7 +10157,7 @@ If the file does not exist, an error is thrown."
(set-match-data link-match-data)
(eval cmd))))
(t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
(and (org-mode-p) (eq old-mode 'org-mode)
(and (eq major-mode 'org-mode) (eq old-mode 'org-mode)
(or (not (equal old-buffer (current-buffer)))
(not (equal old-pos (point))))
(org-mark-ring-push old-pos old-buffer))))
@ -10439,7 +10480,7 @@ such as the file name."
(interactive "P")
(let* ((bfn (buffer-file-name (buffer-base-buffer)))
(case-fold-search nil)
(path (and (org-mode-p) (org-get-outline-path))))
(path (and (eq major-mode 'org-mode) (org-get-outline-path))))
(if current (setq path (append path
(save-excursion
(org-back-to-heading t)
@ -10906,7 +10947,7 @@ Error if there is no such block at point."
"Update all dynamic blocks in the buffer.
This function can be used in a hook."
(interactive)
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(org-map-dblocks 'org-update-dblock)))
@ -11027,13 +11068,16 @@ expands them."
(save-excursion
(org-back-to-heading)
(let (case-fold-search)
(if (looking-at (concat org-outline-regexp
"\\( *\\<" org-comment-string "\\>[ \t]*\\)"))
(replace-match "" t t nil 1)
(if (looking-at org-outline-regexp)
(progn
(goto-char (match-end 0))
(insert org-comment-string " ")))))))
(cond
((looking-at (format org-heading-keyword-regexp-format
org-comment-string))
(goto-char (match-end 1))
(looking-at (concat " +" org-comment-string))
(replace-match "" t t)
(when (eolp) (insert " ")))
((looking-at org-outline-regexp)
(goto-char (match-end 0))
(insert org-comment-string " "))))))
(defvar org-last-todo-state-is-todo nil
"This is non-nil when the last TODO state change led to a TODO state.
@ -11115,8 +11159,8 @@ For calling through lisp, arg is also interpreted in the following way:
(catch 'exit
(org-back-to-heading t)
(if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
(or (looking-at (concat " +" org-todo-regexp "\\( +\\|$\\)"))
(looking-at " *"))
(or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)"))
(looking-at "\\(?: *\\|[ \t]*$\\)"))
(let* ((match-data (match-data))
(startpos (point-at-bol))
(logging (save-match-data (org-entry-get nil "LOGGING" t t)))
@ -11850,39 +11894,43 @@ With argument REMOVE, remove any deadline from the item.
With argument TIME, set the deadline at the corresponding date. TIME
can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
(let* ((old-date (org-entry-get nil "DEADLINE"))
(repeater (and old-date
(string-match
"\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
old-date)
(match-string 1 old-date))))
(if remove
(progn
(when (and old-date org-log-redeadline)
(org-add-log-setup 'deldeadline nil old-date 'findpos
org-log-redeadline))
(org-remove-timestamp-with-keyword org-deadline-string)
(message "Item no longer has a deadline."))
(org-add-planning-info 'deadline time 'closed)
(when (and old-date org-log-redeadline
(not (equal old-date
(substring org-last-inserted-timestamp 1 -1))))
(org-add-log-setup 'redeadline nil old-date 'findpos
org-log-redeadline))
(when repeater
(save-excursion
(org-back-to-heading t)
(when (re-search-forward (concat org-deadline-string " "
org-last-inserted-timestamp)
(save-excursion
(outline-next-heading) (point)) t)
(goto-char (1- (match-end 0)))
(insert " " repeater)
(setq org-last-inserted-timestamp
(concat (substring org-last-inserted-timestamp 0 -1)
" " repeater
(substring org-last-inserted-timestamp -1))))))
(message "Deadline on %s" org-last-inserted-timestamp))))
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let (org-loop-over-headlines-in-active-region)
(org-map-entries
`(org-deadline ',remove ,time) org-loop-over-headlines-in-active-region 'region (if (outline-invisible-p) (org-end-of-subtree nil t))))
(let* ((old-date (org-entry-get nil "DEADLINE"))
(repeater (and old-date
(string-match
"\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
old-date)
(match-string 1 old-date))))
(if remove
(progn
(when (and old-date org-log-redeadline)
(org-add-log-setup 'deldeadline nil old-date 'findpos
org-log-redeadline))
(org-remove-timestamp-with-keyword org-deadline-string)
(message "Item no longer has a deadline."))
(org-add-planning-info 'deadline time 'closed)
(when (and old-date org-log-redeadline
(not (equal old-date
(substring org-last-inserted-timestamp 1 -1))))
(org-add-log-setup 'redeadline nil old-date 'findpos
org-log-redeadline))
(when repeater
(save-excursion
(org-back-to-heading t)
(when (re-search-forward (concat org-deadline-string " "
org-last-inserted-timestamp)
(save-excursion
(outline-next-heading) (point)) t)
(goto-char (1- (match-end 0)))
(insert " " repeater)
(setq org-last-inserted-timestamp
(concat (substring org-last-inserted-timestamp 0 -1)
" " repeater
(substring org-last-inserted-timestamp -1))))))
(message "Deadline on %s" org-last-inserted-timestamp)))))
(defun org-schedule (&optional remove time)
"Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
@ -11890,39 +11938,43 @@ With argument REMOVE, remove any scheduling date from the item.
With argument TIME, scheduled at the corresponding date. TIME can
either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
(let* ((old-date (org-entry-get nil "SCHEDULED"))
(repeater (and old-date
(string-match
"\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
old-date)
(match-string 1 old-date))))
(if remove
(progn
(when (and old-date org-log-reschedule)
(org-add-log-setup 'delschedule nil old-date 'findpos
org-log-reschedule))
(org-remove-timestamp-with-keyword org-scheduled-string)
(message "Item is no longer scheduled."))
(org-add-planning-info 'scheduled time 'closed)
(when (and old-date org-log-reschedule
(not (equal old-date
(substring org-last-inserted-timestamp 1 -1))))
(org-add-log-setup 'reschedule nil old-date 'findpos
org-log-reschedule))
(when repeater
(save-excursion
(org-back-to-heading t)
(when (re-search-forward (concat org-scheduled-string " "
org-last-inserted-timestamp)
(save-excursion
(outline-next-heading) (point)) t)
(goto-char (1- (match-end 0)))
(insert " " repeater)
(setq org-last-inserted-timestamp
(concat (substring org-last-inserted-timestamp 0 -1)
" " repeater
(substring org-last-inserted-timestamp -1))))))
(message "Scheduled to %s" org-last-inserted-timestamp))))
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let (org-loop-over-headlines-in-active-region)
(org-map-entries
`(org-schedule ',remove ,time) org-loop-over-headlines-in-active-region 'region (if (outline-invisible-p) (org-end-of-subtree nil t))))
(let* ((old-date (org-entry-get nil "SCHEDULED"))
(repeater (and old-date
(string-match
"\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
old-date)
(match-string 1 old-date))))
(if remove
(progn
(when (and old-date org-log-reschedule)
(org-add-log-setup 'delschedule nil old-date 'findpos
org-log-reschedule))
(org-remove-timestamp-with-keyword org-scheduled-string)
(message "Item is no longer scheduled."))
(org-add-planning-info 'scheduled time 'closed)
(when (and old-date org-log-reschedule
(not (equal old-date
(substring org-last-inserted-timestamp 1 -1))))
(org-add-log-setup 'reschedule nil old-date 'findpos
org-log-reschedule))
(when repeater
(save-excursion
(org-back-to-heading t)
(when (re-search-forward (concat org-scheduled-string " "
org-last-inserted-timestamp)
(save-excursion
(outline-next-heading) (point)) t)
(goto-char (1- (match-end 0)))
(insert " " repeater)
(setq org-last-inserted-timestamp
(concat (substring org-last-inserted-timestamp 0 -1)
" " repeater
(substring org-last-inserted-timestamp -1))))))
(message "Scheduled to %s" org-last-inserted-timestamp)))))
(defun org-get-scheduled-time (pom &optional inherit)
"Get the scheduled time as a time tuple, of a format suitable
@ -12736,7 +12788,7 @@ only lines with a TODO keyword are included in the output."
(match-beginning 0) (match-beginning 1)))
(org-show-context 'tags-tree))
((eq action 'agenda)
(setq txt (org-format-agenda-item
(setq txt (org-agenda-format-item
""
(concat
(if (eq org-tags-match-list-sublevels 'indented)
@ -13292,7 +13344,7 @@ This works in the agenda, and also in an org-mode buffer."
(interactive
(list (region-beginning) (region-end)
(let ((org-last-tags-completion-table
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(org-get-buffer-tags)
(org-global-tags-completion-table))))
(org-icompleting-read
@ -13311,7 +13363,7 @@ This works in the agenda, and also in an org-mode buffer."
(loop for l from l1 to l2 do
(org-goto-line l)
(setq m (get-text-property (point) 'org-hd-marker))
(when (or (and (org-mode-p) (org-on-heading-p))
(when (or (and (eq major-mode 'org-mode) (org-on-heading-p))
(and agendap m))
(setq buf (if agendap (marker-buffer m) (current-buffer))
pos (if agendap m (point)))
@ -13657,61 +13709,67 @@ with `org-get-tags-at'. If your function gets properties with
to t around the call to `org-entry-properties' to get the same speedup.
Note that if your function moves around to retrieve tags and properties at
a *different* entry, you cannot use these techniques."
(let* ((org-agenda-archives-mode nil) ; just to make sure
(org-agenda-skip-archived-trees (memq 'archive skip))
(org-agenda-skip-comment-trees (memq 'comment skip))
(org-agenda-skip-function
(car (org-delete-all '(comment archive) skip)))
(org-tags-match-list-sublevels t)
matcher file res
org-todo-keywords-for-agenda
org-done-keywords-for-agenda
org-todo-keyword-alist-for-agenda
org-drawers-for-agenda
org-tag-alist-for-agenda)
(unless (and (eq scope 'region) (not (org-region-active-p)))
(let* ((org-agenda-archives-mode nil) ; just to make sure
(org-agenda-skip-archived-trees (memq 'archive skip))
(org-agenda-skip-comment-trees (memq 'comment skip))
(org-agenda-skip-function
(car (org-delete-all '(comment archive) skip)))
(org-tags-match-list-sublevels t)
matcher file res
org-todo-keywords-for-agenda
org-done-keywords-for-agenda
org-todo-keyword-alist-for-agenda
org-drawers-for-agenda
org-tag-alist-for-agenda)
(cond
((eq match t) (setq matcher t))
((eq match nil) (setq matcher t))
(t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
(cond
((eq match t) (setq matcher t))
((eq match nil) (setq matcher t))
(t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
(save-excursion
(save-restriction
(cond ((eq scope 'tree)
(org-back-to-heading t)
(org-narrow-to-subtree)
(setq scope nil))
((and (eq scope 'region) (org-region-active-p))
(narrow-to-region (region-beginning) (region-end))
(setq scope nil)))
(save-excursion
(save-restriction
(cond ((eq scope 'tree)
(org-back-to-heading t)
(org-narrow-to-subtree)
(setq scope nil))
((and (eq scope 'region) (org-region-active-p))
(narrow-to-region (region-beginning)
(save-excursion
(goto-char (region-end))
(unless (and (bolp) (org-at-heading-p))
(outline-next-heading))
(point)))
(setq scope nil)))
(if (not scope)
(progn
(org-prepare-agenda-buffers
(list (buffer-file-name (current-buffer))))
(setq res (org-scan-tags func matcher)))
;; Get the right scope
(cond
((and scope (listp scope) (symbolp (car scope)))
(setq scope (eval scope)))
((eq scope 'agenda)
(setq scope (org-agenda-files t)))
((eq scope 'agenda-with-archives)
(setq scope (org-agenda-files t))
(setq scope (org-add-archive-files scope)))
((eq scope 'file)
(setq scope (list (buffer-file-name))))
((eq scope 'file-with-archives)
(setq scope (org-add-archive-files (list (buffer-file-name))))))
(org-prepare-agenda-buffers scope)
(while (setq file (pop scope))
(with-current-buffer (org-find-base-buffer-visiting file)
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(setq res (append res (org-scan-tags func matcher))))))))))
res))
(if (not scope)
(progn
(org-prepare-agenda-buffers
(list (buffer-file-name (current-buffer))))
(setq res (org-scan-tags func matcher)))
;; Get the right scope
(cond
((and scope (listp scope) (symbolp (car scope)))
(setq scope (eval scope)))
((eq scope 'agenda)
(setq scope (org-agenda-files t)))
((eq scope 'agenda-with-archives)
(setq scope (org-agenda-files t))
(setq scope (org-add-archive-files scope)))
((eq scope 'file)
(setq scope (list (buffer-file-name))))
((eq scope 'file-with-archives)
(setq scope (org-add-archive-files (list (buffer-file-name))))))
(org-prepare-agenda-buffers scope)
(while (setq file (pop scope))
(with-current-buffer (org-find-base-buffer-visiting file)
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(setq res (append res (org-scan-tags func matcher))))))))))
res)))
;;;; Properties
@ -13881,7 +13939,7 @@ things up because then unnecessary parsing is avoided."
beg end range props sum-props key key1 value string clocksum)
(save-excursion
(when (condition-case nil
(and (org-mode-p) (org-back-to-heading t))
(and (eq major-mode 'org-mode) (org-back-to-heading t))
(error nil))
(setq beg (point))
(setq sum-props (get-text-property (point) 'org-summaries))
@ -16010,7 +16068,7 @@ Entries containing a colon are interpreted as H:MM by
"Save all Org-mode buffers without user confirmation."
(interactive)
(message "Saving all Org-mode buffers...")
(save-some-buffers t 'org-mode-p)
(save-some-buffers t (lambda () (eq major-mode 'org-mode)))
(when (featurep 'org-id) (org-id-locations-save))
(message "Saving all Org-mode buffers... done"))
@ -16034,7 +16092,7 @@ changes from another. I believe the procedure must be like this:
(save-window-excursion
(mapc
(lambda (b)
(when (and (with-current-buffer b (org-mode-p))
(when (and (with-current-buffer b (eq major-mode 'org-mode))
(with-current-buffer b buffer-file-name))
(org-pop-to-buffer-same-window b)
(revert-buffer t 'no-confirm)))
@ -16047,7 +16105,7 @@ changes from another. I believe the procedure must be like this:
;;;###autoload
(defun org-switchb (&optional arg)
"Switch between Org buffers.
With a prefix argument, restrict available to files.
With one prefix argument, restrict available buffers to files.
With two prefix arguments, restrict available buffers to agenda files.
Defaults to `iswitchb' for buffer name completion.
@ -16086,17 +16144,17 @@ If EXCLUDE-TMP is non-nil, ignore temporary buffers."
(filter
(cond
((eq predicate 'files)
(lambda (b) (with-current-buffer b (org-mode-p))))
(lambda (b) (with-current-buffer b (eq major-mode 'org-mode))))
((eq predicate 'export)
(lambda (b) (string-match "\*Org .*Export" (buffer-name b))))
((eq predicate 'agenda)
(lambda (b)
(with-current-buffer b
(and (org-mode-p)
(and (eq major-mode 'org-mode)
(setq bfn (buffer-file-name b))
(member (file-truename bfn) agenda-files)))))
(t (lambda (b) (with-current-buffer b
(or (org-mode-p)
(or (eq major-mode 'org-mode)
(string-match "\*Org .*Export"
(buffer-name b)))))))))
(delq nil
@ -16352,7 +16410,8 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(if (org-on-heading-p t)
(add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
(goto-char (point-min))
(setq re (concat org-outline-regexp-bol "+" org-comment-string "\\>"))
(setq re (format org-heading-keyword-regexp-format
org-comment-string))
(while (re-search-forward re nil t)
(add-text-properties
(match-beginning 0) (org-end-of-subtree t) pc)))
@ -16398,7 +16457,7 @@ an embedded LaTeX fragment, let texmathp do its job.
(interactive)
(let (p)
(cond
((not (org-mode-p)) ad-do-it)
((not (eq major-mode 'org-mode)) ad-do-it)
((eq this-command 'cdlatex-math-symbol)
(setq ad-return-value t
texmathp-why '("cdlatex-math-symbol in org-mode" . 0)))
@ -18227,7 +18286,8 @@ See the individual commands for more information."
(org-indent-line-function)
(org-indent-line-to ind)))))
((and org-return-follows-link
(eq (get-text-property (point) 'face) 'org-link))
(or (eq (get-text-property (point) 'face) 'org-link)
(memq 'org-link (get-text-property (point) 'face))))
(call-interactively 'org-open-at-point))
((and (org-at-heading-p)
(looking-at
@ -18837,8 +18897,8 @@ Your bug report will be posted to the Org-mode mailing list.
(save-excursion
(while bl
(set-buffer (pop bl))
(if (org-mode-p) (setq bl nil)))
(when (org-mode-p)
(if (eq major-mode 'org-mode) (setq bl nil)))
(when (eq major-mode 'org-mode)
(easy-menu-change
'("Org") "File List for Agenda"
(append
@ -19379,9 +19439,13 @@ position before START-RE (resp. after END-RE)."
(cons beg end))))))
(defun org-in-block-p (names)
"Is point inside any block whose name belongs to NAMES?
"Non-nil when point belongs to a block whose name belongs to NAMES.
NAMES is a list of strings containing names of blocks."
NAMES is a list of strings containing names of blocks.
Return first block name matched, or nil. Beware that in case of
nested blocks, the returned name may not belong to the closest
block from point."
(save-match-data
(catch 'exit
(let ((case-fold-search t)
@ -19393,7 +19457,7 @@ NAMES is a list of strings containing names of blocks."
(concat "^[ \t]*#\\+begin_" n)
(concat "^[ \t]*#\\+end_" n)
lim-up lim-down)
(throw 'exit t))))
(throw 'exit n))))
names))
nil)))
@ -19424,18 +19488,18 @@ NAMES is a list of strings containing names of blocks."
;; Emacs 23
(add-hook 'occur-mode-find-occurrence-hook
(lambda ()
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(org-reveal))))
;; Emacs 22
(defadvice occur-mode-goto-occurrence
(after org-occur-reveal activate)
(and (org-mode-p) (org-reveal)))
(and (eq major-mode 'org-mode) (org-reveal)))
(defadvice occur-mode-goto-occurrence-other-window
(after org-occur-reveal activate)
(and (org-mode-p) (org-reveal)))
(and (eq major-mode 'org-mode) (org-reveal)))
(defadvice occur-mode-display-occurrence
(after org-occur-reveal activate)
(when (org-mode-p)
(when (eq major-mode 'org-mode)
(let ((pos (occur-mode-find-occurrence)))
(with-current-buffer (marker-buffer pos)
(save-excursion
@ -20020,13 +20084,16 @@ this line is also exported in fixed-width font."
(forward-line 1)))
(save-excursion
(org-back-to-heading)
(if (looking-at (concat org-outline-regexp
"\\( *\\<" org-quote-string "\\>[ \t]*\\)"))
(replace-match "" t t nil 1)
(if (looking-at org-outline-regexp)
(progn
(goto-char (match-end 0))
(insert org-quote-string " "))))))))
(cond
((looking-at (format org-heading-keyword-regexp-format
org-quote-string))
(goto-char (match-end 1))
(looking-at (concat " +" org-quote-string))
(replace-match "" t t)
(when (eolp) (insert " ")))
((looking-at org-outline-regexp)
(goto-char (match-end 0))
(insert org-quote-string " ")))))))
(defun org-reftex-citation ()
"Use reftex-citation to insert a citation into the buffer.
@ -20345,8 +20412,9 @@ empty."
(save-excursion
(beginning-of-line 1)
(let ((case-fold-search nil))
(looking-at (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp
"\\)?[ \t]*$"))))))
(looking-at org-todo-line-regexp)))
(string= (match-string 3) "")))
(defun org-at-heading-or-item-p ()
(or (org-on-heading-p) (org-at-item-p)))
@ -20491,7 +20559,7 @@ If there is no such heading, return nil."
(org-back-to-heading invisible-OK)
(let ((first t)
(level (funcall outline-level)))
(if (and (org-mode-p) (< level 1000))
(if (and (eq major-mode 'org-mode) (< level 1000))
;; A true heading (not a plain list item), in Org-mode
;; This means we can easily find the end by looking
;; only for the right number of stars. Using a regexp to do
@ -20516,7 +20584,7 @@ If there is no such heading, return nil."
(defadvice outline-end-of-subtree (around prefer-org-version activate compile)
"Use Org version in org-mode, for dramatic speed-up."
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(progn
(org-end-of-subtree nil t)
(unless (eobp) (backward-char 1)))
@ -20688,7 +20756,7 @@ Show the heading too, if it is currently invisible."
'(progn
(add-hook 'imenu-after-jump-hook
(lambda ()
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(org-show-context 'org-goto))))))
(defun org-link-display-format (link)
@ -20749,7 +20817,7 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(with-current-buffer (find-file-noselect
(let ((default-directory dir))
(expand-file-name txt)))
(unless (org-mode-p)
(unless (eq major-mode 'org-mode)
(error "Cannot restrict to non-Org-mode file"))
(org-agenda-set-restriction-lock 'file)))
(t (error "Don't know how to restrict Org-mode's agenda")))
@ -20766,7 +20834,7 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
(define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
(add-hook 'speedbar-visiting-tag-hook
(lambda () (and (org-mode-p) (org-show-context 'org-goto))))))
(lambda () (and (eq major-mode 'org-mode) (org-show-context 'org-goto))))))
;;; Fixes and Hacks for problems with other packages
@ -20809,12 +20877,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(eval-after-load "ecb"
'(defadvice ecb-method-clicked (after esf/org-show-context activate)
"Make hierarchy visible when jumping into location from ECB tree buffer."
(if (org-mode-p)
(if (eq major-mode 'org-mode)
(org-show-context))))
(defun org-bookmark-jump-unhide ()
"Unhide the current position, to show the bookmark location."
(and (org-mode-p)
(and (eq major-mode 'org-mode)
(or (outline-invisible-p)
(save-excursion (goto-char (max (point-min) (1- (point))))
(outline-invisible-p)))

2
testing/org-test.el
View File

@ -151,7 +151,7 @@ currently executed.")
(save-window-excursion
(save-match-data
(find-file my-file)
(unless (org-mode-p)
(unless (eq major-mode 'org-mode)
(org-mode))
(setq to-be-removed (current-buffer))
(goto-char (point-min))