diff options
| author | Kenichi Handa <handa@gnu.org> | 2012-10-06 21:55:09 +0900 |
|---|---|---|
| committer | Kenichi Handa <handa@gnu.org> | 2012-10-06 21:55:09 +0900 |
| commit | 16ddec7e9e6adcf615db097d9627d490ca29208c (patch) | |
| tree | 1c16b9565c9cca81ec8f5b10f0f4110340d4654a | |
| parent | 2b89bca49d55cec1a004353354a76de2972c68f3 (diff) | |
| parent | d5acb99a199d83cde1a43482709c3e9d4ec34b2f (diff) | |
| download | emacs-16ddec7e9e6adcf615db097d9627d490ca29208c.tar.gz | |
merge trunk
414 files changed, 32563 insertions, 14372 deletions
diff --git a/ChangeLog b/ChangeLog index 411ef633420..90b57c4c3da 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2012-10-04 Paul Eggert <eggert@cs.ucla.edu> + + Merge from gnulib, incorporating: + 2012-10-02 pselect: reject invalid file descriptors + 2012-10-02 ptsname: reject invalid file descriptors + 2012-10-02 manywarnings: cater to more gcc infelicities + 2012-09-30 sockets, sys_stat: restore AC_C_INLINE + * lib/pselect.c, lib/stdlib.in.h, m4/manywarnings.m4, m4/pselect.m4: + * m4/stdlib_h.m4, m4/sys_stat_h.m4: Update from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + 2012-09-30 Paul Eggert <eggert@cs.ucla.edu> Merge from gnulib, incorporating: diff --git a/admin/ChangeLog b/admin/ChangeLog index b5b1b75c55c..2da65523116 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,18 @@ +2012-10-01 David Engster <deng@randomsample.de> + + * grammars/bovine-grammar.el (bovine--grammar-newstyle-unquote): + Remove. + (bovine-grammar-expand-form): Test for emacs-major-version. + + * grammars/c.by: Add EXPLICIT to keyword tokens. + + * grammars/f90.by: Add %provide token. + + * grammar/grammar.wy (semantic-grammar-lexer): Remove, since it + was copied to grammar.el. New %provide token to generate prefix + which conforms with Emacs conventions. Remove lexer definition, + which is now in grammar.el. + 2012-09-27 Glenn Morris <rgm@gnu.org> * admin.el (set-version): Set msdos.c's Vwindow_system_version. diff --git a/admin/grammars/bovine-grammar.el b/admin/grammars/bovine-grammar.el index efe4db039c4..a7289f6bafe 100644 --- a/admin/grammars/bovine-grammar.el +++ b/admin/grammars/bovine-grammar.el @@ -109,14 +109,6 @@ NAME, ALIASCLASS, DEFINITION and ATTRIBUTES." ;; Cache of macro definitions currently in use. (defvar bovine--grammar-macros nil) -;; Detect if we have an Emacs with newstyle unquotes allowed outside -;; of backquote. -;; This should probably be changed to a test to (= emacs-major-version 24) -;; when it is released, but at the moment it might be possible that people -;; are using an older snapshot. -(defvar bovine--grammar-newstyle-unquote - (equal '(\, test) (read ",test"))) - (defun bovine-grammar-expand-form (form quotemode &optional inplace) "Expand FORM into a new one suitable to the bovine parser. FORM is a list in which we are substituting. @@ -152,7 +144,7 @@ expanded from elsewhere." form (cdr form)) ;; Hack for dealing with new reading of unquotes outside of ;; backquote (introduced in rev. 102591 in emacs-bzr). - (when (and bovine--grammar-newstyle-unquote + (when (and (>= emacs-major-version 24) (listp first) (or (equal (car first) '\,) (equal (car first) '\,@))) @@ -456,6 +448,7 @@ Menu items are appended to the common grammar menu.") (defun bovine-make-parsers () "Generate Emacs' built-in Bovine-based parser files." + (interactive) (semantic-mode 1) ;; Loop through each .by file in current directory, and run ;; `semantic-grammar-batch-build-one-package' to build the grammar. @@ -465,13 +458,14 @@ Menu items are appended to the common grammar menu.") (with-current-buffer (find-file-noselect f) (semantic-grammar-create-package)) (error (message "%s" (error-message-string err)) nil))) - lang) + lang filename) (when (and packagename - (string-match "^semantic-\\(.*\\)-by\\.el\\'" packagename)) + (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename)) (setq lang (match-string 1 packagename)) + (setq filename (concat lang "-by.el")) (with-temp-buffer - (insert-file-contents packagename) - (setq buffer-file-name (expand-file-name packagename)) + (insert-file-contents filename) + (setq buffer-file-name (expand-file-name filename)) ;; Fix copyright header: (goto-char (point-min)) (re-search-forward "^;; Author:") @@ -500,20 +494,14 @@ Menu items are appended to the common grammar menu.") lang ".by. ;;; Code: - -\(require 'semantic/lex) -\(eval-when-compile (require 'semantic/bovine))\n") +") (goto-char (point-min)) (delete-region (point-min) (line-end-position)) - (insert ";;; semantic/bovine/" lang - "-by.el --- Generated parser support file") + (insert ";;; " packagename + " --- Generated parser support file") (delete-trailing-whitespace) - ;; Fix footer: - (goto-char (point-max)) - (re-search-backward ".\n;;; Analyzers") - (delete-region (point) (point-max)) - (insert "(provide 'semantic/bovine/" lang "-by)\n\n") - (insert ";;; semantic/bovine/" lang "-by.el ends here\n") + (re-search-forward ";;; \\(.*\\) ends here") + (replace-match packagename nil nil nil 1) (save-buffer)))))) ;;; bovine-grammar.el ends here diff --git a/admin/grammars/c.by b/admin/grammars/c.by index 1bdaf8f447b..dfced9813d1 100644 --- a/admin/grammars/c.by +++ b/admin/grammars/c.by @@ -1,5 +1,4 @@ ;;; c.by -- LL grammar for C/C++ language specification - ;; Copyright (C) 1999-2012 Free Software Foundation, Inc. ;; ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -39,6 +38,13 @@ ;; > * Can't parse signature element: "RmcBucStatus* rftBucStatus" %package semantic-c-by +%provide semantic/bovine/c-by + +%{ +(declare-function semantic-c-reconstitute-token "semantic/bovine/c") +(declare-function semantic-c-reconstitute-template "semantic/bovine/c") +(declare-function semantic-expand-c-tag "semantic/bovine/c") +} %languagemode c-mode c++-mode %start declaration @@ -98,6 +104,8 @@ %put VIRTUAL summary "Method Modifier: virtual <type> <name>(...) ..." %token MUTABLE "mutable" %put MUTABLE summary "Member Declaration Modifier: mutable <type> <name> ..." +%token EXPLICIT "explicit" +%put EXPLICIT summary "Forbids implicit type conversion: explicit <constructor>" %token STRUCT "struct" %put STRUCT summary "Structure Type Declaration: struct [name] { ... };" @@ -370,6 +378,9 @@ namespacesubparts ;; PUBLIC or PRIVATE bits. Ignore them for now. | template | using + ;; Includes inside namespaces + | spp-include + (TAG $1 'include :inside-ns t) | ;;EMPTY ; @@ -1098,6 +1109,8 @@ functionname function-pointer : LPAREN STAR symbol RPAREN ( (concat "*" $3) ) + | LPAREN symbol RPAREN + ( $2 ) ; fun-or-proto-end diff --git a/admin/grammars/grammar.wy b/admin/grammars/grammar.wy index 1189d6b0886..f89fe6220ff 100644 --- a/admin/grammars/grammar.wy +++ b/admin/grammars/grammar.wy @@ -23,6 +23,9 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +%package semantic-grammar-wy +%provide semantic/grammar-wy + %{ (defvar semantic-grammar-lex-c-char-re) @@ -32,8 +35,6 @@ (defvar semantic-grammar-wy--rindx nil) } -%package semantic-grammar-wy - %languagemode wy-mode ;; Main @@ -52,6 +53,7 @@ %keyword LEFT "%left" %keyword NONASSOC "%nonassoc" %keyword PACKAGE "%package" +%keyword PROVIDE "%provide" %keyword PREC "%prec" %keyword PUT "%put" %keyword QUOTEMODE "%quotemode" @@ -134,6 +136,7 @@ decl: | no_default_prec_decl | languagemode_decl | package_decl + | provide_decl | precedence_decl | put_decl | quotemode_decl @@ -165,6 +168,11 @@ package_decl: `(PACKAGE-TAG ',$2 nil) ; +provide_decl: + PROVIDE SYMBOL + `(TAG ',$2 'provide) + ; + precedence_decl: associativity token_type_opt items `(TAG ',$1 'assoc :type ',$2 :value ',$3) diff --git a/admin/grammars/java-tags.wy b/admin/grammars/java-tags.wy index b58b96c6bfb..708715533ff 100644 --- a/admin/grammars/java-tags.wy +++ b/admin/grammars/java-tags.wy @@ -23,6 +23,7 @@ ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. %package wisent-java-tags-wy +%provide semantic/wisent/javat-wy %languagemode java-mode @@ -444,7 +445,7 @@ class_member_declaration ;;; Type Declaration token ;; ("NAME" type "TYPE" ( PART-LIST ) ( PARENTS ) EXTRA-SPEC "DOCSTRING") interface_declaration - : modifiers_opt INTERFACE IDENTIFIER extends_interfaces_opt interface_body + : modifiers_opt INTERFACE qualified_name extends_interfaces_opt interface_body (TYPE-TAG $3 $2 $5 (if $4 (cons nil $4)) :typemodifiers $1) ; @@ -547,7 +548,7 @@ formal_parameters ;;; Variable token ;; ("NAME" variable "TYPE" DEFAULT-VALUE EXTRA-SPEC "DOCSTRING") formal_parameter - : formal_parameter_modifier_opt type variable_declarator_id + : formal_parameter_modifier_opt type opt_variable_declarator_id (VARIABLE-TAG $3 $2 nil :typemodifiers $1) ; @@ -582,6 +583,13 @@ variable_declarator (cons $1 $region) ; +opt_variable_declarator_id + : ;; EMPTY + (identity "") + | variable_declarator_id + (identity $1) + ; + variable_declarator_id : IDENTIFIER dims_opt (concat $1 $2) diff --git a/admin/grammars/js.wy b/admin/grammars/js.wy index c6b3a58aac3..7b55f5c3834 100644 --- a/admin/grammars/js.wy +++ b/admin/grammars/js.wy @@ -58,6 +58,7 @@ ;; DAMAGE. %package wisent-javascript-jv-wy +%provide semantic/wisent/js-wy ;; JAVE I prefere ecmascript-mode %languagemode ecmascript-mode javascript-mode diff --git a/admin/grammars/make.by b/admin/grammars/make.by index ee933805cf6..6cff4716f82 100644 --- a/admin/grammars/make.by +++ b/admin/grammars/make.by @@ -22,6 +22,7 @@ ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. %package semantic-make-by +%provide semantic/bovine/make-by %languagemode makefile-mode %start Makefile diff --git a/admin/grammars/python.wy b/admin/grammars/python.wy index f7808fd20b8..f17f41c9b1b 100644 --- a/admin/grammars/python.wy +++ b/admin/grammars/python.wy @@ -88,6 +88,12 @@ ;; -------- %package wisent-python-wy +%provide semantic/wisent/python-wy + +%{ +(declare-function wisent-python-reconstitute-function-tag "semantic/wisent/python") +(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python") +} %languagemode python-mode @@ -173,6 +179,7 @@ %token <punctuation> COMMA "," %token <punctuation> ASSIGN "=" %token <punctuation> BACKQUOTE "`" +%token <punctuation> AT "@" ;; ----------------- @@ -307,6 +314,10 @@ %put WHILE summary "Start a 'while' loop" +%keyword WITH "with" +%put WITH summary +"Start statement with an associated context object" + %keyword YIELD "yield" %put YIELD summary "Create a generator function" @@ -545,8 +556,10 @@ import_stmt ;; dotted_as_name (',' dotted_as_name)* dotted_as_name_list - : dotted_as_name - | dotted_as_name_list COMMA dotted_as_name + : dotted_as_name_list COMMA dotted_as_name + (cons $3 $1) + | dotted_as_name + (list $1) ; ;; ('*' | import_as_name (',' import_as_name)*) @@ -649,6 +662,7 @@ compound_stmt | while_stmt | for_stmt | try_stmt + | with_stmt | funcdef | class_declaration ; @@ -756,13 +770,46 @@ zero_one_or_two_test ; ;;;============================================================================ +;;@@ with_stmt +;;;============================================================================ + +;; with_stmt: 'with' test [ with_var ] ':' suite +with_stmt + : WITH test COLON suite + (CODE-TAG $1 nil) + | WITH test with_var COLON suite + (CODE-TAG $1 nil) ;; TODO capture variable + ; + +with_var + : AS expr + () ;; TODO capture + ; + +;;;============================================================================ ;;;@@ funcdef ;;;============================================================================ -;; funcdef: 'def' NAME parameters ':' suite +decorator + : AT dotted_name varargslist_opt NEWLINE + (FUNCTION-TAG $2 "decorator" $3) + ; + +decorators + : decorator + (list $1) + | decorator decorators + (cons $1 $2) + ; + +;; funcdef: [decorators] 'def' NAME parameters ':' suite funcdef : DEF NAME function_parameter_list COLON suite - (FUNCTION-TAG $2 nil $3) + (wisent-python-reconstitute-function-tag + (FUNCTION-TAG $2 nil $3) $5) + | decorators DEF NAME function_parameter_list COLON suite + (wisent-python-reconstitute-function-tag + (FUNCTION-TAG $3 nil $4 :decorators $1) $6) ; function_parameter_list @@ -798,10 +845,11 @@ function_parameter ;; classdef: 'class' NAME ['(' testlist ')'] ':' suite class_declaration : CLASS NAME paren_class_list_opt COLON suite - (TYPE-TAG $2 $1 ;; Name "class" - $5 ;; Members - (cons $3 nil) ;; (SUPERCLASSES . INTERFACES) - ) + (wisent-python-reconstitute-class-tag + (TYPE-TAG $2 $1 ;; Name "class" + $5 ;; Members + (cons $3 nil) ;; (SUPERCLASSES . INTERFACES) + )) ; ;; ['(' testlist ')'] diff --git a/admin/grammars/scheme.by b/admin/grammars/scheme.by index 3925f03c28b..98e75901a71 100644 --- a/admin/grammars/scheme.by +++ b/admin/grammars/scheme.by @@ -18,6 +18,7 @@ ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. %package semantic-scm-by +%provide semantic/bovine/scm-by %languagemode scheme-mode %start scheme diff --git a/admin/grammars/srecode-template.wy b/admin/grammars/srecode-template.wy index f38d7eaa2a1..f84a414b46e 100644 --- a/admin/grammars/srecode-template.wy +++ b/admin/grammars/srecode-template.wy @@ -28,6 +28,9 @@ ;; Semantic Recoder templates are based on Google Templates ;; and are at the bottom of the Semantic Recoder API. +%package srecode-template-wy +%provide srecode/srt-wy + %languagemode srecode-mode %start template_file @@ -46,6 +49,15 @@ %put TEMPLATE summary "template <name>\\n <template definition>" %keyword SECTIONDICTIONARY "sectiondictionary" %put SECTIONDICTIONARY summary "sectiondictionary <name>\\n <dictionary entries>" + +%keyword SECTION "section" +%put SECTION summary + "section <name>\\n <dictionary entries>\\n end" + +%keyword END "end" +%put END summary + "section ... end" + %keyword PROMPT "prompt" %keyword DEFAULT "default" %keyword DEFAULTMACRO "defaultmacro" @@ -62,7 +74,7 @@ %token <separator> TEMPLATE_BLOCK "^----" ;;; Bland default types -%type <property> ":\\(\\w\\|\\s_\\)*" +%type <property> syntax ":\\(\\w\\|\\s_\\)*" %token <property> property %type <symbol> @@ -134,7 +146,7 @@ insertable-string template : TEMPLATE templatename opt-dynamic-arguments newline opt-string - opt-section-dictionaries + section-dictionary-list TEMPLATE_BLOCK newline opt-bind (FUNCTION-TAG $2 nil $3 :documentation $5 :code $7 @@ -165,29 +177,52 @@ opt-string | () ; -opt-section-dictionaries - : () ;; EMPTY - | section-dictionary-list - ; - section-dictionary-list - : one-section-dictionary - (list $1) - | section-dictionary-list one-section-dictionary + : ;; empty + () + | section-dictionary-list flat-section-dictionary + (append $1 (list $2)) + | section-dictionary-list section-dictionary (append $1 (list $2)) ; -one-section-dictionary +flat-section-dictionary : SECTIONDICTIONARY string newline - variable-list + flat-dictionary-entry-list + (cons (read $2) $4) + ; + +flat-dictionary-entry-list + : ;; empty + () + | flat-dictionary-entry-list flat-dictionary-entry + (append $1 $2) + ; + +flat-dictionary-entry + : variable + (EXPANDTAG $1) + ; + +section-dictionary + : SECTION string newline + dictionary-entry-list + END newline (cons (read $2) $4) ; -variable-list +dictionary-entry-list + : ;; empty + () + | dictionary-entry-list dictionary-entry + (append $1 $2) + ; + +dictionary-entry : variable (EXPANDTAG $1) - | variable-list variable - (append $1 (EXPANDTAG $2)) + | section-dictionary + (list $1) ; opt-bind @@ -232,4 +267,4 @@ It ignores whitespace, newlines and comments." semantic-lex-default-action ) -;;; wisent-dot.wy ends here +;;; srecode-template.wy ends here diff --git a/admin/grammars/wisent-grammar.el b/admin/grammars/wisent-grammar.el index 714b5211127..25dba5be2d8 100644 --- a/admin/grammars/wisent-grammar.el +++ b/admin/grammars/wisent-grammar.el @@ -209,15 +209,15 @@ See also the function `wisent-skip-token'." "Return the list of terminal symbols. Keep order of declaration in the WY file without duplicates." (let (terms) - (mapcar + (mapc #'(lambda (tag) - (mapcar #'(lambda (name) - (add-to-list 'terms (intern name))) - (cons (semantic-tag-name tag) - (semantic-tag-get-attribute tag :rest)))) + (mapcar #'(lambda (name) + (add-to-list 'terms (intern name))) + (cons (semantic-tag-name tag) + (semantic-tag-get-attribute tag :rest)))) (semantic--find-tags-by-function #'(lambda (tag) - (memq (semantic-tag-class tag) '(token keyword))) + (memq (semantic-tag-class tag) '(token keyword))) (current-buffer))) (nreverse terms))) @@ -464,23 +464,20 @@ Menu items are appended to the common grammar menu.") ;; DAMAGE.") (defvar wisent-make-parsers--parser-file-name - `(("semantic-grammar-wy.el" - "semantic/grammar-wy") - ("srecode-template-wy.el" - "srecode/srt-wy") - ("wisent-javascript-jv-wy.el" - "semantic/wisent/js-wy" + `(("semantic/grammar-wy.el") + ("srecode/srt-wy.el") + ("semantic/wisent/js-wy.el" "Copyright (C) 1998-2011 Ecma International." ,wisent-make-parsers--ecmascript-license) - ("wisent-java-tags-wy.el" - "semantic/wisent/javat-wy") - ("wisent-python-wy.el" - "semantic/wisent/python-wy" - "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Python Software Foundation; All Rights Reserved." + ("semantic/wisent/javat-wy.el") + ("semantic/wisent/python-wy.el" + "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +\;; 2009, 2010 Python Software Foundation; All Rights Reserved" ,wisent-make-parsers--python-license))) (defun wisent-make-parsers () "Generate Emacs' built-in Wisent-based parser files." + (interactive) (semantic-mode 1) ;; Loop through each .wy file in current directory, and run ;; `semantic-grammar-batch-build-one-package' to build the grammar. @@ -492,16 +489,16 @@ Menu items are appended to the common grammar menu.") (error (message "%s" (error-message-string err)) nil))) output-data) (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name)) - (let ((require-name (nth 1 output-data)) - (additional-copyright (nth 2 output-data)) - (additional-license (nth 3 output-data)) + (let ((additional-copyright (nth 1 output-data)) + (additional-license (nth 2 output-data)) + (filename (progn (string-match ".*/\\(.*\\)" packagename) (match-string 1 packagename))) copyright-end) ;; Touch up the generated parsers for Emacs integration. (with-temp-buffer - (insert-file-contents packagename) + (insert-file-contents filename) ;; Fix copyright header: (goto-char (point-min)) - (when additional-copyright + (when additional-copyright (re-search-forward "Copyright (C).*$") (insert "\n;; " additional-copyright)) (re-search-forward "^;; Author:") @@ -516,22 +513,14 @@ Menu items are appended to the common grammar menu.") f ".") (when additional-license (insert "\n" additional-license)) - (insert "\n\n;;; Code:\n -\(require 'semantic/lex)\n") + (insert "\n\n;;; Code:\n") (goto-char (point-min)) (delete-region (point-min) (line-end-position)) - (insert ";;; " require-name - ".el --- Generated parser support file") + (insert ";;; " packagename + " --- Generated parser support file") + (re-search-forward ";;; \\(.*\\) ends here") + (replace-match packagename nil nil nil 1) (delete-trailing-whitespace) - (re-search-forward ";;\n(require 'semantic/lex)\n") - (delete-region (match-beginning 0) (match-end 0)) - ;; Fix footer: - (goto-char (point-max)) - (re-search-backward "^(provide") - (delete-region (match-beginning 0) (point-max)) - (goto-char (point-max)) - (insert "(provide '" require-name ")\n\n") - (insert ";;; " require-name ".el ends here\n") - (write-region nil nil (expand-file-name packagename)))))))) + (write-region nil nil (expand-file-name filename)))))))) ;;; wisent-grammar.el ends here diff --git a/autogen/Makefile.in b/autogen/Makefile.in index e3264ff0c3f..14cb3c9c9c1 100644 --- a/autogen/Makefile.in +++ b/autogen/Makefile.in @@ -683,6 +683,7 @@ REPLACE_PREAD = @REPLACE_PREAD@ REPLACE_PRINTF = @REPLACE_PRINTF@ REPLACE_PSELECT = @REPLACE_PSELECT@ REPLACE_PTHREAD_SIGMASK = @REPLACE_PTHREAD_SIGMASK@ +REPLACE_PTSNAME = @REPLACE_PTSNAME@ REPLACE_PTSNAME_R = @REPLACE_PTSNAME_R@ REPLACE_PUTENV = @REPLACE_PUTENV@ REPLACE_PWRITE = @REPLACE_PWRITE@ @@ -1633,6 +1634,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \ -e 's|@''REPLACE_MBTOWC''@|$(REPLACE_MBTOWC)|g' \ -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \ + -e 's|@''REPLACE_PTSNAME''@|$(REPLACE_PTSNAME)|g' \ -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \ -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ -e 's|@''REPLACE_RANDOM_R''@|$(REPLACE_RANDOM_R)|g' \ diff --git a/autogen/configure b/autogen/configure index 11e046c551b..f08dd5503a2 100755 --- a/autogen/configure +++ b/autogen/configure @@ -909,6 +909,7 @@ REPLACE_REALLOC REPLACE_RANDOM_R REPLACE_PUTENV REPLACE_PTSNAME_R +REPLACE_PTSNAME REPLACE_MKSTEMP REPLACE_MBTOWC REPLACE_MALLOC @@ -7295,8 +7296,41 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_nomfi_needed" >&5 $as_echo "$gl_cv_cc_nomfi_needed" >&6; } fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -Wuninitialized is supported" >&5 +$as_echo_n "checking whether -Wuninitialized is supported... " >&6; } + if test "${gl_cv_cc_uninitialized_supported+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + gl_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Werror -Wuninitialized" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gl_cv_cc_uninitialized_supported=yes +else + gl_cv_cc_uninitialized_supported=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CFLAGS="$gl_save_CFLAGS" +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_uninitialized_supported" >&5 +$as_echo "$gl_cv_cc_uninitialized_supported" >&6; } + fi + # List all gcc warning categories. gl_manywarn_set= for gl_manywarn_item in \ -W \ @@ -7415,11 +7449,15 @@ $as_echo "$gl_cv_cc_nomfi_needed" >&6; } gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item" done - # Disable the missing-field-initializers warning if needed + # Disable specific options as needed. if test "$gl_cv_cc_nomfi_needed" = yes; then gl_manywarn_set="$gl_manywarn_set -Wno-missing-field-initializers" fi + if test "$gl_cv_cc_uninitialized_supported" = no; then + gl_manywarn_set="$gl_manywarn_set -Wno-uninitialized" + fi + ws=$gl_manywarn_set @@ -16842,6 +16880,7 @@ _ACEOF REPLACE_MALLOC=0; REPLACE_MBTOWC=0; REPLACE_MKSTEMP=0; + REPLACE_PTSNAME=0; REPLACE_PTSNAME_R=0; REPLACE_PUTENV=0; REPLACE_RANDOM_R=0; @@ -21625,6 +21664,69 @@ rm -f core conftest.err conftest.$ac_objext \ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sig_pselect" >&5 $as_echo "$gl_cv_sig_pselect" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pselect detects invalid fds" >&5 +$as_echo_n "checking whether pselect detects invalid fds... " >&6; } +if test "${gl_cv_func_pselect_detects_ebadf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test "$cross_compiling" = yes; then : + + case "$host_os" in + # Guess yes on glibc systems. + *-gnu*) gl_cv_func_pselect_detects_ebadf="guessing yes" ;; + # If we don't know, assume the worst. + *) gl_cv_func_pselect_detects_ebadf="guessing no" ;; + esac + +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <sys/types.h> +#include <sys/time.h> +#if HAVE_SYS_SELECT_H +# include <sys/select.h> +#endif +#include <unistd.h> +#include <errno.h> + +int +main () +{ + + fd_set set; + dup2(0, 16); + FD_ZERO(&set); + FD_SET(16, &set); + close(16); + struct timespec timeout; + timeout.tv_sec = 0; + timeout.tv_nsec = 5000; + return pselect (17, &set, NULL, NULL, &timeout, NULL) != -1 || errno != EBADF; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + gl_cv_func_pselect_detects_ebadf=yes +else + gl_cv_func_pselect_detects_ebadf=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_pselect_detects_ebadf" >&5 +$as_echo "$gl_cv_func_pselect_detects_ebadf" >&6; } + case $gl_cv_func_pselect_detects_ebadf in + *yes) ;; + *) REPLACE_PSELECT=1 ;; + esac fi if test $ac_cv_func_pselect = no || test $gl_cv_sig_pselect = no; then @@ -23438,6 +23540,8 @@ done + + if test $gl_cv_have_include_next = yes; then gl_cv_next_sys_stat_h='<'sys/stat.h'>' else diff --git a/configure.ac b/configure.ac index 5a3aea763c0..edbae29c59f 100644 --- a/configure.ac +++ b/configure.ac @@ -575,6 +575,7 @@ fi AC_DEFUN([gl_THREADLIB]) # Initialize gnulib right after choosing the compiler. +dnl Amongst other things, this sets AR and ARFLAGS. gl_EARLY # It's helpful to have C macros available to GDB, so prefer -g3 to -g diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index c1894fb900b..572cc4f5532 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,8 @@ +2012-10-02 Glenn Morris <rgm@gnu.org> + + * maintaining.texi (VC Directory Commands): + Remove duplicate `q' entry. (Bug#12553) + 2012-09-30 Chong Yidong <cyd@gnu.org> * killing.texi (Rectangles): Document copy-rectangle-as-kill. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 2313d117a90..90bfcf147c5 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1065,7 +1065,7 @@ present. Type @kbd{M-x delete-trailing-whitespace} to delete all trailing whitespace. This command deletes all extra spaces at the end of each line in the buffer, and all empty lines at the end of the buffer; to -ignore the latter, change the varaible @code{delete-trailing-lines} to +ignore the latter, change the variable @code{delete-trailing-lines} to @code{nil}. If the region is active, the command instead deletes extra spaces at the end of each line in the region. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index c719c483ec8..d21e3af83dd 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1186,11 +1186,8 @@ point is on a directory entry, mark all files in that directory tree (@code{vc-dir-mark-all-files}). With a prefix argument, mark all listed files and directories. -@kindex q @r{(VC Directory)} -@findex quit-window @item q -Bury the VC Directory buffer, and delete its window if the window was -created just for that buffer. +Quit the VC Directory buffer, and bury it (@code{quit-window}). @item u Unmark the file or directory on the current line. If the region is @@ -1205,9 +1202,6 @@ files and directories. @item x Hide files with @samp{up-to-date} status (@code{vc-dir-hide-up-to-date}). - -@item q -Quit the VC Directory buffer, and bury it (@code{quit-window}). @end table @findex vc-dir-mark diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index b5c847b4b72..7609efb8ac9 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,23 @@ +2012-10-05 Chong Yidong <cyd@gnu.org> + + * minibuf.texi (Basic Completion): Clarify list form of completion + table (Bug#12564). + +2012-10-05 Bruno Félix Rezende Ribeiro <oitofelix@gmail.com> (tiny change) + + * functions.texi (Function Safety): Copyedit. (Bug#12562) + +2012-10-01 Paul Eggert <eggert@cs.ucla.edu> + + Revert the FOLLOW-SYMLINKS change for file-attributes. + * files.texi (File Attributes, Magic File Names): Undo last change. + +2012-09-30 Paul Eggert <eggert@cs.ucla.edu> + + file-attributes has a new optional arg FOLLOW-SYMLINKS. + * files.texi (File Attributes): Describe it. + (Magic File Names): Use it. + 2012-09-30 Chong Yidong <cyd@gnu.org> * commands.texi (Click Events): Define "mouse position list". diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 93dba237013..9ffa2b74857 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1952,7 +1952,7 @@ position such events have. @defun posnp object This function returns non-@code{nil} if @var{object} is a mouse -oposition list, in either of the formats documented in @ref{Click +position list, in either of the formats documented in @ref{Click Events}); and @code{nil} otherwise. @end defun diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index b7b26c8708c..b28ed6e84c4 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -148,7 +148,7 @@ The message is @samp{No catch for tag}. @xref{Catch and Throw}. @ignore @c Not actually used for anything? Probably definition should be removed. @item protected-field -The message is @samp{Attempt to modify a protected fiel. +The message is @samp{Attempt to modify a protected file}. @end ignore @item scan-error @@ -205,7 +205,7 @@ of @code{domain-error}. The message is @code{Arithmetic range error}. @item singularity-error -The mssage is @samp{Arithmetic singularity error}. This is a +The message is @samp{Arithmetic singularity error}. This is a subcategory of @code{domain-error}. @item underflow-error diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index cab6d12a3d8..845561f91ec 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1397,7 +1397,7 @@ opposed to an unspecified one). @cindex function safety @cindex safety of functions -Some major modes such as SES call functions that are stored in user +Some major modes, such as SES, call functions that are stored in user files. (@inforef{Top, ,ses}, for more information on SES.) User files sometimes have poor pedigrees---you can get a spreadsheet from someone you've just met, or you can get one through email from someone diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 3d6e80bf3f0..39b4fca3b25 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -664,25 +664,22 @@ This function returns the longest common substring of all possible completions of @var{string} in @var{collection}. @cindex completion table -The @var{collection} argument is called the @dfn{completion table}. -Its value must be a list of strings, an alist whose keys are strings -or symbols, an obarray, a hash table, or a completion function. - -Completion compares @var{string} against each of the permissible -completions specified by @var{collection}. If no permissible -completions match, @code{try-completion} returns @code{nil}. If there -is just one matching completion, and the match is exact, it returns +@var{collection} is called the @dfn{completion table}. Its value must +be a list of strings or cons cells, an obarray, a hash table, or a +completion function. + +@code{try-completion} compares @var{string} against each of the +permissible completions specified by the completion table. If no +permissible completions match, it returns @code{nil}. If there is +just one matching completion, and the match is exact, it returns @code{t}. Otherwise, it returns the longest initial sequence common to all possible matching completions. -If @var{collection} is an alist (@pxref{Association Lists}), the -permissible completions are the elements of the alist that are either -strings, or conses whose @sc{car} is a string or symbol. -Symbols are converted to strings using @code{symbol-name}. Other -elements of the alist are ignored. (Remember that in Emacs Lisp, the -elements of alists do not @emph{have} to be conses.) In particular, a -list of strings is allowed, even though we usually do not -think of such lists as alists. +If @var{collection} is an list, the permissible completions are +specified by the elements of the list, each of which should be either +a string, or a cons cell whose @sc{car} is either a string or a symbol +(a symbol is converted to a string using @code{symbol-name}). If the +list contains elements of any other type, those are ignored. @cindex obarray in completion If @var{collection} is an obarray (@pxref{Creating Symbols}), the names diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 8ecaf97a84a..5fdd4acde95 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,270 @@ +2012-10-06 Glenn Morris <rgm@gnu.org> + + * erc.texi: Include emacsver.texi, and use EMACSVER rather than + ERC version. + (Introduction): ERC is distributed with Emacs. + (Obtaining ERC, Installation): Remove chapters, no longer relevant. + (Getting Started): Simplify. + (Getting Help and Reporting Bugs): Refer to general Emacs lists. + (History): Mention ERC maintained as part of Emacs now. + * Makefile.in ($(buildinfodir)/erc$(INFO_EXT), erc.dvi, erc.pdf): + Add dependency on emacsver.texi. + + * erc.texi: Remove hand-written node pointers. + +2012-10-05 Glenn Morris <rgm@gnu.org> + + * newsticker.texi (Overview, Requirements, Usage, Configuration): + Copyedits. + +2012-10-01 Eric Ludlam <zappo@gnu.org> + + * ede.texi (Quick Start, Project Local Variables) + (Miscellaneous commands, ede-java-root, Development Overview) + (Detecting a Project): New nodes. + (Simple projects): Node deleted. + + * eieio.texi (Building Classes): Some slot attributes cannot be + overridden. + (Slot Options): Remove an example. + (Method Invocation, Documentation): New nodes. + +2012-10-01 Glenn Morris <rgm@gnu.org> + + * Makefile.in ($(buildinfodir)/reftex$(INFO_EXT)), reftex.dvi) + (reftex.pdf): Add dependency on emacsver.texi. + * reftex.texi: Don't include directory part for emacsver.texi; + the Makefile's -I handles it. + +2012-09-30 Ralf Angeli <angeli@caeruleus.net> + + Merge from standalone RefTeX repository. + + * reftex.texi: Express TeX, LaTeX, AUCTeX, BibTeX and RefTeX + with macros. + (Imprint): Mention Wolfgang in list of contributors. + (Creating Citations): Give a hint about how to + auto-revert the BibTeX database file when using external editors. + (Referencing Labels): Simplify section about reference macro + cycling. + (Options (Referencing Labels)): Adapt to new structure of + `reftex-ref-style-alist'. + (Referencing Labels, Reference Styles): Document changes in the + referencing functionality. + (Commands): Mention options for definition of header and footer in + BibTeX files. + (Options (Creating Citations)): Document + `reftex-create-bibtex-header' and `reftex-create-bibtex-footer'. + (Reference Styles): New section. + (varioref (LaTeX package), fancyref (LaTeX package)): Remove. + (Options (Referencing Labels)): Remove descriptions of deprecated + variables `reftex-vref-is-default' and `reftex-fref-is-default'. + Add descriptions for `reftex-ref-style-alist' and + `reftex-ref-style-default-list'. + (Referencing Labels): Update regarding reference styles. + (Citation Styles): Mention support for ConTeXt. + (Options (Defining Label Environments)): Fix typo. + (Options (Creating Citations)): Document + `reftex-cite-key-separator'. + +2012-09-30 Achim Gratz <Stromeko@Stromeko.DE> + + * org.texi: Add description of ORG_ADD_CONTRIB to info + documentation. Add link to Worg for more details. + + * org.texi: Clarify installation procedure. Provide link to the + build system description on Worg. + + * org.texi: Remove reference to utils/, x11idle.c is now in + contrib/scripts. + + * org.texi: Re-normalize to "Org mode" in manual. + + * org.texi (Installation): Adapt documentation to new build + system. Mention GNU ELPA (since it needs to be handled like Emacs + built-in Org). + +2012-09-30 Adam Spiers <orgmode@adamspiers.org> (tiny change) + + * org.texi: Fix typo in description of the 'Hooks' section. + + * org.texi: Add ID to the list of special properties. + +2012-09-30 Andrew Hyatt <ahyatt@gmail.com> (tiny change) + + * org.texi (Moving subtrees): Document the ability to archive to a + datetree. + +2012-09-30 Bastien Guerry <bzg@altern.org> + + * org.texi (Installation, Feedback, Batch execution): Use + (add-to-list 'load-path ... t) for the contrib dir. + + * org.texi (results): Update documentation for ":results drawer" + and ":results org". + + * org.texi (Column width and alignment): Fix typo. + + * org.texi (Activation): Point to the "Conflicts" section. + + * org.texi (Conflicts): Mention filladapt.el in the list of + conflicting packages. + + * org.texi (Activation): Adding org-mode to `auto-mode-alist' is + not needed for versions of Emacs > 22.1. + + * org.texi (History and Acknowledgments): Fix typo. + + * org.texi (History and Acknowledgments): Add my own + acknowledgments. + + * org.texi (Agenda commands): Document the new command and the new + option. + + * org.texi (Agenda commands): Delete `org-agenda-action' section. + (Agenda commands): Reorder. Document `*' to toggle persistent + marks. + + * org.texi (Agenda dispatcher): Mention + `org-toggle-agenda-sticky'. + (Agenda commands, Exporting Agenda Views): Fix typo. + + * org.texi (Templates in contexts, Setting Options): Update to + reflect changes in how contexts options are processed. + + * org.texi (Templates in contexts): Document the new structure of + the variables `org-agenda-custom-commands-contexts' and + `org-capture-templates-contexts'. + + * org.texi (Templates in contexts): Document the new option + `org-capture-templates-contexts'. + (Storing searches): Document the new option + `org-agenda-custom-commands-contexts'. + + * org.texi (Formula syntax for Lisp): Reformat. + + * org.texi (Special properties, Column attributes) + (Agenda column view): Document the new special property + CLOCKSUM_T. + + * org.texi (Template expansion): Document the new %l template. + + * org.texi (Fast access to TODO states): Fix documentation about + allowed characters for fast todo selection. + + * org.texi (Weekly/daily agenda): Mention APPT_WARNTIME and its + use in `org-agenda-to-appt'. + + * org.texi (Comment lines): Update wrt comments. + + * org.texi (Resolving idle time): Document new keybinding. + + * org.texi (Clocking commands): Document the use of S-M-<up/down> + on clock timestamps. + + * org.texi (Fast access to TODO states): Explicitely says only + letters are supported as fast TODO selection keys. + + * org.texi (Link abbreviations): Illustrate the use of the "%h" + specifier. Document the new "%(my-function)" specifier. + + * org.texi (Clocking commands): New cindex. + (Clocking commands): Update documentation for `org-clock-in'. + Document `org-clock-in-last'. Mention `org-clock-out' and + `org-clock-in-last' as commands that can be globally bound. + (Resolving idle time): Document continuous clocking. + + * org.texi (Top, Introduction): Fix formatting. + (Activation): Add index entries. + (Conventions): Update section. + (Embedded @LaTeX{}): Fix formatting. + + * org.texi (Visibility cycling): Document `show-children'. + + * org.texi (Using capture): Mention the `org-capture-last-stored' + bookmark as a way to jump to the last stored capture. + + * org.texi (Uploading files): Fix typo. + + * org.texi (Using capture): Document `C-0' as a prefix argument + for `org-capture'. + + * org.texi (Agenda commands): Document persistent marks. + + * org.texi (Template expansion): Update doc to reflect change. + + * org.texi (Radio tables): Document the :no-escape parameter. + + * org.texi (Repeated tasks): Document repeat cookies for years, + months, weeks, days and hours. + + * org.texi (Export options): State that you can use the d: option + by specifying a list of drawers. + + * org.texi (HTML preamble and postamble): Small doc improvement. + +2012-09-30 Brian van den Broek <vanden@gmail.com> (tiny change) + + * org.texi: The sections in the Exporting section of the manual + left out articles in the description of the org-export-as-* + commands, among other places. This patch adds them, adds a few + missing prepositions, and switches instances of "an HTML" to "a + html" for internal consistency. + + * org.texi: Alter several examples of headings with timestamps in + them to include the timestamps in the body instead of the heading. + +2012-09-30 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Agenda dispatcher): Document sticky agenda views and + the new key for them. + +2012-09-30 Charles <millarc@verizon.net> (tiny change) + + * org.texi (Advanced features): Fix error in table. + +2012-09-30 Feng Shu <tumashu@gmail.com> + + * org.texi (@LaTeX{} fragments): Document imagemagick as an + alternative to dvipng. + +2012-09-30 François Allisson <francois@allisson.co> (tiny change) + + * org.texi: Remove extra curly bracket. + +2012-09-30 Giovanni Ridolfi <giovanni.ridolfi@yahoo.it> (tiny change) + + * org.texi (org-clock-in-last and org-clock-cancel): Update the + defkeys. + +2012-09-30 Ippei FURUHASHI <top.tuna+orgmode@gmail.com> (tiny change) + + * org.texi (Agenda commands): Fix two typos by giving + corresponding function names, according to + `org-agenda-view-mode-dispatch'. + +2012-09-30 Jan Bäcker <jan.boecker@jboecker.de> + + * org.texi (The spreadsheet): Fix typo. + +2012-09-30 Memnon Anon <gegendosenfleisch@gmail.com> (tiny change) + + * org.texi (Tracking your habits): Point to the "Tracking TODO + state changes" section. + +2012-09-30 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.texi (Literal examples): Remove reference to unknown + `org-export-latex-minted' variable. Also simplify footnote since + `org-export-latex-listings' documentation is exhaustive already. + + * org.texi (Plain lists): Remove reference to now hard-coded + `bullet' automatic rule. + +2012-09-30 Toby S. Cubitt <tsc25@cantab.net> + + * org.texi: Updated documentation accordingly. + 2012-09-13 Paul Eggert <eggert@cs.ucla.edu> * texinfo.tex: Merge from gnulib. diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index c42a10b88bc..5ce6d82e683 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -336,12 +336,12 @@ epa.pdf: ${srcdir}/epa.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/epa.texi erc : $(buildinfodir)/erc$(INFO_EXT) -$(buildinfodir)/erc$(INFO_EXT): ${srcdir}/erc.texi +$(buildinfodir)/erc$(INFO_EXT): ${srcdir}/erc.texi $(emacsdir)/emacsver.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/erc.texi -erc.dvi: ${srcdir}/erc.texi +erc.dvi: ${srcdir}/erc.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) ${srcdir}/erc.texi -erc.pdf: ${srcdir}/erc.texi +erc.pdf: ${srcdir}/erc.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/erc.texi ert : $(buildinfodir)/ert$(INFO_EXT) @@ -526,12 +526,12 @@ rcirc.pdf: ${srcdir}/rcirc.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/rcirc.texi reftex : $(buildinfodir)/reftex$(INFO_EXT) -$(buildinfodir)/reftex$(INFO_EXT): ${srcdir}/reftex.texi +$(buildinfodir)/reftex$(INFO_EXT): ${srcdir}/reftex.texi $(emacsdir)/emacsver.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/reftex.texi -reftex.dvi: ${srcdir}/reftex.texi +reftex.dvi: ${srcdir}/reftex.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) ${srcdir}/reftex.texi -reftex.pdf: ${srcdir}/reftex.texi +reftex.pdf: ${srcdir}/reftex.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/reftex.texi remember : $(buildinfodir)/remember$(INFO_EXT) diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index f8f6d06b93a..2b198575bcb 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -35232,7 +35232,7 @@ character of the prefix can simply be typed twice. Calc is controlled by many variables, most of which can be reset from within Calc. Some variables are less involved with actual -calculation and can be set outside of Calc using Emacs'ss +calculation and can be set outside of Calc using Emacs's customization facilities. These variables are listed below. Typing @kbd{M-x customize-variable RET @var{variable-name} RET} will bring up a buffer in which the variable's value can be redefined. diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 9195ca3f10c..18abb0647a2 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -2087,7 +2087,7 @@ of a list. @var{list} should evaluate to a list; the body @var{forms} are executed with @var{var} bound to each element of the list in turn. Finally, the @var{result} form (or @code{nil}) is evaluated with @var{var} bound to @code{nil} to produce the result returned by -the loop. Unlike with Emacs'ss built in @code{dolist}, the loop is +the loop. Unlike with Emacs's built in @code{dolist}, the loop is surrounded by an implicit @code{nil} block. @end defspec @@ -2097,7 +2097,7 @@ of times. The body is executed with @var{var} bound to the integers from zero (inclusive) to @var{count} (exclusive), in turn. Then the @code{result} form is evaluated with @var{var} bound to the total number of iterations that were done (i.e., @code{(max 0 @var{count})}) -to get the return value for the loop form. Unlike with Emacs'ss built in +to get the return value for the loop form. Unlike with Emacs's built in @code{dolist}, the loop is surrounded by an implicit @code{nil} block. @end defspec diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index 655d11b5d17..046cdc99414 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -82,11 +82,11 @@ learn and adopt GNU ways of doing things. @menu * EDE Project Concepts:: @ede{} Project Concepts * EDE Mode:: Turning on @ede{} mode. +* Quick Start:: Quick start to building a project. * Creating a project:: Creating a project. * Modifying your project:: Adding and removing files and targets. * Building and Debugging:: Initiating a build or debug session. * Miscellaneous commands:: Other project related commands. -* Simple projects:: Projects not managed by @ede{}. * Extending EDE:: Programming and extending @ede{}. @end menu @@ -125,7 +125,7 @@ of search to files in a single target, or to discover the location of documentation or interface files. @ede{} can provide this information. -@node EDE Mode, Creating a project, EDE Project Concepts, top +@node EDE Mode, Quick Start, EDE Project Concepts, top @chapter @ede{} Mode @ede{} is implemented as a minor mode, which augments other modes such @@ -142,7 +142,303 @@ bar. This menu provides several menu items for high-level @ede{} commands. These menu items, and their corresponding keybindings, are independent of the type of project you are actually working on. -@node Creating a project, Modifying your project, EDE Mode, top +@node Quick Start, Creating a project, EDE Mode, top +@chapter Quick Start + +Once you have @ede{} enabled, you can create a project. This chapter +provides an example C++ project that will create Automake files for +compilation. + +@section Step 1: Create root directory + +First, lets create a directory for our project. For this example, +we'll start with something in @file{/tmp}. + +@example +C-x C-f /tmp/myproject/README RET +M-x make-directory RET RET +@end example + +Now put some plain text in your README file to start. + +Now, lets create the project: + +@example +M-x ede-new RET Automake RET myproject RET +@end example + + +Nothing visible happened, but if you use @code{dired} to look at the +directory, you should see this: + +@example + /tmp/myproject: + total used in directory 32 available 166643476 + drwxr-xr-x 2 zappo users 4096 2012-02-23 22:10 . + drwxrwxrwt 73 root root 20480 2012-02-23 22:10 .. + -rw-r--r-- 1 zappo users 195 2012-02-23 22:10 Project.ede + -rw-r--r-- 1 zappo users 10 2012-02-23 22:09 README +@end example + +@section Step 2: Create Subdirectories and Files + +We'll make a more complex project, so use dired to create some more +directories using the @kbd{+} key, and typing in new directories: + +@example ++ include RET ++ src RET +@end example + +Now I'll short-cut in this tutorial. Create the following files: + +@file{include/myproj.hh} +@example +/** myproj.hh --- + */ + +#ifndef myproj_hh +#define myproj_hh 1 + +#define IMPORTANT_MACRO 1 + +int my_lib_function(); + +#endif // myproj_hh +@end example + + +@file{src/main.cpp} +@example +/** main.cpp --- + */ + +#include <iostream> +#include "myproj.hh" + +int main() @{ + +@} + +#ifdef IMPORTANT_MACRO +int my_fcn() @{ + +@} +#endif +@end example + +@file{src/mylib.cpp} +@example +/** mylib.cpp --- + * + * Shared Library to build + */ + +int my_lib_function() @{ + +@} +@end example + +@section Step 3: Create subprojects + +@ede{} needs subdirectories to also have projects in them. You can +now create those projects. + +With @file{main.cpp} as your current buffer, type: + +@example +M-x ede-new RET Automake RET src RET +@end example + +and in @file{myproj.hh} as your current buffer, type: + +@example +M-x ede-new RET Automake RET include RET +@end example + +These steps effectively only create the Project.ede file in which you +will start adding targets. + +@section Step 4: Create targets + +In order to build a program, you must have targets in your @ede{} +Projects. You can create targets either from a buffer, or from a +@code{dired} directory buffer. + +Note: If for some reason a directory list buffer, or file does not have the +@samp{Project} menu item, or if @ede{} keybindings don't work, just +use @kbd{M-x revert-buffer RET} to force a refresh. Sometimes +creating a new project doesn't restart buffers correctly. + +Lets start with the header file. In @file{include/myproj.hh}, you +could use the menu, but we will now start using the @ede{} command prefix +which is @kbd{C-c .}. + +@example +C-c . t includes RET miscellaneous RET y +@end example + + +This creates a misc target for holding your includes, and then adds +myproj.hh to the target. Automake (the tool) has better ways to do +this, but for this project, it is sufficient. + +Next, visit the @file{src} directory using dired. There should be a +@samp{Project} menu. You can create a new target with + +@example +. t myprogram RET program RET +@end example + +Note that @kbd{. t} is a command for creating a target. This command +is also in the menu. This will create a target that will build a +program. If you want, visit @file{Project.ede} to see the structure +built so far. + +Next, place the cursor on @file{main.cpp}, and use @kbd{. a} to add +that file to your target. + +@example +. a myprogram RET +@end example + +Note that these prompts often have completion, so you can just press +@kbd{TAB} to complete the name @file{myprogram}. + +If you had many files to add to the same target, you could mark them +all in your dired buffer, and add them all at the same time. + +Next, do the same for the library by placing the cursor on @file{mylib.cpp}. + +@example +. t mylib RET sharedobject RET +. a mylib RET +@end example + +@section Step 5: Compile, and fail + +Next, we'll try to compile the project, but we aren't done yet, so it +won't work right away. + +Visit @file{/tmp/myproject/Project.ede}. We're starting here because +we don't have any program files in this directory yet. Now we can use +the compile command: + +@example +C-c . C +@end example + +Because this is the very first time, it will create a bunch of files +for you that are required by Automake. It will then use automake to +build the support infrastructure it needs. This step is skipped if +you choose just a @file{Makefile} build system. + +After the Automake init, it runs compile. You will immediately +discover the error in main.cpp can't find @file{myproj.hh}. We need +to go fix this. + +@section Step 6: Customizing your project + +To fix the failed compile, we need to add +@file{/tmp/myproject/include} to the include path. + +Visit @file{main.cpp}. + +@example +M-x customize-project RET +@end example + +Select the @samp{[Settings]} subgroup of options. Under +@samp{Variable :} click @samp{[INS]}. At this point, you need to be +somewhat savvy with Automake. Add a variable named @samp{CPPFLAGS}, +and set the value to @samp{../include}. + +You should see something like this: + +@example +Variables : +[INS] [DEL] Cons-cell: + Name: AM_CPPFLAGS + Value: -I../include +[INS] +Variables to set in this Makefile. +@end example + +Click @samp{[Apply]}. Feel free to visit @file{Project.ede} to see +how it changed the config file. + +Compile the whole project again with @kbd{C-c . C} from +@file{main.cpp}. It should now compile. + +@section Step 7: Shared library dependency + +Note: Supporting shared libraries for Automake in this way is easy, +but doing so from a project of type Makefile is a bit tricky. If you +are creating shared libraries too, stick to Automake projects. + +Next, lets add a dependency from @file{main.cpp} on our shared +library. To do that, update main like this: + +@example +int main() @{ + + my_lib_function(); + +@} +@end example + +Now compile with: + +@example +C-c . c +@end example + +where the lower case @kbd{c} compiles just that target. You should +see an error. + +This time, we need to add a dependency from @file{main.cpp} on our shared +library. To do that, we need to customize our target instead of the +project. This is because variables such as the include path are +treated globally, whereas dependencies for a target are target specific. + +@example +M-x customize-target RET +@end example + +On the first page, you will see an Ldlibs-local section. Add mylib to +it by first clicking @samp{[INS]}, and they adding the library. It +should look like this: + +@example +Ldlibs-Local : +[INS] [DEL] Local Library: libmylib.la +[INS] +Libraries that are part of this project. [Hide Rest] +The full path to these libraries should be specified, such as: +../lib/libMylib.la or ../ar/myArchive.a +@end example + +You will also see other variables for library related flags and system +libraries if you need them. Click @samp{[Accept]}, and from +@file{main.cpp}, again compile the whole project to force all +dependent elements to compile: + +@example +C-c . C +@end example + +@section Step 8: Run your program + +You can run your program directly from @ede{}. + +@example +C-c . R RET RET +@end example + +If your program takes command line arguments, you can type them in +when it offers the command line you want to use to run your program. + +@node Creating a project, Modifying your project, Quick Start, top @chapter Creating a project To create a new project, first visit a file that you want to include @@ -212,6 +508,7 @@ detailed information about exactly what these features do. * Add/Remove target:: * Add/Remove files:: * Customize Features:: +* Project Local Variables:: * EDE Project Features:: @end menu @@ -252,7 +549,7 @@ not wish to add the file to any target, you can choose @samp{none}. You can customize this behavior with the variable @command{ede-auto-add-method}. -@node Customize Features, EDE Project Features, Add/Remove files, Modifying your project +@node Customize Features, Project Local Variables, Add/Remove files, Modifying your project @section Customize Features A project, and its targets, are objects using the @samp{EIEIO} object @@ -272,7 +569,55 @@ object, you can edit the file by typing @kbd{C-c . e} (@code{ede-edit-file-target}). You should ``rescan'' the project afterwards (@pxref{Miscellaneous commands}). -@node EDE Project Features, , Customize Features, Modifying your project +@node Project Local Variables, EDE Project Features, Customize Features, Modifying your project +@section Project Local Variables + +EDE projects can store and manager project local variables. The +variables are stored in the project, and will be restored when a +project reloads. + +Projects which are not stored on disk WILL NOT restore your project +local variables later. + +You can use @ref{Customize Features} to of the project to edit the +project local variables. They are under the 'Settings' group as +``Project Local Variables''. + +You can also use @kbd{M-x ede-set} to set a new variable local in the +mini buffer. + +In multi-level projects such as Automake and Make generating projects, +project local variables are installed from both the TOP most project, +and the local directory's project. In that way, you can have some +variables across your whole project, and some specific to a +subdirectory. + +You can use project local variables to set any Emacs variable so that +buffers belonging to different projects can have different settings. + +NOTE: When you use project-local variables with @ref{ede-cpp-root}, +the format is an association list. For example: + +@example +(ede-cpp-root-project "SOMENAME" + :file "/dir/to/some/file" + :local-variables + '((grep-command . "grep -nHi -e ") + (compile-command . "make -f MyCustomMakefile all"))) +@end example + +The same is true when you use project-local variables with +@ref{ede-java-root}. For example: + +@example +(ede-java-root-project "SOMENAME" + :file "/dir/to/some/file" + :local-variables + '((grep-command . "grep -nHi -e ") + (compile-command . "ant"))) +@end example + +@node EDE Project Features, , Project Local Variables, Modifying your project @section EDE Project Features This section details user facing features of an @ede{} @samp{Make} @@ -351,7 +696,7 @@ Build a distribution file for your project. These commands are also available from the @samp{Development} menu. -@node Miscellaneous commands, Simple projects, Building and Debugging, top +@node Miscellaneous commands, Extending EDE, Building and Debugging, top @chapter Miscellaneous commands If you opt to go in and edit @ede{} project files directly---for @@ -384,7 +729,69 @@ hierarchical tree, grouped according to target. To activate the speedbar in this mode, type @kbd{C-c . s} (@code{ede-speedbar}). -@node Simple projects, Extending EDE, Miscellaneous commands, top +@menu +* Make and Automake projects:: Project types of @samp{ede-project} +* Automake direct projects:: Project interface on hand-written automake files. +* Android projects:: Projects for Android development +* Arduino projects:: Projects for Arduino sketches +* Simple projects:: Projects @ede{} doesn't manage. +@end menu + +@node Make and Automake projects +@section Make and Automake projects + +A project of @samp{ede-project} type creates a file called +@file{Project.ede} in every project directory. This is used to track +your configuration information. If you configure this project to be +in @samp{Makefile} mode, then this project will autogenerate a +@file{Makefile}. If you configure it in @samp{Automake} mode a +@file{Makefile.am} file will be created. The automake bootstrapping +routines will also import and maintain a configure.am script and a +host of other files required by Automake. + +@node Automake direct projects +@section Automake direct projects + +The project type that reads @file{Makefile.am} directly is derived +from the sources of the original @file{project-am.el} mode that was +distributed independently. This mode eventually became @ede{}. The +@samp{project-am} project will read existing automake files, but will +not generate them automatically, or create new ones. As such, it is +useful as a browsing tool, or as maintenance in managing file lists. + +@node Android projects +@section Android projects + +An Android project of type @samp{ede-android-project} will detect and +support development of Android apps. Android projects use an +@file{AndroidManifest.xml} file. Always load your Manifest first in a +running Emacs to make sure the project is identified correctly. + +Android projects can be created with @code{ede-new} but depend on a +correctly configured Android SDK via @cedet{} support. + +@defun cedet-android-sdk-root +@anchor{cedet-android-sdk-root} +The root to the android @var{SDK}. +@end defun + +Android projects support different configurations including compile, +and install, which will upload a program to your Android device. It +also supports several debugging tools via @file{android.el}. + +@node Arduino projects +@section Arduino projects + +An arduino project of type @samp{ede-arduino-project} will read your +@file{~/.arduino/preferences.txt} file, and identify your sketches. +You will still need the Arduino IDE to set up your preferences and +locate your arduino. After quitting the IDE, Emacs will be able to +find your sketches, compile them, and upload them to your arduino. + +If you have the @file{arduino} command on your path, @ede{} will be +able to find your SDK and compile your programs. + +@node Simple projects @section Simple Projects There is a wide array of Simple projects. The root for simple @@ -401,14 +808,14 @@ It can be configured with minimal lisp knowledge to do header file lookup for @semantic{}, improving code completion performance. @menu -* ede-cpp-root:: This project marks the root of a C/C++ code project. -* ede-simple subclassing:: Create your own simple project. -* ede-emacs:: A project for working with Emacs. -* ede-linux:: A project for working with Linux kernels. -* Custom Locate:: Customizing how to locate files in a simple project +* ede-cpp-root:: This project marks the root of a C/C++ code project. +* ede-java-root:: This project marks the root of a Java project. +* ede-emacs:: A project for working with Emacs. +* ede-linux:: A project for working with Linux kernels. +* Custom Locate:: Customizing how to locate files in a simple project @end menu -@node ede-cpp-root +@node ede-cpp-root, ede-java-root, Simple projects, Simple projects @subsection ede-cpp-root The @code{ede-cpp-root} project type allows you to create a single @@ -492,6 +899,11 @@ The name of the file to find. The directory root for this cpp-root project. @end table +When creating a project with @code{ede-cpp-root}, you can get +additional configurations via @ref{Project Local Variables}. Be aware +that the format for project local variables is an association list. +You cannot use @kbd{M-x ede-set} and have your project local variables +persist between sessions. If the cpp-root project style is right for you, but you want a dynamic loader, instead of hard-coding path name values in your @file{.emacs}, you @@ -540,14 +952,90 @@ of project. @xref{ede-cpp-root-project}, for details about the class that defines the @code{ede-cpp-root} project type. -@node ede-simple subclassing -@subsection ede-simple Subclassing +@node ede-java-root, ede-emacs, ede-cpp-root, Simple projects +@subsection ede-java-root + +Much like the project type @ref{ede-cpp-root}, the java variant is +can be setup in your @file{.emacs} file and just marks a directory as +the root of a java source tree. -todo - Write some doc. +The @code{ede-java-root} project class knows a few things about Java +projects. In particular, you can use it to control your classpath at +both the system level, and for your project. If it is insufficient, +you can subclass @code{ede-java-root-project} and add your own tweaks +in just a few lines. See @ref{ede-cpp-root} for an example using the +C++ variant. + +In the most basic case, add this to your @file{.emacs} file, modifying +appropriate bits as needed. + +@example +(ede-java-root-project "SOMENAME" :file "/dir/to/some/file" :srcroot '("src")) +@end example + +Replace @var{SOMENAME} with whatever name you want, and the filename +to an actual file at the root of your project. It might be a +Makefile, a README file. Whatever. It doesn't matter. It's just a +key to hang the rest of @ede{} off of. - In the meantime look in the commentary of ede-simple.el +Replace the value of :srcroot with a list of directories under the +project root which contains Java sources. For example, if you have: -@node ede-emacs +@example +~/myprojects/P1/ +~/myprojects/P1/src/ +~/myprojects/P1/src/com/ericsoft/MyCode.java +~/myprojects/P1/doc/ +@end example + +Then @file{src} represents the directory under which all your Java +code is. It is important that @file{src} is one step above the +directory that is the base of your package name, such as +@file{com/ericsoft} in the example above so that new files can be +discovered via fully qualified name. You can have multiple such +directories in one project, and each will be accessible. + +You can specify your classpath like this: + +@example +(ede-java-root-project "NAME" :file "FILENAME" + :srcroot '("src") + :classpath '("/absolute/path.jar") + :localclasspath '( "/relative/path.jar" )) +@end example + +In this example, @code{:classpath} specifies absolute paths somewhere +on your system, and the explicit jar or source root directories +@semantic{} will search when performing completions. + +The @code{:localclasspath} is like @code{:classpath}, but it will +contain path names relative to the root of your project. + +If you want to override the file-finding tool with your own +function you can do this: + +@example +(ede-java-root-project "NAME" :file "FILENAME" :locate-fcn 'MYFCN) +@end example + +Where @var{MYFCN} is a symbol for a function. The locate function can +be used in place of @code{ede-expand-filename} so you can quickly +customize your custom target to use specialized local routines instead +of the default @ede{} routines. The function symbol must take two +arguments: + +@table @var +@item NAME +The name of the file to find. +@item DIR +The directory root for this java-root project. +@end table + +If you would like to create your Java projects dynamically, instead of +putting them all in your @file{.emacs}, you can do that too. See +@ref{ede-cpp-root} for details that can be applied to this project type. + +@node ede-emacs, ede-linux, ede-java-root, Simple projects @subsection ede-emacs The @code{ede-emacs} project automatically identifies an Emacs source @@ -556,7 +1044,7 @@ tree, and enables EDE project mode for it. It pre-populates the C Preprocessor symbol map for correct parsing, and has an optimized include file identification function. -@node ede-linux +@node ede-linux, Custom Locate, ede-emacs, Simple projects @subsection ede-linux The @code{ede-linux} project will automatically identify a Linux @@ -565,7 +1053,7 @@ Kernel source tree, and enable EDE project mode for it. It pre-populates the C Preprocessor symbol map for reasonable parsing, and has an optimized include file identification function. -@node Custom Locate +@node Custom Locate, , ede-linux, Simple projects @subsection Custom Locate The various simple project styles all have one major drawback, which @@ -604,7 +1092,7 @@ You can add your own locate tool but subclassing from methods. See the code in @file{ede-locate.el} for GNU Global as a simple example. -@node Extending EDE, , Simple projects, top +@node Extending EDE, , Miscellaneous commands, top @chapter Extending @ede{} This chapter is intended for users who want to write new parts or fix @@ -647,6 +1135,8 @@ See the @file{ede-skel.el} file for examples of these. The files examples. @menu +* Development Overview:: +* Detecting a Project:: * User interface methods:: Methods associated with keybindings * Base project methods:: The most basic methods on @ede{} objects. * Sourcecode objects:: Defining new sourcecode classes. @@ -657,7 +1147,164 @@ examples. * Compilers:: Details of compiler classes. @end menu -@node User interface methods +@node Development Overview, Detecting a Project, Extending EDE, Extending EDE +@section Development Overview + +@ede{} is made up of a series of classes implemented with @eieio{}. +These classes define an interface that can be used to create different +types of projects. + +@ede{} defines two superclasses which are @code{ede-project} and +@code{ede-target}. All commands in @ede{} are usually meant to +address the current project, or current target. + +All specific projects in @ede{} derive subclasses of the @ede{} superclasses. +In this way, specific behaviors such as how a project is saved, or how a +target is compiled can be customized by a project author in detail. @ede{} +communicates to these project objects via an API using methods. The +commands you use in @ede{} mode are high-level functional wrappers over +these methods. + +Some example project types are: + +@table @code +@item project-am +Automake project which reads existing Automake files. +@item ede-proj-project +This project type will create @file{Makefiles}, +or @file{Makefile.am} files to compile your project. +@item ede-linux +This project type will detect linux source trees. +@item ede-emacs +This project will detect an Emacs source tree. +@end table + +There are several other project types as well. + +The first class you need to know to create a new project type is +@code{ede-project-autoload}. New instances of this class are needed +to define how Emacs associates different files/buffers with different +project types. All the autoloads are kept in the variable +@code{ede-project-class-files}. + +The next most important class to know is @code{ede-project}. This is +the baseclass defines how all projects behave. The basic pattern for +a project is that there is one project per directory, and the topmost +project or directory defines the project as a whole. + +Key features of @code{ede-project} are things like name and version +number. It also holds a list of @code{ede-target} objects and a list +of sub projects, or more @code{ede-project} objects. + +New project types must subclass @code{ede-project} to add special +behavior. New project types also need to subclass @code{ede-target} to +add specialty behavior. + +In this way, the common @ede{} interface is designed to work against +@code{ede-project}, and thus all subclasses. + +@code{ede-project} subclasses @code{ede-project-placeholder}. This is +the minimum necessary project needed to be cached between runs of +Emacs. This way, Emacs can track all projects ever seen, without +loading those projects into memory. + +Here is a high-level UML diagram for the @ede{} system created with @cogre{}.. + +@example ++-----------------------+ +-----------------------+ +| | |ede-project-placeholder| +|ede-project-class-files| +-----------------------+ +| | +-----------------------+ ++-----------------------+ +-----------------------+ + /\ ^ + \/ /_\ + | | + +--------------------+ +-----------+ +----------+ + |ede-project-autoload| |ede-project| |ede-target| + +--------------------+<>--------------+-----------+<>-------+----------+ + +--------------------+ +-----------+ +----------+ + +--------------------+ +-----------+ +----------+ + ^ + /_\ + | + +---------------------+-----------------+ + | | | + | | | + | | | + +----------------+ +-------------------+ +---------+ + |ede-proj-project| |project-am-makefile| |ede-emacs| + +----------------+ +-------------------+ +---------+ + +----------------+ +-------------------+ +---------+ + +----------------+ +-------------------+ +---------+ +@end example + + +@node Detecting a Project, User interface methods, Development Overview, Extending EDE +@section Detecting a Project + +Project detection happens with the list of @code{ede-project-autoload} +instances stored in @code{ede-project-class-files}. The full project +detection scheme works like this: + +@table @asis +@item Step 1: +@code{find-file-hooks} calls @code{ede-turn-on-hook} on BUFFER. +@item Step 2: +@code{ede-turn-on-hook} turns on @code{ede-minor-mode} +@item Step 3: +@code{ede-minor-mode} looks to see if BUFFER is associated with any +open projects. If not, it calls @code{ede-load-project-file} to find +a project associated with the current directory BUFFER is in. +@item Step 4: +@code{ede-minor-mode} associates the found project with the current +buffer with a series of variables, such as @code{ede-object}, and +@code{ede-object-project} and @code{ede-object-root-project}. +@end table + +Once a buffer is associated, @ede{} minor mode commands will operate +on that buffer. + +The function @code{ede-load-project-file} is at the heart of detecting +projects, and it works by looping over all the known project autoload +types in @code{ede-project-autoload} using the utility +@code{ede-directory-project-p}. + +The function @code{ede-directory-project-p} will call +@code{ede-dir-to-projectfile} on every @code{ede-project-autoload} +until one of them returns true. The method +@code{ede-dir-to-projectfile} in turn gets the @code{:proj-file} slot +from the autoload. If it is a string (ie, a project file name), it +checks to see if that exists in BUFFER's directory. If it is a +function, then it calls that function and expects it to return a file +name or nil. If the file exists, then this directory is assumed to be +part of a project, and @code{ede-directory-project-p} returns the +instance of @code{ede-project-autoload} that matched. + +If the current directory contains the file @code{.ede-ignore} then +that directory is automatically assumed to contain no projects, even +if there is a matching pattern. Use this type of file in a directory +that may contain many other sub projects, but still has a Makefile of +some sort. + +If the current directory is a project, then @ede{} scans upwards till +it finds the top of the project. It does this by calling +@code{ede-toplevel-project}. If this hasn't already been discovered, +the directories as scanned upward one at a time until a directory with +no project is found. The last found project becomes the project +root. If the found instance of @code{ede-project-autoload} has a +valid @code{proj-root} slot value, then that function is called instead +of scanning the project by hand. Some project types have a short-cut +for determining the root of a project, so this comes in handy. + +Getting back to @code{ede-load-project-file}, this now has an instance +of @code{ede-project-autoload}. It uses the @code{load-type} slot to +both autoload in the project type, and to create a new instance of the +project type found for the root of the project. That project is added +to the global list of all projects. All subprojects are then created +and assembled into the project data structures. + + +@node User interface methods, Base project methods, Detecting a Project, Extending EDE @section User interface methods These methods are core behaviors associated with user commands. @@ -689,7 +1336,7 @@ Make a distribution (tar archive) of the project. Rescan a project file, changing the data in the existing objects. @end table -@node Base project methods +@node Base project methods, Sourcecode objects, User interface methods, Extending EDE @section Base project methods These methods are important for querying base information from project @@ -726,7 +1373,7 @@ stored in. List all documentation a project or target is responsible for. @end table -@node Sourcecode objects +@node Sourcecode objects, Compiler and Linker objects, Base project methods, Extending EDE @section Sourcecode objects @ede{} projects track source file / target associates via source code @@ -772,7 +1419,7 @@ In this case, the garbage pattern is the same. @xref{Sourcecode}. -@node Compiler and Linker objects +@node Compiler and Linker objects, Project, Sourcecode objects, Extending EDE @section Compiler and Linker objects In order for a target to create a @file{Makefile}, it must know how to @@ -833,21 +1480,21 @@ See @file{ede-proj-obj.el} for examples of the combination. @defindex sc @defindex cm -@node Project +@node Project, Targets, Compiler and Linker objects, Extending EDE @section Project @menu -* ede-project-placeholder :: -* ede-project :: -* ede-cpp-root-project :: -* ede-simple-project :: -* ede-simple-base-project :: -* ede-proj-project :: -* project-am-makefile :: -* ede-step-project :: +* ede-project-placeholder:: +* ede-project:: +* ede-cpp-root-project:: +* ede-simple-project:: +* ede-simple-base-project:: +* ede-proj-project:: +* project-am-makefile:: +* ede-step-project:: @end menu -@node ede-project-placeholder +@node ede-project-placeholder, ede-project, Project, Project @subsection ede-project-placeholder @pjindex ede-project-placeholder @@ -937,7 +1584,7 @@ Make sure placeholder @var{THIS} is replaced with the real thing, and pass throu Make sure placeholder @var{THIS} is replaced with the real thing, and pass through. @end deffn -@node ede-project +@node ede-project, ede-cpp-root-project, ede-project-placeholder, Project @subsection ede-project @pjindex ede-project @@ -1233,7 +1880,7 @@ Retrieves the slot @code{menu} from an object of class @code{ede-project} Commit change to local variables in @var{PROJ}. @end deffn -@node ede-cpp-root-project +@node ede-cpp-root-project, ede-simple-project, ede-project, Project @subsection ede-cpp-root-project @pjindex ede-cpp-root-project @@ -1361,7 +2008,7 @@ Within this project @var{PROJ}, find the file @var{NAME}. This knows details about or source tree. @end deffn -@node ede-simple-project +@node ede-simple-project, ede-simple-base-project, ede-cpp-root-project, Project @subsection ede-simple-project @pjindex ede-simple-project @@ -1391,7 +2038,7 @@ No children Commit any change to @var{PROJ} to its file. @end deffn -@node ede-simple-base-project +@node ede-simple-base-project, ede-proj-project, ede-simple-project, Project @subsection ede-simple-base-project @pjindex ede-simple-base-project @@ -1421,7 +2068,7 @@ This one project could control a tree of subdirectories. @table @asis @end table -@node ede-proj-project +@node ede-proj-project, project-am-makefile, ede-simple-base-project, Project @subsection ede-proj-project @pjindex ede-proj-project @@ -1618,7 +2265,7 @@ Return a list of files that constitutes a distribution of @var{THIS} project. Commit change to local variables in @var{PROJ}. @end deffn -@node project-am-makefile +@node project-am-makefile, ede-step-project, ede-proj-project, Project @subsection project-am-makefile @pjindex project-am-makefile @@ -1660,7 +2307,7 @@ Despite the fact that this is a method, it depends on the current buffer being in order to provide a smart default target type. @end deffn -@node ede-step-project +@node ede-step-project, , project-am-makefile, Project @subsection ede-step-project @pjindex ede-step-project @@ -1792,35 +2439,35 @@ Return a list of files that constitutes a distribution of @var{THIS} project. Commit change to local variables in @var{PROJ}. @end deffn -@node Targets +@node Targets, Sourcecode, Project, Extending EDE @section Targets @menu -* ede-target :: -* ede-proj-target :: -* ede-proj-target-makefile :: -* semantic-ede-proj-target-grammar :: -* ede-proj-target-makefile-objectcode :: -* ede-proj-target-makefile-archive :: -* ede-proj-target-makefile-program :: -* ede-proj-target-makefile-shared-object :: -* ede-proj-target-elisp :: -* ede-proj-target-elisp-autoloads :: -* ede-proj-target-makefile-miscelaneous :: -* ede-proj-target-makefile-info :: -* ede-proj-target-scheme :: -* project-am-target :: -* project-am-objectcode :: -* project-am-program :: -* project-am-header-noinst :: -* project-am-header-inst :: -* project-am-lisp :: -* project-am-texinfo :: -* project-am-man :: +* ede-target:: +* ede-proj-target:: +* ede-proj-target-makefile:: +* semantic-ede-proj-target-grammar:: +* ede-proj-target-makefile-objectcode:: +* ede-proj-target-makefile-archive:: +* ede-proj-target-makefile-program:: +* ede-proj-target-makefile-shared-object:: +* ede-proj-target-elisp:: +* ede-proj-target-elisp-autoloads:: +* ede-proj-target-makefile-miscelaneous:: +* ede-proj-target-makefile-info:: +* ede-proj-target-scheme:: +* project-am-target:: +* project-am-objectcode:: +* project-am-program:: +* project-am-header-noinst:: +* project-am-header-inst:: +* project-am-lisp:: +* project-am-texinfo:: +* project-am-man:: @end menu -@node ede-target +@node ede-target, ede-proj-target, Targets, Targets @subsection ede-target @tgindex ede-target @@ -2033,7 +2680,7 @@ Return the name of @var{THIS} target, suitable for make or debug style commands. Retrieves the slot @code{menu} from an object of class @code{ede-target} @end deffn -@node ede-proj-target +@node ede-proj-target, ede-proj-target-makefile, ede-target, Targets @subsection ede-proj-target @tgindex ede-proj-target @@ -2227,7 +2874,7 @@ sources variable. @end deffn -@node ede-proj-target-makefile +@node ede-proj-target-makefile, semantic-ede-proj-target-grammar, ede-proj-target, Targets @subsection ede-proj-target-makefile @tgindex ede-proj-target-makefile @@ -2329,7 +2976,7 @@ Return a list of configuration variables from @var{THIS}. Use @var{CONFIGURATION} as the current configuration to query. @end deffn -@node semantic-ede-proj-target-grammar +@node semantic-ede-proj-target-grammar, ede-proj-target-makefile-objectcode, ede-proj-target-makefile, Targets @subsection semantic-ede-proj-target-grammar @tgindex semantic-ede-proj-target-grammar @@ -2383,7 +3030,7 @@ Argument @var{THIS} is the target that should insert stuff. @end deffn -@node ede-proj-target-makefile-objectcode +@node ede-proj-target-makefile-objectcode, ede-proj-target-makefile-archive, semantic-ede-proj-target-grammar, Targets @subsection ede-proj-target-makefile-objectcode @tgindex ede-proj-target-makefile-objectcode @@ -2445,7 +3092,7 @@ Argument @var{THIS} is the target to get sources from. @end deffn -@node ede-proj-target-makefile-archive +@node ede-proj-target-makefile-archive, ede-proj-target-makefile-program, ede-proj-target-makefile-objectcode, Targets @subsection ede-proj-target-makefile-archive @tgindex ede-proj-target-makefile-archive @@ -2488,7 +3135,7 @@ Makefile.am generator, so use it to add this important bin program. @end deffn -@node ede-proj-target-makefile-program +@node ede-proj-target-makefile-program, ede-proj-target-makefile-shared-object, ede-proj-target-makefile-archive, Targets @subsection ede-proj-target-makefile-program @tgindex ede-proj-target-makefile-program @@ -2569,7 +3216,7 @@ Insert bin_PROGRAMS variables needed by target @var{THIS}. @end deffn -@node ede-proj-target-makefile-shared-object +@node ede-proj-target-makefile-shared-object, ede-proj-target-elisp, ede-proj-target-makefile-program, Targets @subsection ede-proj-target-makefile-shared-object @tgindex ede-proj-target-makefile-shared-object @@ -2629,7 +3276,7 @@ Makefile.am generator, so use it to add this important bin program. @end deffn -@node ede-proj-target-elisp +@node ede-proj-target-elisp, ede-proj-target-elisp-autoloads, ede-proj-target-makefile-shared-object, Targets @subsection ede-proj-target-elisp @tgindex ede-proj-target-elisp @@ -2706,7 +3353,7 @@ There are standards in Elisp files specifying how the version string is found, such as a @code{-version} variable, or the standard header. @end deffn -@node ede-proj-target-elisp-autoloads +@node ede-proj-target-elisp-autoloads, ede-proj-target-makefile-miscelaneous, ede-proj-target-elisp, Targets @subsection ede-proj-target-elisp-autoloads @tgindex ede-proj-target-elisp-autoloads @@ -2823,7 +3470,7 @@ sources variable. @end deffn -@node ede-proj-target-makefile-miscelaneous +@node ede-proj-target-makefile-miscelaneous, ede-proj-target-makefile-info, ede-proj-target-elisp-autoloads, Targets @subsection ede-proj-target-makefile-miscelaneous @tgindex ede-proj-target-makefile-miscelaneous @@ -2880,7 +3527,7 @@ Return a list of files which @var{THIS} target depends on. @end deffn -@node ede-proj-target-makefile-info +@node ede-proj-target-makefile-info, ede-proj-target-scheme, ede-proj-target-makefile-miscelaneous, Targets @subsection ede-proj-target-makefile-info @tgindex ede-proj-target-makefile-info @@ -2967,7 +3614,7 @@ Does the usual for Makefile mode, but splits source into two variables when working in Automake mode. @end deffn -@node ede-proj-target-scheme +@node ede-proj-target-scheme, project-am-target, ede-proj-target-makefile-info, Targets @subsection ede-proj-target-scheme @tgindex ede-proj-target-scheme @@ -3012,7 +3659,7 @@ Tweak the configure file (current buffer) to accommodate @var{THIS}. @end deffn -@node project-am-target +@node project-am-target, project-am-objectcode, ede-proj-target-scheme, Targets @subsection project-am-target @tgindex project-am-target @@ -3050,7 +3697,7 @@ Run the current project in the debugger. Edit the target associated w/ this file. @end deffn -@node project-am-objectcode +@node project-am-objectcode, project-am-program, project-am-target, Targets @subsection project-am-objectcode @tgindex project-am-objectcode @@ -3095,7 +3742,7 @@ Default target to use when compiling an object code target. There are no default header files. @end deffn -@node project-am-program +@node project-am-program, project-am-header-noinst, project-am-objectcode, Targets @subsection project-am-program @tgindex project-am-program @@ -3134,7 +3781,7 @@ Additional LD args. @end table @end table -@node project-am-header-noinst +@node project-am-header-noinst, project-am-header-inst, project-am-program, Targets @subsection project-am-header-noinst @tgindex project-am-header-noinst @@ -3167,7 +3814,7 @@ No children Return the default macro to 'edit' for this object. @end deffn -@node project-am-header-inst +@node project-am-header-inst, project-am-lisp, project-am-header-noinst, Targets @subsection project-am-header-inst @tgindex project-am-header-inst @@ -3200,7 +3847,7 @@ No children Return the default macro to 'edit' for this object. @end deffn -@node project-am-lisp +@node project-am-lisp, project-am-texinfo, project-am-header-inst, Targets @subsection project-am-lisp @tgindex project-am-lisp @@ -3230,7 +3877,7 @@ No children Return the default macro to 'edit' for this object. @end deffn -@node project-am-texinfo +@node project-am-texinfo, project-am-man, project-am-lisp, Targets @subsection project-am-texinfo @tgindex project-am-texinfo @@ -3273,7 +3920,7 @@ Return the default macro to 'edit' for this object type. @end deffn @deffn Method project-compile-target-command :AFTER this -Default target t- use when compiling a texinfo file. +Default target to use when compiling a texinfo file. @end deffn @deffn Method ede-documentation :AFTER this @@ -3282,7 +3929,7 @@ Documentation is not for object @var{THIS}, but is provided by @var{THIS} for ot files in the project. @end deffn -@node project-am-man +@node project-am-man, , project-am-texinfo, Targets @comment node-name, next, previous, up @subsection project-am-man @tgindex project-am-man @@ -3313,18 +3960,18 @@ No children Return the default macro to 'edit' for this object type. @end deffn -@node Sourcecode +@node Sourcecode, Compilers, Targets, Extending EDE @section Sourcecode The source code type is an object designed to associated files with targets. @menu -* ede-sourcecode :: +* ede-sourcecode:: @end menu -@node ede-sourcecode +@node ede-sourcecode, , Sourcecode, Sourcecode @subsection ede-sourcecode @scindex ede-sourcecode @@ -3427,7 +4074,7 @@ Return non-@code{nil} if @var{THIS} will take @var{FILENAME} as an auxiliary . Return non-@code{nil} if @var{THIS} will take @var{FILENAME} as an auxiliary . @end deffn -@node Compilers +@node Compilers, , Sourcecode, Extending EDE @section Compilers The compiler object is designed to associate source code with @@ -3436,14 +4083,14 @@ When the makefile is created, this object type knows how to create compile commands. @menu -* ede-compilation-program :: -* ede-compiler :: -* ede-object-compiler :: -* ede-linker :: +* ede-compilation-program:: +* ede-compiler:: +* ede-object-compiler:: +* ede-linker:: @end menu -@node ede-compilation-program +@node ede-compilation-program, ede-compiler, Compilers, Compilers @subsection ede-compilation-program @cmindex ede-compilation-program @@ -3562,7 +4209,7 @@ Tweak the configure file (current buffer) to accommodate @var{THIS}. @end deffn -@node ede-compiler +@node ede-compiler, ede-object-compiler, ede-compilation-program, Compilers @subsection ede-compiler @cmindex ede-compiler @@ -3678,7 +4325,7 @@ Return a string based on @var{THIS} representing a make object variable. @end deffn -@node ede-object-compiler +@node ede-object-compiler, ede-linker, ede-compiler, Compilers @subsection ede-object-compiler @cmindex ede-object-compiler @@ -3722,7 +4369,7 @@ A variable dedicated to dependency generation. Insert variables needed by the compiler @var{THIS}. @end deffn -@node ede-linker +@node ede-linker, , ede-object-compiler, Compilers @subsection ede-linker @cmindex ede-linker diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index c006e635a78..6b3a87f19fc 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -63,7 +63,7 @@ Emacs. * Making New Objects:: How to construct new objects. * Accessing Slots:: How to access a slot. * Writing Methods:: How to write a method. -@c * Method Invocation:: How methods are invoked. +* Method Invocation:: How methods are invoked. * Predicates:: Class-p, Object-p, etc-p. * Association Lists:: List of objects as association lists. * Customizing:: Customizing objects. @@ -71,8 +71,9 @@ Emacs. * Base Classes:: Additional classes you can inherit from. * Browsing:: Browsing your class lists. * Class Values:: Displaying information about a class or object. +* Documentation:: Automatically creating texinfo documentation. * Default Superclass:: The root superclasses. -* Signals:: When you make errors +* Signals:: When you make errors. * Naming Conventions:: Name your objects in an Emacs friendly way. * CLOS compatibility:: What are the differences? * Wish List:: Things about EIEIO that could be improved. @@ -269,6 +270,10 @@ If two parents share the same slot name, the parent which appears in the @var{superclass-list} first sets the tags for that slot. If the new class has a slot with the same name as the parent, the new slot overrides the parent's slot. + +When overriding a slot, some slot attributes cannot be overridden +because they break basic OO rules. You cannot override @code{:type} +or @code{:protection}. @end defmac @noindent @@ -294,7 +299,7 @@ This option is here to support programs written with older versions of @end defvar @menu -* Inheritance:: How to specify parents classes +* Inheritance:: How to specify parents classes. * Slot Options:: How to specify features of a slot. * Class Options:: How to specify features for this class. @end menu @@ -435,35 +440,6 @@ A symbol that is a function like this: :initform + @end example will set the initial value as that symbol. -A function that is a lambda expression, like this: -@example -:initform (lambda () some-variablename) -@end example - -will be evaluated at instantiation time to the value of -@code{some-variablename}. -@c This feature was more annoying than useful. Use the -@c `initialize-instance' function to do this. -@c -@c On the other hand, if you need code to be -@c executed at instantiation time as the initform, code like this: -@c @example -@c :initform (lambda () (+ 1 some-global-var)) -@c @end example -@c will be identified as a function call, and be executed in place. - -@cindex lambda-default - - -Lastly, using the function @code{lambda-default} instead of -@code{lambda} will let you specify a lambda expression to use as the -value, without evaluation, thus: -@example -:initform (lambda-default () some-variablename) -@end example -@c @@TODO - This will be deleted after fair warning. -will not be evaluated at instantiation time, and the value in this -slot will instead be @code{(lambda () some-variablename)}. After a class has been created with @code{defclass}, you can change that default value with @code{oset-default}. @ref{Accessing Slots}. @@ -481,9 +457,6 @@ Here are some examples: An object of your class type. @item (or null symbol) A symbol, or nil. - @item function - A function symbol, or a @code{lambda-default} expression. - @end table @item :allocation @@ -621,9 +594,12 @@ Search for methods in the class hierarchy in breadth first order. This is the default. @item :depth-first Search for methods in the class hierarchy in a depth first order. +@item :c3 +Searches for methods in in a linearized way that most closely matches +what CLOS does when a monotonic class structure is defined. @end table -@c @xref{Method Invocation}, for more on method invocation order. +@xref{Method Invocation}, for more on method invocation order. @item :metaclass Unsupported CLOS option. Enables the use of a different base class other @@ -1008,10 +984,39 @@ method. @c TODO - Write some more about static methods here -@c @node Method Invocation -@c @chapter Method Invocation +@node Method Invocation +@chapter Method Invocation -@c TODO - writeme +When classes are defined, you can specify the +@code{:method-invocation-order}. This is a feature specific to EIEIO. + +This controls the order in which method resolution occurs for +@code{:primary} methods in cases of multiple inheritance. The order +affects which method is called first in a tree, and if +@code{call-next-method} is used, it controls the order in which the +stack of methods are run. + +The original EIEIO order turned out to be broken for multiple +inheritance, but some programs depended on it. As such this option +was added when the default invocation order was fixed to something +that made more sense in that case. + +Valid values are: + +@table @code +@item :breadth-first +Search for methods in the class hierarchy in breadth first order. +This is the default. +@item :depth-first +Search for methods in the class hierarchy in a depth first order. +@item :c3 +Searches for methods in in a linearized way that most closely matches +what CLOS does when CLOS when a monotonic class structure is defined. + +This is derived from the Dylan language documents by +Kim Barrett et al.: A Monotonic Superclass Linearization for Dylan +Retrieved from: http://192.220.96.201/dylan/linearization-oopsla96.html +@end table @node Predicates @comment node-name, next, previous, up @@ -1399,9 +1404,12 @@ a header line comment from the class allocated slot if one is not provided. @end defmethod -@defun eieio-persistent-read filename -Read @var{filename} which contains an @code{eieio-persistent} object -previously written with @code{eieio-persistent-save}. +@defun eieio-persistent-read filename &optional class allow-subclass +Read a persistent object from @var{filename}, and return it. +Signal an error if the object in @var{FILENAME} is not a constructor +for @var{CLASS}. Optional @var{allow-subclass} says that it is ok for +@code{eieio-persistent-read} to load in subclasses of class instead of +being pedantic. @end defun @node eieio-named @@ -1544,8 +1552,51 @@ a class. In a program, pass it a string with the name of a class, a class symbol, or an object. The resulting buffer will display all slot names. -Additionally, all methods defined to have functionality on this class -are displayed. +Additionally, all methods defined to have functionality on this class is +displayed. + +@node Documentation +@comment node-name, next, previous, up +@chapter Documentation + +It is possible to automatically create documentation for your classes in +texinfo format by using the tools in the file @file{eieio-doc.el} + +@deffn Command eieiodoc-class class indexstring &optional skiplist + +This will start at the current point, and create an indented menu of +all the child classes of, and including @var{class}, but skipping any +classes that might be in @var{skiplist}. It will then create nodes for +all these classes, subsection headings, and indexes. + +Each class will be indexed using the texinfo labeled index +@var{indexstring} which is a two letter description. +@xref{(texinfo) New Indices}. + +To use this command, the texinfo macro + +@example +@@defindex @@var @{ indexstring @} +@end example + +@noindent +where @var{indexstring} is replaced with the two letter code. + +Next, an inheritance tree will be created listing all parents of that +section's class. + +Then, all the slots will be expanded in tables, and described +using the documentation strings from the code. Default values will also +be displayed. Only those slots with @code{:initarg} specified will be +expanded, others will be hidden. If a slot is inherited from a parent, +that slot will also be skipped unless the default value is different. +If there is a change, then the documentation part of the slot will be +replace with an @@xref back to the parent. + +This command can only display documentation for classes whose +definitions have been loaded in this Emacs session. + +@end deffn @node Default Superclass @comment node-name, next, previous, up diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 6d791d7c5f6..378180bef31 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -3,13 +3,13 @@ @setfilename ../../info/erc @settitle ERC Manual @syncodeindex fn cp +@include emacsver.texi @c %**end of header @copying -This manual is for ERC version 5.3. +This manual is for ERC as distributed with Emacs @value{EMACSVER}. -Copyright @copyright{} 2005-2012 -Free Software Foundation, Inc. +Copyright @copyright{} 2005-2012 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -48,8 +48,7 @@ and modified without restriction. @contents @ifnottex -@node Top, Introduction, (dir), (dir) -@comment node-name, next, previous, up +@node Top @top ERC @insertcopying @@ -57,9 +56,6 @@ and modified without restriction. @menu * Introduction:: What is ERC? -* Obtaining ERC:: How to get ERC releases and development - versions. -* Installation:: Compiling and installing ERC. * Getting Started:: Quick Start guide to using ERC. * Keystroke Summary:: Keystrokes used in ERC buffers. * Modules:: Available modules for ERC. @@ -76,11 +72,6 @@ and modified without restriction. @detailmenu --- The Detailed Node Listing --- -Obtaining ERC - -* Releases:: Released versions of ERC. -* Development:: Latest unreleased development changes. - Getting Started * Sample Session:: Example of connecting to the #emacs channel @@ -95,11 +86,11 @@ Advanced Usage @end detailmenu @end menu -@node Introduction, Obtaining ERC, Top, Top -@comment node-name, next, previous, up +@node Introduction @chapter Introduction ERC is a powerful, modular, and extensible IRC client for Emacs. +It is distributed with Emacs since version 22.1. It comes with the following capabilities enabled by default. @@ -119,217 +110,13 @@ It comes with the following capabilities enabled by default. @end itemize -@node Obtaining ERC, Installation, Introduction, Top -@comment node-name, next, previous, up -@chapter Obtaining ERC - -@menu -* Releases:: Released versions of ERC. -* Development:: Latest unreleased development changes. -@end menu - -Note that some ERC files are not included with Emacs due to copyright or -dependency issues. If desired, they may be found at the following -locations, or from your local GNU mirror. - -@itemize @bullet -@item @uref{http://ftp.gnu.org/gnu/erc/erc-5.3-extras.tar.gz} -@item @uref{http://ftp.gnu.org/gnu/erc/erc-5.3-extras.zip} -@end itemize - -The rest of this chapter may be skipped if you are using the version of -ERC that comes with Emacs. - -@node Releases, Development, Obtaining ERC, Obtaining ERC -@comment node-name, next, previous, up -@section Releases - -Choose to install a release if you want to minimize risk. - -Errors are corrected in development first. User-visible changes will be -announced on the @email{erc-discuss@@gnu.org} mailing list. -@pxref{Getting Help and Reporting Bugs}. - -@cindex releases, Debian package -@cindex Debian package for ERC -Debian users can get ERC via apt-get. The @file{erc} package is -available in the official Debian repository. - -@cindex releases, from source -Alternatively, you can download the latest release from -@uref{http://ftp.gnu.org/gnu/erc}, or your local GNU mirror. - -@node Development, , Releases, Obtaining ERC -@comment node-name, next, previous, up -@section Development -@cindex development - -Choose the development version if you want to live on the bleeding edge -of ERC development or try out new features before release. - -@cindex git version control system, using -The git version control system allows you to keep up-to-date with the -latest changes to the development version of ERC. It also allows you -to contribute changes (via commits, if you are have developer access to -the repository, or via patches, otherwise). If you would like to -contribute to ERC development, it is highly recommended that you use -git. - -If you are new to git, you might find this tutorial helpful: -@uref{http://www.kernel.org/pub/software/scm/git/docs/gittutorial.html}. - -Downloading ERC with git and staying up-to-date involves the following -steps. - -@enumerate -@item Install git. - -@itemize @bullet -@item Debian and Ubuntu: @kbd{apt-get install git-core}. -@item Windows: @uref{http://git.or.cz/gitwiki/WindowsInstall}. -@item Other operating systems: download, compile, and install the source -from @uref{http://www.kernel.org/pub/software/scm/git/}, or find a git -package for your operating system. -@end itemize - -@item Download the ERC development branch. - -If you have developer access to ERC, do: - -@example -git clone ssh://loginname@@git.sv.gnu.org/srv/git/erc.git -@end example - -otherwise, do: - -@example -git clone git://git.sv.gnu.org/erc.git -@end example - -If you are behind a restrictive firewall, and do not have developer -access, then do the following instead: - -@example -git clone http://git.sv.gnu.org/r/erc.git -@end example - -@item List upstream changes that are missing from your local copy. -Do this whenever you want to see whether new changes have been committed -to ERC. If you wish, you may skip this step and proceed directly to -the ``update'' step. - -@example -# Change to the source directory you are interested in. -cd erc - -# Fetch new changes from the repository, but don't apply them yet -git fetch origin - -# Display log messages for the new changes -git log HEAD..origin -@end example - -``origin'' is git's name for the location where you originally got ERC -from. You can change this location at any time by editing the -@file{.git/config} file in the directory where the ERC source was -placed. - -@cindex updating ERC with git -@item Update to the latest version by pulling in any missing changes. -@example -cd erc -git pull origin -@end example - -git will show how many files changed, and will provide a visual display -for how many lines were changed in each file. - -@end enumerate - -There are other ways to interact with the ERC repository. - -@itemize -@item Browse git repo: @uref{http://git.sv.gnu.org/gitweb/?p=erc.git} -@item Latest development snapshot: @uref{http://mwolson.org/static/dist/erc-latest.tar.gz} -@item Latest development snapshot (zip file): @uref{http://mwolson.org/static/dist/erc-latest.zip} -@end itemize - -The latest development snapshot can lag behind the git repo by as much -as 20 minutes, but never more than that. - -For further information on committing changes to ERC and performing -development, please consult -@uref{http://emacswiki.org/cgi-bin/wiki/ErcDevelopment}. - - -@node Installation, Getting Started, Obtaining ERC, Top -@comment node-name, next, previous, up -@chapter Installation - -ERC may be compiled and installed on your machine. - -This section may be skipped if you are using the version of ERC that -comes with Emacs. - -@subsubheading Compilation - -This is an optional step, since Emacs Lisp source code does not -necessarily have to be byte-compiled. It will yield a speed increase, -though. - -A working copy of Emacs or XEmacs is needed in order to compile ERC. By -default, the program that is installed with the name @command{emacs} -will be used. - -If you want to use the @command{xemacs} binary to perform the -compilation, you would need to edit @file{Makefile} in the top-level -directory as follows. You can put either a full path to an Emacs or -XEmacs binary or just the command name, as long as it is in the -@env{PATH}. - -@example -EMACS = xemacs -SITEFLAG = -no-site-file -@end example - -Running @code{make} should compile the ERC source files in the -@file{lisp} directory. - -@subsubheading Installation - -ERC may be installed into your file hierarchy by doing the following. - -Edit the @file{Makefile} file so that @env{ELISPDIR} points to where you -want the source and compiled ERC files to be installed and -@env{INFODIR} indicates where to put the ERC manual. Of course, you -will want to edit @env{EMACS} and @env{SITEFLAG} as shown in the -Compilation section if you are using XEmacs. - -If you are installing ERC on a Debian system, you might want to change -the value of @env{INSTALLINFO} as specified in @file{Makefile}. - -Run @code{make} as a normal user. - -Run @code{make install} as the root user if you have chosen installation -locations that require this. - - -@node Getting Started, Keystroke Summary, Installation, Top -@comment node-name, next, previous, up +@node Getting Started @chapter Getting Started @cindex settings -To use ERC, add the directory containing its files to your -@code{load-path} variable, in your @file{.emacs} file. Then, load ERC -itself. An example follows. - -@lisp -(require 'erc) -@end lisp - -Once ERC is loaded, the command @kbd{M-x erc} will start ERC and -prompt for the server to connect to. +The command @kbd{M-x erc} will start ERC and prompt for the server to +connect to. If you want to place ERC settings in their own file, you can place them in @file{~/.emacs.d/.ercrc.el}, creating it if necessary. @@ -344,8 +131,7 @@ you want, do @kbd{M-x customize-variable RET erc-modules RET}. * Special Features:: Differences from standalone IRC clients @end menu -@node Sample Session, Special Features, Getting Started, Getting Started -@comment node-name, next, previous, up +@node Sample Session @section Sample Session This is an example ERC session which shows how to connect to the #emacs @@ -403,8 +189,7 @@ talk with them. @end itemize -@node Special Features, , Sample Session, Getting Started -@comment node-name, next, previous, up +@node Special Features @section Special Features ERC has some features that distinguish it from some IRC clients. @@ -478,8 +263,7 @@ ERC buffer and run the @code{/RECONNECT} command. @end itemize -@node Keystroke Summary, Modules, Getting Started, Top -@comment node-name, next, previous, up +@node Keystroke Summary @chapter Keys Used in ERC @cindex keystrokes @@ -562,8 +346,7 @@ Kill current input line using `erc-bol' followed by `kill-line'. @end table -@node Modules, Advanced Usage, Keystroke Summary, Top -@comment node-name, next, previous, up +@node Modules @chapter Modules @cindex modules @@ -701,8 +484,7 @@ Translate morse code in messages @c PRE5_4: Document every option of every module in its own subnode -@node Advanced Usage, Getting Help and Reporting Bugs, Modules, Top -@comment node-name, next, previous, up +@node Advanced Usage @chapter Advanced Usage @cindex advanced topics @@ -712,8 +494,7 @@ Translate morse code in messages * Options:: Options that are available for ERC. @end menu -@node Connecting, Sample Configuration, Advanced Usage, Advanced Usage -@comment node-name, next, previous, up +@node Connecting @section Connecting to an IRC Server @cindex connecting @@ -846,8 +627,7 @@ User full name. This can be either a string or a function to call. @end defopt -@node Sample Configuration, Options, Connecting, Advanced Usage -@comment node-name, next, previous, up +@node Sample Configuration @section Sample Configuration @cindex configuration, sample @@ -926,8 +706,7 @@ stuff, to the current ERC buffer." ;; (setq erc-kill-server-buffer-on-quit t) @end lisp -@node Options, , Sample Configuration, Advanced Usage -@comment node-name, next, previous, up +@node Options @section Options @cindex options @@ -939,8 +718,7 @@ check out the available options for ERC is to do @kbd{M-x customize-group erc RET}. -@node Getting Help and Reporting Bugs, History, Advanced Usage, Top -@comment node-name, next, previous, up +@node Getting Help and Reporting Bugs @chapter Getting Help and Reporting Bugs @cindex help, getting @cindex bugs, reporting @@ -952,36 +730,24 @@ or if you have bugs to report, there are several places you can go. @item @uref{http://www.emacswiki.org/cgi-bin/wiki/ERC} is the -emacswiki.org page for ERC. Anyone may add tips, hints, or bug -descriptions to it. +emacswiki.org page for ERC. Anyone may add tips, hints, etc. to it. @item -There are several mailing lists for ERC. To subscribe, visit -@uref{http://savannah.gnu.org/mail/?group=erc}. - -The mailing lists are also available on Gmane. -(@url{http://gmane.org/}). Gmane provides additional methods for -accessing the mailing lists, adding content to them, and searching them. - -@enumerate -@item gmane.emacs.erc.announce: Announcements - -@item gmane.emacs.erc.discuss: General discussion - -@item gmane.emacs.erc.cvs: Log messages for changes to the ERC source code - -@end enumerate +You can ask questions about using ERC on the Emacs mailing list, +@uref{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs}. @item You can visit the IRC Freenode channel @samp{#emacs}. Many of the contributors are frequently around and willing to answer your questions. +@item +To report a bug in ERC, use @kbd{M-x report-emacs-bug}. + @end itemize -@node History, Copying, Getting Help and Reporting Bugs, Top -@comment node-name, next, previous, up +@node History @chapter History @cindex history, of ERC @@ -1044,18 +810,22 @@ our revision control system. Our mailing list address changed as well. We switched to using git for our version control system. +@item 2009+ + +Since about 2009, ERC is no longer developed as a separate project, but +is maintained as part of Emacs. + @end itemize -@node Copying, GNU Free Documentation License, History, Top -@comment node-name, next, previous, up +@node Copying +@appendix GNU GENERAL PUBLIC LICENSE @include gpl.texi -@node GNU Free Documentation License, Concept Index, Copying, Top -@comment node-name, next, previous, up +@node GNU Free Documentation License +@appendix GNU Free Documentation License @include doclicense.texi -@node Concept Index, , GNU Free Documentation License, Top -@comment node-name, next, previous, up +@node Concept Index @unnumbered Index @printindex cp diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi index 919ca21cc3e..5add229724c 100644 --- a/doc/misc/newsticker.texi +++ b/doc/misc/newsticker.texi @@ -69,14 +69,14 @@ developing GNU and promoting software freedom.'' @node Overview @chapter Overview -Newsticker provides a newsticker for Emacs. A newsticker is a thing +Newsticker provides a newsticker for Emacs. A newsticker is a thing that asynchronously retrieves headlines from a list of news sites, prepares these headlines for reading, and allows for loading the corresponding articles in a web browser. Headlines consist of a title and (possibly) a small description. They -are contained in "RSS" (RDF Site Summary) or "Atom" files. Newsticker +are contained in ``RSS'' (RDF Site Summary) or ``Atom'' files. Newsticker works with the following RSS formats: @itemize @@ -105,8 +105,9 @@ messages in a stock-quote ticker, or just changing. Newsticker allows for automatic processing of headlines by providing hooks and (sample) functions for automatically downloading images and -enclosed files (as delivered by podcasts, e.g.). +enclosed files (as delivered by, e.g., podcasts). +@ignore @ifhtml Here are screen shots of the @uref{newsticker-1.7.png, version 1.7 (current version)} and some older screen shots: @@ -116,6 +117,7 @@ Here are screen shots of the @uref{newsticker-1.7.png, version 1.7 @uref{newsticker-1.3.png, version 1.3}, @uref{newsticker-1.0.png, version 1.0}. @end ifhtml +@end ignore @node Requirements @chapter Requirements @@ -123,7 +125,7 @@ Here are screen shots of the @uref{newsticker-1.7.png, version 1.7 Newsticker can be used with @uref{http://www.gnu.org/software/emacs/emacs.html, GNU Emacs} version 21.1 or later as well as @uref{http://www.xemacs.org, XEmacs}. It -requires an XML-parser (@file{xml.el}) which is part of GNU Emacs. If +requires an XML-parser (@file{xml.el}), which is part of GNU Emacs. If you are using XEmacs you want to get the @file{net-utils} package which contains @file{xml.el} for XEmacs. @@ -161,11 +163,11 @@ You can choose between two different frontends for reading headlines: @itemize @item Newsticker's @emph{treeview} uses separate windows for the feeds (in tree form), a list of headlines for the current feed, and -the content of the current headline. Feeds can be placed into groups -which itself can be placed in groups and so on. +the content of the current headline. Feeds can be placed into groups, +which themselves can be placed in groups and so on. @item Newsticker's @emph{plainview} displays all headlines in a -single buffer, called @samp{*newsticker*}. The modeline in the -@samp{*newsticker*} buffer informs whenever new headlines have +single buffer, called @samp{*newsticker*}. The modeline in the +@samp{*newsticker*} buffer informs you whenever new headlines have arrived. @end itemize In both views clicking mouse-button 2 or pressing RET on a headline @@ -175,13 +177,13 @@ your favorite web browser. @findex newsticker-start-ticker @findex newsticker-stop-ticker The scrolling, or flashing of headlines in the echo area, can be -started with the command @code{newsticker-start-ticker}. It can be +started with the command @code{newsticker-start-ticker}. It can be stopped with @code{newsticker-stop-ticker}. @findex newsticker-start @findex newsticker-stop If you just want to start the periodic download of headlines use the -command @code{newsticker-start}. Calling @code{newsticker-stop} will +command @code{newsticker-start}. Calling @code{newsticker-stop} will stop the periodic download, but will call @code{newsticker-stop-ticker} as well. @@ -189,7 +191,7 @@ stop the periodic download, but will call @chapter Configuration All Newsticker options are customizable, i.e. they can be changed with -Emacs customization methods: Call the command +Emacs customization methods. Call the command @code{customize-group} and enter @samp{newsticker} for the customization group. @@ -209,7 +211,7 @@ feeds are retrieved and how this is done. @itemize @item @vindex newsticker-url-list -@code{newsticker-url-list} defines the list of headlines which are +@code{newsticker-url-list} defines the list of headlines that are retrieved. @item @vindex newsticker-retrieval-method @@ -245,11 +247,11 @@ commands to newsticker functions. @item @vindex newsticker-new-item-functions @code{newsticker-new-item-functions} allows for automatic -processing of headlines. See `newsticker-download-images', and -`newsticker-download-enclosures' for sample functions. +processing of headlines. See @code{newsticker-download-images}, and +@code{newsticker-download-enclosures} for sample functions. @item @vindex newsticker-plainview-hooks -The subgroup @code{newsticker-plainview-hooks} contains hook which +The subgroup @code{newsticker-plainview-hooks} contains hooks that apply to the plainview reader only. @end itemize @@ -276,7 +278,7 @@ the echo area. @itemize @item @vindex newsticker-frontend -@code{newsticker-frontend} determines the actual headline reader. The +@code{newsticker-frontend} determines the actual headline reader. The ``plainview'' reader uses a single buffer, the ``treeview'' uses separate buffers and windows. @end itemize diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 575b9cbebe6..89c99018460 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -1,11 +1,8 @@ - \input texinfo @c %**start of header @setfilename ../../info/org @settitle The Org Manual - -@set VERSION 7.8.11 -@set DATE May 2012 +@set VERSION 7.9.2 (GNU Emacs 24.3) @c Use proper quote and backtick for code sections in PDF output @c Cf. Texinfo manual 14.2 @@ -347,7 +344,7 @@ Introduction * Installation:: How to install a downloaded version of Org * Activation:: How to activate Org for certain buffers * Feedback:: Bug reports, ideas, patches etc. -* Conventions:: Type-setting conventions in the manual +* Conventions:: Typesetting conventions in the manual Document structure @@ -495,6 +492,7 @@ Capture templates * Template elements:: What is needed for a complete template entry * Template expansion:: Filling in information about time and context +* Templates in contexts:: Only show a template in a specific context Archiving @@ -560,7 +558,7 @@ Embedded @LaTeX{} * Special symbols:: Greek letters and other symbols * Subscripts and superscripts:: Simple syntax for raising/lowering text -* @LaTeX{} fragments:: Complex formulas made easy +* @LaTeX{} fragments:: Complex formulas made easy * Previewing @LaTeX{} fragments:: What will this snippet look like? * CDLaTeX mode:: Speed up entering of formulas @@ -695,6 +693,7 @@ Specific header arguments * results:: Specify the type of results and how they will be collected and handled * file:: Specify a path for file output +* file-desc:: Specify a description for file results * dir:: Specify the default (possibly remote) directory for code block execution * exports:: Export code and/or results @@ -718,6 +717,7 @@ Specific header arguments * rownames:: Handle row names in tables * shebang:: Make tangled files executable * eval:: Limit evaluation of specific code blocks +* wrap:: Mark source block evaluation results Miscellaneous @@ -740,7 +740,7 @@ Interaction with other packages Hacking -* Hooks:: Who to reach into Org's internals +* Hooks:: How to reach into Org's internals * Add-on packages:: Available extensions * Adding hyperlink types:: New custom link types * Context-sensitive commands:: How to add functionality to such commands @@ -776,7 +776,7 @@ MobileOrg * Installation:: How to install a downloaded version of Org * Activation:: How to activate Org for certain buffers * Feedback:: Bug reports, ideas, patches etc. -* Conventions:: Type-setting conventions in the manual +* Conventions:: Typesetting conventions in the manual @end menu @node Summary, Installation, Introduction, Introduction @@ -854,61 +854,111 @@ Theory Ltd.} @cindex installation @cindex XEmacs -@b{Important:} @i{If you are using a version of Org that is part of the Emacs -distribution or an XEmacs package, please skip this section and go directly -to @ref{Activation}. To see what version of Org (if any) is part of your -Emacs distribution, type @kbd{M-x load-library RET org} and then @kbd{M-x -org-version}.} +@b{Important:} @i{If you the version of Org that comes with Emacs or as a +XEmacs package, please skip this section and go directly to @ref{Activation}. +If you downloaded Org as an ELPA package, please read the instructions on the +@uref{http://orgmode.org/elpa/, Org ELPA page}. To see what version of Org +(if any) is part of your Emacs distribution, type @kbd{M-x org-version} (if +your Emacs distribution does not come with Org, this function will not be +defined).} -If you have downloaded Org from the Web, either as a distribution @file{.zip} -or @file{.tar} file, or as a Git archive, you must take the following steps -to install it: go into the unpacked Org distribution directory and edit the -top section of the file @file{Makefile}. You must set the name of the Emacs -binary (likely either @file{emacs} or @file{xemacs}), and the paths to the -directories where local Lisp and Info files are kept. If you don't have -access to the system-wide directories, you can simply run Org directly from -the distribution directory by adding the @file{lisp} subdirectory to the -Emacs load path. To do this, add the following line to @file{.emacs}: +Installation of Org mode uses a build system, which is described in more +detail on @uref{http://orgmode.org/worg/dev/org-build-system.html, Worg}. -@example -(setq load-path (cons "~/path/to/orgdir/lisp" load-path)) -@end example +If you have downloaded Org from the Web as a distribution @file{.zip} or +@file{.tar.gz} archive, take the following steps to install it: -@noindent -If you plan to use code from the @file{contrib} subdirectory, do a similar -step for this directory: +@itemize @bullet +@item Unpack the distribution archive. +@item Change into (@code{cd}) the Org directory. +@item Run @code{make help config} +and then check and edit the file @file{local.mk} if the default configuration +does not match your system. Set the name of the Emacs binary (likely either +@file{emacs} or @file{xemacs}), and the paths to the directories where local +Lisp and Info files will be installed. If the Emacs binary is not in your +path, give the full path to the executable. Avoid spaces in any path names. +@item Run @code{make config} +again to check the configuration. +@item Optionally run @code{make test} +to build Org mode and then run the full testsuite. +@item Run @code{make install} or @code{sudo make install} +to build and install Org mode on your system. +@end itemize -@example -(setq load-path (cons "~/path/to/orgdir/contrib/lisp" load-path)) -@end example +If you use a cloned Git repository, then the procedure is slightly different. +The following description assumes that you are using the @code{master} branch +(where the development is done). You could also use the @code{maint} branch +instead, where the release versions are published, just replace @code{master} +with @code{maint} in the description below. -@noindent Now byte-compile the Lisp files with the shell command: +@itemize @bullet +@item Change into (@code{cd}) the Org repository. +@item Run @code{git checkout master} +to switch to the @code{master} branch of the Org repository. +@item Run @code{make help} +and then check and edit the file @file{local.mk}. You must set the name of +the Emacs binary (likely either @file{emacs} or @file{xemacs}), and the paths +to the directories where local Lisp and Info files will be installed. If the +Emacs binary is not in your path, you must give the full path to the +executable. Avoid spaces in any path names. +@item Run @code{make config} +to check the configuration. +@item Run @code{make update2} or @code{make up2} +to update the Git repository and build and install Org mode. The latter +invocation runs the complete test suite before installation and installs only +if the build passes all tests. +@end itemize + +If you don't have access to the system-wide directories and you don't want to +install somewhere into your home directory, you can run Org directly from the +distribution directory or Org repository by compiling Org mode in place: + +@itemize @bullet +@item Change into (@code{cd}) the Org repository. +@item Run @code{git checkout master} +to switch to the @code{master} branch of the Org repository. +@item Run @code{make compile} +@end itemize + +Last but not least you can also run Org mode directly from an Org repository +without any compilation. Simply replace the last step in the recipe above +with @code{make uncompiled}. + +Then add the following line to @file{.emacs}: @example -make +(add-to-list 'load-path "~/path/to/orgdir/lisp") @end example -@noindent If you are running Org from the distribution directory, this is -all. If you want to install Org into the system directories, use (as -administrator) +@noindent +If you plan to use code from the @file{contrib} subdirectory without +compiling them, do a similar step for this directory: @example -make install +(add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t) @end example +If you want to include those files with the build and install, please +customize the variable @code{ORG_ADD_CONTRIB} instead in your @code{local.mk} +file, for more details please see this +@uref{http://orgmode.org/worg/dev/org-build-system.html#sec-4-1-2, +description on Worg}. + Installing Info files is system dependent, because of differences in the -@file{install-info} program. The following should correctly install the Info -files on most systems, please send a bug report if not@footnote{The output -from install-info (if any) is also system dependent. In particular Debian -and its derivatives use two different versions of install-info and you may -see the message: +@file{install-info} program. The Info documentation is installed together +with the rest of Org mode. If you don't install Org mode, it is possible to +install the Info documentation separately (you need to have +install-info@footnote{The output from install-info (if any) is system +dependent. In particular Debian and its derivatives use two different +versions of install-info and you may see the message: @example This is not dpkg install-info anymore, but GNU install-info See the man page for ginstall-info for command line arguments @end example -@noindent which can be safely ignored.}. +@noindent which can be safely ignored.} +on your system). @example make install-info @@ -928,17 +978,28 @@ Do not forget to activate Org as described in the following section. @section Activation @cindex activation @cindex autoload +@cindex ELPA @cindex global key bindings @cindex key bindings, global +@findex org-agenda +@findex org-capture +@findex org-store-link +@findex org-iswitchb + +Since Emacs 22.2, files with the @file{.org} extension use Org mode by +default. If you are using an earlier version of Emacs, add this line to your +@file{.emacs} file: -To make sure files with extension @file{.org} use Org mode, add the following -line to your @file{.emacs} file. @lisp (add-to-list 'auto-mode-alist '("\\.org\\'" . org-mode)) @end lisp -@noindent Org mode buffers need font-lock to be turned on - this is the -default in Emacs@footnote{If you don't use font-lock globally, turn it on in -Org buffer with @code{(add-hook 'org-mode-hook 'turn-on-font-lock)}}. + +Org mode buffers need font-lock to be turned on - this is the default in +Emacs@footnote{If you don't use font-lock globally, turn it on in Org buffer +with @code{(add-hook 'org-mode-hook 'turn-on-font-lock)}}. + +There are compatibility issues between Org mode and some other Elisp +packages, please take the time to check the list (@pxref{Conflicts}). The four Org commands @command{org-store-link}, @command{org-capture}, @command{org-agenda}, and @command{org-iswitchb} should be accessible through @@ -1016,8 +1077,9 @@ $ emacs -Q -l /path/to/minimal-org.el @end example However if you are using Org mode as distributed with Emacs, a minimal setup -is not necessary. In that case it is sufficient to start Emacs as @code{emacs --Q}. The @code{minimal-org.el} setup file can have contents as shown below. +is not necessary. In that case it is sufficient to start Emacs as +@code{emacs -Q}. The @code{minimal-org.el} setup file can have contents as +shown below. @example ;;; Minimal setup to load latest `org-mode' @@ -1029,7 +1091,7 @@ is not necessary. In that case it is sufficient to start Emacs as @code{emacs ;; add latest org-mode to load path (add-to-list 'load-path (expand-file-name "/path/to/org-mode/lisp")) -(add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp")) +(add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp" t)) ;; activate org (require 'org-install) @@ -1081,7 +1143,9 @@ attach it to your bug report. @node Conventions, , Feedback, Introduction @section Typesetting conventions used in this manual -Org uses three types of keywords: TODO keywords, tags, and property +@subsubheading TODO keywords, tags, properties, etc. + +Org mainly uses three types of keywords: TODO keywords, tags and property names. In this manual we use the following conventions: @table @code @@ -1099,17 +1163,33 @@ User-defined properties are capitalized; built-in properties with special meaning are written with all capitals. @end table -The manual lists both the keys and the corresponding commands for accessing -functionality. Org mode often uses the same key for different functions, -depending on context. The command that is bound to such keys has a generic -name, like @code{org-metaright}. In the manual we will, wherever possible, -give the function that is internally called by the generic command. For -example, in the chapter on document structure, @kbd{M-@key{right}} will be -listed to call @code{org-do-demote}, while in the chapter on tables, it will -be listed to call org-table-move-column-right. - -If you prefer, you can compile the manual without the command names by -unsetting the flag @code{cmdnames} in @file{org.texi}. +Moreover, Org uses @i{option keywords} (like @code{#+TITLE} to set the title) +and @i{environment keywords} (like @code{#+BEGIN_HTML} to start a @code{HTML} +environment). They are written in uppercase in the manual to enhance its +readability, but you can use lowercase in your Org files@footnote{Easy +templates insert lowercase keywords and Babel dynamically inserts +@code{#+results}.} + +@subsubheading Keybindings and commands +@kindex C-c a +@findex org-agenda +@kindex C-c c +@findex org-capture + +The manual suggests two global keybindings: @kbd{C-c a} for @code{org-agenda} +and @kbd{C-c c} for @code{org-capture}. These are only suggestions, but the +rest of the manual assumes that you are using these keybindings. + +Also, the manual lists both the keys and the corresponding commands for +accessing a functionality. Org mode often uses the same key for different +functions, depending on context. The command that is bound to such keys has +a generic name, like @code{org-metaright}. In the manual we will, wherever +possible, give the function that is internally called by the generic command. +For example, in the chapter on document structure, @kbd{M-@key{right}} will +be listed to call @code{org-do-demote}, while in the chapter on tables, it +will be listed to call @code{org-table-move-column-right}. If you prefer, +you can compile the manual without the command names by unsetting the flag +@code{cmdnames} in @file{org.texi}. @node Document Structure, Tables, Introduction, Top @chapter Document structure @@ -1159,7 +1239,8 @@ Headlines define the structure of an outline tree. The headlines in Org start with one or more stars, on the left margin@footnote{See the variables @code{org-special-ctrl-a/e}, @code{org-special-ctrl-k}, and @code{org-ctrl-k-protect-subtree} to configure special behavior of @kbd{C-a}, -@kbd{C-e}, and @kbd{C-k} in headlines.}. For example: +@kbd{C-e}, and @kbd{C-k} in headlines.} @footnote{Clocking only works with +headings indented less then 30 stars.}. For example: @example * Top level headline @@ -1239,6 +1320,7 @@ tables, @kbd{S-@key{TAB}} jumps to the previous field. @cindex show all, command @orgcmd{C-u C-u C-u @key{TAB},show-all} Show all, including drawers. +@cindex revealing context @orgcmd{C-c C-r,org-reveal} Reveal context around point, showing the current entry, the following heading and the hierarchy above. Useful for working near a location that has been @@ -1246,8 +1328,13 @@ exposed by a sparse tree command (@pxref{Sparse trees}) or an agenda command (@pxref{Agenda commands}). With a prefix argument show, on each level, all sibling headings. With a double prefix argument, also show the entire subtree of the parent. +@cindex show branches, command @orgcmd{C-c C-k,show-branches} Expose all the headings of the subtree, CONTENT view for just one subtree. +@cindex show children, command +@orgcmd{C-c @key{TAB},show-children} +Expose all direct children of the subtree. With a numeric prefix argument N, +expose all children down to level N. @orgcmd{C-c C-x b,org-tree-to-indirect-buffer} Show the current subtree in an indirect buffer@footnote{The indirect buffer @@ -1429,7 +1516,7 @@ more details, see the docstring of the command @code{org-clone-subtree-with-time-shift}. @orgcmd{C-c C-w,org-refile} Refile entry or region to a different location. @xref{Refiling notes}. -@orgcmd{C-c ^,org-sort-entries-or-items} +@orgcmd{C-c ^,org-sort} Sort same-level entries. When there is an active region, all entries in the region will be sorted. Otherwise the children of the current headline are sorted. The command prompts for the sorting method, which can be @@ -1714,19 +1801,16 @@ state of the checkbox. In any case, verify bullets and indentation consistency in the whole list. @kindex C-c - @vindex org-plain-list-ordered-item-terminator -@vindex org-list-automatic-rules @item C-c - Cycle the entire list level through the different itemize/enumerate bullets (@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}) or a subset of them, depending on @code{org-plain-list-ordered-item-terminator}, the type of list, -and its position@footnote{See @code{bullet} rule in -@code{org-list-automatic-rules} for more information.}. With a numeric -prefix argument N, select the Nth bullet from this list. If there is an -active region when calling this, selected text will be changed into an item. -With a prefix argument, all lines will be converted to list items. If the -first line already was a list item, any item marker will be removed from the -list. Finally, even without an active region, a normal line will be -converted into a list item. +and its indentation. With a numeric prefix argument N, select the Nth bullet +from this list. If there is an active region when calling this, selected +text will be changed into an item. With a prefix argument, all lines will be +converted to list items. If the first line already was a list item, any item +marker will be removed from the list. Finally, even without an active +region, a normal line will be converted into a list item. @kindex C-c * @item C-c * Turn a plain list item into a headline (so that it becomes a subheading at @@ -1756,11 +1840,13 @@ numerically, alphabetically, by time, or by custom function. @cindex visibility cycling, drawers @vindex org-drawers +@cindex org-insert-drawer +@kindex C-c C-x d Sometimes you want to keep information associated with an entry, but you normally don't want to see it. For this, Org mode has @emph{drawers}. Drawers need to be configured with the variable -@code{org-drawers}@footnote{You can define drawers on a per-file basis -with a line like @code{#+DRAWERS: HIDDEN PROPERTIES STATE}}. Drawers +@code{org-drawers}@footnote{You can define additional drawers on a +per-file basis with a line like @code{#+DRAWERS: HIDDEN STATE}}. Drawers look like this: @example @@ -1772,6 +1858,13 @@ look like this: After the drawer. @end example +You can interactively insert drawers at point by calling +@code{org-insert-drawer}, which is bound to @key{C-c C-x d}. With an active +region, this command will put the region inside the drawer. With a prefix +argument, this command calls @code{org-insert-property-drawer} and add a +property drawer right below the current headline. Completion over drawer +keywords is also possible using @key{M-TAB}. + Visibility cycling (@pxref{Visibility cycling}) on the headline will hide and show the entry, but keep the drawer collapsed to a single line. In order to look inside the drawer, you need to move the cursor to the drawer line and @@ -2226,7 +2319,7 @@ on a per-file basis with: If you would like to overrule the automatic alignment of number-rich columns to the right and of string-rich column to the left, you can use @samp{<r>}, -@samp{c}@footnote{Centering does not work inside Emacs, but it does have an +@samp{<c>}@footnote{Centering does not work inside Emacs, but it does have an effect when exporting to HTML.} or @samp{<l>} in a similar fashion. You may also combine alignment and field width like this: @samp{<l10>}. @@ -2577,23 +2670,28 @@ durations computations @ref{Durations and time values}. @subsection Emacs Lisp forms as formulas @cindex Lisp forms, as table formulas -It is also possible to write a formula in Emacs Lisp; this can be useful for -string manipulation and control structures, if Calc's functionality is not -enough. If a formula starts with a single-quote followed by an opening -parenthesis, then it is evaluated as a Lisp form. The evaluation should -return either a string or a number. Just as with @file{calc} formulas, you -can specify modes and a printf format after a semicolon. With Emacs Lisp -forms, you need to be conscious about the way field references are -interpolated into the form. By default, a reference will be interpolated as -a Lisp string (in double-quotes) containing the field. If you provide the -@samp{N} mode switch, all referenced elements will be numbers (non-number -fields will be zero) and interpolated as Lisp numbers, without quotes. If -you provide the @samp{L} flag, all fields will be interpolated literally, -without quotes. I.e., if you want a reference to be interpreted as a string -by the Lisp form, enclose the reference operator itself in double-quotes, -like @code{"$3"}. Ranges are inserted as space-separated fields, so you can -embed them in list or vector syntax. Here are a few examples---note how the -@samp{N} mode is used when we do computations in Lisp: +It is also possible to write a formula in Emacs Lisp. This can be useful +for string manipulation and control structures, if Calc's functionality is +not enough. + +If a formula starts with a single-quote followed by an opening parenthesis, +then it is evaluated as a Lisp form. The evaluation should return either a +string or a number. Just as with @file{calc} formulas, you can specify modes +and a printf format after a semicolon. + +With Emacs Lisp forms, you need to be conscious about the way field +references are interpolated into the form. By default, a reference will be +interpolated as a Lisp string (in double-quotes) containing the field. If +you provide the @samp{N} mode switch, all referenced elements will be numbers +(non-number fields will be zero) and interpolated as Lisp numbers, without +quotes. If you provide the @samp{L} flag, all fields will be interpolated +literally, without quotes. I.e., if you want a reference to be interpreted +as a string by the Lisp form, enclose the reference operator itself in +double-quotes, like @code{"$3"}. Ranges are inserted as space-separated +fields, so you can embed them in list or vector syntax. + +Here are a few examples---note how the @samp{N} mode is used when we do +computations in Lisp: @example @r{Swap the first two characters of the content of column 1} @@ -2657,7 +2755,7 @@ modified in order to still reference the same field. To avoid this from happening, in particular in range references, anchor ranges at the table borders (using @code{@@<}, @code{@@>}, @code{$<}, @code{$>}), or at hlines using the @code{@@I} notation. Automatic adaptation of field references does -of cause not happen if you edit the table structure with normal editing +of course not happen if you edit the table structure with normal editing commands---then you must fix the equations yourself. Instead of typing an equation into the field, you may also use the following @@ -2899,7 +2997,7 @@ makes use of these features: | # | Peter | 10 | 8 | 23 | 41 | 8.2 | | # | Sam | 2 | 4 | 3 | 9 | 1.8 | |---+---------+--------+--------+--------+-------+------| -| | Average | | | | 29.7 | | +| | Average | | | | 25.0 | | | ^ | | | | | at | | | $ | max=50 | | | | | | |---+---------+--------+--------+--------+-------+------| @@ -3227,6 +3325,8 @@ mailto:adent@@galaxy.net @r{Mail link} vm:folder @r{VM folder link} vm:folder#id @r{VM message link} vm://myself@@some.where.org/folder#id @r{VM on remote machine} +vm-imap:account:folder @r{VM IMAP folder link} +vm-imap:account:folder#id @r{VM IMAP message link} wl:folder @r{WANDERLUST folder link} wl:folder#id @r{WANDERLUST message link} mhe:folder @r{MH-E folder link} @@ -3498,18 +3598,26 @@ that relates the linkwords to replacement text. Here is an example: @smalllisp @group (setq org-link-abbrev-alist - '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=") - ("google" . "http://www.google.com/search?q=") - ("gmap" . "http://maps.google.com/maps?q=%s") - ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1") - ("ads" . "http://adsabs.harvard.edu/cgi-bin/nph-abs_connect?author=%s&db_key=AST"))) + '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=") + ("url-to-ja" . "http://translate.google.fr/translate?sl=en&tl=ja&u=%h") + ("google" . "http://www.google.com/search?q=") + ("gmap" . "http://maps.google.com/maps?q=%s") + ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1") + ("ads" . "http://adsabs.harvard.edu/cgi-bin/nph-abs_connect?author=%s&db_key=AST"))) @end group @end smalllisp If the replacement text contains the string @samp{%s}, it will be -replaced with the tag. Otherwise the tag will be appended to the string -in order to create the link. You may also specify a function that will -be called with the tag as the only argument to create the link. +replaced with the tag. Using @samp{%h} instead of @samp{%s} will +url-encode the tag (see the example above, where we need to encode +the URL parameter.) Using @samp{%(my-function)} will pass the tag +to a custom function, and replace it by the resulting string. + +If the replacement text don't contain any specifier, it will simply +be appended to the string in order to create the link. + +Instead of a string, you may also specify a function that will be +called with the tag as the only argument to create the link. With the above setting, you could link to a specific bug with @code{[[bugzilla:129]]}, search the web for @samp{OrgMode} with @@ -3567,7 +3675,7 @@ Jump to line 255. Search for a link target @samp{<<My Target>>}, or do a text search for @samp{my target}, similar to the search in internal links, see @ref{Internal links}. In HTML export (@pxref{HTML export}), such a file -link will become an HTML reference to the corresponding named anchor in +link will become a HTML reference to the corresponding named anchor in the linked file. @item *My Target In an Org file, restrict search to headlines. @@ -3844,9 +3952,10 @@ from @code{DONE} to @code{REPORT} in the example above. See also @subsection Fast access to TODO states If you would like to quickly change an entry to an arbitrary TODO state -instead of cycling through the states, you can set up keys for -single-letter access to the states. This is done by adding the section -key after each keyword, in parentheses. For example: +instead of cycling through the states, you can set up keys for single-letter +access to the states. This is done by adding the selection character after +each keyword, in parentheses@footnote{All characters are allowed except +@code{@@^!}, which have a special meaning here.}. For example: @lisp (setq org-todo-keywords @@ -4065,9 +4174,11 @@ time-stamped note for a change. These records will be inserted after the headline as an itemized list, newest first@footnote{See the variable @code{org-log-states-order-reversed}}. When taking a lot of notes, you might want to get the notes out of the way into a drawer (@pxref{Drawers}). -Customize the variable @code{org-log-into-drawer} to get this -behavior---the recommended drawer for this is called @code{LOGBOOK}. You can -also overrule the setting of this variable for a subtree by setting a +Customize the variable @code{org-log-into-drawer} to get this behavior---the +recommended drawer for this is called @code{LOGBOOK}@footnote{Note that the +@code{LOGBOOK} drawer is unfolded when pressing @key{SPC} in the agenda to +show an entry---use @key{C-u SPC} to keep it folded here}. You can also +overrule the setting of this variable for a subtree by setting a @code{LOG_INTO_DRAWER} property. Since it is normally too much to record a note for every state, Org mode @@ -4157,10 +4268,10 @@ The TODO may also have minimum and maximum ranges specified by using the syntax @samp{.+2d/3d}, which says that you want to do the task at least every three days, but at most every two days. @item -You must also have state logging for the @code{DONE} state enabled, in order -for historical data to be represented in the consistency graph. If it is not -enabled it is not an error, but the consistency graphs will be largely -meaningless. +You must also have state logging for the @code{DONE} state enabled +(@pxref{Tracking TODO state changes}), in order for historical data to be +represented in the consistency graph. If it is not enabled it is not an +error, but the consistency graphs will be largely meaningless. @end enumerate To give you an idea of what the above rules look like in action, here's an @@ -4872,8 +4983,8 @@ in the current file will be offered as possible completions. @orgcmd{C-c C-x p,org-set-property} Set a property. This prompts for a property name and a value. If necessary, the property drawer is created as well. -@item M-x org-insert-property-drawer -@findex org-insert-property-drawer +@item C-u M-x org-insert-drawer +@cindex org-insert-drawer Insert a property drawer into the current entry. The drawer will be inserted early in the entry, but after the lines with planning information like deadlines. @@ -4904,6 +5015,7 @@ column view (@pxref{Column view}), or to use them in queries. The following property names are special and (except for @code{:CATEGORY:}) should not be used as keys in the properties drawer: +@cindex property, special, ID @cindex property, special, TODO @cindex property, special, TAGS @cindex property, special, ALLTAGS @@ -4915,11 +5027,14 @@ used as keys in the properties drawer: @cindex property, special, TIMESTAMP @cindex property, special, TIMESTAMP_IA @cindex property, special, CLOCKSUM +@cindex property, special, CLOCKSUM_T @cindex property, special, BLOCKED @c guessing that ITEM is needed in this area; also, should this list be sorted? @cindex property, special, ITEM @cindex property, special, FILE @example +ID @r{A globally unique ID used for synchronization during} + @r{iCalendar or MobileOrg export.} TODO @r{The TODO keyword of the entry.} TAGS @r{The tags defined directly in the headline.} ALLTAGS @r{All tags, including inherited ones.} @@ -4932,8 +5047,11 @@ TIMESTAMP @r{The first keyword-less timestamp in the entry.} TIMESTAMP_IA @r{The first inactive timestamp in the entry.} CLOCKSUM @r{The sum of CLOCK intervals in the subtree. @code{org-clock-sum}} @r{must be run first to compute the values in the current buffer.} +CLOCKSUM_T @r{The sum of CLOCK intervals in the subtree for today.} + @r{@code{org-clock-sum-today} must be run first to compute the} + @r{values in the current buffer.} BLOCKED @r{"t" if task is currently blocked by children or siblings} -ITEM @r{The content of the entry.} +ITEM @r{The headline of the entry.} FILE @r{The filename the entry is located in.} @end example @@ -5149,7 +5267,7 @@ values. @example :COLUMNS: %25ITEM %9Approved(Approved?)@{X@} %Owner %11Status \@footnote{Please note that the COLUMNS definition must be on a single line---it is wrapped here only because of formatting constraints.} - %10Time_Estimate@{:@} %CLOCKSUM + %10Time_Estimate@{:@} %CLOCKSUM %CLOCKSUM_T :Owner_ALL: Tammy Mark Karl Lisa Don :Status_ALL: "In progress" "Not started yet" "Finished" "" :Approved_ALL: "[ ]" "[X]" @@ -5168,8 +5286,9 @@ modified title (@samp{Approved?}, with a question mark). Summaries will be created for the @samp{Time_Estimate} column by adding time duration expressions like HH:MM, and for the @samp{Approved} column, by providing an @samp{[X]} status if all children have been checked. The -@samp{CLOCKSUM} column is special, it lists the sum of CLOCK intervals -in the subtree. +@samp{CLOCKSUM} and @samp{CLOCKSUM_T} columns are special, they lists the +sums of CLOCK intervals in the subtree, either for all clocks or just for +today. @node Using column view, Capturing column view, Defining columns, Column view @subsection Using column view @@ -5370,8 +5489,10 @@ timeline and agenda displays, the headline of an entry associated with a plain timestamp will be shown exactly on that date. @example -* Meet Peter at the movies <2006-11-01 Wed 19:15> -* Discussion on climate change <2006-11-02 Thu 20:00-22:00> +* Meet Peter at the movies + <2006-11-01 Wed 19:15> +* Discussion on climate change + <2006-11-02 Thu 20:00-22:00> @end example @item Timestamp with repeater interval @@ -5382,7 +5503,8 @@ interval of N days (d), weeks (w), months (m), or years (y). The following will show up in the agenda every Wednesday: @example -* Pick up Sam at school <2007-05-16 Wed 12:30 +1w> +* Pick up Sam at school + <2007-05-16 Wed 12:30 +1w> @end example @item Diary-style sexp entries @@ -5426,7 +5548,8 @@ angular ones. These timestamps are inactive in the sense that they do @emph{not} trigger an entry to show up in the agenda. @example -* Gillian comes late for the fifth time [2006-11-01 Wed] +* Gillian comes late for the fifth time + [2006-11-01 Wed] @end example @end table @@ -5825,9 +5948,10 @@ or plain timestamp. In the following example @noindent the @code{+1m} is a repeater; the intended interpretation is that the task has a deadline on <2005-10-01> and repeats itself every (one) month starting -from that time. If you need both a repeater and a special warning period in -a deadline entry, the repeater should come first and the warning period last: -@code{DEADLINE: <2005-10-01 Sat +1m -3d>}. +from that time. You can use yearly, monthly, weekly, daily and hourly repeat +cookies by using the @code{y/w/m/d/h} letters. If you need both a repeater +and a special warning period in a deadline entry, the repeater should come +first and the warning period last: @code{DEADLINE: <2005-10-01 Sat +1m -3d>}. @vindex org-todo-repeat-to-state Deadlines and scheduled items produce entries in the agenda when they are @@ -5898,12 +6022,14 @@ created for this purpose, it is described in @ref{Structure editing}. @cindex time clocking Org mode allows you to clock the time you spend on specific tasks in a -project. When you start working on an item, you can start the clock. -When you stop working on that task, or when you mark the task done, the -clock is stopped and the corresponding time interval is recorded. It -also computes the total time spent on each subtree of a project. And it -remembers a history or tasks recently clocked, to that you can jump quickly -between a number of tasks absorbing your time. +project. When you start working on an item, you can start the clock. When +you stop working on that task, or when you mark the task done, the clock is +stopped and the corresponding time interval is recorded. It also computes +the total time spent on each subtree@footnote{Clocking only works if all +headings are indented with less than 30 stars. This is a hardcoded +limitation of `lmax' in `org-clock-sum'.} of a project. And it remembers a +history or tasks recently clocked, to that you can jump quickly between a +number of tasks absorbing your time. To save the clock history across Emacs sessions, use @lisp @@ -5928,6 +6054,7 @@ what to do with it. @table @kbd @orgcmd{C-c C-x C-i,org-clock-in} @vindex org-clock-into-drawer +@vindex org-clock-continuously @cindex property, LOG_INTO_DRAWER Start the clock on the current item (clock-in). This inserts the CLOCK keyword together with a timestamp. If this is not the first clocking of @@ -5938,9 +6065,10 @@ the setting of this variable for a subtree by setting a @code{CLOCK_INTO_DRAWER} or @code{LOG_INTO_DRAWER} property. When called with a @kbd{C-u} prefix argument, select the task from a list of recently clocked tasks. With two @kbd{C-u -C-u} prefixes, clock into the task at point and mark it as the default task. -The default task will always be available when selecting a clocking task, -with letter @kbd{d}.@* +C-u} prefixes, clock into the task at point and mark it as the default task; +the default task will then always be available with letter @kbd{d} when +selecting a clocking task. With three @kbd{C-u C-u C-u} prefixes, force +continuous clocking by starting the clock when the last clock stopped.@* @cindex property: CLOCK_MODELINE_TOTAL @cindex property: LAST_REPEAT @vindex org-clock-modeline-total @@ -5970,6 +6098,12 @@ HH:MM}. See the variable @code{org-log-note-clock-out} for the possibility to record an additional note together with the clock-out timestamp@footnote{The corresponding in-buffer setting is: @code{#+STARTUP: lognoteclock-out}}. +@orgcmd{C-c C-x C-x,org-clock-in-last} +@vindex org-clock-continuously +Reclock the last clocked task. With one @kbd{C-u} prefix argument, +select the task from the clock history. With two @kbd{C-u} prefixes, +force continuous clocking by starting the clock when the last clock +stopped. @orgcmd{C-c C-x C-e,org-clock-modify-effort-estimate} Update the effort estimate for the current clock task. @kindex C-c C-y @@ -5979,12 +6113,18 @@ Recompute the time interval after changing one of the timestamps. This is only necessary if you edit the timestamps directly. If you change them with @kbd{S-@key{cursor}} keys, the update is automatic. @orgcmd{C-S-@key{up/down},org-clock-timestamps-up/down} -On @code{CLOCK} log lines, increase/decrease both timestamps at the same -time so that duration keeps the same. +On @code{CLOCK} log lines, increase/decrease both timestamps so that the +clock duration keeps the same. +@orgcmd{S-M-@key{up/down},org-timestamp-up/down} +On @code{CLOCK} log lines, increase/decrease the timestamp at point and +the one of the previous (or the next clock) timestamp by the same duration. +For example, if you hit @kbd{S-M-@key{up}} to increase a clocked-out timestamp +by five minutes, then the clocked-in timestamp of the next clock will be +increased by five minutes. @orgcmd{C-c C-t,org-todo} Changing the TODO state of an item to DONE automatically stops the clock if it is running in this same item. -@orgcmd{C-c C-x C-x,org-clock-cancel} +@orgcmd{C-c C-x C-q,org-clock-cancel} Cancel the current clock. This is useful if a clock was started by mistake, or if you ended up working on something else. @orgcmd{C-c C-x C-j,org-clock-goto} @@ -6004,6 +6144,10 @@ The @kbd{l} key may be used in the timeline (@pxref{Timeline}) and in the agenda (@pxref{Weekly/daily agenda}) to show which tasks have been worked on or closed during a day. +@strong{Important:} note that both @code{org-clock-out} and +@code{org-clock-in-last} can have a global keybinding and will not +modify the window disposition. + @node The clock table, Resolving idle time, Clocking commands, Clocking work time @subsection The clock table @cindex clocktable, dynamic block @@ -6141,7 +6285,9 @@ would be @end example @node Resolving idle time, , The clock table, Clocking work time -@subsection Resolving idle time +@subsection Resolving idle time and continuous clocking + +@subsubheading Resolving idle time @cindex resolve idle time @cindex idle, resolve, dangling @@ -6156,12 +6302,12 @@ as 10 or 15, Emacs can alert you when you get back to your computer after being idle for that many minutes@footnote{On computers using Mac OS X, idleness is based on actual user idleness, not just Emacs' idle time. For X11, you can install a utility program @file{x11idle.c}, available in the -UTILITIES directory of the Org git distribution, to get the same general -treatment of idleness. On other systems, idle time refers to Emacs idle time -only.}, and ask what you want to do with the idle time. There will be a -question waiting for you when you get back, indicating how much idle time has -passed (constantly updated with the current amount), as well as a set of -choices to correct the discrepancy: +@code{contrib/scripts} directory of the Org git distribution, to get the same +general treatment of idleness. On other systems, idle time refers to Emacs +idle time only.}, and ask what you want to do with the idle time. There will +be a question waiting for you when you get back, indicating how much idle +time has passed (constantly updated with the current amount), as well as a +set of choices to correct the discrepancy: @table @kbd @item k @@ -6206,7 +6352,19 @@ identical to dealing with away time due to idleness; it is just happening due to a recovery event rather than a set amount of idle time. You can also check all the files visited by your Org agenda for dangling -clocks at any time using @kbd{M-x org-resolve-clocks}. +clocks at any time using @kbd{M-x org-resolve-clocks RET} (or @kbd{C-c C-x C-z}). + +@subsubheading Continuous clocking +@cindex continuous clocking +@vindex org-clock-continuously + +You may want to start clocking from the time when you clocked out the +previous task. To enable this systematically, set @code{org-clock-continuously} +to @code{t}. Each time you clock in, Org retrieves the clock-out time of the +last clocked entry for this session, and start the new clock from there. + +If you only want this from time to time, use three universal prefix arguments +with @code{org-clock-in} and two @kbd{C-u C-u} with @code{org-clock-in-last}. @node Effort estimates, Relative timer, Clocking work time, Dates and Times @section Effort estimates @@ -6436,6 +6594,15 @@ template in the usual way. Visit the last stored capture item in its buffer. @end table +@vindex org-capture-bookmark +@cindex org-capture-last-stored +You can also jump to the bookmark @code{org-capture-last-stored}, which will +automatically be created unless you set @code{org-capture-bookmark} to +@code{nil}. + +To insert the capture at point in an Org buffer, call @code{org-capture} with +a @code{C-0} prefix argument. + @node Capture templates, , Using capture, Capture @subsection Capture templates @cindex templates, for Capture @@ -6490,6 +6657,7 @@ like this: @menu * Template elements:: What is needed for a complete template entry * Template expansion:: Filling in information about time and context +* Templates in contexts:: Only show a template in a specific context @end menu @node Template elements, Template expansion, Capture templates, Capture templates @@ -6633,36 +6801,38 @@ buffer again after capture is completed. @end table @end table -@node Template expansion, , Template elements, Capture templates +@node Template expansion, Templates in contexts, Template elements, Capture templates @subsubsection Template expansion In the template itself, special @kbd{%}-escapes@footnote{If you need one of -these sequences literally, escape the @kbd{%} with a backslash.} allow +these sequences literally, escape the @kbd{%} with a backslash.} allow dynamic insertion of content. The templates are expanded in the order given here: @smallexample -%[@var{file}] @r{insert the contents of the file given by @var{file}.} -%(@var{sexp}) @r{evaluate Elisp @var{sexp} and replace with the result.} -%<...> @r{the result of format-time-string on the ... format specification.} -%t @r{timestamp, date only.} -%T @r{timestamp with date and time.} -%u, %U @r{like the above, but inactive timestamps.} -%a @r{annotation, normally the link created with @code{org-store-link}.} -%i @r{initial content, the region when capture is called while the} +%[@var{file}] @r{Insert the contents of the file given by @var{file}.} +%(@var{sexp}) @r{Evaluate Elisp @var{sexp} and replace with the result.} + @r{The sexp must return a string.} +%<...> @r{The result of format-time-string on the ... format specification.} +%t @r{Timestamp, date only.} +%T @r{Timestamp, with date and time.} +%u, %U @r{Like the above, but inactive timestamps.} +%i @r{Initial content, the region when capture is called while the} @r{region is active.} @r{The entire text will be indented like @code{%i} itself.} -%A @r{like @code{%a}, but prompt for the description part.} +%a @r{Annotation, normally the link created with @code{org-store-link}.} +%A @r{Like @code{%a}, but prompt for the description part.} +%l @r{Like %a, but only insert the literal link.} %c @r{Current kill ring head.} %x @r{Content of the X clipboard.} -%k @r{title of the currently clocked task.} -%K @r{link to the currently clocked task.} -%n @r{user name (taken from @code{user-full-name}).} -%f @r{file visited by current buffer when org-capture was called.} -%F @r{full path of the file or directory visited by current buffer.} -%:keyword @r{specific information for certain link types, see below.} -%^g @r{prompt for tags, with completion on tags in target file.} -%^G @r{prompt for tags, with completion all tags in all agenda files.} -%^t @r{like @code{%t}, but prompt for date. Similarly @code{%^T}, @code{%^u}, @code{%^U}.} +%k @r{Title of the currently clocked task.} +%K @r{Link to the currently clocked task.} +%n @r{User name (taken from @code{user-full-name}).} +%f @r{File visited by current buffer when org-capture was called.} +%F @r{Full path of the file or directory visited by current buffer.} +%:keyword @r{Specific information for certain link types, see below.} +%^g @r{Prompt for tags, with completion on tags in target file.} +%^G @r{Prompt for tags, with completion all tags in all agenda files.} +%^t @r{Like @code{%t}, but prompt for date. Similarly @code{%^T}, @code{%^u}, @code{%^U}.} @r{You may define a prompt like @code{%^@{Birthday@}t}.} %^C @r{Interactive selection of which kill or clip to use.} %^L @r{Like @code{%^C}, but insert as link.} @@ -6671,6 +6841,9 @@ dynamic insertion of content. The templates are expanded in the order given her @r{You may specify a default value and a completion table with} @r{%^@{prompt|default|completion2|completion3...@}.} @r{The arrow keys access a prompt-specific history.} +%\n @r{Insert the text entered at the nth %^@{@var{prompt}@}, where @code{n} is} + @r{a number, starting from 1.} +%? @r{After completing the template, position cursor here.} @end smallexample @noindent @@ -6682,21 +6855,21 @@ similar way.}: @vindex org-from-is-user-regexp @smallexample -Link type | Available keywords -------------------------+---------------------------------------------- -bbdb | %:name %:company -irc | %:server %:port %:nick -vm, wl, mh, mew, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:date @r{(message date header field)} - | %:date-timestamp @r{(date as active timestamp)} - | %:date-timestamp-inactive @r{(date as inactive timestamp)} - | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}} -gnus | %:group, @r{for messages also all email fields} -w3, w3m | %:url -info | %:file %:node -calendar | %:date +Link type | Available keywords +---------------------------------+---------------------------------------------- +bbdb | %:name %:company +irc | %:server %:port %:nick +vm, vm-imap, wl, mh, mew, rmail | %:type %:subject %:message-id + | %:from %:fromname %:fromaddress + | %:to %:toname %:toaddress + | %:date @r{(message date header field)} + | %:date-timestamp @r{(date as active timestamp)} + | %:date-timestamp-inactive @r{(date as inactive timestamp)} + | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}} +gnus | %:group, @r{for messages also all email fields} +w3, w3m | %:url +info | %:file %:node +calendar | %:date @end smallexample @noindent @@ -6706,6 +6879,29 @@ To place the cursor after template expansion use: %? @r{After completing the template, position cursor here.} @end smallexample +@node Templates in contexts, , Template expansion, Capture templates +@subsubsection Templates in contexts + +@vindex org-capture-templates-contexts +To control whether a capture template should be accessible from a specific +context, you can customize @var{org-capture-templates-contexts}. Let's say +for example that you have a capture template @code{"p"} for storing Gnus +emails containing patches. Then you would configure this option like this: + +@example +(setq org-capture-templates-contexts + '(("p" (in-mode . "message-mode")))) +@end example + +You can also tell that the command key @code{"p"} should refer to another +template. In that case, add this command key like this: + +@example +(setq org-capture-templates-contexts + '(("p" "q" (in-mode . "message-mode")))) +@end example + +See the docstring of the variable for more information. @node Attachments, RSS Feeds, Capture, Capture - Refile - Archive @section Attachments @@ -6947,16 +7143,20 @@ is invoked, the level 1 trees will be checked. @cindex archive locations The default archive location is a file in the same directory as the current file, with the name derived by appending @file{_archive} to the -current file name. For information and examples on how to change this, +current file name. You can also choose what heading to file archived +items under, with the possibility to add them to a datetree in a file. +For information and examples on how to specify the file and the heading, see the documentation string of the variable -@code{org-archive-location}. There is also an in-buffer option for -setting this variable, for example@footnote{For backward compatibility, -the following also works: If there are several such lines in a file, -each specifies the archive location for the text below it. The first -such line also applies to any text before its definition. However, -using this method is @emph{strongly} deprecated as it is incompatible -with the outline structure of the document. The correct method for -setting multiple archive locations in a buffer is using properties.}: +@code{org-archive-location}. + +There is also an in-buffer option for setting this variable, for +example@footnote{For backward compatibility, the following also works: +If there are several such lines in a file, each specifies the archive +location for the text below it. The first such line also applies to any +text before its definition. However, using this method is +@emph{strongly} deprecated as it is incompatible with the outline +structure of the document. The correct method for setting multiple +archive locations in a buffer is using properties.}: @cindex #+ARCHIVE @example @@ -7220,6 +7420,17 @@ the region. Otherwise, restrict it to the current subtree@footnote{For backward compatibility, you can also press @kbd{0} to restrict to the current region/subtree.}. After pressing @kbd{< <}, you still need to press the character selecting the command. + +@item * +@vindex org-agenda-sticky +Toggle sticky agenda views. By default, Org maintains only a single agenda +buffer and rebuilds it each time you change the view, to make sure everything +is always up to date. If you switch between views often and the build time +bothers you, you can turn on sticky agenda buffers (make this the default by +customizing the variable @code{org-agenda-sticky}). With sticky agendas, the +dispatcher only switches to the selected view, you need to update it by hand +with @kbd{r} or @kbd{g}. You can toggle sticky agenda view any time with +@code{org-toggle-sticky-agenda}. @end table You can also define custom commands that will be accessible through the @@ -7368,11 +7579,13 @@ in an Org or Diary file. @cindex appointment @cindex reminders -Org can interact with Emacs appointments notification facility. To add all -the appointments of your agenda files, use the command -@code{org-agenda-to-appt}. This command also lets you filter through the -list of your appointments and add only those belonging to a specific category -or matching a regular expression. See the docstring for details. +Org can interact with Emacs appointments notification facility. To add the +appointments of your agenda files, use the command @code{org-agenda-to-appt}. +This command lets you filter through the list of your appointments and add +only those belonging to a specific category or matching a regular expression. +It also reads a @code{APPT_WARNTIME} property which will then override the +value of @code{appt-message-warning-time} for this appointment. See the +docstring for details. @node Global TODO list, Matching tags and properties, Weekly/daily agenda, Built-in agenda views @subsection The global TODO list @@ -7511,6 +7724,9 @@ So a search @samp{+LEVEL=3+boss-TODO="DONE"} lists all level three headlines that have the tag @samp{boss} and are @emph{not} marked with the TODO keyword DONE. In buffers with @code{org-odd-levels-only} set, @samp{LEVEL} does not count the number of stars, but @samp{LEVEL=2} will correspond to 3 stars etc. +The ITEM special property cannot currently be used in tags/property +searches@footnote{But @pxref{x-agenda-skip-entry-regexp, +,skipping entries based on regexp}.}. Here are more examples: @table @samp @@ -8218,21 +8434,6 @@ Schedule this item. With prefix arg remove the scheduling timestamp @orgcmd{C-c C-d,org-agenda-deadline} Set a deadline for this item. With prefix arg remove the deadline. @c -@orgcmd{k,org-agenda-action} -Agenda actions, to set dates for selected items to the cursor date. -This command also works in the calendar! The command prompts for an -additional key: -@example -m @r{Mark the entry at point for action. You can also make entries} - @r{in Org files with @kbd{C-c C-x C-k}.} -d @r{Set the deadline of the marked entry to the date at point.} -s @r{Schedule the marked entry at the date at point.} -r @r{Call @code{org-capture} with the cursor date as default date.} -@end example -@noindent -Press @kbd{r} afterward to refresh the agenda and see the effect of the -command. -@c @orgcmd{S-@key{right},org-agenda-do-date-later} Change the timestamp associated with the current line by one day into the future. If the date is in the past, the first call to this command will move @@ -8265,9 +8466,18 @@ Cancel the currently running clock. @c @orgcmd{J,org-agenda-clock-goto} Jump to the running clock in another window. +@c +@orgcmd{k,org-agenda-capture} +Like @code{org-capture}, but use the date at point as the default date for +the capture template. See @var{org-capture-use-agenda-date} to make this +the default behavior of @code{org-capture}. +@cindex capturing, from agenda +@vindex org-capture-use-agenda-date @tsubheading{Bulk remote editing selected entries} @cindex remote editing, bulk, from agenda +@vindex org-agenda-bulk-persistent-marks +@vindex org-agenda-bulk-custom-functions @orgcmd{m,org-agenda-bulk-mark} Mark the entry at point for bulk action. With prefix arg, mark that many @@ -8286,10 +8496,12 @@ Unmark all marked entries for bulk action. Bulk action: act on all marked entries in the agenda. This will prompt for another key to select the action to be applied. The prefix arg to @kbd{B} will be passed through to the @kbd{s} and @kbd{d} commands, to bulk-remove -these special timestamps. +these special timestamps. By default, marks are removed after the bulk. If +you want them to persist, set @code{org-agenda-bulk-persistent-marks} to +@code{t} or hit @kbd{p} at the prompt. + @example -r @r{Prompt for a single refile target and move all entries. The entries} - @r{will no longer be in the agenda; refresh (@kbd{g}) to bring them back.} +* @r{Toggle persistent marks.} $ @r{Archive all selected entries.} A @r{Archive entries by moving them to their respective archive siblings.} t @r{Change TODO state. This prompts for a single TODO keyword and} @@ -8300,10 +8512,12 @@ t @r{Change TODO state. This prompts for a single TODO keyword and} s @r{Schedule all items to a new date. To shift existing schedule dates} @r{by a fixed number of days, use something starting with double plus} @r{at the prompt, for example @samp{++8d} or @samp{++2w}.} +d @r{Set deadline to a specific date.} +r @r{Prompt for a single refile target and move all entries. The entries} + @r{will no longer be in the agenda; refresh (@kbd{g}) to bring them back.} S @r{Reschedule randomly into the coming N days. N will be prompted for.} @r{With prefix arg (@kbd{C-u B S}), scatter only across weekdays.} -d @r{Set deadline to a specific date.} -f @r{Apply a function to marked entries.} +f @r{Apply a function@footnote{You can also create persistent custom functions through@code{org-agenda-bulk-custom-functions}.} to marked entries.} @r{For example, the function below sets the CATEGORY property of the} @r{entries to web.} @r{(defun set-category ()} @@ -8371,7 +8585,7 @@ Export a single iCalendar file containing entries from all agenda files. This is a globally available command, and also available in the agenda menu. @tsubheading{Exporting to a file} -@orgcmd{C-x C-w,org-write-agenda} +@orgcmd{C-x C-w,org-agenda-write} @cindex exporting agenda views @cindex agenda views, exporting @vindex org-agenda-exporter-settings @@ -8420,11 +8634,12 @@ buffer, or a sparse tree (the latter covering of course only the current buffer). @kindex C-c a C @vindex org-agenda-custom-commands + Custom commands are configured in the variable @code{org-agenda-custom-commands}. You can customize this variable, for -example by pressing @kbd{C-c a C}. You can also directly set it with -Emacs Lisp in @file{.emacs}. The following example contains all valid -search types: +example by pressing @kbd{C-c a C}. You can also directly set it with Emacs +Lisp in @file{.emacs}. The following example contains all valid search +types: @lisp @group @@ -8584,6 +8799,27 @@ this interface, the @emph{values} are just Lisp expressions. So if the value is a string, you need to add the double-quotes around the value yourself. +@vindex org-agenda-custom-commands-contexts +To control whether an agenda command should be accessible from a specific +context, you can customize @var{org-agenda-custom-commands-contexts}. Let's +say for example that you have an agenda commands @code{"o"} displaying a view +that you only need when reading emails. Then you would configure this option +like this: + +@example +(setq org-agenda-custom-commands-contexts + '(("o" (in-mode . "message-mode")))) +@end example + +You can also tell that the command key @code{"o"} should refer to another +command key @code{"r"}. In that case, add this command key like this: + +@example +(setq org-agenda-custom-commands-contexts + '(("o" "r" (in-mode . "message-mode")))) +@end example + +See the docstring of the variable for more information. @node Exporting Agenda Views, Agenda column view, Custom agenda views, Agenda Views @section Exporting Agenda Views @@ -8598,7 +8834,7 @@ a PDF file will also create the postscript file.}, and iCalendar files. If you want to do this only occasionally, use the command @table @kbd -@orgcmd{C-x C-w,org-write-agenda} +@orgcmd{C-x C-w,org-agenda-write} @cindex exporting agenda views @cindex agenda views, exporting @vindex org-agenda-exporter-settings @@ -8777,6 +9013,14 @@ a column listing the planned total effort for a task---one of the major applications for column view in the agenda. If you want information about clocked time in the displayed period use clock table mode (press @kbd{R} in the agenda). + +@item +@cindex property, special, CLOCKSUM_T +When the column view in the agenda shows the @code{CLOCKSUM_T}, that is +always today's clocked time for this item. So even in the weekly agenda, +the clocksum listed in column view only originates from today. This lets +you compare the time you spent on a task for today, with the time already +spent (via @code{CLOCKSUM}) and with the planned total effort for it. @end enumerate @@ -8988,11 +9232,11 @@ a horizontal line (@samp{<hr/>} in HTML and @code{\hrule} in @LaTeX{}). @cindex exporting, not @cindex #+BEGIN_COMMENT -Lines starting with @samp{#} in column zero are treated as comments and will -never be exported. If you want an indented line to be treated as a comment, -start it with @samp{#+ }. Also entire subtrees starting with the word -@samp{COMMENT} will never be exported. Finally, regions surrounded by -@samp{#+BEGIN_COMMENT} ... @samp{#+END_COMMENT} will not be exported. +Lines starting with zero or more whitespace characters followed by @samp{#} +are treated as comments and will never be exported. Also entire subtrees +starting with the word @samp{COMMENT} will never be exported. Finally, +regions surrounded by @samp{#+BEGIN_COMMENT} ... @samp{#+END_COMMENT} will +not be exported. @table @kbd @kindex C-c ; @@ -9016,7 +9260,7 @@ the object with @code{\ref@{tab:basic-data@}}: @example #+CAPTION: This is the caption for the next table (or link) -#+LABEL: tbl:basic-data +#+LABEL: tab:basic-data | ... | ...| |-----|----| @end example @@ -9080,23 +9324,14 @@ look like the fontified Emacs buffer@footnote{This works automatically for the HTML backend (it requires version 1.34 of the @file{htmlize.el} package, which is distributed with Org). Fontified code chunks in @LaTeX{} can be achieved using either the listings or the -@url{http://code.google.com/p/minted, minted,} package. To use listings, turn -on the variable @code{org-export-latex-listings} and ensure that the listings -package is included by the @LaTeX{} header (e.g.@: by configuring -@code{org-export-latex-packages-alist}). See the listings documentation for -configuration options, including obtaining colored output. For minted it is -necessary to install the program @url{http://pygments.org, pygments}, in -addition to setting @code{org-export-latex-minted}, ensuring that the minted -package is included by the @LaTeX{} header, and ensuring that the -@code{-shell-escape} option is passed to @file{pdflatex} (see -@code{org-latex-to-pdf-process}). See the documentation of the variables -@code{org-export-latex-listings} and @code{org-export-latex-minted} for -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.}, see @ref{Easy Templates} for -shortcuts to easily insert code blocks. +@url{http://code.google.com/p/minted, minted,} package. Refer to +@code{org-export-latex-listings} documentation for 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.}, see @ref{Easy Templates} for shortcuts to easily insert code +blocks. @cindex #+BEGIN_SRC @example @@ -9276,7 +9511,7 @@ readily processed to produce pretty output for a number of export backends. @menu * Special symbols:: Greek letters and other symbols * Subscripts and superscripts:: Simple syntax for raising/lowering text -* @LaTeX{} fragments:: Complex formulas made easy +* @LaTeX{} fragments:: Complex formulas made easy * Previewing @LaTeX{} fragments:: What will this snippet look like? * CDLaTeX mode:: Speed up entering of formulas @end menu @@ -9382,10 +9617,11 @@ this regularly or on pages with significant page views, you should install server in order to limit the load of our server.}. Finally, it can also process the mathematical expressions into images@footnote{For this to work you need to be on a system with a working @LaTeX{} installation. You also -need the @file{dvipng} program, available at -@url{http://sourceforge.net/projects/dvipng/}. The @LaTeX{} header that will -be used when processing a fragment can be configured with the variable -@code{org-format-latex-header}.} that can be displayed in a browser or in +need the @file{dvipng} program or the @file{convert}, respectively available +at @url{http://sourceforge.net/projects/dvipng/} and from the +@file{imagemagick} suite. The @LaTeX{} header that will be used when +processing a fragment can be configured with the variable +@code{org-format-latex-header}.} that can be displayed in a browser or in DocBook documents. @LaTeX{} fragments don't need any special marking at all. The following @@ -9630,7 +9866,7 @@ Insert template with export options, see example below. @cindex #+EXPORT_SELECT_TAGS @cindex #+EXPORT_EXCLUDE_TAGS @cindex #+XSLT -@cindex #+LATEX_HEADER +@cindex #+LaTeX_HEADER @vindex user-full-name @vindex user-mail-address @vindex org-export-default-language @@ -9650,7 +9886,7 @@ Insert template with export options, see example below. @r{You need to confirm using these, or configure @code{org-export-allow-BIND}} #+LINK_UP: the ``up'' link of an exported page #+LINK_HOME: the ``home'' link of an exported page -#+LATEX_HEADER: extra line(s) for the @LaTeX{} header, like \usepackage@{xyz@} +#+LaTeX_HEADER: extra line(s) for the @LaTeX{} header, like \usepackage@{xyz@} #+EXPORT_SELECT_TAGS: Tags that select a tree for export #+EXPORT_EXCLUDE_TAGS: Tags that exclude a tree from export #+XSLT: the XSLT stylesheet used by DocBook exporter to generate FO file @@ -9707,7 +9943,7 @@ author: @r{turn on/off inclusion of author name/email into exported file} email: @r{turn on/off inclusion of author email into exported file} creator: @r{turn on/off inclusion of creator info into exported file} timestamp: @r{turn on/off inclusion creation time into exported file} -d: @r{turn on/off inclusion of drawers} +d: @r{turn on/off inclusion of drawers, or list drawers to include} @end example @noindent These options take effect in both the HTML and @LaTeX{} export, except for @@ -9770,7 +10006,7 @@ with special characters and symbols available in these encodings. @table @kbd @orgcmd{C-c C-e a,org-export-as-ascii} @cindex property, EXPORT_FILE_NAME -Export as ASCII file. For an Org file, @file{myfile.org}, the ASCII file +Export as an ASCII file. For an Org file, @file{myfile.org}, the ASCII file will be @file{myfile.txt}. The file will be overwritten without warning. If there is an active region@footnote{This requires @code{transient-mark-mode} be turned on.}, only the region will be @@ -9802,13 +10038,13 @@ at a different level, specify it with a prefix argument. For example, @end example @noindent -creates only top level headlines and does the rest as items. When +creates only top level headlines and exports the rest as items. When headlines are converted to items, the indentation of the text following the headline is changed to fit nicely under the item. This is done with the assumption that the first body line indicates the base indentation of the body text. Any indentation larger than this is adjusted to preserve the layout relative to the first line. Should there be lines with less -indentation than the first, these are left alone. +indentation than the first one, these are left alone. @vindex org-export-ascii-links-to-notes Links will be exported in a footnote-like style, with the descriptive part in @@ -9819,7 +10055,7 @@ the text and the link in a note before the next heading. See the variable @section HTML export @cindex HTML export -Org mode contains an HTML (XHTML 1.0 strict) exporter with extensive +Org mode contains a HTML (XHTML 1.0 strict) exporter with extensive HTML formatting, in ways similar to John Gruber's @emph{markdown} language, but with additional support for tables. @@ -9845,7 +10081,7 @@ language, but with additional support for tables. @table @kbd @orgcmd{C-c C-e h,org-export-as-html} @cindex property, EXPORT_FILE_NAME -Export as HTML file. For an Org file @file{myfile.org}, +Export as a HTML file. For an Org file @file{myfile.org}, the HTML file will be @file{myfile.html}. The file will be overwritten without warning. If there is an active region@footnote{This requires @code{transient-mark-mode} be turned on.}, only the region will be @@ -9854,7 +10090,7 @@ current subtree, use @kbd{C-c @@}.}, the tree head will become the document title. If the tree head entry has, or inherits, an @code{EXPORT_FILE_NAME} property, that name will be used for the export. @orgcmd{C-c C-e b,org-export-as-html-and-open} -Export as HTML file and immediately open it with a browser. +Export as a HTML file and immediately open it with a browser. @orgcmd{C-c C-e H,org-export-as-html-to-buffer} Export to a temporary buffer. Do not create a file. @orgcmd{C-c C-e R,org-export-region-as-html} @@ -9864,7 +10100,7 @@ the region. This is good for cut-and-paste operations. @item C-c C-e v h/b/H/R Export only the visible part of the document. @item M-x org-export-region-as-html -Convert the region to HTML under the assumption that it was Org mode +Convert the region to HTML under the assumption that it was in Org mode syntax before. This is a global command that can be invoked in any buffer. @item M-x org-replace-region-by-HTML @@ -9901,11 +10137,11 @@ creates two levels of headings and does the rest as items. The HTML exporter lets you define a preamble and a postamble. The default value for @code{org-export-html-preamble} is @code{t}, which -means that the preamble is inserted depending on the relevant formatting -string in @code{org-export-html-preamble-format}. +means that the preamble is inserted depending on the relevant format string +in @code{org-export-html-preamble-format}. Setting @code{org-export-html-preamble} to a string will override the default -formatting string. Setting it to a function, will insert the output of the +format string. Setting it to a function, will insert the output of the function, which must be a string; such a function takes no argument but you can check against the value of @code{opt-plist}, which contains the list of publishing properties for the current file. Setting to @code{nil} will not @@ -9917,7 +10153,7 @@ means that the HTML exporter will look for the value of @code{org-export-creator-info} and @code{org-export-time-stamp-file}, @code{org-export-html-validation-link} and build the postamble from these values. Setting @code{org-export-html-postamble} to @code{t} will insert the -postamble from the relevant formatting string found in +postamble from the relevant format string found in @code{org-export-html-postamble-format}. Setting it to @code{nil} will not insert any postamble. @@ -9958,7 +10194,7 @@ includes automatic links created by radio targets (@pxref{Radio targets}). Links to external files will still work if the target file is on the same @i{relative} path as the published Org file. Links to other @file{.org} files will be translated into HTML links under the assumption -that an HTML version also exists of the linked file, at the same relative +that a HTML version also exists of the linked file, at the same relative path. @samp{id:} links can then be used to jump to specific entries across files. For information related to linking files while publishing them to a publishing directory see @ref{Publishing links}. @@ -10199,7 +10435,7 @@ viewing options: path: @r{The path to the script. The default is to grab the script from} @r{@url{http://orgmode.org/org-info.js}, but you might want to have} @r{a local copy and use a path like @samp{../scripts/org-info.js}.} -view: @r{Initial view when website is first shown. Possible values are:} +view: @r{Initial view when the website is first shown. Possible values are:} info @r{Info-like interface with one section per page.} overview @r{Folding interface, initially showing only top-level.} content @r{Folding interface, starting with all headlines visible.} @@ -10265,7 +10501,7 @@ sections. @table @kbd @orgcmd{C-c C-e l,org-export-as-latex} @cindex property EXPORT_FILE_NAME -Export as @LaTeX{} file. For an Org file +Export as a @LaTeX{} file. For an Org file @file{myfile.org}, the @LaTeX{} file will be @file{myfile.tex}. The file will be overwritten without warning. If there is an active region@footnote{This requires @code{transient-mark-mode} be turned on.}, only the region will be @@ -10278,7 +10514,7 @@ Export to a temporary buffer. Do not create a file. @item C-c C-e v l/L Export only the visible part of the document. @item M-x org-export-region-as-latex -Convert the region to @LaTeX{} under the assumption that it was Org mode +Convert the region to @LaTeX{} under the assumption that it was in Org mode syntax before. This is a global command that can be invoked in any buffer. @item M-x org-replace-region-by-latex @@ -10322,11 +10558,11 @@ By default, the @LaTeX{} output uses the class @code{article}. @vindex org-export-latex-classes @vindex org-export-latex-default-packages-alist @vindex org-export-latex-packages-alist -@cindex #+LATEX_HEADER -@cindex #+LATEX_CLASS -@cindex #+LATEX_CLASS_OPTIONS -@cindex property, LATEX_CLASS -@cindex property, LATEX_CLASS_OPTIONS +@cindex #+LaTeX_HEADER +@cindex #+LaTeX_CLASS +@cindex #+LaTeX_CLASS_OPTIONS +@cindex property, LaTeX_CLASS +@cindex property, LaTeX_CLASS_OPTIONS You can change this globally by setting a different value for @code{org-export-latex-default-class} or locally by adding an option like @code{#+LaTeX_CLASS: myclass} in your file, or with a @code{:LaTeX_CLASS:} @@ -10336,11 +10572,22 @@ defines a header template for each class@footnote{Into which the values of @code{org-export-latex-default-packages-alist} and @code{org-export-latex-packages-alist} are spliced.}, and allows you to define the sectioning structure for each class. You can also define your own -classes there. @code{#+LaTeX_CLASS_OPTIONS} or a @code{LaTeX_CLASS_OPTIONS} -property can specify the options for the @code{\documentclass} macro. You -can also use @code{#+LATEX_HEADER: \usepackage@{xyz@}} to add lines to the -header. See the docstring of @code{org-export-latex-classes} for more -information. +classes there. @code{#+LaTeX_CLASS_OPTIONS} or a @code{:LaTeX_CLASS_OPTIONS:} +property can specify the options for the @code{\documentclass} macro. The +options to documentclass have to be provided, as expected by @LaTeX{}, within +square brackets. You can also use @code{#+LaTeX_HEADER: \usepackage@{xyz@}} +to add lines to the header. See the docstring of +@code{org-export-latex-classes} for more information. An example is shown +below. + +@example +#+LaTeX_CLASS: article +#+LaTeX_CLASS_OPTIONS: [a4paper] +#+LaTeX_HEADER: \usepackage@{xyz@} + +* Headline 1 + some text +@end example @node Quoting @LaTeX{} code, Tables in @LaTeX{} export, Header and sectioning, @LaTeX{} and PDF export @subsection Quoting @LaTeX{} code @@ -10424,9 +10671,7 @@ add something like @samp{placement=[h!]} to the attributes. It is to be noted this option can be used with tables as well@footnote{One can also take advantage of this option to pass other, unrelated options into the figure or table environment. For an example see the section ``Exporting org files'' in -@url{http://orgmode.org/worg/org-hacks.html}}. For example the -@code{#+ATTR_LaTeX:} line below is exported as the @code{figure} environment -below it. +@url{http://orgmode.org/worg/org-hacks.html}}. If you would like to let text flow around the image, add the word @samp{wrap} to the @code{#+ATTR_LaTeX:} line, which will make the figure occupy the left @@ -10513,7 +10758,7 @@ transitions. Frames will automatically receive a @code{fragile} option if they contain source code that uses the verbatim environment. Special @file{beamer} specific code can be inserted using @code{#+BEAMER:} and -@code{#+BEGIN_beamer...#+end_beamer} constructs, similar to other export +@code{#+BEGIN_BEAMER...#+END_BEAMER} constructs, similar to other export backends, but with the difference that @code{#+LaTeX:} stuff will be included in the presentation as well. @@ -10613,7 +10858,7 @@ Currently DocBook exporter only supports DocBook V5.0. @table @kbd @orgcmd{C-c C-e D,org-export-as-docbook} @cindex property EXPORT_FILE_NAME -Export as DocBook file. For an Org file, @file{myfile.org}, the DocBook XML +Export as a DocBook file. For an Org file, @file{myfile.org}, the DocBook XML file will be @file{myfile.xml}. The file will be overwritten without warning. If there is an active region@footnote{This requires @code{transient-mark-mode} to be turned on}, only the region will be @@ -10622,12 +10867,12 @@ current subtree, use @kbd{C-c @@}.}, the tree head will become the document title. If the tree head entry has, or inherits, an @code{EXPORT_FILE_NAME} property, that name will be used for the export. @orgcmd{C-c C-e V,org-export-as-docbook-pdf-and-open} -Export as DocBook file, process to PDF, then open the resulting PDF file. +Export as a DocBook file, process to PDF, then open the resulting PDF file. @vindex org-export-docbook-xslt-proc-command @vindex org-export-docbook-xsl-fo-proc-command -Note that, in order to produce PDF output based on exported DocBook file, you -need to have XSLT processor and XSL-FO processor software installed on your +Note that, in order to produce PDF output based on an exported DocBook file, +you need to have XSLT processor and XSL-FO processor software installed on your system. Check variables @code{org-export-docbook-xslt-proc-command} and @code{org-export-docbook-xsl-fo-proc-command}. @@ -10791,7 +11036,7 @@ special characters included in XHTML entities: @cindex org-odt.el @cindex org-modules -Orgmode@footnote{Versions 7.8 or later} supports export to OpenDocument Text +Org Mode@footnote{Versions 7.8 or later} supports export to OpenDocument Text (ODT) format using the @file{org-odt.el} module. Documents created by this exporter use the @cite{OpenDocument-v1.2 specification}@footnote{@url{http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html, @@ -10848,7 +11093,7 @@ inherits, an @code{EXPORT_FILE_NAME} property, that name will be used for the export. @orgcmd{C-c C-e O,org-export-as-odt-and-open} -Export as OpenDocument Text file and open the resulting file. +Export as an OpenDocument Text file and open the resulting file. @vindex org-export-odt-preferred-output-format If @code{org-export-odt-preferred-output-format} is specified, open the @@ -11180,11 +11425,11 @@ the @LaTeX{}-to-MathML converter. @table @kbd @item M-x org-export-as-odf -Convert a @LaTeX{} math snippet to OpenDocument formula (@file{.odf}) file. +Convert a @LaTeX{} math snippet to an OpenDocument formula (@file{.odf}) file. @item M-x org-export-as-odf-and-open -Convert a @LaTeX{} math snippet to OpenDocument formula (@file{.odf}) file and -open the formula file with the system-registered application. +Convert a @LaTeX{} math snippet to an OpenDocument formula (@file{.odf}) file +and open the formula file with the system-registered application. @end table @cindex dvipng @@ -11720,10 +11965,10 @@ all the nodes. @table @kbd @orgcmd{C-c C-e j,org-export-as-taskjuggler} -Export as TaskJuggler file. +Export as a TaskJuggler file. @orgcmd{C-c C-e J,org-export-as-taskjuggler-and-open} -Export as TaskJuggler file and then open the file with TaskJugglerUI. +Export as a TaskJuggler file and then open the file with TaskJugglerUI. @end table @subsection Tasks @@ -11833,7 +12078,7 @@ The Freemind exporter was written by Lennart Borgman. @table @kbd @orgcmd{C-c C-e m,org-export-as-freemind} -Export as Freemind mind map. For an Org file @file{myfile.org}, the Freemind +Export as a Freemind mind map. For an Org file @file{myfile.org}, the Freemind file will be @file{myfile.mm}. @end table @@ -11847,7 +12092,7 @@ does not interpret any additional Org mode features. @table @kbd @orgcmd{C-c C-e x,org-export-as-xoxo} -Export as XOXO file. For an Org file @file{myfile.org}, the XOXO file will be +Export as an XOXO file. For an Org file @file{myfile.org}, the XOXO file will be @file{myfile.html}. @orgkey{C-c C-e v x} Export only the visible part of the document. @@ -12318,7 +12563,7 @@ publish it as @file{theindex.html}. @end multitable The file will be created when first publishing a project with the -@code{:makeindex} set. The file only contains a statement @code{#+include: +@code{:makeindex} set. The file only contains a statement @code{#+INCLUDE: "theindex.inc"}. You can then build around this include statement by adding a title, style information, etc. @@ -12352,7 +12597,7 @@ Publishing to a local directory is also much faster than to a remote one, so that you can afford more easily to republish entire projects. If you set @code{org-publish-use-timestamps-flag} to @code{nil}, you gain the main benefit of re-including any changed external files such as source example -files you might include with @code{#+INCLUDE}. The timestamp mechanism in +files you might include with @code{#+INCLUDE:}. The timestamp mechanism in Org is not smart enough to detect if included files have been modified. @node Sample configuration, Triggering publication, Uploading files, Publishing @@ -12709,7 +12954,7 @@ and/or the name of the evaluated code block. The default value of @code{org-babel-results-keyword}. By default, the evaluation facility is only enabled for Lisp code blocks -specified as @code{emacs-lisp}. However, source code blocks in many languages +specified as @code{emacs-lisp}. However, source code blocks in many languages can be evaluated within Org mode (see @ref{Languages} for a list of supported languages and @ref{Structure of code blocks} for information on the syntax used to define a code block). @@ -12723,8 +12968,8 @@ evaluation from the @kbd{C-c C-c} key binding.}. This will call the its results into the Org mode buffer. @cindex #+CALL -It is also possible to evaluate named code blocks from anywhere in an -Org mode buffer or an Org mode table. Live code blocks located in the current +It is also possible to evaluate named code blocks from anywhere in an Org +mode buffer or an Org mode table. Live code blocks located in the current Org mode buffer or in the ``Library of Babel'' (see @ref{Library of Babel}) can be executed. Named code blocks can be executed with a separate @code{#+CALL:} line or inline within a block of text. @@ -12826,7 +13071,7 @@ Code blocks in the following languages are supported. Language-specific documentation is available for some languages. If available, it can be found at -@uref{http://orgmode.org/worg/org-contrib/babel/languages}. +@uref{http://orgmode.org/worg/org-contrib/babel/languages.html}. The @code{org-babel-load-languages} controls which languages are enabled for evaluation (by default only @code{emacs-lisp} is enabled). This variable can @@ -13018,7 +13263,7 @@ Multi-line header arguments on an un-named code block: (message "data1:%S, data2:%S" data1 data2) #+END_SRC - #+results: + #+RESULTS: : data1:1, data2:2 @end example @@ -13030,7 +13275,7 @@ Multi-line header arguments on a named code block: (message "data:%S" data) #+END_SRC - #+results: named-block + #+RESULTS: named-block : data:2 @end example @@ -13065,6 +13310,7 @@ argument in lowercase letters. The following header arguments are defined: * results:: Specify the type of results and how they will be collected and handled * file:: Specify a path for file output +* file-desc:: Specify a description for file results * dir:: Specify the default (possibly remote) directory for code block execution * exports:: Export code and/or results @@ -13088,6 +13334,7 @@ argument in lowercase letters. The following header arguments are defined: * rownames:: Handle row names in tables * shebang:: Make tangled files executable * eval:: Limit evaluation of specific code blocks +* wrap:: Mark source block evaluation results @end menu Additional header arguments are defined on a language-specific basis, see @@ -13102,7 +13349,7 @@ syntax used to specify arguments is the same across all languages. In every case, variables require a default value when they are declared. The values passed to arguments can either be literal values, references, or -Emacs Lisp code (see @ref{var, Emacs Lisp evaluation of variables}). References +Emacs Lisp code (see @ref{var, Emacs Lisp evaluation of variables}). References include anything in the Org mode file that takes a @code{#+NAME:}, @code{#+TBLNAME:}, or @code{#+RESULTS:} line. This includes tables, lists, @code{#+BEGIN_EXAMPLE} blocks, other code blocks, and the results of other @@ -13141,7 +13388,7 @@ an Org mode table named with either a @code{#+NAME:} or @code{#+TBLNAME:} line (length table) #+END_SRC -#+results: table-length +#+RESULTS: table-length : 4 @end example @@ -13160,7 +13407,7 @@ carried through to the source code block) (print x) #+END_SRC -#+results: +#+RESULTS: | simple | list | @end example @@ -13173,7 +13420,7 @@ optionally followed by parentheses (* 2 length) #+END_SRC -#+results: +#+RESULTS: : 8 @end example @@ -13188,7 +13435,7 @@ code block name using standard function call syntax (* 2 input) #+END_SRC -#+results: double +#+RESULTS: double : 16 #+NAME: squared @@ -13196,7 +13443,7 @@ code block name using standard function call syntax (* input input) #+END_SRC -#+results: squared +#+RESULTS: squared : 4 @end example @@ -13215,7 +13462,7 @@ on two lines (concatenate 'string x " for you.") #+END_SRC -#+results: read-literal-example +#+RESULTS: read-literal-example : A literal example : on two lines for you. @@ -13257,7 +13504,7 @@ following example assigns the last cell of the first row the table data #+END_SRC -#+results: +#+RESULTS: : a @end example @@ -13278,7 +13525,7 @@ to @code{data}. data #+END_SRC -#+results: +#+RESULTS: | 2 | b | | 3 | c | | 4 | d | @@ -13300,7 +13547,7 @@ column is referenced. data #+END_SRC -#+results: +#+RESULTS: | 1 | 2 | 3 | 4 | @end example @@ -13320,7 +13567,7 @@ another by commas, as shown in the following example. data #+END_SRC -#+results: +#+RESULTS: | 11 | 14 | 17 | @end example @@ -13353,7 +13600,7 @@ Emacs Lisp, as shown in the following example. $data #+END_SRC -#+results: +#+RESULTS: : (a b c) @end example @@ -13414,15 +13661,19 @@ buffer as quoted text. E.g., @code{:results value verbatim}. @item @code{file} The results will be interpreted as the path to a file, and will be inserted into the Org mode buffer as a file link. E.g., @code{:results value file}. -@item @code{raw}, @code{org} +@item @code{raw} The results are interpreted as raw Org mode code and are inserted directly into the buffer. If the results look like a table they will be aligned as such by Org mode. E.g., @code{:results value raw}. +@item @code{org} +The results are will be enclosed in a @code{BEGIN_SRC org} block. +They are not comma-escaped by default but they will be if you hit @kbd{TAB} +in the block and/or if you export the file. E.g., @code{:results value org}. @item @code{html} -Results are assumed to be HTML and will be enclosed in a @code{begin_html} +Results are assumed to be HTML and will be enclosed in a @code{BEGIN_HTML} block. E.g., @code{:results value html}. @item @code{latex} -Results assumed to be @LaTeX{} and are enclosed in a @code{begin_latex} block. +Results assumed to be @LaTeX{} and are enclosed in a @code{BEGIN_LaTeX} block. E.g., @code{:results value latex}. @item @code{code} Result are assumed to be parsable code and are enclosed in a code block. @@ -13431,7 +13682,7 @@ E.g., @code{:results value code}. The result is converted to pretty-printed code and is enclosed in a code block. This option currently supports Emacs Lisp, Python, and Ruby. E.g., @code{:results value pp}. -@item @code{wrap} +@item @code{drawer} The result is wrapped in a RESULTS drawer. This can be useful for inserting @code{raw} or @code{org} syntax results in such a way that their extent is known and they can be automatically removed or replaced. @@ -13459,7 +13710,7 @@ be prepended to the existing results. Otherwise the new results will be inserted as with @code{replace}. @end itemize -@node file, dir, results, Specific header arguments +@node file, file-desc, results, Specific header arguments @subsubsection @code{:file} The header argument @code{:file} is used to specify an external file in which @@ -13475,7 +13726,16 @@ The argument to @code{:file} should be either a string specifying the path to a file, or a list of two strings in which case the first element of the list should be the path to a file and the second a description for the link. -@node dir, exports, file, Specific header arguments +@node file-desc, dir, file, Specific header arguments +@subsubsection @code{:file-desc} + +The value of the @code{:file-desc} header argument is used to provide a +description for file code block results which are inserted as Org mode links +(see @ref{Link format}). If the @code{:file-desc} header argument is given +with no value the link path will be placed in both the ``link'' and the +``description'' portion of the Org mode link. + +@node dir, exports, file-desc, Specific header arguments @subsubsection @code{:dir} and remote execution While the @code{:file} header argument can be used to specify the path to the @@ -13655,21 +13915,34 @@ interpreted language. @node noweb, noweb-ref, session, Specific header arguments @subsubsection @code{:noweb} -The @code{:noweb} header argument controls expansion of ``noweb'' style (see -@ref{Noweb reference syntax}) references in a code block. This header -argument can have one of three values: @code{yes}, @code{no}, or @code{tangle}. +The @code{:noweb} header argument controls expansion of ``noweb'' syntax +references (see @ref{Noweb reference syntax}) when the code block is +evaluated, tangled, or exported. The @code{:noweb} header argument can have +one of the five values: @code{no}, @code{yes}, @code{tangle}, or +@code{no-export} @code{strip-export}. @itemize @bullet -@item @code{yes} -All ``noweb'' syntax references in the body of the code block will be -expanded before the block is evaluated, tangled or exported. @item @code{no} -The default. No ``noweb'' syntax specific action is taken when the code -block is evaluated, tangled or exported. +The default. ``Noweb'' syntax references in the body of the code block will +not be expanded before the code block is evaluated, tangled or exported. +@item @code{yes} +``Noweb'' syntax references in the body of the code block will be +expanded before the code block is evaluated, tangled or exported. @item @code{tangle} -All ``noweb'' syntax references in the body of the code block will be -expanded before the block is tangled, however ``noweb'' references will not -be expanded when the block is evaluated or exported. +``Noweb'' syntax references in the body of the code block will be expanded +before the code block is tangled. However, ``noweb'' syntax references will +not be expanded when the code block is evaluated or exported. +@item @code{no-export} +``Noweb'' syntax references in the body of the code block will be expanded +before the block is evaluated or tangled. However, ``noweb'' syntax +references will not be expanded when the code block is exported. +@item @code{strip-export} +``Noweb'' syntax references in the body of the code block will be expanded +before the block is evaluated or tangled. However, ``noweb'' syntax +references will not be removed when the code block is exported. +@item @code{eval} +``Noweb'' syntax references in the body of the code block will only be +expanded before the block is evaluated. @end itemize @subsubheading Noweb prefix lines @@ -13760,7 +14033,7 @@ the results of evaluating code blocks. It can be used to avoid re-evaluating unchanged code blocks. Note that the @code{:cache} header argument will not attempt to cache results when the @code{:session} header argument is used, because the results of the code block execution may be stored in the session -outside of the Org-mode buffer. The @code{:cache} header argument can have +outside of the Org mode buffer. The @code{:cache} header argument can have one of two values: @code{yes} or @code{no}. @itemize @bullet @@ -13770,7 +14043,7 @@ every time it is called. @item @code{yes} Every time the code block is run a SHA1 hash of the code and arguments passed to the block will be generated. This hash is packed into the -@code{#+results:} line and will be checked on subsequent +@code{#+RESULTS:} line and will be checked on subsequent executions of the code block. If the code block has not changed since the last time it was evaluated, it will not be re-evaluated. @end itemize @@ -13787,7 +14060,7 @@ changed since it was last run. runif(1) #+END_SRC - #+results[a2a72cd647ad44515fab62e144796432793d68e1]: random + #+RESULTS[a2a72cd647ad44515fab62e144796432793d68e1]: random 0.4659510825295 #+NAME: caller @@ -13795,7 +14068,7 @@ changed since it was last run. x #+END_SRC - #+results[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller + #+RESULTS[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller 0.254227238707244 @end example @@ -13839,7 +14112,7 @@ default value yields the following results. return tab #+END_SRC -#+results: echo-table +#+RESULTS: echo-table | a | b | c | | d | e | f | | g | h | i | @@ -13861,7 +14134,7 @@ Leaves hlines in the table. Setting @code{:hlines yes} has this effect. return tab #+END_SRC -#+results: echo-table +#+RESULTS: echo-table | a | b | c | |---+---+---| | d | e | f | @@ -13899,7 +14172,7 @@ processing, then reapplied to the results. return [[val + '*' for val in row] for row in tab] #+END_SRC -#+results: echo-table-again +#+RESULTS: echo-table-again | a | |----| | b* | @@ -13942,7 +14215,7 @@ and is then reapplied to the results. return [[val + 10 for val in row] for row in tab] #+END_SRC -#+results: echo-table-once-again +#+RESULTS: echo-table-once-again | one | 11 | 12 | 13 | 14 | 15 | | two | 16 | 17 | 18 | 19 | 20 | @end example @@ -13960,7 +14233,7 @@ Setting the @code{:shebang} header argument to a string value first line of any tangled file holding the code block, and the file permissions of the tangled file are set to make it executable. -@node eval, , shebang, Specific header arguments +@node eval, wrap, shebang, Specific header arguments @subsubsection @code{:eval} The @code{:eval} header argument can be used to limit the evaluation of specific code blocks. The @code{:eval} header argument can be useful for @@ -13985,6 +14258,14 @@ If this header argument is not set then evaluation is determined by the value of the @code{org-confirm-babel-evaluate} variable see @ref{Code evaluation security}. +@node wrap, , eval, Specific header arguments +@subsubsection @code{:wrap} +The @code{:wrap} header argument is used to mark the results of source block +evaluation. The header argument can be passed a string that will be appended +to @code{#+BEGIN_} and @code{#+END_}, which will then be used to wrap the +results. If not string is specified then the results will be wrapped in a +@code{#+BEGIN/END_RESULTS} block. + @node Results of evaluation, Noweb reference syntax, Header arguments, Working With Source Code @section Results of evaluation @cindex code block, results of evaluation @@ -14054,7 +14335,7 @@ process. For example, compare the following two blocks: print "bye" #+END_SRC -#+results: +#+RESULTS: : hello : bye @end example @@ -14067,7 +14348,7 @@ In non-session mode, the `2' is not printed and does not appear. print "bye" #+END_SRC -#+results: +#+RESULTS: : hello : 2 : bye @@ -14112,7 +14393,7 @@ correct code is not broken in a language, such as Ruby, where syntactically valid in languages that you use, then please consider setting the default value. -Note: if noweb tangling is slow in large Org-mode files consider setting the +Note: if noweb tangling is slow in large Org mode files consider setting the @code{*org-babel-use-quick-and-dirty-noweb-expansion*} variable to true. This will result in faster noweb reference resolution at the expense of not correctly resolving inherited values of the @code{:noweb-ref} header @@ -14252,7 +14533,7 @@ done emacs -Q --batch -l $ORGINSTALL \ --eval "(progn (add-to-list 'load-path (expand-file-name \"~/src/org/lisp/\")) -(add-to-list 'load-path (expand-file-name \"~/src/org/contrib/lisp/\")) +(add-to-list 'load-path (expand-file-name \"~/src/org/contrib/lisp/\" t)) (require 'org)(require 'org-exp)(require 'ob)(require 'ob-tangle) (mapc (lambda (file) (find-file (expand-file-name file \"$DIR\")) @@ -14358,19 +14639,19 @@ keystrokes are typed on a line by itself. The following template selectors are currently supported. @multitable @columnfractions 0.1 0.9 -@item @kbd{s} @tab @code{#+begin_src ... #+end_src} -@item @kbd{e} @tab @code{#+begin_example ... #+end_example} -@item @kbd{q} @tab @code{#+begin_quote ... #+end_quote} -@item @kbd{v} @tab @code{#+begin_verse ... #+end_verse} -@item @kbd{c} @tab @code{#+begin_center ... #+end_center} -@item @kbd{l} @tab @code{#+begin_latex ... #+end_latex} -@item @kbd{L} @tab @code{#+latex:} -@item @kbd{h} @tab @code{#+begin_html ... #+end_html} -@item @kbd{H} @tab @code{#+html:} -@item @kbd{a} @tab @code{#+begin_ascii ... #+end_ascii} -@item @kbd{A} @tab @code{#+ascii:} -@item @kbd{i} @tab @code{#+index:} line -@item @kbd{I} @tab @code{#+include:} line +@item @kbd{s} @tab @code{#+BEGIN_SRC ... #+END_SRC} +@item @kbd{e} @tab @code{#+BEGIN_EXAMPLE ... #+END_EXAMPLE} +@item @kbd{q} @tab @code{#+BEGIN_QUOTE ... #+END_QUOTE} +@item @kbd{v} @tab @code{#+BEGIN_VERSE ... #+END_VERSE} +@item @kbd{c} @tab @code{#+BEGIN_CENTER ... #+END_CENTER} +@item @kbd{l} @tab @code{#+BEGIN_LaTeX ... #+END_LaTeX} +@item @kbd{L} @tab @code{#+LaTeX:} +@item @kbd{h} @tab @code{#+BEGIN_HTML ... #+END_HTML} +@item @kbd{H} @tab @code{#+HTML:} +@item @kbd{a} @tab @code{#+BEGIN_ASCII ... #+END_ASCII} +@item @kbd{A} @tab @code{#+ASCII:} +@item @kbd{i} @tab @code{#+INDEX:} line +@item @kbd{I} @tab @code{#+INCLUDE:} line @end multitable For example, on an empty line, typing "<e" and then pressing TAB, will expand @@ -14464,7 +14745,7 @@ either by the @i{calc} interpreter, or by the @i{Emacs Lisp} interpreter. @cindex options, for customization @cindex variables, for customization -There are more than 180 variables that can be used to customize +There are more than 500 variables that can be used to customize Org. For the sake of compactness of the manual, I am not describing the variables here. A structured overview of customization variables is available with @kbd{M-x org-customize}. Or select @@ -14515,8 +14796,8 @@ Set tags that can be inherited by any entry in the file, including the top-level entries. @item #+DRAWERS: NAME1 ..... @vindex org-drawers -Set the file-local set of drawers. The corresponding global variable is -@code{org-drawers}. +Set the file-local set of additional drawers. The corresponding global +variable is @code{org-drawers}. @item #+LINK: linkword replace @vindex org-link-abbrev-alist These lines (several are allowed) specify link abbreviations. @@ -14727,7 +15008,7 @@ This line contains the formulas for the table directly above the line. @item #+TITLE:, #+AUTHOR:, #+EMAIL:, #+LANGUAGE:, #+TEXT:, #+DATE:, @itemx #+OPTIONS:, #+BIND:, #+XSLT:, @itemx #+DESCRIPTION:, #+KEYWORDS:, -@itemx #+LATEX_HEADER:, #+STYLE:, #+LINK_UP:, #+LINK_HOME:, +@itemx #+LaTeX_HEADER:, #+STYLE:, #+LINK_UP:, #+LINK_HOME:, @itemx #+EXPORT_SELECT_TAGS:, #+EXPORT_EXCLUDE_TAGS: These lines provide settings for exporting files. For more details see @ref{Export options}. @@ -15100,6 +15381,18 @@ Yes, these are unfortunately more difficult to remember. If you want to have other replacement keys, look at the variable @code{org-disputed-keys}. +@item @file{filladapt.el} by Kyle Jones +@cindex @file{filladapt.el} + +Org mode tries to do the right thing when filling paragraphs, list items and +other elements. Many users reported they had problems using both +@file{filladapt.el} and Org mode, so a safe thing to do is to disable it like +this: + +@lisp +(add-hook 'org-mode-hook 'turn-off-filladapt-mode) +@end lisp + @item @file{yasnippet.el} @cindex @file{yasnippet.el} The way Org mode binds the TAB key (binding to @code{[tab]} instead of @@ -15210,7 +15503,7 @@ This appendix covers some aspects where users can extend the functionality of Org. @menu -* Hooks:: Who to reach into Org's internals +* Hooks:: How to reach into Org's internals * Add-on packages:: Available extensions * Adding hyperlink types:: New custom link types * Context-sensitive commands:: How to add functionality to such commands @@ -15463,6 +15756,10 @@ calculation marks, that column is automatically discarded as well. Please note that the translator function sees the table @emph{after} the removal of these columns, the function never knows that there have been additional columns. + +@item :no-escape t +When non-nil, do not escape special characters @code{&%#_^} when exporting +the table. The default value is nil. @end table @noindent @@ -15862,9 +16159,10 @@ Skip current entry if the TODO keyword is TODO or WAITING. Skip current entry if the TODO keyword marks a DONE state. @item (org-agenda-skip-entry-if 'timestamp) Skip current entry if it has any timestamp, may also be deadline or scheduled. -@item (org-agenda-skip-entry 'regexp "regular expression") +@anchor{x-agenda-skip-entry-regexp} +@item (org-agenda-skip-entry-if 'regexp "regular expression") Skip current entry if the regular expression matches in the entry. -@item (org-agenda-skip-entry 'notregexp "regular expression") +@item (org-agenda-skip-entry-if 'notregexp "regular expression") Skip current entry unless the regular expression matches. @item (org-agenda-skip-subtree-if 'regexp "regular expression") Same as above, but check and skip the entire subtree. @@ -16003,6 +16301,7 @@ If WHICH is nil or `all', get all properties. If WHICH is `special' or `standard', only get that subclass. @end defun @vindex org-use-property-inheritance +@findex org-insert-property-drawer @defun org-entry-get pom property &optional inherit Get value of PROPERTY for entry at point-or-marker POM. By default, this only looks at properties defined locally in the entry. If INHERIT @@ -16025,7 +16324,7 @@ Get all property keys in the current buffer. @end defun @defun org-insert-property-drawer -Insert a property drawer at point. +Insert a property drawer for the current entry. Also @end defun @defun org-entry-put-multivalued-property pom property &rest values @@ -16178,13 +16477,16 @@ The following example counts the number of entries with TODO keyword @cindex iPhone @cindex MobileOrg -@uref{http://mobileorg.ncogni.to/, MobileOrg} is an application for the -@i{iPhone/iPod Touch} series of devices, developed by Richard Moreland. -@i{MobileOrg} offers offline viewing and capture support for an Org mode -system rooted on a ``real'' computer. It does also allow you to record -changes to existing entries. Android users should check out +@i{MobileOrg} is the name of the mobile companion app for Org mode, currently +available for iOS and for Android. @i{MobileOrg} offers offline viewing and +capture support for an Org mode system rooted on a ``real'' computer. It +does also allow you to record changes to existing entries. +The @uref{http://mobileorg.ncogni.to/, iOS implementation} for the +@i{iPhone/iPod Touch/iPad} series of devices, was developed by Richard +Moreland. Android users should check out @uref{http://wiki.github.com/matburt/mobileorg-android/, MobileOrg Android} -by Matt Jones. +by Matt Jones. The two implementations are not identical but offer similar +features. This appendix describes the support Org has for creating agenda views in a format that can be displayed by @i{MobileOrg}, and for integrating notes @@ -16254,8 +16556,8 @@ rely on outline paths, in the hope that these will be unique enough.}. Finally, Org writes the file @file{index.org}, containing links to all other files. @i{MobileOrg} first reads this file from the server, and then downloads all agendas and Org files listed in it. To speed up the download, -MobileOrg will only read files whose checksums@footnote{stored automatically -in the file @file{checksums.dat}} have changed. +MobileOrg will only read files whose checksums@footnote{Checksums are stored +automatically in the file @file{checksums.dat}} have changed. @node Pulling from MobileOrg, , Pushing to MobileOrg, MobileOrg @section Pulling from MobileOrg @@ -16316,6 +16618,8 @@ the current agenda files will be searched.} using @kbd{C-c a ?}. @cindex history @cindex thanks +@section From Carsten + Org was born in 2003, out of frustration over the user interface of the Emacs Outline mode. I was trying to organize my notes and projects, and using Emacs seemed to be the natural way to go. However, having to remember eleven @@ -16349,7 +16653,7 @@ Bastien has written a large number of extensions to Org (most of them integrated into the core by now), including the @LaTeX{} exporter and the plain list parser. His support during the early days, when he basically acted as co-maintainer, was central to the success of this project. Bastien also -invented Worg, helped establishing the Web presence of Org, and sponsors +invented Worg, helped establishing the Web presence of Org, and sponsored hosting costs for the orgmode.org website. @item Eric Schulte and Dan Davison Eric and Dan are jointly responsible for the Org-babel system, which turns @@ -16370,8 +16674,57 @@ webpages derived from Org using an Info-like or a folding interface with single-key navigation. @end table -@noindent OK, now to the full list of contributions! Again, please let me -know what I am missing here! +@noindent See below for the full list of contributions! Again, please +let me know what I am missing here! + +@section From Bastien + +I (Bastien) have been maintaining Org since January 2011. This appendix +would not be complete without adding a few more acknowledgements and thanks +to Carsten's ones above. + +I am first grateful to Carsten for his trust while handing me over the +maintainership of Org. His support as been great since day one of this new +adventure, and it helped a lot. + +When I took over maintainership, I knew I would have to make Org more +collaborative than ever, as I would have to rely on people that are more +knowledgeable than I am on many parts of the code. Here is a list of the +persons I could rely on, they should really be considered co-maintainers, +either of the code or the community: + +@table @i +@item Eric Schulte +Eric is maintaining the Babel parts of Org. His reactivity here kept me away +from worrying about possible bugs here and let me focus on other parts. + +@item Nicolas Goaziou +Nicolas is maintaining the consistency of the deepest parts of Org. His work +on @file{org-element.el} and @file{org-export.el} has been outstanding, and +opened the doors for many new ideas and features. + +@item Jambunathan K +Jambunathan contributed the ODT exporter, definitely a killer feature of +Org mode. He also contributed the new HTML exporter, which is another core +feature of Org. Here too, I knew I could rely on him to fix bugs in these +areas and to patiently explain the users what was the problems and solutions. + +@item Achim Gratz +Achim rewrote the building process of Org, turning some @emph{ad hoc} tools +into a flexible and conceptually clean process. He patiently coped with the +many hiccups that such a change can create for users. + +@item Nick Dokos +The Org mode mailing list would not be such a nice place without Nick, who +patiently helped users so many times. It is impossible to overestimate such +a great help, and the list would not be so active without him. +@end table + +I received support from so many users that it is clearly impossible to be +fair when shortlisting a few of them -- but Org's history would not be +complete if the ones above were not mentioned in this manual. + +@section List of contributions @itemize @bullet @@ -16599,7 +16952,6 @@ work on a tty. @item @i{Piotr Zielinski} wrote @file{org-mouse.el}, proposed agenda blocks and contributed various ideas and code snippets. -@item @end itemize diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi index 69092093af8..1ffa2473b27 100644 --- a/doc/misc/reftex.texi +++ b/doc/misc/reftex.texi @@ -6,26 +6,44 @@ @syncodeindex vr cp @syncodeindex fn cp -@c Version and Contact Info -@set VERSION 4.31 -@set EDITION 4.31 -@set DATE February 2006 -@set AUCTEXSITE @uref{http://www.gnu.org/software/auctex/,AUCTeX distribution site} -@set MAINTAINERSITE @uref{http://www.gnu.org/software/auctex/reftex.html,Ref@TeX{} web page} +@ifnottex +@macro RefTeX {} +Ref@TeX{} +@end macro +@macro AUCTeX {} +AUC@TeX{} +@end macro +@macro BibTeX {} +Bib@TeX{} +@end macro +@macro ConTeXt {} +Con@TeX{}t +@end macro +@end ifnottex +@tex +\gdef\RefTeX{Ref\TeX} +\gdef\AUCTeX{AUC\TeX} +\gdef\BibTeX{Bib\TeX} +\gdef\ConTeXt{Con\TeX t} +@end tex + +@include emacsver.texi + +@set VERSION @value{EMACSVER} +@set AUCTEXSITE @uref{http://www.gnu.org/software/auctex/,@AUCTeX{} web site} +@set MAINTAINERSITE @uref{http://www.gnu.org/software/auctex/reftex.html,@RefTeX{} web page} @set MAINTAINERCONTACT @uref{mailto:auctex-devel@@gnu.org,contact the maintainers} -@set MAINTAINER the AUC@TeX{} project -@set SUPPORTADDRESS AUC@TeX{} user mailing list (@email{auctex@@gnu.org}) -@set DEVELADDRESS AUC@TeX{} developer mailing list (@email{auctex-devel@@gnu.org}) -@set BUGADDRESS AUC@TeX{} bug mailing list (@email{bug-auctex@@gnu.org}) -@set XEMACSFTP @uref{ftp://ftp.xemacs.org/pub/xemacs/packages/,XEmacs ftp site} +@set MAINTAINER the @AUCTeX{} project +@set SUPPORTADDRESS @AUCTeX{} user mailing list (@email{auctex@@gnu.org}) +@set DEVELADDRESS @AUCTeX{} developer mailing list (@email{auctex-devel@@gnu.org}) +@set BUGADDRESS @AUCTeX{} bug mailing list (@email{bug-auctex@@gnu.org}) +@set XEMACSFTP @uref{ftp://ftp.xemacs.org/pub/xemacs/packages/,XEmacs FTP site} @c %**end of header @copying -This file documents @b{Ref@TeX{}}, a package to do labels, references, -citations and indices for LaTeX documents with Emacs. - -This is edition @value{EDITION} of the @b{Ref@TeX{}} User Manual for -@b{Ref@TeX{}} @value{VERSION} +This manual documents @RefTeX{} (version @value{VERSION}), a package +to do labels, references, citations and indices for LaTeX documents +with Emacs. Copyright @copyright{} 1997-2012 Free Software Foundation, Inc. @@ -64,9 +82,9 @@ developing GNU and promoting software freedom.'' @end macro @titlepage -@title Ref@TeX{} User Manual -@subtitle Support for LaTeX labels, references, citations and index entries with GNU Emacs -@subtitle Edition @value{EDITION}, @value{DATE} +@title @RefTeX{} User Manual +@subtitle Support for @LaTeX{} labels, references, citations and index entries with GNU Emacs +@subtitle Version @value{VERSION} @author by Carsten Dominik @page @@ -79,18 +97,17 @@ developing GNU and promoting software freedom.'' @ifnottex @node Top,,,(dir) -@top RefTeX +@top @RefTeX{} -@b{Ref@TeX{}} is a package for managing Labels, References, -Citations and index entries with GNU Emacs. +@RefTeX{} is a package for managing Labels, References, Citations and +index entries with GNU Emacs. -Don't be discouraged by the size of this manual, which covers -@b{Ref@TeX{}} in great depth. All you need to know to use -@b{Ref@TeX{}} can be summarized on two pages (@pxref{RefTeX in a -Nutshell}). You can go back later to other parts of this document when -needed. +This manual documents @RefTeX{} version @value{VERSION}. -@insertcopying +Don't be discouraged by the size of this manual, which covers @RefTeX{} +in great depth. All you need to know to use @RefTeX{} can be summarized +on two pages (@pxref{RefTeX in a Nutshell}). You can go back later to +other parts of this document when needed. @menu * Introduction:: Quick-Start information. @@ -106,8 +123,8 @@ needed. * Faces:: Fontification of RefTeX's buffers. * Multifile Documents:: Document spread over many files. * Language Support:: How to support other languages. -* Finding Files:: Included TeX files and BibTeX .bib files. -* AUCTeX:: Cooperation with AUCTeX. +* Finding Files:: Included @TeX{} files and @BibTeX{} .bib files. +* AUCTeX:: Cooperation with @AUCTeX{}. * Optimizations:: When RefTeX is too slow. * Problems and Work-Arounds:: First Aid. * Imprint:: Author, Web-site, Thanks @@ -123,6 +140,7 @@ The Index * Index:: The full index. @detailmenu + --- The Detailed Node Listing --- Introduction @@ -136,9 +154,8 @@ Labels and References * Builtin Label Environments:: The environments RefTeX knows about. * Defining Label Environments:: ... and environments it doesn't. * Reference Info:: View the label corresponding to a \ref. +* Reference Styles:: Macros to be used instead of \ref. * xr (LaTeX package):: References to external documents. -* varioref (LaTeX package):: How to create \vref instead of \ref. -* fancyref (LaTeX package):: How to create \fref instead of \ref. Defining Label Environments @@ -176,7 +193,7 @@ The Index Phrases File AUCTeX * AUCTeX-RefTeX Interface:: How both packages work together -* Style Files:: AUCTeX's style files can support RefTeX +* Style Files:: @AUCTeX{}'s style files can support RefTeX * Bib-Cite:: Hypertext reading of a document Options, Keymaps, Hooks @@ -202,18 +219,18 @@ Options, Keymaps, Hooks @chapter Introduction @cindex Introduction -@b{Ref@TeX{}} is a specialized package for support of labels, -references, citations, and the index in LaTeX. @b{Ref@TeX{}} wraps -itself round 4 LaTeX macros: @code{\label}, @code{\ref}, @code{\cite}, -and @code{\index}. Using these macros usually requires looking up -different parts of the document and searching through BibTeX database -files. @b{Ref@TeX{}} automates these time--consuming tasks almost -entirely. It also provides functions to display the structure of a -document and to move around in this structure quickly. +@RefTeX{} is a specialized package for support of labels, references, +citations, and the index in @LaTeX{}. @RefTeX{} wraps itself round four +@LaTeX{} macros: @code{\label}, @code{\ref}, @code{\cite}, and +@code{\index}. Using these macros usually requires looking up different +parts of the document and searching through @BibTeX{} database files. +@RefTeX{} automates these time-consuming tasks almost entirely. It also +provides functions to display the structure of a document and to move +around in this structure quickly. @iftex -Don't be discouraged by the size of this manual, which covers @b{Ref@TeX{}} -in great depth. All you need to know to use @b{Ref@TeX{}} can be +Don't be discouraged by the size of this manual, which covers @RefTeX{} +in great depth. All you need to know to use @RefTeX{} can be summarized on two pages (@pxref{RefTeX in a Nutshell}). You can go back later to other parts of this document when needed. @end iftex @@ -230,51 +247,122 @@ reports or suggestions. @section Installation @cindex Installation -@b{Ref@TeX{}} is bundled and pre--installed with Emacs since version -20.2. It was also bundled and pre--installed with XEmacs 19.16--20.x. -XEmacs 21.x users want to install the corresponding plug-in package -which is available from the @value{XEMACSFTP}. See the XEmacs 21.x -documentation on package installation for details. +@RefTeX{} has been bundled and pre-installed with Emacs since +version 20.2. It has also been bundled and pre-installed with XEmacs +19.16--20.x. XEmacs 21.x users want to install the corresponding +plug-in package which is available from the @value{XEMACSFTP}. See the +XEmacs 21.x documentation on package installation for details. -Users of earlier Emacs distributions (including Emacs 19) can get a copy -of the @b{Ref@TeX{}} distribution from the maintainers web-page. -@xref{Imprint}, for more information. +Users of earlier Emacs distributions (including Emacs 19) or people +craving for new features and bugs can get a copy of the @RefTeX{} +distribution from the maintainer's web page. @xref{Imprint}, for more +information. The following instructions will guide you through the +process of installing such a distribution. -@section Environment -@cindex Finding files -@cindex BibTeX database files, not found -@cindex TeX files, not found -@cindex @code{TEXINPUTS}, environment variable -@cindex @code{BIBINPUTS}, environment variable +@subsection Building and Installing -@b{Ref@TeX{}} needs to access all files which are part of a multifile -document, and the BibTeX database files requested by the -@code{\bibliography} command. To find these files, @b{Ref@TeX{}} will -require a search path, i.e. a list of directories to check. Normally -this list is stored in the environment variables @code{TEXINPUTS} and -@code{BIBINPUTS} which are also used by @b{Ref@TeX{}}. However, on some -systems these variables do not contain the full search path. If -@b{Ref@TeX{}} does not work for you because it cannot find some files, -read @ref{Finding Files}. +Note: Currently installation is supported for Emacs only. XEmacs users +might want to refer to the @RefTeX{} package available through the +package system of XEmacs. + +@subsubheading Installation with make + +In order to install RefTeX, unpack the distribution and edit the header +of the Makefile. Basically, you need to change the path specifications +for Emacs Lisp files and info files. Also, enter the name of your Emacs +executable (usually either @samp{emacs} or @samp{xemacs}). + +Then, type + +@example +make +make install +@end example + +to compile and install the code and documentation. + +Per default @RefTeX{} is installed in its own subdirectory which might +not be on your load path. In this case, add it to load path with a +command like the following, replacing the sample directory with the one +where @RefTeX{} is installed in your case. + +@example +(add-to-list 'load-path "/path/to/reftex") +@end example -@section Entering @b{Ref@TeX{}} Mode +Put this command into your init file before other @RefTeX{}-related +settings. + +@subsubheading Installation by Hand + +If you want to get your hands dirty, there is also the possibility to +install by manually copying files. + +@enumerate a +@item +Copy the reftex*.el lisp files to a directory on your load path. Make +sure that no old copy of @RefTeX{} shadows these files. +@item +Byte compile the files. The sequence of compiling should be: +reftex-var.el, reftex.el, and then all the others. +@item +Copy the info file reftex.info to the info directory. +@end enumerate + +@subsection Loading @RefTeX{} + +In order to make the most important functions for entering @RefTeX{} +mode available add the following line to your init file. + +@example +(require 'reftex) +@end example + +@subsection Entering @RefTeX{} Mode @findex turn-on-reftex @findex reftex-mode @vindex LaTeX-mode-hook @vindex latex-mode-hook -To turn @b{Ref@TeX{}} Mode on and off in a particular buffer, use -@kbd{M-x reftex-mode}. To turn on @b{Ref@TeX{}} Mode for all LaTeX -files, add the following lines to your @file{.emacs} file: +To turn @RefTeX{} Mode on and off in a particular buffer, use +@kbd{M-x reftex-mode @key{RET}}. To turn on @RefTeX{} Mode for all +LaTeX files, add the following lines to your @file{.emacs} file: @example (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode (add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode @end example +That's all! + +To get started, read the documentation, in particular the +summary. (@pxref{RefTeX in a Nutshell}) + +In order to produce a printed version of the documentation, use +@code{make pdf} to produce a reftex.pdf file. Analogously you can use +the @code{dvi}, @code{ps}, or @code{html} targets to create DVI, +PostScript or HTML files. + +@subsection Environment +@cindex Finding files +@cindex BibTeX database files, not found +@cindex TeX files, not found +@cindex @code{TEXINPUTS}, environment variable +@cindex @code{BIBINPUTS}, environment variable + +@RefTeX{} needs to access all files which are part of a multifile +document, and the BibTeX database files requested by the +@code{\bibliography} command. To find these files, @RefTeX{} will +require a search path, i.e. a list of directories to check. Normally +this list is stored in the environment variables @code{TEXINPUTS} and +@code{BIBINPUTS} which are also used by @RefTeX{}. However, on some +systems these variables do not contain the full search path. If +@RefTeX{} does not work for you because it cannot find some files, +@xref{Finding Files}. + @page @node RefTeX in a Nutshell, , Installation, Introduction -@section @b{Ref@TeX{}} in a Nutshell +@section @RefTeX{} in a Nutshell @cindex Quick-Start @cindex Getting Started @cindex RefTeX in a Nutshell @@ -289,7 +377,7 @@ can jump quickly to every part of your document. Press @kbd{?} to get help. @item -@b{Labels and References}@* @b{Ref@TeX{}} helps to create unique labels +@b{Labels and References}@* @RefTeX{} helps to create unique labels and to find the correct key for references quickly. It distinguishes labels for different environments, knows about all standard environments (and many others), and can be configured to recognize any @@ -300,7 +388,7 @@ additional labeled environments you have defined yourself (variable @item @b{Creating Labels}@* Type @kbd{C-c (} (@code{reftex-label}) to insert a label at point. -@b{Ref@TeX{}} will either +@RefTeX{} will either @itemize @minus @item derive a label from context (default for section labels) @@ -325,7 +413,7 @@ into the original buffer. @item @b{Citations}@* Typing @kbd{C-c [} (@code{reftex-citation}) will let you specify a -regular expression to search in current BibTeX database files (as +regular expression to search in current @BibTeX{} database files (as specified in the @code{\bibliography} command) and pull out a list of matches for you to choose from. The list is @emph{formatted} and sorted. The selected article is referenced as @samp{\cite@{@var{key}@}} @@ -334,9 +422,9 @@ different macros). @item @b{Index Support}@* -@b{Ref@TeX{}} helps to enter index entries. It also compiles all +@RefTeX{} helps to enter index entries. It also compiles all entries into an alphabetically sorted @file{*Index*} buffer which you -can use to check and edit the entries. @b{Ref@TeX{}} knows about the +can use to check and edit the entries. @RefTeX{} knows about the standard index macros and can be configured to recognize any additional macros you have defined (@code{reftex-index-macros}). Multiple indices are supported. @@ -354,7 +442,7 @@ and enter the arguments with completion. @b{The Index Phrases File (Delayed Indexing)}@* Type @kbd{C-c \} (@code{reftex-index-phrase-selection-or-word}) to add the current word or selection to a special @emph{index phrase file}. -@b{Ref@TeX{}} can later search the document for occurrences of these +@RefTeX{} can later search the document for occurrences of these phrases and let you interactively index the matches. @item @@ -366,11 +454,11 @@ all entries. @page @item @b{Viewing Cross-References}@* -When point is on the @var{key} argument of a cross--referencing macro +When point is on the @var{key} argument of a cross-referencing macro (@code{\label}, @code{\ref}, @code{\cite}, @code{\bibitem}, -@code{\index}, and variations) or inside a BibTeX database entry, you +@code{\index}, and variations) or inside a @BibTeX{} database entry, you can press @kbd{C-c &} (@code{reftex-view-crossref}) to display -corresponding locations in the document and associated BibTeX database +corresponding locations in the document and associated @BibTeX{} database files. @* When the enclosing macro is @code{\cite} or @code{\ref} and no other message occupies the echo area, information about the citation or label @@ -380,12 +468,12 @@ will automatically be displayed in the echo area. @b{Multifile Documents}@* Multifile Documents are fully supported. The included files must have a file variable @code{TeX-master} or @code{tex-main-file} pointing to the -master file. @b{Ref@TeX{}} provides cross-referencing information from +master file. @RefTeX{} provides cross-referencing information from all parts of the document, and across document borders (@file{xr.sty}). @item -@b{Document Parsing}@* @b{Ref@TeX{}} needs to parse the document in +@b{Document Parsing}@* @RefTeX{} needs to parse the document in order to find labels and other information. It does it automatically once and updates its list internally when @code{reftex-label} and @code{reftex-index} are used. To enforce reparsing, call any of the @@ -394,20 +482,20 @@ commands described above with a raw @kbd{C-u} prefix, or press the buffer, or the index buffer. @item -@b{AUCTeX} @* If your major LaTeX mode is AUCTeX, @b{Ref@TeX{}} can -cooperate with it (see variable @code{reftex-plug-into-AUCTeX}). AUCTeX +@b{@AUCTeX{}} @* If your major @LaTeX{} mode is @AUCTeX{}, @RefTeX{} can +cooperate with it (see variable @code{reftex-plug-into-AUCTeX}). @AUCTeX{} contains style files which trigger appropriate settings in -@b{Ref@TeX{}}, so that for many of the popular LaTeX packages no +@RefTeX{}, so that for many of the popular @LaTeX{} packages no additional customizations will be necessary. @item @b{Useful Settings}@* -To integrate RefTeX with AUCTeX, use +To integrate RefTeX with @AUCTeX{}, use @lisp (setq reftex-plug-into-AUCTeX t) @end lisp -To make your own LaTeX macro definitions known to @b{Ref@TeX{}}, +To make your own @LaTeX{} macro definitions known to @RefTeX{}, customize the variables @example @code{reftex-label-alist} @r{(for label macros/environments)} @@ -417,15 +505,15 @@ customize the variables @code{reftex-index-default-macro} @r{(to set the default macro)} @end example If you have a large number of macros defined, you may want to write -an AUCTeX style file to support them with both AUCTeX and -@b{Ref@TeX{}}. +an @AUCTeX{} style file to support them with both @AUCTeX{} and +@RefTeX{}. -@item @b{Where Next?}@* Go ahead and use @b{Ref@TeX{}}. Use its menus +@item @b{Where Next?}@* Go ahead and use @RefTeX{}. Use its menus until you have picked up the key bindings. For an overview of what you can do in each of the different special buffers, press @kbd{?}. Read -the manual if you get stuck, of if you are curious what else might be +the manual if you get stuck, or if you are curious what else might be available. The first part of the manual explains in -a tutorial way how to use and customize @b{Ref@TeX{}}. The second +a tutorial way how to use and customize @RefTeX{}. The second part is a command and variable reference. @end enumerate @@ -463,10 +551,10 @@ Prefix argument. @tablesubheading{Moving around} @item n -Goto next entry in the table of context. +Goto next entry in the table of contents. @item p -Goto previous entry in the table of context. +Goto previous entry in the table of contents. @item C-c C-n Goto next section heading. Useful when many labels and index entries @@ -506,7 +594,7 @@ always show the location corresponding to the line at point in the @file{*toc*} buffer. This is similar to pressing @key{SPC} after each cursor motion. The default for this flag can be set with the variable @code{reftex-toc-follow-mode}. Note that only context in files already -visited is shown. @b{Ref@TeX{}} will not visit a file just for follow +visited is shown. @RefTeX{} will not visit a file just for follow mode. See, however, the variable @code{reftex-revisit-to-follow}. @@ -521,8 +609,8 @@ Show calling point in another window. This is the point from where Promote the current section. This will convert @code{\section} to @code{\chapter}, @code{\subsection} to @code{\section} etc. If there is an active region, all sections in the region will be promoted, including -the one at point. To avoid mistakes, @b{Ref@TeX{}} requires a fresh -document scan before executing this command - if necessary, it will +the one at point. To avoid mistakes, @RefTeX{} requires a fresh +document scan before executing this command -- if necessary, it will automatically do this scan and ask the user to repeat the promotion command. @@ -578,7 +666,7 @@ variable @code{reftex-toc-include-file-boundaries}. Toggle the display of labels in the @file{*toc*} buffer. The default for this flag can be set with the variable @code{reftex-toc-include-labels}. When called with a prefix argument, -@b{Ref@TeX{}} will prompt for a label type and include only labels of +@RefTeX{} will prompt for a label type and include only labels of the selected type in the @file{*toc*} buffer. The mode line @samp{L<>} indicator shows which labels are included. @@ -587,7 +675,7 @@ indicator shows which labels are included. Toggle the display of index entries in the @file{*toc*} buffer. The default for this flag can be set with the variable @code{reftex-toc-include-index-entries}. When called with a prefix -argument, @b{Ref@TeX{}} will prompt for a specific index and include +argument, @RefTeX{} will prompt for a specific index and include only entries in the selected index in the @file{*toc*} buffer. The mode line @samp{I<>} indicator shows which index is used. @@ -605,18 +693,18 @@ document. @item r @vindex reftex-enable-partial-scans -Reparse the LaTeX document and rebuild the @file{*toc*} buffer. When +Reparse the @LaTeX{} document and rebuild the @file{*toc*} buffer. When @code{reftex-enable-partial-scans} is non-@code{nil}, rescan only the file this location is defined in, not the entire document. @item C-u r -Reparse the @emph{entire} LaTeX document and rebuild the @file{*toc*} +Reparse the @emph{entire} @LaTeX{} document and rebuild the @file{*toc*} buffer. @item x Switch to the @file{*toc*} buffer of an external document. When the current document is using the @code{xr} package (@pxref{xr (LaTeX -package)}), @b{Ref@TeX{}} will switch to one of the external +package)}), @RefTeX{} will switch to one of the external documents. @@ -669,11 +757,11 @@ recentering of the TOC window on the current frame with @cindex LaTeX classes, KOMA-Script @cindex TOC entries for environments @vindex reftex-section-levels -The section macros recognized by @b{Ref@TeX{}} are all LaTeX section +The section macros recognized by @RefTeX{} are all @LaTeX{} section macros (from @code{\part} to @code{\subsubparagraph}) and the commands @code{\addchap} and @code{\addsec} from the KOMA-Script classes. Additional macros can be configured with the variable -@code{reftex-section-levels}. It is also possible to add certain LaTeX +@code{reftex-section-levels}. It is also possible to add certain @LaTeX{} environments to the table of contents. This is probably only useful for theorem-like environments. @xref{Defining Label Environments}, for an example. @@ -686,21 +774,21 @@ example. @cindex Label environment @cindex @code{\label} -LaTeX provides a powerful mechanism to deal with cross--references in a +@LaTeX{} provides a powerful mechanism to deal with cross-references in a document. When writing a document, any part of it can be marked with a -label, like @samp{\label@{mark@}}. LaTeX records the current value of a +label, like @samp{\label@{mark@}}. @LaTeX{} records the current value of a certain counter when a label is defined. Later references to this label (like @samp{\ref@{mark@}}) will produce the recorded value of the counter. Labels can be used to mark sections, figures, tables, equations, -footnotes, items in enumerate lists etc. LaTeX is context sensitive in +footnotes, items in enumerate lists etc. @LaTeX{} is context sensitive in doing this: A label defined in a figure environment automatically records the figure counter, not the section counter. Several different environments can share a common counter and therefore -a common label category. E.g. labels in both @code{equation} and -@code{eqnarray} environments record the value of the same counter - the +a common label category. For example labels in both @code{equation} and +@code{eqnarray} environments record the value of the same counter -- the equation counter. @menu @@ -709,9 +797,8 @@ equation counter. * Builtin Label Environments:: The environments RefTeX knows about. * Defining Label Environments:: ... and environments it doesn't. * Reference Info:: View the label corresponding to a \ref. +* Reference Styles:: Macros to be used instead of \ref. * xr (LaTeX package):: References to external documents. -* varioref (LaTeX package):: How to create \vref instead of \ref. -* fancyref (LaTeX package):: How to create \fref instead of \ref. @end menu @node Creating Labels, Referencing Labels, , Labels and References @@ -722,12 +809,12 @@ equation counter. @kindex C-c ( @findex reftex-label -In order to create a label in a LaTeX document, press @kbd{C-c (} -(@code{reftex-label}). Just like LaTeX, @b{Ref@TeX{}} is context sensitive +In order to create a label in a @LaTeX{} document, press @kbd{C-c (} +(@code{reftex-label}). Just like @LaTeX{}, @RefTeX{} is context sensitive and will figure out the environment it currently is in and adapt the label to that environment. A label usually consists of a short prefix -indicating the type of the label and a unique mark. @b{Ref@TeX{}} has -3 different modes to create this mark. +indicating the type of the label and a unique mark. @RefTeX{} has +three different modes to create this mark. @enumerate @item @@ -735,10 +822,10 @@ indicating the type of the label and a unique mark. @b{Ref@TeX{}} has @vindex reftex-derive-label-parameters @vindex reftex-label-illegal-re @vindex reftex-abbrev-parameters -A label can be derived from context. This means, @b{Ref@TeX{}} takes +A label can be derived from context. This means, @RefTeX{} takes the context of the label definition and constructs a label from that@footnote{Note that the context may contain constructs which are -invalid in labels. @b{Ref@TeX{}} will therefore strip the accent from +invalid in labels. @RefTeX{} will therefore strip the accent from accented Latin-1 characters and remove everything else which is not valid in labels. This mechanism is safe, but may not be satisfactory for non-western languages. Check the following variables if you need to @@ -746,28 +833,28 @@ change things: @code{reftex-translate-to-ascii-function}, @code{reftex-derive-label-parameters}, @code{reftex-label-illegal-re}, @code{reftex-abbrev-parameters}.}. This works best for section labels, where the section heading is used to construct a label. In fact, -@b{Ref@TeX{}}'s default settings use this method only for section +@RefTeX{}'s default settings use this method only for section labels. You will be asked to confirm the derived label, or edit it. @item We may also use a simple unique number to identify a label. This is mostly useful for labels where it is difficult to come up with a very -good descriptive name. @b{Ref@TeX{}}'s default settings use this method -for equations, enumerate items and footnotes. The author of @b{Ref@TeX{}} +good descriptive name. @RefTeX{}'s default settings use this method +for equations, enumerate items and footnotes. The author of @RefTeX{} tends to write documents with many equations and finds it impossible to come up with good names for each of them. These simple labels are inserted without query, and are therefore very fast. Good descriptive -names are not really necessary as @b{Ref@TeX{}} will provide context to +names are not really necessary as @RefTeX{} will provide context to reference a label (@pxref{Referencing Labels}). @item The third method is to ask the user for a label. This is most useful for things which are easy to describe briefly and do not turn up -too frequently in a document. @b{Ref@TeX{}} uses this for figures and +too frequently in a document. @RefTeX{} uses this for figures and tables. Of course, one can enter the label directly by typing the full @samp{\label@{mark@}}. The advantage of using @code{reftex-label} -anyway is that @b{Ref@TeX{}} will know that a new label has been defined. +anyway is that @RefTeX{} will know that a new label has been defined. It will then not be necessary to rescan the document in order to access this label later. @end enumerate @@ -777,9 +864,9 @@ If you want to change the way certain labels are created, check out the variable @code{reftex-insert-label-flags} (@pxref{Options (Creating Labels)}). -If you are using AUCTeX to write your LaTeX documents, you can +If you are using @AUCTeX{} to write your @LaTeX{} documents, you can set it up to delegate the creation of labels to -@b{Ref@TeX{}}. @xref{AUCTeX}, for more information. +@RefTeX{}. @xref{AUCTeX}, for more information. @node Referencing Labels, Builtin Label Environments, Creating Labels, Labels and References @section Referencing Labels @@ -792,24 +879,31 @@ set it up to delegate the creation of labels to @findex reftex-reference @vindex reftex-trust-label-prefix -@b{Ref@TeX{}} scans the document in order to find all labels. To make +@RefTeX{} scans the document in order to find all labels. To make referencing labels easier, it assigns to each label a category, the @emph{label type} (for example section, table, figure, equation, etc.). -In order to determine the label type, RefTeX parses around each label +In order to determine the label type, @RefTeX{} parses around each label to see in what kind of environments it is located. You can speed up the parsing by using type-specific prefixes for labels and configuring the variable @code{reftex-trust-label-prefix}. -Referencing Labels is really at the heart of @b{Ref@TeX{}}. Press @kbd{C-c -)} in order to reference a label (reftex-reference). This will start a -selection process and finally insert the complete @samp{\ref@{label@}} -into the buffer. +Referencing Labels is really at the heart of @RefTeX{}. Press @kbd{C-c +)} in order to reference a label (@code{reftex-reference}). This will +start a selection process and finally insert the complete +@samp{\ref@{label@}} into the buffer. + +@vindex reftex-ref-macro-prompt +First, you can select which reference macro you want to use, +e.g. @samp{\ref} or @samp{\pageref}. Later in the process you have +another chance to make this selection and you can therefore disable this +step by customizing @code{reftex-ref-macro-prompt} if you find it too +intrusive. @xref{Reference Styles}. -First, @b{Ref@TeX{}} will determine the label category which is required. -Often that can be figured out from context. For example, if you -write @samp{As shown in eq.} and the press @kbd{C-c )}, @b{Ref@TeX{}} knows -that an equation label is going to be referenced. If it cannot figure -out what label category is needed, it will query for one. +Then, @RefTeX{} will determine the label category which is required. +Often that can be figured out from context. For example, if you write +@samp{As shown in eq.} and then press @kbd{C-c )}, @RefTeX{} knows that +an equation label is going to be referenced. If it cannot figure out +what label category is needed, it will query for one. You will then be presented with a label selection menu. This is a special buffer which contains an outline of the document along with all @@ -820,7 +914,7 @@ sufficient to identify the label. If you are unsure about a certain label, pressing @key{SPC} will show the label definition point in another window. -In order to reference a label, move to cursor to the correct label and +In order to reference a label, move the cursor to the correct label and press @key{RET}. You can also reference several labels with a single call to @code{reftex-reference} by marking entries with the @kbd{m} key (see below). @@ -871,7 +965,7 @@ window. See also the @kbd{f} key. Toggle follow mode. When follow mode is active, the other window will always display the full context of the current label. This is similar to pressing @key{SPC} after each cursor motion. Note that only context -in files already visited is shown. @b{RefTeX} will not visit a file +in files already visited is shown. @RefTeX{} will not visit a file just for follow mode. See, however, the variable @code{reftex-revisit-to-follow}. @@ -888,8 +982,8 @@ references all marked labels. @item mouse-2 @vindex reftex-highlight-selection Clicking with mouse button 2 on a label will accept it like @key{RET} -would. See also variable @code{reftex-highlight-selection}, @ref{Options -(Misc)}. +would. See also variable @code{reftex-highlight-selection}, +@ref{Options (Misc)}. @vindex reftex-multiref-punctuation @item m - + , @@ -923,26 +1017,15 @@ Enter a label with completion. This may also be a label which does not yet exist in the document. @item v -@cindex @code{varioref}, LaTeX package -@cindex @code{\vref} -@cindex LaTeX packages, @code{varioref} -Toggle between @code{\ref} and @code{\vref} macro for references. The -@code{\vref} macro is defined in the @code{varioref} LaTeX package. -With this key you can force @b{Ref@TeX{}} to insert a @code{\vref} -macro. The current state of this flag is displayed by the @samp{S<>} -indicator in the mode line of the selection buffer. +Cycle forward through active reference macros. The selected macro is +displayed by the @samp{S<...>} indicator in the mode line of the +selection buffer. This mechanism comes in handy if you are using +@LaTeX{} packages like @code{varioref} or @code{fancyref} and want to +use the special referencing macros they provide (e.g. @code{\vref} or +@code{\fref}) instead of @code{\ref}. @item V -@cindex @code{fancyref}, LaTeX package -@cindex @code{\fref} -@cindex @code{\Fref} -@cindex LaTeX packages, @code{fancyref} -Cycle between @code{\ref}, @code{\fref} and @code{\Fref}. The -@code{\fref} and @code{\Fref} macros are defined in the @code{fancyref} -LaTeX package. With this key you can force @b{Ref@TeX{}} to insert a -@code{\fref} or @code{\Fref} macro. The current state of this flag is -displayed by the @samp{S<>} indicator in the mode line of the -selection buffer. +Cycle backward through active reference macros. @tablesubheading{Exiting} @@ -966,7 +1049,7 @@ selection buffer. @item t Toggle the display of the table of contents in the selection buffer. With prefix @var{arg}, change the maximum level of toc entries displayed -to @var{arg}. Chapters are level 1, section are level 2. +to @var{arg}. Chapters are level 1, sections are level 2. @item # Toggle the display of a label counter in the selection buffer. @@ -974,7 +1057,7 @@ Toggle the display of a label counter in the selection buffer. @item % Toggle the display of labels hidden in comments in the selection buffers. Sometimes, you may have commented out parts of your document. -If these parts contain label definitions, @b{Ref@TeX{}} can still display +If these parts contain label definitions, @RefTeX{} can still display and reference these labels. @tablesubheading{Updating the buffer} @@ -998,7 +1081,7 @@ Switch the label category. After prompting for another label category, a menu for that category will be shown. @item x -Reference a label from an external document. With the LaTeX package +Reference a label from an external document. With the @LaTeX{} package @code{xr} it is possible to reference labels defined in another document. This key will switch to the label menu of an external document and let you select a label from there (@pxref{xr (LaTeX @@ -1018,10 +1101,10 @@ keymap @code{reftex-select-label-map} may be used. @vindex reftex-label-alist @vindex reftex-label-alist-builtin -@b{Ref@TeX{}} needs to be aware of the environments which can be referenced -with a label (i.e. which carry their own counters). By default, @b{Ref@TeX{}} +@RefTeX{} needs to be aware of the environments which can be referenced +with a label (i.e. which carry their own counters). By default, @RefTeX{} recognizes all labeled environments and macros discussed in @cite{The -LaTeX Companion by Goossens, Mittelbach & Samarin, Addison-Wesley +@LaTeX{} Companion by Goossens, Mittelbach & Samarin, Addison-Wesley 1994.}. These are: @itemize @minus @@ -1038,7 +1121,7 @@ LaTeX Companion by Goossens, Mittelbach & Samarin, Addison-Wesley @cindex LaTeX core @code{figure}, @code{figure*}, @code{table}, @code{table*}, @code{equation}, @code{eqnarray}, @code{enumerate}, the @code{\footnote} macro (this is -the LaTeX core stuff) +the @LaTeX{} core stuff) @item @cindex AMS-LaTeX @cindex @code{amsmath}, LaTeX package @@ -1053,7 +1136,7 @@ the LaTeX core stuff) @cindex @code{subequations}, AMS-LaTeX environment @code{align}, @code{gather}, @code{multline}, @code{flalign}, @code{alignat}, @code{xalignat}, @code{xxalignat}, @code{subequations} -(from AMS-LaTeX's @file{amsmath.sty} package) +(from AMS-@LaTeX{}'s @file{amsmath.sty} package) @item @cindex @code{endnote}, LaTeX package @cindex LaTeX packages, @code{endnote} @@ -1112,7 +1195,7 @@ the @code{\endnote} macro (from @file{endnotes.sty}) @end itemize If you want to use other labeled environments, defined with -@code{\newtheorem}, @b{Ref@TeX{}} needs to be configured to recognize +@code{\newtheorem}, @RefTeX{} needs to be configured to recognize them (@pxref{Defining Label Environments}). @node Defining Label Environments, Reference Info, Builtin Label Environments, Labels and References @@ -1120,7 +1203,7 @@ them (@pxref{Defining Label Environments}). @cindex Label environments, defining @vindex reftex-label-alist -@b{Ref@TeX{}} can be configured to recognize additional labeled +@RefTeX{} can be configured to recognize additional labeled environments and macros. This is done with the variable @code{reftex-label-alist} (@pxref{Options (Defining Label Environments)}). If you are not familiar with Lisp, you can use the @@ -1143,7 +1226,7 @@ Environments}). * Quick Equation:: When a macro sets the label type. * Figure Wrapper:: When a macro argument is a label. * Adding Magic Words:: Other words for other languages. -* Using \eqref:: How to switch to this AMS-LaTeX macro. +* Using \eqref:: How to switch to this AMS-@LaTeX{} macro. * Non-Standard Environments:: Environments without \begin and \end * Putting it Together:: How to combine many entries. @end menu @@ -1154,7 +1237,7 @@ Environments}). @cindex @code{axiom}, newtheorem @cindex @code{\newtheorem} -Suppose you are using @code{\newtheorem} in LaTeX in order to define two +Suppose you are using @code{\newtheorem} in @LaTeX{} in order to define two new environments, @code{theorem} and @code{axiom} @example @@ -1172,7 +1255,7 @@ to be used like this: \end@{axiom@} @end example -So we need to tell @b{Ref@TeX{}} that @code{theorem} and @code{axiom} are new +So we need to tell @RefTeX{} that @code{theorem} and @code{axiom} are new labeled environments which define their own label categories. We can either use Lisp to do this (e.g. in @file{.emacs}) or use the custom library. With Lisp it would look like this @@ -1184,7 +1267,7 @@ library. With Lisp it would look like this @end lisp The type indicator characters @code{?a} and @code{?h} are used for -prompts when @b{Ref@TeX{}} queries for a label type. @code{?h} +prompts when @RefTeX{} queries for a label type. @code{?h} was chosen for @code{theorem} since @code{?t} is already taken by @code{table}. Note that also @code{?s}, @code{?f}, @code{?e}, @code{?i}, @code{?n} are already used for standard environments. @@ -1192,10 +1275,10 @@ was chosen for @code{theorem} since @code{?t} is already taken by @noindent The labels for Axioms and Theorems will have the prefixes @samp{ax:} and @samp{thr:}, respectively. @xref{AUCTeX}, for information on how -AUCTeX can use RefTeX to automatically create labels when a new environment -is inserted into a buffer. Additionally, the following needs to be -added to one's .emacs file before AUCTeX will automatically create -labels for the new environments. +@AUCTeX{} can use @RefTeX{} to automatically create labels when a new +environment is inserted into a buffer. Additionally, the following +needs to be added to one's .emacs file before @AUCTeX{} will +automatically create labels for the new environments. @lisp (add-hook 'LaTeX-mode-hook @@ -1226,9 +1309,9 @@ Environments)}). @end itemize The following list of strings is used to guess the correct label type -from the word before point when creating a reference. E.g. if you +from the word before point when creating a reference. For example if you write: @samp{As we have shown in Theorem} and then press @kbd{C-c )}, -@b{Ref@TeX{}} will know that you are looking for a theorem label and +@RefTeX{} will know that you are looking for a theorem label and restrict the menu to only these labels without even asking. The final item in each entry is the level at which the environment @@ -1299,7 +1382,7 @@ and used like this: Einstein's equation is \quickeq@{E=mc^2 \label@{eq:einstein@}@}. @end example -We need to tell @b{Ref@TeX{}} that any label defined in the argument of the +We need to tell @RefTeX{} that any label defined in the argument of the @code{\quickeq} is an equation label. Here is how to do this with lisp: @lisp @@ -1310,7 +1393,7 @@ The first element in this list is now the macro with empty braces as an @emph{image} of the macro arguments. @code{?e} indicates that this is an equation label, the different @code{nil} elements indicate to use the default values for equations. The @samp{1} as the fifth element -indicates that the context of the label definition should be the 1st +indicates that the context of the label definition should be the first argument of the macro. Here is again how this would look in the customization buffer: @@ -1352,7 +1435,7 @@ which would be called like \myfig[htp]@{filename@}@{caption text@}@{label@}@{1@} @end example -Now we need to tell @b{Ref@TeX{}} that the 4th argument of the +Now we need to tell @RefTeX{} that the fourth argument of the @code{\myfig} macro @emph{is itself} a figure label, and where to find the context. @@ -1366,8 +1449,8 @@ The empty pairs of brackets indicate the different arguments of the indicates that this is a figure label which will be listed together with labels from normal figure environments. The @code{nil} entries for prefix and reference format mean to use the defaults for figure labels. -The @samp{3} for the context method means to grab the 3rd macro argument -- the caption. +The @samp{3} for the context method means to grab the third macro argument +-- the caption. As a side effect of this configuration, @code{reftex-label} will now insert the required naked label (without the @code{\label} macro) when @@ -1420,7 +1503,7 @@ predefined label categories. Another case where one only wants to change the information associated with the label category is to change the macro which is used for -referencing the label. When working with the AMS-LaTeX stuff, you might +referencing the label. When working with the AMS-@LaTeX{}, you might prefer @code{\eqref} for doing equation references. Here is how to do this: @@ -1428,7 +1511,7 @@ do this: (setq reftex-label-alist '((nil ?e nil "~\\eqref@{%s@}" nil nil))) @end lisp -@b{Ref@TeX{}} has also a predefined symbol for this special purpose. The +@RefTeX{} has also a predefined symbol for this special purpose. The following is equivalent to the line above. @lisp @@ -1436,7 +1519,7 @@ following is equivalent to the line above. @end lisp Note that this is automatically done by the @file{amsmath.el} style file -of AUCTeX (@pxref{Style Files}) - so if you use AUCTeX, +of @AUCTeX{} (@pxref{Style Files}) -- so if you use @AUCTeX{}, this configuration will not be necessary. @node Non-Standard Environments, Putting it Together, Using \eqref, Defining Label Environments @@ -1446,8 +1529,8 @@ this configuration will not be necessary. @cindex Special parser functions @cindex Parser functions, for special environments -Some LaTeX packages define environment-like structures without using the -standard @samp{\begin..\end} structure. @b{Ref@TeX{}} cannot parse +Some @LaTeX{} packages define environment-like structures without using the +standard @samp{\begin..\end} structure. @RefTeX{} cannot parse these directly, but you can write your own special-purpose parser and use it instead of the name of an environment in an entry for @code{reftex-label-alist}. The function should check if point is @@ -1506,7 +1589,7 @@ terminated by @samp{\z.} or by an empty line. The difficulty is that the @samp{\a.} lists can nest and that an empty line terminates all list levels in one go. So we have to count nesting levels between @samp{\a.} and @samp{\z.}. Here is the implementation -for @b{Ref@TeX{}}. +for @RefTeX{}. @lisp (setq reftex-label-alist @@ -1558,7 +1641,7 @@ the entries described above: (detect-linguex ?x "ex:" "~\\ref@{%s@}" nil ("Example" "Ex.")))) @end lisp -@node Reference Info, xr (LaTeX package), Defining Label Environments, Labels and References +@node Reference Info, Reference Styles, Defining Label Environments, Labels and References @section Reference Info @findex reftex-view-crossref @findex reftex-mouse-view-crossref @@ -1575,12 +1658,100 @@ information about the label referenced there. Note that the information is only displayed if the echo area is not occupied by a different message. -@b{Ref@TeX{}} can also display the label definition corresponding to a +@RefTeX{} can also display the label definition corresponding to a @code{\ref} macro, or all reference locations corresponding to a @code{\label} macro. @xref{Viewing Cross-References}, for more information. -@node xr (LaTeX package), varioref (LaTeX package), Reference Info, Labels and References +@node Reference Styles, xr (LaTeX package), Reference Info, Labels and References +@section Reference Styles + +In case you defined your own macros for referencing or you are using +@LaTeX{} packages providing specialized macros to be used instead of +@code{\ref}, @RefTeX{} provides ways to select and insert them in a +convenient way. + +@RefTeX{} comes equipped with a set of so-called reference styles where +each relates to one or more reference macros. The standard macros +@samp{\ref} and @samp{\pageref} or provided by the ``Default'' style. +The ``Varioref'' style offers macros for the @samp{varioref} @LaTeX{} +package (@samp{\vref}, @samp{\Vref}, @samp{\Ref}, @samp{\vpageref}), +``Fancyref'' for the @samp{fancyref} package (@samp{\fref}, +@samp{\Fref}) and ``Hyperref'' for the @samp{hyperref} package +(@samp{\autoref}, @samp{\autopageref}). + +@vindex reftex-ref-style-default-list +A style can be toggled by selecting the respective entry in the +@samp{Reference Style} menu. Changes made through the menu will only +last for the Emacs session. In order to configure a preference +permanently, the variable @code{reftex-ref-style-default-list} should be +customized. This variable specifies the list of styles to be activated. +It can also be set as a file variable if the preference should be set +for a specific file. + +@vindex reftex-ref-style-alist +In case the built-in styles do not suffice, you can add additional +macros and styles to the variable @code{reftex-ref-style-alist}. Those +do not necessarily have to be related to a certain @LaTeX{} package but +can follow an arbitrary grouping rule. For example you could define a +style called ``Personal'' for your personal referencing macros. (When +changing the variable you should be aware that other Emacs packages, +like @AUCTeX{}, might rely on the entries from the default value to be +present.) + +Once a style is active the macros it relates to are available for +selection when you are about to insert a reference. In general this +process involves three steps: the selection of a reference macro, a +label type and a label. Reference macros can be chosen in the first and +last step. + +@vindex reftex-ref-macro-prompt +In the first step you will be presented with a list of macros from which +you can select one by typing a single key. If you dislike having an +extra step for reference macro selection, you can disable it by +customizing @code{reftex-ref-macro-prompt} and relying only on the +selection facilities provided in the last step. + +In the last step, i.e. the label selection, two key bindings are +provided to set the reference macro. Type @key{v} in order to cycle +forward through the list of available macros or @key{V} to cycle +backward. The mode line of the selection buffer shows the macro +currently selected. + +In case you are not satisfied with the order of macros when cycling +through them you should adapt the order of entries in the variable +@code{reftex-ref-style-alist} to fit your liking. + +For each entry in @code{reftex-ref-style-alist} a function with the name +@code{reftex-<package>-<macro>} (e.g. @code{reftex-varioref-vref}) will +be created automatically by @RefTeX{}. These functions can be used +instead of @kbd{C-c )} and provide an alternative way of having your +favorite referencing macro preselected and if cycling through the macros +seems inconvenient to you.@footnote{You could e.g. bind +@code{reftex-varioref-vref} to @kbd{C-c v} and +@code{reftex-fancyref-fref} to @kbd{C-c f}.} + +@cindex @code{varioref}, LaTeX package +@cindex LaTeX packages, @code{varioref} +@cindex @code{fancyref}, LaTeX package +@cindex LaTeX packages, @code{fancyref} +@vindex reftex-vref-is-default (deprecated) +@vindex reftex-fref-is-default (deprecated) +In former versions of @RefTeX{} only support for @code{varioref} and +@code{fancyref} was included. @code{varioref} is a @LaTeX{} package to +create cross-references with page information. @code{fancyref} is a +package where a macro call like @code{\fref@{@var{fig:map-of-germany}@}} +creates not only the number of the referenced counter but also the +complete text around it, like @samp{Figure 3 on the preceding page}. In +order to make it work you need to use label prefixes like @samp{fig:} +consistently -- something @RefTeX{} does automatically. For each of +these packages a variable could be configured to make its macros to take +precedence over @code{\ref}. Those were @code{reftex-vref-is-default} +and @code{reftex-fref-is-default} respectively. While still working, +these variables are deprecated now. Instead of setting them, the +variable @code{reftex-ref-style-default-list} should be adapted now. + +@node xr (LaTeX package), , Reference Styles, Labels and References @section @code{xr}: Cross-Document References @cindex @code{xr}, LaTeX package @cindex LaTeX packages, @code{xr} @@ -1589,7 +1760,7 @@ information. @cindex References to external documents @cindex Cross-document references -The LaTeX package @code{xr} makes it possible to create references to +The @LaTeX{} package @code{xr} makes it possible to create references to labels defined in external documents. The preamble of a document using @code{xr} will contain something like this: @@ -1604,66 +1775,26 @@ and we can make references to any labels defined in these external documents by using the prefixes @samp{V1-} and @samp{V3-}, respectively. -@b{Ref@TeX{}} can be used to create such references as well. Start the +@RefTeX{} can be used to create such references as well. Start the referencing process normally, by pressing @kbd{C-c )}. Select a label type if necessary. When you see the label selection buffer, pressing @kbd{x} will switch to the label selection buffer of one of the external -documents. You may then select a label as before and @b{Ref@TeX{}} will +documents. You may then select a label as before and @RefTeX{} will insert it along with the required prefix. For this kind of inter-document cross-references, saving of parsing information and the use of multiple selection buffers can mean a large speed-up (@pxref{Optimizations}). -@node varioref (LaTeX package), fancyref (LaTeX package), xr (LaTeX package), Labels and References -@section @code{varioref}: Variable Page References -@cindex @code{varioref}, LaTeX package -@cindex @code{\vref} -@cindex LaTeX packages, @code{varioref} -@vindex reftex-vref-is-default -@code{varioref} is a frequently used LaTeX package to create -cross--references with page information. When you want to make a -reference with the @code{\vref} macro, just press the @kbd{v} key in the -selection buffer to toggle between @code{\ref} and @code{\vref} -(@pxref{Referencing Labels}). The mode line of the selection buffer -shows the current status of this switch. If you find that you almost -always use @code{\vref}, you may want to make it the default by -customizing the variable @code{reftex-vref-is-default}. If this -toggling seems too inconvenient, you can also use the command -@code{reftex-varioref-vref}@footnote{bind it to @kbd{C-c v}.}. -Or use AUCTeX to create your macros (@pxref{AUCTeX}). - -@node fancyref (LaTeX package), , varioref (LaTeX package), Labels and References -@section @code{fancyref}: Fancy Cross References -@cindex @code{fancyref}, LaTeX package -@cindex @code{\fref} -@cindex @code{\Fref} -@cindex LaTeX packages, @code{fancyref} -@vindex reftex-fref-is-default -@code{fancyref} is a LaTeX package where a macro call like -@code{\fref@{@var{fig:map-of-germany}@}} creates not only the number of -the referenced counter but also the complete text around it, like -@samp{Figure 3 on the preceding page}. In order to make it work you -need to use label prefixes like @samp{fig:} consistently - something -@b{Ref@TeX{}} does automatically. When you want to make a reference -with the @code{\fref} macro, just press the @kbd{V} key in the selection -buffer to cycle between @code{\ref}, @code{\fref} and @code{\Fref} -(@pxref{Referencing Labels}). The mode line of the selection buffer -shows the current status of this switch. If this cycling seems -inconvenient, you can also use the commands @code{reftex-fancyref-fref} -and @code{reftex-fancyref-Fref}@footnote{bind them to @kbd{C-c -f} and @kbd{C-c F}.}. Or use AUCTeX to create your macros -(@pxref{AUCTeX}). - @node Citations, Index Support, Labels and References, Top @chapter Citations @cindex Citations @cindex @code{\cite} -Citations in LaTeX are done with the @code{\cite} macro or variations of +Citations in @LaTeX{} are done with the @code{\cite} macro or variations of it. The argument of the macro is a citation key which identifies an -article or book in either a BibTeX database file or in an explicit -@code{thebibliography} environment in the document. @b{Ref@TeX{}}'s +article or book in either a @BibTeX{} database file or in an explicit +@code{thebibliography} environment in the document. @RefTeX{}'s support for citations helps to select the correct key quickly. @menu @@ -1684,7 +1815,7 @@ support for citations helps to select the correct key quickly. @cindex Selection buffer, citations @cindex Selection process -In order to create a citation, press @kbd{C-c [}. @b{Ref@TeX{}} then +In order to create a citation, press @kbd{C-c [}. @RefTeX{} then prompts for a regular expression which will be used to search through the database and present the list of matches to choose from in a selection process similar to that for selecting labels @@ -1695,8 +1826,8 @@ logic @code{and} for regular expressions. For example @samp{Einstein&&Bose} will match all articles which mention Bose-Einstein condensation, or which are co-authored by Bose and Einstein. When entering the regular expression, you can complete on -known citation keys. RefTeX also offers a default when prompting for a -regular expression. This default is the word before the cursor or the +known citation keys. @RefTeX{} also offers a default when prompting for +a regular expression. This default is the word before the cursor or the word before the current @samp{\cite} command. Sometimes this may be a good search key. @@ -1704,16 +1835,16 @@ good search key. @cindex @code{thebibliography}, LaTeX environment @cindex @code{BIBINPUTS}, environment variable @cindex @code{TEXBIB}, environment variable -@b{Ref@TeX{}} prefers to use BibTeX database files specified with a +@RefTeX{} prefers to use @BibTeX{} database files specified with a @code{\bibliography} macro to collect its information. Just like -BibTeX, it will search for the specified files in the current directory +@BibTeX{}, it will search for the specified files in the current directory and along the path given in the environment variable @code{BIBINPUTS}. -If you do not use BibTeX, but the document contains an explicit -@code{thebibliography} environment, @b{Ref@TeX{}} will collect its +If you do not use @BibTeX{}, but the document contains an explicit +@code{thebibliography} environment, @RefTeX{} will collect its information from there. Note that in this case the information presented in the selection buffer will just be a copy of relevant @code{\bibitem} entries, not the structured listing available with -BibTeX database files. +@BibTeX{} database files. @kindex ? In the selection buffer, the following keys provide special commands. A @@ -1743,7 +1874,7 @@ another window. See also the @kbd{f} key. @item f Toggle follow mode. When follow mode is active, the other window will always display the full database entry of the current article. This is -equivalent to pressing @key{SPC} after each cursor motion. With BibTeX +equivalent to pressing @key{SPC} after each cursor motion. With @BibTeX{} entries, follow mode can be rather slow. @tablesubheading{Selecting entries and creating the citation} @@ -1774,12 +1905,12 @@ Accept all (marked) entries in the selection buffer and create a separate @code{\cite} macro for each of it. @item e -Create a new BibTeX database file which contains all @i{marked} entries +Create a new @BibTeX{} database file which contains all @i{marked} entries in the selection buffer. If no entries are marked, all entries are selected. @item E -Create a new BibTeX database file which contains all @i{unmarked} +Create a new @BibTeX{} database file which contains all @i{unmarked} entries in the selection buffer. If no entries are marked, all entries are selected. @@ -1814,6 +1945,17 @@ entries. In order to define additional commands for this selection process, the keymap @code{reftex-select-bib-map} may be used. +Note that if you do not use Emacs to edit the @BibTeX{} database files, +@RefTeX{} will ask if the related buffers should be updated once it +detects that the files were changed externally. If you do not want to +be bothered by such queries, you can activate Auto Revert mode for these +buffers by adding the following expression to your init file: + +@lisp +(add-hook 'bibtex-mode-hook 'turn-on-auto-revert-mode) +@end lisp + + @node Citation Styles, Citation Info, Creating Citations, Citations @section Citation Styles @cindex Citation styles @@ -1821,20 +1963,22 @@ keymap @code{reftex-select-bib-map} may be used. @cindex Citation styles, @code{harvard} @cindex Citation styles, @code{chicago} @cindex Citation styles, @code{jurabib} +@cindex Citation styles, @ConTeXt{} @cindex @code{natbib}, citation style @cindex @code{harvard}, citation style @cindex @code{chicago}, citation style @cindex @code{jurabib}, citation style +@cindex @ConTeXt{}, citation style @vindex reftex-cite-format -The standard LaTeX macro @code{\cite} works well with numeric or simple -key citations. To deal with the more complex task of author-year +The standard @LaTeX{} macro @code{\cite} works well with numeric or +simple key citations. To deal with the more complex task of author-year citations as used in many natural sciences, a variety of packages has been developed which define derived forms of the @code{\cite} macro. -@b{Ref@TeX{}} can be configured to produce these citation macros as well -by setting the variable @code{reftex-cite-format}. For the most -commonly used packages (@code{natbib}, @code{harvard}, @code{chicago}, -@code{jurabib}) this may be done from the menu, under +@RefTeX{} can be configured to produce these citation macros as well by +setting the variable @code{reftex-cite-format}. For the most commonly +used @LaTeX{} packages (@code{natbib}, @code{harvard}, @code{chicago}, +@code{jurabib}) and for @ConTeXt{} this may be done from the menu, under @code{Ref->Citation Styles}. Since there are usually several macros to create the citations, executing @code{reftex-citation} (@kbd{C-c [}) starts by prompting for the correct macro. For the Natbib style, this @@ -1856,7 +2000,7 @@ SELECT A CITATION FORMAT @end example @vindex reftex-cite-prompt-optional-args -If cite formats contain empty paris of square brackets, RefTeX can +If citation formats contain empty pairs of square brackets, @RefTeX{} will prompt for values of these optional arguments if you call the @code{reftex-citation} command with a @kbd{C-u} prefix. Following the most generic of these packages, @code{natbib}, the builtin @@ -1872,12 +2016,12 @@ To make one of these styles the default, customize the variable (setq reftex-cite-format 'natbib) @end lisp -You can also use AUCTeX style files to automatically set the +You can also use @AUCTeX{} style files to automatically set the citation style based on the @code{usepackage} commands in a given document. @xref{Style Files}, for information on how to set up the style files correctly. -@node Citation Info, Chapterbib and Bibunits, Citation Styles, Citations, Top +@node Citation Info, Chapterbib and Bibunits, Citation Styles, Citations @section Citation Info @cindex Displaying citations @cindex Citations, displaying @@ -1893,9 +2037,9 @@ argument of a @code{\cite} macro, the echo area will display some information about the article cited there. Note that the information is only displayed if the echo area is not occupied by a different message. -@b{Ref@TeX{}} can also display the @code{\bibitem} or BibTeX database +@RefTeX{} can also display the @code{\bibitem} or @BibTeX{} database entry corresponding to a @code{\cite} macro, or all citation locations -corresponding to a @code{\bibitem} or BibTeX database entry. +corresponding to a @code{\bibitem} or @BibTeX{} database entry. @xref{Viewing Cross-References}. @node Chapterbib and Bibunits, Citations Outside LaTeX, Citation Info, Citations @@ -1904,24 +2048,24 @@ corresponding to a @code{\bibitem} or BibTeX database entry. @cindex @code{bibunits}, LaTeX package @cindex Bibliographies, multiple -@code{chapterbib} and @code{bibunits} are two LaTeX packages which +@code{chapterbib} and @code{bibunits} are two @LaTeX{} packages which produce multiple bibliographies in a document. This is no problem for -@b{Ref@TeX{}} as long as all bibliographies use the same BibTeX database +@RefTeX{} as long as all bibliographies use the same @BibTeX{} database files. If they do not, it is best to have each document part in a separate file (as it is required for @code{chapterbib} anyway). Then -@b{Ref@TeX{}} will still scan the locally relevant databases correctly. If +@RefTeX{} will still scan the locally relevant databases correctly. If you have multiple bibliographies within a @emph{single file}, this may or may not be the case. @node Citations Outside LaTeX, BibTeX Database Subsets, Chapterbib and Bibunits, Citations -@section Citations outside LaTeX +@section Citations outside @LaTeX{} @cindex Citations outside LaTeX @vindex reftex-default-bibliography -The command @code{reftex-citation} can also be executed outside a LaTeX +The command @code{reftex-citation} can also be executed outside a @LaTeX{} buffer. This can be useful to reference articles in the mail buffer and other documents. You should @emph{not} enter @code{reftex-mode} for -this, just execute the command. The list of BibTeX files will in this +this, just execute the command. The list of @BibTeX{} files will in this case be taken from the variable @code{reftex-default-bibliography}. Setting the variable @code{reftex-cite-format} to the symbol @code{locally} does a decent job of putting all relevant information @@ -1943,24 +2087,24 @@ binding for @code{reftex-cite-format}. @cindex BibTeX database subsets @findex reftex-create-bibtex-file -@b{Ref@TeX{}} offers two ways to create a new BibTeX database file. +@RefTeX{} offers two ways to create a new @BibTeX{} database file. The first option produces a file which contains only the entries actually referenced in the current document. This can be useful if -the database in only meant for a single document and you want to clean +the database is only meant for a single document and you want to clean it of old and unused ballast. It can also be useful while writing a document together with collaborators, in order to avoid sending around the entire (possibly very large) database. To create the file, use @kbd{M-x reftex-create-bibtex-file}, also available from the menu under @code{Ref->Global Actions->Create Bibtex File}. The command will -prompt for a BibTeX file name and write the extracted entries to that +prompt for a @BibTeX{} file name and write the extracted entries to that file. The second option makes use of the selection process started by the command @kbd{C-c [} (@pxref{Creating Citations}). This command uses a regular expression to select entries, and lists them in a formatted selection buffer. After pressing the @kbd{e} key (mnemonics: Export), -the command will prompt for the name of a new BibTeX file and write +the command will prompt for the name of a new @BibTeX{} file and write the selected entries to that file. You can also first mark some entries in the selection buffer with the @kbd{m} key and then export either the @i{marked} entries (with the @kbd{e} key) or the @@ -1971,15 +2115,15 @@ either the @i{marked} entries (with the @kbd{e} key) or the @cindex Index Support @cindex @code{\index} -LaTeX has builtin support for creating an Index. The LaTeX core +@LaTeX{} has builtin support for creating an Index. The @LaTeX{} core supports two different indices, the standard index and a glossary. With -the help of special LaTeX packages (@file{multind.sty} or +the help of special @LaTeX{} packages (@file{multind.sty} or @file{index.sty}), any number of indices can be supported. Index entries are created with the @code{\index@{@var{entry}@}} macro. All entries defined in a document are written out to the @file{.aux} file. A separate tool must be used to convert this information into a -nicely formatted index. Tools used with LaTeX include @code{MakeIndex} +nicely formatted index. Tools used with @LaTeX{} include @code{MakeIndex} and @code{xindy}. Indexing is a very difficult task. It must follow strict conventions to @@ -1996,27 +2140,27 @@ correspond to appropriate index entries. This part of the index can very well be developed along with the document. Often it is worthwhile to define special purpose macros which define an item and at the same time make an index entry, possibly with special formatting to make the -reference page in the index bold or underlined. To make @b{Ref@TeX{}} +reference page in the index bold or underlined. To make @RefTeX{} support for indexing possible, these special macros must be added to -@b{Ref@TeX{}}'s configuration (@pxref{Defining Index Macros}). +@RefTeX{}'s configuration (@pxref{Defining Index Macros}). @item The rest of the index is often just a collection of where in the document certain words or phrases are being used. This part is difficult to develop along with the document, because consistent entries for each occurrence are needed and are best selected when the document -is ready. @b{Ref@TeX{}} supports this with an @emph{index phrases file} +is ready. @RefTeX{} supports this with an @emph{index phrases file} which collects phrases and helps indexing the phrases globally. @end enumerate -Before you start, you need to make sure that @b{Ref@TeX{}} knows about -the index style being used in the current document. @b{Ref@TeX{}} has +Before you start, you need to make sure that @RefTeX{} knows about +the index style being used in the current document. @RefTeX{} has builtin support for the default @code{\index} and @code{\glossary} -macros. Other LaTeX packages, like the @file{multind} or @file{index} +macros. Other @LaTeX{} packages, like the @file{multind} or @file{index} package, redefine the @code{\index} macro to have an additional -argument, and @b{Ref@TeX{}} needs to be configured for those. A -sufficiently new version of AUCTeX (9.10c or later) will do this -automatically. If you really don't use AUCTeX (you should!), this +argument, and @RefTeX{} needs to be configured for those. A +sufficiently new version of @AUCTeX{} (9.10c or later) will do this +automatically. If you really don't use @AUCTeX{} (you should!), this configuration needs to be done by hand with the menu (@code{Ref->Index Style}), or globally for all your documents with @@ -2057,7 +2201,7 @@ When there is nothing selected and no word at point, this command will just call @code{reftex-index}, described below. In order to create a general index entry, press @kbd{C-c <} -(@code{reftex-index}). @b{Ref@TeX{}} will prompt for one of the +(@code{reftex-index}). @RefTeX{} will prompt for one of the available index macros and for its arguments. Completion will be available for the index entry and, if applicable, the index tag. The index tag is a string identifying one of multiple indices. With the @@ -2072,7 +2216,7 @@ to the redefined @code{\index} macro. @findex reftex-index-visit-phrases-buffer @cindex Macro definition lines, in phrase buffer -@b{Ref@TeX{}} maintains a file in which phrases can be collected for +@RefTeX{} maintains a file in which phrases can be collected for later indexing. The file is located in the same directory as the master file of the document and has the extension @file{.rip} (@b{R}eftex @b{I}ndex @b{P}hrases). You can create or visit the file with @kbd{C-c @@ -2080,7 +2224,7 @@ file of the document and has the extension @file{.rip} (@b{R}eftex is initialized by inserting a file header which contains the definition of the available index macros. This list is initialized from @code{reftex-index-macros} (@pxref{Defining Index Macros}). You can -edit the header as needed, but if you define new LaTeX indexing macros, +edit the header as needed, but if you define new @LaTeX{} indexing macros, don't forget to add them to @code{reftex-index-macros} as well. Here is a phrase file header example: @@ -2122,7 +2266,7 @@ Phrases for indexing can be collected while writing the document. The command @kbd{C-c \} (@code{reftex-index-phrase-selection-or-word}) copies the current selection (if active) or the word near point into the phrases buffer. It then selects this buffer, so that the phrase line -can be edited. To return to the LaTeX document, press @kbd{C-c C-c} +can be edited. To return to the @LaTeX{} document, press @kbd{C-c C-c} (@code{reftex-index-phrases-save-and-return}). You can also prepare the list of index phrases in a different way and @@ -2131,7 +2275,7 @@ a word list of the document and remove all words which should not be indexed. The phrase lines in the phrase buffer must have a specific format. -@b{Ref@TeX{}} will use font-lock to indicate if a line has the proper +@RefTeX{} will use font-lock to indicate if a line has the proper format. A phrase line looks like this: @example @@ -2226,7 +2370,7 @@ region and @kbd{C-c C-a} on all phrase lines in the buffer. It is probably good to do indexing in small chunks since your concentration may not last long enough to do everything in one go. -@b{Ref@TeX{}} will start at the first phrase line and search the phrase +@RefTeX{} will start at the first phrase line and search the phrase globally in the whole document. At each match it will stop, compute the replacement string and offer you the following choices@footnote{Windows users: Restrict yourself to the described keys during indexing. Pressing @@ -2275,9 +2419,9 @@ sentence, and even typos. You can always say @emph{no} at a match you do not like. @item Wrap Long Lines Inserting index macros increases the line length. Turn this option on -to allow @b{Ref@TeX{}} to wrap long lines. +to allow @RefTeX{} to wrap long lines. @item Skip Indexed Matches -When this is on, @b{Ref@TeX{}} will at each match try to figure out if +When this is on, @RefTeX{} will at each match try to figure out if this match is already indexed. A match is considered indexed if it is either the argument of an index macro, or if an index macro is directly (without whitespace separation) before or after the match. Index macros @@ -2289,7 +2433,7 @@ Even though indexing should be the last thing you do to a document, you are bound to make changes afterwards. Indexing then has to be applied to the changed regions. The command @code{reftex-index-phrases-apply-to-region} is designed for this -purpose. When called from a LaTeX document with active region, it will +purpose. When called from a @LaTeX{} document with active region, it will apply @code{reftex-index-all-phrases} to the current region. @node Displaying and Editing the Index, Builtin Index Macros, The Index Phrases File, Index Support @@ -2303,7 +2447,7 @@ apply @code{reftex-index-all-phrases} to the current region. @findex reftex-display-index In order to compile and display the index, press @kbd{C-c >}. If the -document uses multiple indices, @b{Ref@TeX{}} will ask you to select +document uses multiple indices, @RefTeX{} will ask you to select one. Then, all index entries will be sorted alphabetically and displayed in a special buffer, the @file{*Index*} buffer. From that buffer you can check and edit each entry. @@ -2317,7 +2461,7 @@ region, make the region active and use a numeric prefix @samp{3} (press restriction can be moved from one section to the next by pressing the @kbd{<} and @kbd{>} keys. -One caveat: @b{Ref@TeX{}} finds the definition point of an index entry +One caveat: @RefTeX{} finds the definition point of an index entry by searching near the buffer position where it had found to macro during scanning. If you have several identical index entries in the same buffer and significant changes have shifted the entries around, you must @@ -2371,7 +2515,7 @@ always show the location corresponding to the line in the @file{*Index*} buffer at point. This is similar to pressing @key{SPC} after each cursor motion. The default for this flag can be set with the variable @code{reftex-index-follow-mode}. Note that only context in files -already visited is shown. @b{Ref@TeX{}} will not visit a file just for +already visited is shown. @RefTeX{} will not visit a file just for follow mode. See, however, the variable @code{reftex-revisit-to-follow}. @@ -2459,12 +2603,12 @@ will move to the correct position. @item r @vindex reftex-enable-partial-scans -Reparse the LaTeX document and rebuild the @file{*Index*} buffer. When +Reparse the @LaTeX{} document and rebuild the @file{*Index*} buffer. When @code{reftex-enable-partial-scans} is non-@code{nil}, rescan only the file this location is defined in, not the entire document. @item C-u r -Reparse the @emph{entire} LaTeX document and rebuild the @file{*Index*} +Reparse the @emph{entire} @LaTeX{} document and rebuild the @file{*Index*} buffer. @item s @@ -2483,8 +2627,8 @@ indices). @cindex LaTeX packages, @code{multind} @cindex LaTeX packages, @code{index} -@b{Ref@TeX{}} by default recognizes the @code{\index} and -@code{\glossary} macros which are defined in the LaTeX core. It has +@RefTeX{} by default recognizes the @code{\index} and +@code{\glossary} macros which are defined in the @LaTeX{} core. It has also builtin support for the re-implementations of @code{\index} in the @file{multind} and @file{index} packages. However, since the different definitions of the @code{\index} macro are incompatible, @@ -2513,7 +2657,7 @@ argument in the text and places it into a separate index with the tag @samp{name}@footnote{We are using the syntax of the @file{index} package here.}. The last macro also places its argument into the index, but as subitems under the main index entry @samp{Astronomical Objects}. Here -is how to make @b{Ref@TeX{}} recognize and correctly interpret these +is how to make @RefTeX{} recognize and correctly interpret these macros, first with Emacs Lisp. @lisp @@ -2528,7 +2672,7 @@ Note that the index tag is @samp{idx} for the main index, and for the default index and for the glossary. The character arguments @code{?x}, @code{?n}, and @code{?o} are for -quick identification of these macros when @b{Ref@TeX{}} inserts new +quick identification of these macros when @RefTeX{} inserts new index entries with @code{reftex-index}. These codes need to be unique. @code{?i}, @code{?I}, and @code{?g} are reserved for the @code{\index}, @code{\index*}, and @code{\glossary} macros, @@ -2589,22 +2733,22 @@ in the buffer with @kbd{C-c /} (@code{reftex-index-selection-or-word}). The index tag is "idx". @node Viewing Cross-References, RefTeXs Menu, Index Support, Top -@chapter Viewing Cross--References +@chapter Viewing Cross-References @findex reftex-view-crossref @findex reftex-mouse-view-crossref @kindex C-c & @kindex S-mouse-2 -@b{Ref@TeX{}} can display cross--referencing information. This means, -if two document locations are linked, @b{Ref@TeX{}} can display the +@RefTeX{} can display cross-referencing information. This means, +if two document locations are linked, @RefTeX{} can display the matching location(s) in another window. The @code{\label} and @code{\ref} macros are one way of establishing such a link. Also, a @code{\cite} -macro is linked to the corresponding @code{\bibitem} macro or a BibTeX +macro is linked to the corresponding @code{\bibitem} macro or a @BibTeX{} database entry. The feature is invoked by pressing @kbd{C-c &} (@code{reftex-view-crossref}) while point is on the @var{key} argument -of a macro involved in cross--referencing. You can also click with +of a macro involved in cross-referencing. You can also click with @kbd{S-mouse-2} on the macro argument. Here is what will happen for individual classes of macros: @@ -2615,7 +2759,7 @@ individual classes of macros: Display the corresponding label definition. All usual variants@footnote{all macros that start with @samp{ref} or end with @samp{ref} or @samp{refrange}} of the @code{\ref} macro are active for -cross--reference display. This works also for labels defined in an +cross-reference display. This works also for labels defined in an external document when the current document refers to them through the @code{xr} interface (@pxref{xr (LaTeX package)}). @@ -2626,13 +2770,13 @@ Display a document location which references this label. Pressing @kbd{C-c &} several times moves through the entire document and finds all locations. Not only the @code{\label} macro but also other macros with label arguments (as configured with @code{reftex-label-alist}) are -active for cross--reference display. +active for cross-reference display. @item @code{\cite} @cindex @code{\cite} -Display the corresponding BibTeX database entry or @code{\bibitem}. +Display the corresponding @BibTeX{} database entry or @code{\bibitem}. All usual variants@footnote{all macros that either start or end with -@samp{cite}} of the @code{\cite} macro are active for cross--reference +@samp{cite}} of the @code{\cite} macro are active for cross-reference display. @item @code{\bibitem} @@ -2641,12 +2785,12 @@ Display a document location which cites this article. Pressing @kbd{C-c &} several times moves through the entire document and finds all locations. -@item BibTeX +@item @BibTeX{} @cindex BibTeX buffer, viewing cite locations from @cindex Viewing cite locations from BibTeX buffer -@kbd{C-c &} is also active in BibTeX buffers. All locations in a +@kbd{C-c &} is also active in @BibTeX{} buffers. All locations in a document where the database entry at point is cited will be displayed. -On first use, @b{Ref@TeX{}} will prompt for a buffer which belongs to +On first use, @RefTeX{} will prompt for a buffer which belongs to the document you want to search. Subsequent calls will use the same document, until you break this link with a prefix argument to @kbd{C-c &}. @@ -2661,7 +2805,7 @@ and @code{\glossary} macros, all macros configured in @vindex reftex-view-crossref-extra While the display of cross referencing information for the above -mentioned macros is hard--coded, you can configure additional relations +mentioned macros is hard-coded, you can configure additional relations in the variable @code{reftex-view-crossref-extra}. @iftex @@ -2669,14 +2813,14 @@ in the variable @code{reftex-view-crossref-extra}. @end iftex @node RefTeXs Menu, Key Bindings, Viewing Cross-References, Top -@section @b{Ref@TeX{}}'s Menu +@section @RefTeX{}'s Menu @cindex RefTeXs Menu @cindex Menu, in the menu bar -@b{Ref@TeX{}} installs a @code{Ref} menu in the menu bar on systems +@RefTeX{} installs a @code{Ref} menu in the menu bar on systems which support this. From this menu you can access all of -@b{Ref@TeX{}}'s commands and a few of its options. There is also a -@code{Customize} submenu which can be used to access @b{Ref@TeX{}}'s +@RefTeX{}'s commands and a few of its options. There is also a +@code{Customize} submenu which can be used to access @RefTeX{}'s entire set of options. @node Key Bindings, Faces, RefTeXs Menu, Top @@ -2713,7 +2857,7 @@ Here is a summary of the available key bindings. @end example Note that the @kbd{S-mouse-2} binding is only provided if this key is -not already used by some other package. @b{Ref@TeX{}} will not override an +not already used by some other package. @RefTeX{} will not override an existing binding to @kbd{S-mouse-2}. Personally, I also bind some functions in the users @kbd{C-c} map for @@ -2749,7 +2893,7 @@ default. If you want to have these key bindings available, set in your @end lisp @vindex reftex-load-hook -Changing and adding to @b{Ref@TeX{}}'s key bindings is best done in the hook +Changing and adding to @RefTeX{}'s key bindings is best done in the hook @code{reftex-load-hook}. For information on the keymaps which should be used to add keys, see @ref{Keymaps and Hooks}. @@ -2757,9 +2901,9 @@ which should be used to add keys, see @ref{Keymaps and Hooks}. @section Faces @cindex Faces -@b{Ref@TeX{}} uses faces when available to structure the selection and +@RefTeX{} uses faces when available to structure the selection and table of contents buffers. It does not create its own faces, but uses -the ones defined in @file{font-lock.el}. Therefore, @b{Ref@TeX{}} will +the ones defined in @file{font-lock.el}. Therefore, @RefTeX{} will use faces only when @code{font-lock} is loaded. This seems to be reasonable because people who like faces will very likely have it loaded. If you wish to turn off fontification or change the involved @@ -2775,9 +2919,9 @@ files: @itemize @bullet @item -@b{Ref@TeX{}} has full support for multifile documents. You can edit parts of +@RefTeX{} has full support for multifile documents. You can edit parts of several (multifile) documents at the same time without conflicts. -@b{Ref@TeX{}} provides functions to run @code{grep}, @code{search} and +@RefTeX{} provides functions to run @code{grep}, @code{search} and @code{query-replace} on all files which are part of a multifile document. @@ -2785,10 +2929,10 @@ document. @vindex tex-main-file @vindex TeX-master All files belonging to a multifile document should define a File -Variable (@code{TeX-master} for AUCTeX or @code{tex-main-file} for the -standard Emacs LaTeX mode) containing the name of the master file. For +Variable (@code{TeX-master} for @AUCTeX{} or @code{tex-main-file} for the +standard Emacs @LaTeX{} mode) containing the name of the master file. For example, to set the file variable @code{TeX-master}, include something -like the following at the end of each TeX file: +like the following at the end of each @TeX{} file: @example %%% Local Variables: *** @@ -2797,7 +2941,7 @@ like the following at the end of each TeX file: %%% End: *** @end example -AUCTeX with the setting +@AUCTeX{} with the setting @lisp (setq-default TeX-master nil) @@ -2805,14 +2949,14 @@ AUCTeX with the setting will actually ask you for each new file about the master file and insert this comment automatically. For more details see the documentation of -the AUCTeX (@pxref{Multifile,,,auctex, The AUC TeX User Manual}), the +the @AUCTeX{} (@pxref{Multifile,,,auctex, The AUCTeX User Manual}), the documentation about the Emacs (La)TeX mode (@pxref{TeX Print,,,emacs, The GNU Emacs Manual}) and the Emacs documentation on File Variables (@pxref{File Variables,,,emacs, The GNU Emacs Manual}). @item The context of a label definition must be found in the same file as the -label itself in order to be processed correctly by @b{Ref@TeX{}}. The only +label itself in order to be processed correctly by @RefTeX{}. The only exception is that section labels referring to a section statement outside the current file can still use that section title as context. @@ -2822,7 +2966,7 @@ context. @section Language Support @cindex Language support -Some parts of @b{Ref@TeX{}} are language dependent. The default +Some parts of @RefTeX{} are language dependent. The default settings work well for English. If you are writing in a different language, the following hints may be useful: @@ -2838,7 +2982,7 @@ to be changed for other languages. See the variables @item @vindex reftex-translate-to-ascii-function @vindex reftex-label-illegal-re -Also, when a label is derived from context, @b{Ref@TeX{}} clears the +Also, when a label is derived from context, @RefTeX{} clears the context string from non-ASCII characters in order to make a valid label. If there should ever be a version of @TeX{} which allows extended characters @emph{in labels}, then we will have to look at the @@ -2846,7 +2990,7 @@ variables @code{reftex-translate-to-ascii-function} and @code{reftex-label-illegal-re}. @item -When a label is referenced, @b{Ref@TeX{}} looks at the word before point +When a label is referenced, @RefTeX{} looks at the word before point to guess which label type is required. These @emph{magic words} are different in every language. For an example of how to add magic words, see @ref{Adding Magic Words}. @@ -2854,7 +2998,7 @@ see @ref{Adding Magic Words}. @vindex reftex-multiref-punctuation @vindex reftex-cite-punctuation @item -@b{Ref@TeX{}} inserts ``punctuation'' for multiple references and +@RefTeX{} inserts ``punctuation'' for multiple references and for the author list in citations. Some of this may be language dependent. See the variables @code{reftex-multiref-punctuation} and @code{reftex-cite-punctuation}. @@ -2865,25 +3009,25 @@ dependent. See the variables @code{reftex-multiref-punctuation} and @cindex Finding files In order to find files included in a document via @code{\input} or -@code{\include}, @b{Ref@TeX{}} searches all directories specified in the +@code{\include}, @RefTeX{} searches all directories specified in the environment variable @code{TEXINPUTS}. Similarly, it will search the path specified in the variables @code{BIBINPUTS} and @code{TEXBIB} for -BibTeX database files. +@BibTeX{} database files. -When searching, @b{Ref@TeX{}} will also expand recursive path +When searching, @RefTeX{} will also expand recursive path definitions (directories ending in @samp{//} or @samp{!!}). But it will only search and expand directories @emph{explicitly} given in these variables. This may cause problems under the following circumstances: @itemize @bullet @item -Most TeX system have a default search path for both TeX files and BibTeX +Most @TeX{} system have a default search path for both @TeX{} files and @BibTeX{} files which is defined in some setup file. Usually this default path is -for system files which @b{Ref@TeX{}} does not need to see. But if your -document needs TeX files or BibTeX database files in a directory only -given in the default search path, @b{Ref@TeX{}} will fail to find them. +for system files which @RefTeX{} does not need to see. But if your +document needs @TeX{} files or @BibTeX{} database files in a directory only +given in the default search path, @RefTeX{} will fail to find them. @item -Some TeX systems do not use environment variables at all in order to +Some @TeX{} systems do not use environment variables at all in order to specify the search path. Both default and user search path are then defined in setup files. @end itemize @@ -2896,7 +3040,7 @@ There are three ways to solve this problem: Specify all relevant directories explicitly in the environment variables. If for some reason you don't want to mess with the default variables @code{TEXINPUTS} and @code{BIBINPUTS}, define your own -variables and configure @b{Ref@TeX{}} to use them instead: +variables and configure @RefTeX{} to use them instead: @lisp (setq reftex-texpath-environment-variables '("MYTEXINPUTS")) @@ -2904,7 +3048,7 @@ variables and configure @b{Ref@TeX{}} to use them instead: @end lisp @item -Specify the full search path directly in @b{Ref@TeX{}}'s variables. +Specify the full search path directly in @RefTeX{}'s variables. @lisp (setq reftex-texpath-environment-variables @@ -2914,10 +3058,10 @@ Specify the full search path directly in @b{Ref@TeX{}}'s variables. @end lisp @item -Some TeX systems provide stand--alone programs to do the file search just -like TeX and BibTeX. E.g. Thomas Esser's @code{teTeX} uses the +Some @TeX{} systems provide stand-alone programs to do the file search just +like @TeX{} and @BibTeX{}. E.g. Thomas Esser's @code{teTeX} uses the @code{kpathsearch} library which provides the command @code{kpsewhich} -to search for files. @b{Ref@TeX{}} can be configured to use this +to search for files. @RefTeX{} can be configured to use this program. Note that the exact syntax of the @code{kpsewhich} command depends upon the version of that program. @@ -2935,8 +3079,8 @@ command depends upon the version of that program. Some people like to use RefTeX with noweb files, which usually have the extension @file{.nw}. In order to deal with such files, the new extension must be added to the list of valid extensions in the variable -@code{reftex-file-extensions}. When working with AUCTeX as major mode, -the new extension must also be known to AUCTeX via the variable +@code{reftex-file-extensions}. When working with @AUCTeX{} as major mode, +the new extension must also be known to @AUCTeX{} via the variable @code{TeX-file-extension}. For example: @lisp @@ -2956,15 +3100,15 @@ am leaving this stuff in the manual for people who want to write thick books, where some of it still might be useful.} Implementing the principle of least surprises, the default settings of -@b{Ref@TeX{}} ensure a safe ride for beginners and casual users. However, -when using @b{Ref@TeX{}} for a large project and/or on a small computer, +@RefTeX{} ensure a safe ride for beginners and casual users. However, +when using @RefTeX{} for a large project and/or on a small computer, there are ways to improve speed or memory usage. @itemize @bullet @item @b{Removing Lookup Buffers}@* @cindex Removing lookup buffers -@b{Ref@TeX{}} will load other parts of a multifile document as well as BibTeX +@RefTeX{} will load other parts of a multifile document as well as @BibTeX{} database files for lookup purposes. These buffers are kept, so that subsequent use of the same files is fast. If you can't afford keeping these buffers around, and if you can live with a speed penalty, try @@ -2978,13 +3122,13 @@ these buffers around, and if you can live with a speed penalty, try @b{Partial Document Scans}@* @cindex Partial documents scans @cindex Document scanning, partial -A @kbd{C-u} prefix on the major @b{Ref@TeX{}} commands @code{reftex-label} +A @kbd{C-u} prefix on the major @RefTeX{} commands @code{reftex-label} (@kbd{C-u C-c (}), @code{reftex-reference} (@kbd{C-u C-c )}), @code{reftex-citation} (@kbd{C-u C-c [}), @code{reftex-toc} (@kbd{C-u C-c =}), and @code{reftex-view-crossref} (@kbd{C-u C-c &}) initiates re-parsing of the entire document in order to update the parsing information. For a large document this can be unnecessary, in -particular if only one file has changed. @b{Ref@TeX{}} can be configured +particular if only one file has changed. @RefTeX{} can be configured to do partial scans instead of full ones. @kbd{C-u} re-parsing then does apply only to the current buffer and files included from it. Likewise, the @kbd{r} key in both the label selection buffer and the @@ -3004,7 +3148,7 @@ try @cindex Saving parser information @cindex Parse information, saving to a file @vindex reftex-parse-file-extension -Even with partial scans enabled, @b{Ref@TeX{}} still has to make one full +Even with partial scans enabled, @RefTeX{} still has to make one full scan, when you start working with a document. To avoid this, parsing information can be stored in a file. The file @file{MASTER.rel} is used for storing information about a document with master file @@ -3022,11 +3166,11 @@ session. To use this feature, put into @file{.emacs}: @b{Identifying label types by prefix}@* @cindex Parse information, saving to a file @vindex reftex-trust-label-prefix -@b{Ref@TeX{}} normally parses around each label to check in which +@RefTeX{} normally parses around each label to check in which environment this label is located, in order to assign a label type to the label. If your document contains thousands of labels, document parsing will take considerable time. If you have been using label prefixes -like tab: and fn: consistently, you can tell @b{Ref@TeX{}} to get the +like tab: and fn: consistently, you can tell @RefTeX{} to get the label type directly from the prefix, without additional parsing. This will be faster and also allow labels to end up in the correct category if for some reason it is not possible to derive the correct type from @@ -3041,7 +3185,7 @@ equation labels, use @b{Automatic Document Scans}@* @cindex Automatic document scans @cindex Document scanning, automatic -At rare occasions, @b{Ref@TeX{}} will automatically rescan a part of the +At rare occasions, @RefTeX{} will automatically rescan a part of the document. If this gets into your way, it can be turned off with @vindex reftex-allow-automatic-rescan @@ -3049,7 +3193,7 @@ document. If this gets into your way, it can be turned off with (setq reftex-allow-automatic-rescan nil) @end lisp -@b{Ref@TeX{}} will then occasionally annotate new labels in the selection +@RefTeX{} will then occasionally annotate new labels in the selection buffer, saying that their position in the label list in uncertain. A manual document scan will fix this. @@ -3059,7 +3203,7 @@ manual document scan will fix this. @cindex Selection buffers, multiple Normally, the selection buffer @file{*RefTeX Select*} is re-created for every selection process. In documents with very many labels this can -take several seconds. @b{Ref@TeX{}} provides an option to create a +take several seconds. @RefTeX{} provides an option to create a separate selection buffer for each label type and to keep this buffer from one selection to the next. These buffers are updated automatically only when a new label has been added in the buffers category with @@ -3089,7 +3233,7 @@ with the @kbd{g} key. To get this behavior, use instead @need 2000 @noindent @b{As a summary}, here are the settings I recommend for heavy use of -@b{Ref@TeX{}} with large documents: +@RefTeX{} with large documents: @lisp @group @@ -3100,30 +3244,30 @@ with the @kbd{g} key. To get this behavior, use instead @end lisp @node AUCTeX, Multifile Documents, Faces, Top -@section AUC@TeX{} +@section @AUCTeX{} @cindex @code{AUCTeX}, Emacs package @cindex Emacs packages, @code{AUCTeX} -AUCTeX is without doubt the best major mode for editing TeX and LaTeX +@AUCTeX{} is without doubt the best major mode for editing @TeX{} and @LaTeX{} files with Emacs (@pxref{Top,AUCTeX,,auctex, The AUCTeX User Manual}). -If AUCTeX is not part of your Emacs distribution, you can get +If @AUCTeX{} is not part of your Emacs distribution, you can get it@footnote{XEmacs 21.x users may want to install the corresponding -XEmacs package.} by ftp from the @value{AUCTEXSITE}. +XEmacs package.} by FTP from the @value{AUCTEXSITE}. @menu * AUCTeX-RefTeX Interface:: How both packages work together -* Style Files:: AUCTeX's style files can support RefTeX +* Style Files:: @AUCTeX{}'s style files can support RefTeX * Bib-Cite:: Hypertext reading of a document @end menu @node AUCTeX-RefTeX Interface, Style Files, , AUCTeX -@subsection The AUC@TeX{}-@b{Ref@TeX{}} Interface +@subsection The @AUCTeX{}-@RefTeX{} Interface -@b{Ref@TeX{}} contains code to interface with AUCTeX. When this +@RefTeX{} contains code to interface with @AUCTeX{}. When this interface is turned on, both packages will interact closely. Instead of -using @b{Ref@TeX{}}'s commands directly, you can then also use them -indirectly as part of the AUCTeX -environment@footnote{@b{Ref@TeX{}} 4.0 and AUCTeX 9.10c will be +using @RefTeX{}'s commands directly, you can then also use them +indirectly as part of the @AUCTeX{} +environment@footnote{@RefTeX{} 4.0 and @AUCTeX{} 9.10c will be needed for all of this to work. Parts of it work also with earlier versions.}. The interface is turned on with @@ -3146,12 +3290,12 @@ The following list describes the individual parts of the interface. @kindex C-c C-s @findex LaTeX-section, @r{AUCTeX} @findex TeX-insert-macro, @r{AUCTeX} -@b{AUCTeX calls @code{reftex-label} to insert labels}@* +@b{@AUCTeX{} calls @code{reftex-label} to insert labels}@* When a new section is created with @kbd{C-c C-s}, or a new environment -is inserted with @kbd{C-c C-e}, AUCTeX normally prompts for a label to +is inserted with @kbd{C-c C-e}, @AUCTeX{} normally prompts for a label to go with it. With the interface, @code{reftex-label} is called instead. -For example, if you type @kbd{C-c C-e equation @key{RET}}, AUCTeX and -@b{Ref@TeX{}} will insert +For example, if you type @kbd{C-c C-e equation @key{RET}}, @AUCTeX{} and +@RefTeX{} will insert @example \begin@{equation@} @@ -3163,12 +3307,12 @@ For example, if you type @kbd{C-c C-e equation @key{RET}}, AUCTeX and @noindent without further prompts. -Similarly, when you type @kbd{C-c C-s section @key{RET}}, @b{Ref@TeX{}} +Similarly, when you type @kbd{C-c C-s section @key{RET}}, @RefTeX{} will offer its default label which is derived from the section title. @item -@b{AUCTeX tells @b{Ref@TeX{}} about new sections}@* -When creating a new section with @kbd{C-c C-s}, @b{Ref@TeX{}} will not +@b{@AUCTeX{} tells @RefTeX{} about new sections}@* +When creating a new section with @kbd{C-c C-s}, @RefTeX{} will not have to rescan the buffer in order to see it. @item @@ -3182,44 +3326,44 @@ have to rescan the buffer in order to see it. @findex TeX-arg-index, @r{AUCTeX function} @findex TeX-insert-macro, @r{AUCTeX function} @kindex C-c @key{RET} -@b{@b{Ref@TeX{}} supplies macro arguments}@* When you insert a macro -interactively with @kbd{C-c @key{RET}}, AUCTeX normally prompts for +@b{@RefTeX{} supplies macro arguments}@* When you insert a macro +interactively with @kbd{C-c @key{RET}}, @AUCTeX{} normally prompts for macro arguments. Internally, it uses the functions @code{TeX-arg-label}, @code{TeX-arg-cite}, and @code{TeX-arg-index} to prompt for arguments which are labels, citation keys and index entries. The interface takes over these functions@footnote{@code{fset} is used to -do this, which is not reversible. However, @b{Ref@TeX{}} implements the +do this, which is not reversible. However, @RefTeX{} implements the old functionality when you later decide to turn off the interface.} and -supplies the macro arguments with @b{Ref@TeX{}'s} mechanisms. For -example, when you type @kbd{C-c @key{RET} ref @key{RET}}, @b{Ref@TeX{}} +supplies the macro arguments with @b{@RefTeX{}'s} mechanisms. For +example, when you type @kbd{C-c @key{RET} ref @key{RET}}, @RefTeX{} will supply its label selection process (@pxref{Referencing Labels}). @item -@b{@b{Ref@TeX{}} tells AUCTeX about new labels, citation-- and index keys}@* -@b{Ref@TeX{}} will add all newly created labels to AUCTeX's completion list. +@b{@RefTeX{} tells @AUCTeX{} about new labels, citation and index keys}@* +@RefTeX{} will add all newly created labels to @AUCTeX{}'s completion list. @end itemize @node Style Files, Bib-Cite, AUCTeX-RefTeX Interface, AUCTeX @subsection Style Files @cindex Style files, AUCTeX @findex TeX-add-style-hook, @r{AUCTeX} -Style files are Emacs Lisp files which are evaluated by AUCTeX in +Style files are Emacs Lisp files which are evaluated by @AUCTeX{} in association with the @code{\documentclass} and @code{\usepackage} commands of a document (@pxref{Style Files,,,auctex}). Support for -@b{Ref@TeX{}} in such a style file is useful when the LaTeX style +@RefTeX{} in such a style file is useful when the @LaTeX{} style defines macros or environments connected with labels, citations, or the index. Many style files (e.g. @file{amsmath.el} or @file{natbib.el}) -distributed with AUCTeX already support @b{Ref@TeX{}} in this +distributed with @AUCTeX{} already support @RefTeX{} in this way. -Before calling a @b{Ref@TeX{}} function, the style hook should always +Before calling a @RefTeX{} function, the style hook should always test for the availability of the function, so that the style file will -also work for people who do not use @b{Ref@TeX{}}. +also work for people who do not use @RefTeX{}. Additions made with style files in the way described below remain local to the current document. For example, if one package uses AMSTeX, the -style file will make @b{Ref@TeX{}} switch over to @code{\eqref}, but +style file will make @RefTeX{} switch over to @code{\eqref}, but this will not affect other documents. @findex reftex-add-label-environments @@ -3230,7 +3374,7 @@ function @code{reftex-add-to-label-alist} which is still available as an alias for compatibility.} which defines additions to @code{reftex-label-alist}. The argument taken by this function must have the same format as @code{reftex-label-alist}. The @file{amsmath.el} -style file of AUCTeX for example contains the following: +style file of @AUCTeX{} for example contains the following: @lisp @group @@ -3262,7 +3406,7 @@ with @code{\newtheorem} might use Similarly, a style hook may contain a call to @code{reftex-set-cite-format} to set the citation format. The style file @file{natbib.el} for the Natbib citation style does switch -@b{Ref@TeX{}}'s citation format like this: +@RefTeX{}'s citation format like this: @lisp (TeX-add-style-hook "natbib" @@ -3286,7 +3430,7 @@ the style @file{multind.el} contains @end lisp If you have your own package @file{myindex} which defines the -following macros to be used with the LaTeX @file{index.sty} file +following macros to be used with the @LaTeX{} @file{index.sty} file @example \newcommand@{\molec@}[1]@{#1\index@{Molecules!#1@}@} \newcommand@{\aindex@}[1]@{#1\index[author]@{#1@} @@ -3310,7 +3454,7 @@ you could write this in the style file @file{myindex.el}: Finally the hook may contain a call to @code{reftex-add-section-levels} to define additional section statements. For example, the FoilTeX class has just two headers, @code{\foilhead} and @code{\rotatefoilhead}. Here -is a style file @file{foils.el} that will inform @b{Ref@TeX{}} about these: +is a style file @file{foils.el} that will inform @RefTeX{} about these: @lisp (TeX-add-style-hook "foils" @@ -3326,20 +3470,20 @@ is a style file @file{foils.el} that will inform @b{Ref@TeX{}} about these: @cindex Emacs packages, @code{bib-cite} Once you have written a document with labels, references and citations, -it can be nice to read it like a hypertext document. @b{Ref@TeX{}} has +it can be nice to read it like a hypertext document. @RefTeX{} has support for that: @code{reftex-view-crossref} (bound to @kbd{C-c &}), @code{reftex-mouse-view-crossref} (bound to @kbd{S-mouse-2}), and @code{reftex-search-document}. A somewhat fancier interface with mouse highlighting is provided (among other things) by Peter S. Galbraith's @file{bib-cite.el}. There is some overlap in the functionalities of -Bib-cite and @b{Ref@TeX{}}. Bib-cite.el comes bundled with -AUCTeX. +Bib-cite and @RefTeX{}. Bib-cite.el comes bundled with +@AUCTeX{}. Bib-cite version 3.06 and later can be configured so that bib-cite's -mouse functions use @b{Ref@TeX{}} for displaying references and citations. -This can be useful in particular when working with the LaTeX @code{xr} +mouse functions use @RefTeX{} for displaying references and citations. +This can be useful in particular when working with the @LaTeX{} @code{xr} package or with an explicit @code{thebibliography} environment (rather -than BibTeX). Bib-cite cannot handle those, but @b{Ref@TeX{}} does. To +than @BibTeX{}). Bib-cite cannot handle those, but @RefTeX{} does. To make use of this feature, try @vindex bib-cite-use-reftex-view-crossref @@ -3354,7 +3498,7 @@ make use of this feature, try @itemize @bullet @item -@b{LaTeX commands}@* +@b{@LaTeX{} commands}@* @cindex LaTeX commands, not found @code{\input}, @code{\include}, and @code{\section} (etc.) statements have to be first on a line (except for white space). @@ -3362,7 +3506,7 @@ have to be first on a line (except for white space). @item @b{Commented regions}@* @cindex Labels, commented out -@b{Ref@TeX{}} sees also labels in regions commented out and will refuse to +@RefTeX{} sees also labels in regions commented out and will refuse to make duplicates of such labels. This is considered to be a feature. @item @@ -3382,7 +3526,7 @@ scan will fix this. The label environment definitions in @code{reftex-label-alist} are global and apply to all documents. If you need to make definitions local to a document, because they would interfere with settings in other -documents, you should use AUCTeX and set up style files with calls to +documents, you should use @AUCTeX{} and set up style files with calls to @code{reftex-add-label-environments}, @code{reftex-set-cite-format}, @code{reftex-add-index-macros}, and @code{reftex-add-section-levels}. Settings made with these functions remain local to the current @@ -3398,9 +3542,9 @@ document. @xref{AUCTeX}. @cindex Emacs packages, @code{iso-cvt} When using packages which make the buffer representation of a file different from its disk representation (e.g. x-symbol, isotex, -iso-cvt) you may find that @b{Ref@TeX{}}'s parsing information sometimes +iso-cvt) you may find that @RefTeX{}'s parsing information sometimes reflects the disk state of a file. This happens only in @emph{unvisited} -parts of a multifile document, because @b{Ref@TeX{}} visits these files +parts of a multifile document, because @RefTeX{} visits these files literally for speed reasons. Then both short context and section headings may look different from what you usually see on your screen. In rare cases @code{reftex-toc} may have problems to jump to an affected @@ -3410,7 +3554,7 @@ this: @item @vindex reftex-keep-temporary-buffers @code{(setq reftex-keep-temporary-buffers t)}@* -This implies that @b{Ref@TeX{}} will load all parts of a multifile +This implies that @RefTeX{} will load all parts of a multifile document into Emacs (i.e. there won't be any temporary buffers). @item @vindex reftex-initialize-temporary-buffers @@ -3437,7 +3581,7 @@ to specify a label. E.g. Lamport's @file{pf.sty} uses both @end example @noindent -We need to trick @b{Ref@TeX{}} into swallowing this: +We need to trick @RefTeX{} into swallowing this: @lisp @group @@ -3450,7 +3594,7 @@ We need to trick @b{Ref@TeX{}} into swallowing this: @noindent The first line is just a normal configuration for a macro. For the -@code{step+} environment we actually tell @b{Ref@TeX{}} to look for the +@code{step+} environment we actually tell @RefTeX{} to look for the @emph{macro} @samp{\begin@{step+@}} and interpret the @emph{first} argument (which really is a second argument to the macro @code{\begin}) as a label of type @code{?p}. Argument count for this macro starts only @@ -3462,7 +3606,7 @@ context. @cindex Idle timer restart @vindex reftex-use-itimer-in-xemacs In XEmacs, idle timer restart does not work reliably after fast -keystrokes. Therefore @b{Ref@TeX{}} currently uses the post command +keystrokes. Therefore @RefTeX{} currently uses the post command hook to start the timer used for automatic crossref information. When this bug gets fixed, a real idle timer can be requested with @lisp @@ -3475,7 +3619,7 @@ this bug gets fixed, a real idle timer can be requested with @cindex Key bindings, problems with Viper mode @findex viper-harness-minor-mode With @i{Viper} mode prior to Vipers version 3.01, you need to protect -@b{Ref@TeX{}}'s keymaps with +@RefTeX{}'s keymaps with @lisp (viper-harness-minor-mode "reftex") @@ -3491,15 +3635,15 @@ With @i{Viper} mode prior to Vipers version 3.01, you need to protect @cindex Acknowledgments @cindex Thanks @cindex Bug reports -@cindex @code{http}, @b{Ref@TeX{}} home page -@cindex @code{ftp}, @b{Ref@TeX{}} site +@cindex @code{http}, @RefTeX{} home page +@cindex @code{ftp}, @RefTeX{} site -Ref@TeX{} was written by @i{Carsten Dominik} +@RefTeX{} was written by @i{Carsten Dominik} @email{dominik@@science.uva.nl}, with contributions by @i{Stephen -Eglen}. Ref@TeX{} is currently maintained by @value{MAINTAINER}, see +Eglen}. @RefTeX{} is currently maintained by @value{MAINTAINER}, see the @value{MAINTAINERSITE} for detailed information. -If you have questions about Ref@TeX{}, you can send email to the +If you have questions about @RefTeX{}, you can send email to the @value{SUPPORTADDRESS}. If you want to contribute code or ideas, write to the @value{DEVELADDRESS}. And in the rare case of finding a bug, please use @kbd{M-x reftex-report-bug @key{RET}} which will prepare a @@ -3512,42 +3656,31 @@ There are also several Usenet groups which have competent readers who might be able to help: @code{comp.emacs}, @code{gnu.emacs.help}, @code{comp.emacs.xemacs}, and @code{comp.text.tex}. -@b{Ref@TeX{}} is bundled and pre-installed with Emacs since version 20.2. -It was also bundled and pre-installed with XEmacs 19.16--20.x. XEmacs -21.x users want to install the corresponding plugin package which is -available from the @value{XEMACSFTP}. See the XEmacs 21.x -documentation on package installation for details. - -Users of earlier Emacs distributions (including Emacs 19) can get a -@b{Ref@TeX{}} distribution from the @value{MAINTAINERSITE}. Note that -the Emacs 19 version supports many but not all features described in -this manual. - -Thanks to the people on the Net who have used @b{Ref@TeX{}} and helped +Thanks to the people on the Net who have used @RefTeX{} and helped developing it with their reports. In particular thanks to @i{Ralf Angeli, Fran Burstall, Alastair Burt, Lars Clausen, Soren Dayton, Stephen Eglen, Karl Eichwalder, Erik Frisk, Peter Galbraith, Kai Grossjohann, Frank Harrell, Till A. Heilmann, Peter Heslin, Stephan Heuel, Alan Ho, Lute Kamstra, Dieter Kraft, David Kastrup, Adrian Lanz, -Juri Linkov, Rory Molinari, Stefan Monnier, Laurent Mugnier, Dan -Nicolaescu, Sudeep Kumar Palat, Daniel Polani, Alan Shutko, Robin Socha, -Richard Stanton, Allan Strand, Jan Vroonhof, Christoph Wedler, Alan -Williams, Roland Winkler, Hans-Christoph Wirth, Eli Zaretskii}. - +Juri Linkov, Wolfgang Mayer, Rory Molinari, Stefan Monnier, Laurent +Mugnier, Dan Nicolaescu, Sudeep Kumar Palat, Daniel Polani, Alan Shutko, +Robin Socha, Richard Stanton, Allan Strand, Jan Vroonhof, Christoph +Wedler, Alan Williams, Roland Winkler, Hans-Christoph Wirth, Eli +Zaretskii}. The @code{view-crossref} feature was inspired by @i{Peter Galbraith's} @file{bib-cite.el}. Finally thanks to @i{Uwe Bolick} who first got me interested in -supporting LaTeX labels and references with an editor (which was +supporting @LaTeX{} labels and references with an editor (which was MicroEmacs at the time). @node Commands, Options, Imprint, Top @chapter Commands @cindex Commands, list of -Here is a summary of @b{Ref@TeX{}}'s commands which can be executed from -LaTeX files. Command which are executed from the special buffers are +Here is a summary of @RefTeX{}'s commands which can be executed from +@LaTeX{} files. Command which are executed from the special buffers are not described here. All commands are available from the @code{Ref} menu. See @xref{Key Bindings}. @@ -3567,8 +3700,8 @@ it. With one or two @kbd{C-u} prefixes, enforce document rescan first. @end deffn @deffn Command reftex-citation -Make a citation using BibTeX database files. After prompting for a regular -expression, scans the buffers with BibTeX entries (taken from the +Make a citation using @BibTeX{} database files. After prompting for a regular +expression, scans the buffers with @BibTeX{} entries (taken from the @code{\bibliography} command or a @code{thebibliography} environment) and offers the matching entries for selection. The selected entry is formatted according to @code{reftex-cite-format} and inserted into the @@ -3588,8 +3721,8 @@ expression to match all entries in all files. @deffn Command reftex-index Query for an index macro and insert it along with its arguments. The index macros available are those defined in @code{reftex-index-macro} or -by a call to @code{reftex-add-index-macros}, typically from an AUCTeX -style file. @b{Ref@TeX{}} provides completion for the index tag and the +by a call to @code{reftex-add-index-macros}, typically from an @AUCTeX{} +style file. @RefTeX{} provides completion for the index tag and the index key, and will prompt for other arguments. @end deffn @@ -3600,8 +3733,8 @@ to make an index entry. The phrase indexed is the current selection or the word near point. When called with one @kbd{C-u} prefix, let the user have a chance to edit the index entry. When called with 2 @kbd{C-u} as prefix, also ask for the index macro and other stuff. When -called inside TeX math mode as determined by the @file{texmathp.el} -library which is part of AUCTeX, the string is first processed with the +called inside @TeX{} math mode as determined by the @file{texmathp.el} +library which is part of @AUCTeX{}, the string is first processed with the @code{reftex-index-math-format}, which see. @end deffn @@ -3610,7 +3743,7 @@ Add current selection or the word at point to the phrases buffer. When you are in transient-mark-mode and the region is active, the selection will be used - otherwise the word at point. You get a chance to edit the entry in the phrases buffer - to save the -buffer and return to the LaTeX document, finish with @kbd{C-c C-c}. +buffer and return to the @LaTeX{} document, finish with @kbd{C-c C-c}. @end deffn @deffn Command reftex-index-visit-phrases-buffer @@ -3644,9 +3777,9 @@ the command @code{reftex-view-crossref-from-bibtex}. With one or two @end deffn @deffn Command reftex-view-crossref-from-bibtex -View location in a LaTeX document which cites the BibTeX entry at point. -Since BibTeX files can be used by many LaTeX documents, this function -prompts upon first use for a buffer in @b{Ref@TeX{}} mode. To reset this +View location in a @LaTeX{} document which cites the @BibTeX{} entry at point. +Since @BibTeX{} files can be used by many @LaTeX{} documents, this function +prompts upon first use for a buffer in @RefTeX{} mode. To reset this link to a document, call the function with a prefix arg. Calling this function several times find successive citation locations. @end deffn @@ -3677,7 +3810,7 @@ active TAGS table is required. @deffn Command reftex-isearch-minor-mode Toggle a minor mode which enables incremental search to work globally -on the entire multifile document. Files will be searched in th +on the entire multifile document. Files will be searched in the sequence they appear in the document. @end deffn @@ -3699,7 +3832,7 @@ Renumber all simple labels in the document to make them sequentially. Simple labels are the ones created by RefTeX, consisting only of the prefix and a number. After the command completes, all these labels will have sequential numbers throughout the document. Any references to the -labels will be changed as well. For this, @b{Ref@TeX{}} looks at the +labels will be changed as well. For this, @RefTeX{} looks at the arguments of any macros which either start or end with the string @samp{ref}. This command should be used with care, in particular in multifile documents. You should not use it if another document refers @@ -3711,21 +3844,30 @@ Produce a list of all duplicate labels in the document. @end deffn @deffn Command reftex-create-bibtex-file -Create a new BibTeX database file with all entries referenced in document. -The command prompts for a filename and writes the collected entries to -that file. Only entries referenced in the current document with -any @code{\cite}-like macros are used. -The sequence in the new file is the same as it was in the old database. +@vindex reftex-create-bibtex-header +@vindex reftex-create-bibtex-footer +Create a new @BibTeX{} database file with all entries referenced in +document. The command prompts for a filename and writes the collected +entries to that file. Only entries referenced in the current document +with any @code{\cite}-like macros are used. The sequence in the new +file is the same as it was in the old database. + +Entries referenced from other entries must appear after all referencing +entries. + +You can define strings to be used as header or footer for the created +files in the variables @code{reftex-create-bibtex-header} or +@code{reftex-create-bibtex-footer} respectively. @end deffn @deffn Command reftex-customize -Run the customize browser on the @b{Ref@TeX{}} group. +Run the customize browser on the @RefTeX{} group. @end deffn @deffn Command reftex-show-commentary Show the commentary section from @file{reftex.el}. @end deffn @deffn Command reftex-info -Run info on the top @b{Ref@TeX{}} node. +Run info on the top @RefTeX{} node. @end deffn @deffn Command reftex-parse-document Parse the entire document in order to update the parsing information. @@ -3739,7 +3881,7 @@ removes the parse file associated with the current document. @chapter Options, Keymaps, Hooks @cindex Options, list of -Here is a complete list of @b{Ref@TeX{}}'s configuration variables. All +Here is a complete list of @RefTeX{}'s configuration variables. All variables have customize support - so if you are not familiar with Emacs Lisp (and even if you are) you might find it more comfortable to use @code{customize} to look at and change these variables. @kbd{M-x @@ -3765,14 +3907,14 @@ reftex-customize} will get you there. @cindex Table of contents, options @defopt reftex-include-file-commands -List of LaTeX commands which input another file. +List of @LaTeX{} commands which input another file. The file name is expected after the command, either in braces or separated by whitespace. @end defopt @defopt reftex-max-section-depth Maximum depth of section levels in document structure. -Standard LaTeX needs 7, default is 12. +Standard @LaTeX{} needs 7, default is 12. @end defopt @defopt reftex-section-levels @@ -3910,7 +4052,7 @@ itself and has the following structure: @end example Each list entry describes either an environment carrying a counter for -use with @code{\label} and @code{\ref}, or a LaTeX macro defining a +use with @code{\label} and @code{\ref}, or a @LaTeX{} macro defining a label as (or inside) one of its arguments. The elements of each list entry are: @@ -3947,7 +4089,7 @@ list, to cover cases in which different environments carry the same label type (like @code{equation} and @code{eqnarray}). If the type indicator is @code{nil} and the macro has a label argument @samp{@{*@}}, the macro defines neutral labels just like @code{\label}. In this case -the reminder of this entry is ignored. +the remainder of this entry is ignored. @item @var{label-prefix} Label prefix string, like @samp{tab:}. The prefix is a short string @@ -3968,7 +4110,7 @@ Example: In a file @file{intro.tex}, @samp{eq:%f:} will become @samp{eq:intro:}. @item @var{reference-format} -Format string for reference insert in buffer. @samp{%s} will be +Format string for reference insertion in buffer. @samp{%s} will be replaced by the label. When the format starts with @samp{~}, this @samp{~} will only be inserted when the character before point is @emph{not} a whitespace. @@ -3996,7 +4138,7 @@ If an integer, use the nth argument of the macro. As a special case, 1000 means to get text after the last macro argument. @item If a string, use as regexp to search @emph{backward} from the label. -Context is then the text following the end of the match. E.g. putting +Context is then the text following the end of the match. E.g. setting this to @samp{\\caption[[@{]} will use the caption in a figure or table environment. @samp{\\begin@{eqnarray@}\|\\\\} works for eqnarrays. @@ -4021,7 +4163,7 @@ context: @end example @end itemize -Label context is used in two ways by @b{Ref@TeX{}}: For display in the label +Label context is used in two ways by @RefTeX{}: For display in the label menu, and to derive a label string. If you want to use a different method for each of these, specify them as a dotted pair. E.g. @code{(nil . t)} uses the text after the label (@code{nil}) for @@ -4033,7 +4175,7 @@ List of magic words which identify a reference to be of this type. If the word before point is equal to one of these words when calling @code{reftex-reference}, the label list offered will be automatically restricted to labels of the correct type. If the first element of this -word--list is the symbol `regexp', the strings are interpreted as regular +word list is the symbol `regexp', the strings are interpreted as regular expressions. @item @var{toc-level} @@ -4047,7 +4189,7 @@ made. @end table If the type indicator characters of two or more entries are the same, -@b{Ref@TeX{}} will use +@RefTeX{} will use @itemize @minus @item the first non-@code{nil} format and prefix @@ -4081,7 +4223,7 @@ replaced with the environment or macro. @defopt reftex-trust-label-prefix Non-@code{nil} means, trust the label prefix when determining label type. It is customary to use special label prefixes to distinguish different label -types. The label prefixes have no syntactic meaning in LaTeX (unless +types. The label prefixes have no syntactic meaning in @LaTeX{} (unless special packages like fancyref) are being used. RefTeX can and by default does parse around each label to detect the correct label type, but this process can be slow when a document contains thousands of @@ -4122,7 +4264,7 @@ Flags governing label insertion. The value has the form (@var{derive} @var{prompt}) @end example -If @var{derive} is @code{t}, @b{Ref@TeX{}} will try to derive a sensible +If @var{derive} is @code{t}, @RefTeX{} will try to derive a sensible label from context. A section label for example will be derived from the section heading. The conversion of the context to a valid label is governed by the specifications given in @@ -4171,7 +4313,7 @@ buffer. @deffn Hook reftex-string-to-label-function Function to turn an arbitrary string into a valid label. -@b{Ref@TeX{}}'s default function uses the variable +@RefTeX{}'s default function uses the variable @code{reftex-derive-label-parameters}. @end deffn @@ -4278,35 +4420,38 @@ This is used to string together whole reference sets, like @code{reftex-reference}. @end defopt -@defopt reftex-vref-is-default -Non-@code{nil} means, the varioref macro @code{\vref} is used as -default. In the selection buffer, the @kbd{v} key toggles the reference -macro between @code{\ref} and @code{\vref}. The value of this variable -determines the default which is active when entering the selection -process. Instead of @code{nil} or @code{t}, this may also be a string -of type letters indicating the label types for which it should be -true. +@defopt reftex-ref-style-alist +Alist of reference styles. Each element is a list of the style name, +the name of the @LaTeX{} package associated with the style or @code{t} +for any package, and an alist of macros where the first entry of each +item is the reference macro and the second a key for selecting the macro +when the macro type is being prompted for. (See also +@code{reftex-ref-macro-prompt}.) The keys, represented as characters, +have to be unique. @end defopt -@defopt reftex-fref-is-default -Non-@code{nil} means, the fancyref macro @code{\fref} is used as -default. In the selection buffer, the @kbd{V} key toggles the reference -macro between @code{\ref}, @code{\fref} and @code{\Fref}. The value of -this variable determines the default which is active when entering the -selection process. Instead of @code{nil} or @code{t}, this may also be -a string of type letters indicating the label types for which it should -be true. +@defopt reftex-ref-style-default-list +List of reference styles to be activated by default. The order is +significant and controls the order in which macros can be cycled in the +buffer for selecting a label. The entries in the list have to match the +respective reference style names used in the variable +@code{reftex-ref-style-alist}. +@end defopt + +@defopt reftex-ref-macro-prompt +Controls if @code{reftex-reference} prompts for the reference macro. @end defopt @deffn Hook reftex-format-ref-function If non-@code{nil}, should be a function which produces the string to insert as a reference. Note that the insertion format can also be changed with @code{reftex-label-alist}. This hook also is used by the -special commands to insert @code{\vref} and @code{\fref} references, so -even if you set this, your setting will be ignored by the special -commands. The function will be called with two arguments, the -@var{label} and the @var{default-format} (usually @samp{~\ref@{%s@}}). -It should return the string to insert into the buffer. +special commands to insert e.g. @code{\vref} and @code{\fref} +references, so even if you set this, your setting will be ignored by the +special commands. The function will be called with three arguments, the +@var{label}, the @var{default format} which normally is +@samp{~\ref@{%s@}} and the @var{reference style}. The function should +return the string to insert into the buffer. @end deffn @defopt reftex-level-indent @@ -4315,11 +4460,11 @@ Number of spaces to be used for indentation per section level. @defopt reftex-guess-label-type Non-@code{nil} means, @code{reftex-reference} will try to guess the -label type. To do that, @b{Ref@TeX{}} will look at the word before the +label type. To do that, @RefTeX{} will look at the word before the cursor and compare it with the magic words given in -@code{reftex-label-alist}. When it finds a match, @b{Ref@TeX{}} will +@code{reftex-label-alist}. When it finds a match, @RefTeX{} will immediately offer the correct label menu - otherwise it will prompt you -for a label type. If you set this variable to @code{nil}, @b{Ref@TeX{}} +for a label type. If you set this variable to @code{nil}, @RefTeX{} will always prompt for a label type. @end defopt @@ -4351,7 +4496,7 @@ The keymap which is active in the labels selection process @cindex Creating citations, options @defopt reftex-bibliography-commands -LaTeX commands which specify the BibTeX databases to use with the document. +@LaTeX{} commands which specify the @BibTeX{} databases to use with the document. @end defopt @defopt reftex-bibfile-ignore-regexps @@ -4359,20 +4504,20 @@ List of regular expressions to exclude files in @code{\\bibliography@{..@}}. File names matched by any of these regexps will not be parsed. Intended for files which contain only @code{@@string} macro definitions and the like, which are ignored by -@b{Ref@TeX{}} anyway. +@RefTeX{} anyway. @end defopt @defopt reftex-default-bibliography -List of BibTeX database files which should be used if none are specified. +List of @BibTeX{} database files which should be used if none are specified. When @code{reftex-citation} is called from a document with neither a @samp{\bibliography@{...@}} statement nor a @code{thebibliography} -environment, @b{Ref@TeX{}} will scan these files instead. Intended for -using @code{reftex-citation} in non-LaTeX files. The files will be +environment, @RefTeX{} will scan these files instead. Intended for +using @code{reftex-citation} in non-@LaTeX{} files. The files will be searched along the BIBINPUTS or TEXBIB path. @end defopt @defopt reftex-sort-bibtex-matches -Sorting of the entries found in BibTeX databases by reftex-citation. +Sorting of the entries found in @BibTeX{} databases by reftex-citation. Possible values: @example nil @r{Do not sort entries.} @@ -4393,7 +4538,7 @@ In the format, the following percent escapes will be expanded. @table @code @item %l -The BibTeX label of the citation. +The @BibTeX{} label of the citation. @item %a List of author names, see also @code{reftex-cite-punctuation}. @item %2a @@ -4405,7 +4550,7 @@ Works like @samp{%a}, but on list of editor names. (@samp{%2e} and @samp{%E} work a well). @end table -It is also possible to access all other BibTeX database fields: +It is also possible to access all other @BibTeX{} database fields: @example %b booktitle %c chapter %d edition %h howpublished @@ -4426,7 +4571,7 @@ after the string has been formatted. A pair of square brackets indicates an optional argument, and RefTeX will prompt for the values of these arguments. -Beware that all this only works with BibTeX database files. When +Beware that all this only works with @BibTeX{} database files. When citations are made from the @code{\bibitems} in an explicit @code{thebibliography} environment, only @samp{%l} is available. @@ -4505,6 +4650,24 @@ The keymap which is active in the citation-key selection process (@pxref{Creating Citations}). @end deffn +@defopt reftex-cite-key-separator +String used to separate several keys in a single @samp{\\cite} macro. +Per default this is @samp{","} but if you often have to deal with a lot +of entries and need to break the macro across several lines you might +want to change it to @samp{", "}. +@end defopt + +@defopt reftex-create-bibtex-header +Header to insert in BibTeX files generated by +@code{reftex-create-bibtex-file}. +@end defopt + +@defopt reftex-create-bibtex-footer +Footer to insert in BibTeX files generated by +@code{reftex-create-bibtex-file}. +@end defopt + + @node Options (Index Support), Options (Viewing Cross-References), Options (Creating Citations), Options @section Index Support @cindex Options, Index support @@ -4553,7 +4716,7 @@ should be @samp{Molecules!}. @var{exclude} can be a function. If this function exists and returns a non-@code{nil} value, the index entry at point is ignored. This was implemented to support the (deprecated) @samp{^} and @samp{_} shortcuts -in the LaTeX2e @code{index} package. +in the @LaTeX{}2e @code{index} package. @var{repeat}, if non-@code{nil}, means the index macro does not typeset the entry in the text, so that the text has to be repeated outside the @@ -4564,14 +4727,14 @@ The final entry may also be a symbol. It must have an association in the variable @code{reftex-index-macros-builtin} to specify the main indexing package you are using. Valid values are currently @example -default @r{The LaTeX default - unnecessary to specify this one} +default @r{The @LaTeX{} default - unnecessary to specify this one} multind @r{The multind.sty package} index @r{The index.sty package} index-shortcut @r{The index.sty packages with the ^ and _ shortcuts.} @r{Should not be used - only for old documents} @end example -Note that AUCTeX sets these things internally for @b{Ref@TeX{}} as well, -so with a sufficiently new version of AUCTeX, you should not set the +Note that @AUCTeX{} sets these things internally for @RefTeX{} as well, +so with a sufficiently new version of @AUCTeX{}, you should not set the package here. @end defopt @@ -4584,7 +4747,7 @@ This is a list with @code{(@var{macro-key} @var{default-tag})}. @var{default-tag} is the tag to be used if the macro requires a @var{tag} argument. When this is @code{nil} and a @var{tag} is needed, -@b{Ref@TeX{}} will ask for it. When this is the empty string and the +@RefTeX{} will ask for it. When this is the empty string and the TAG argument of the index macro is optional, the TAG argument will be omitted. @end defopt @@ -4604,11 +4767,11 @@ last @r{The last used index tag will be offered as default} @defopt reftex-index-math-format Format of index entries when copied from inside math mode. When -@code{reftex-index-selection-or-word} is executed inside TeX math mode, +@code{reftex-index-selection-or-word} is executed inside @TeX{} math mode, the index key copied from the buffer is processed with this format string through the @code{format} function. This can be used to add the math delimiters (e.g. @samp{$}) to the string. Requires the -@file{texmathp.el} library which is part of AUCTeX. +@file{texmathp.el} library which is part of @AUCTeX{}. @end defopt @defopt reftex-index-phrase-file-extension @@ -4660,7 +4823,7 @@ When doing global indexing from the phrases buffer, searches for some phrases may match at places where that phrase was already indexed. In particular when indexing an already processed document again, this will even be the norm. When this variable is non-@code{nil}, -@b{Ref@TeX{}} checks if the match is an index macro argument, or if an +@RefTeX{} checks if the match is an index macro argument, or if an index macro is directly before or after the phrase. If that is the case, that match will be ignored. @end defopt @@ -4701,7 +4864,7 @@ Normal hook which is run when a buffer is put into The letters which denote sections in the index. Usually these are all capital letters. Don't use any downcase letters. Order is not significant, the index will be sorted by whatever the sort function -thinks is correct. In addition to these letters, @b{Ref@TeX{}} will +thinks is correct. In addition to these letters, @RefTeX{} will create a group @samp{!} which contains all entries sorted below the lowest specified letter. In the @file{*Index*} buffer, pressing any of these capital letters or @kbd{!} will jump to that section. @@ -4773,7 +4936,7 @@ escapes. Non-@code{nil} means, automatic citation display will revisit files if necessary. When nil, citation display in echo area will only be active for cached echo strings (see @code{reftex-cache-cite-echo}), or for -BibTeX database files which are already visited by a live associated +@BibTeX{} database files which are already visited by a live associated buffers. @end defopt @@ -4790,7 +4953,7 @@ scans. In order to clear it, use @kbd{M-x reftex-reset-mode}. @cindex Finding files, options @defopt reftex-texpath-environment-variables -List of specifications how to retrieve the search path for TeX files. +List of specifications how to retrieve the search path for @TeX{} files. Several entries are possible. @itemize @minus @item @@ -4809,7 +4972,7 @@ be expanded recursively. See also @code{reftex-use-external-file-finders}. @end defopt @defopt reftex-bibpath-environment-variables -List of specifications how to retrieve the search path for BibTeX +List of specifications how to retrieve the search path for @BibTeX{} files. Several entries are possible. @itemize @minus @item @@ -4847,14 +5010,14 @@ then @samp{/tex/}, and then all subdirectories of @samp{./}. If this option is @code{nil}, the subdirectories of @samp{./} are searched before @samp{/tex/}. This is mainly for speed - most of the time the recursive path is for the system files and not for the user files. Set -this to @code{nil} if the default makes @b{Ref@TeX{}} finding files with +this to @code{nil} if the default makes @RefTeX{} finding files with equal names in wrong sequence. @end defopt @defopt reftex-use-external-file-finders Non-@code{nil} means, use external programs to find files. Normally, -@b{Ref@TeX{}} searches the paths given in the environment variables -@code{TEXINPUTS} and @code{BIBINPUTS} to find TeX files and BibTeX +@RefTeX{} searches the paths given in the environment variables +@code{TEXINPUTS} and @code{BIBINPUTS} to find @TeX{} files and @BibTeX{} database files. With this option turned on, it calls an external program specified in the option @code{reftex-external-file-finders} instead. As a side effect, the variables @@ -4881,14 +5044,14 @@ non-@code{nil}. @defopt reftex-keep-temporary-buffers Non-@code{nil} means, keep buffers created for parsing and lookup. -@b{Ref@TeX{}} sometimes needs to visit files related to the current +@RefTeX{} sometimes needs to visit files related to the current document. We distinguish files visited for @table @asis @item PARSING Parts of a multifile document loaded when (re)-parsing the document. @item LOOKUP -BibTeX database files and TeX files loaded to find a reference, to +@BibTeX{} database files and @TeX{} files loaded to find a reference, to display label context, etc. @end table The created buffers can be kept for later use, or be thrown away @@ -4912,7 +5075,7 @@ away, the initialization of the buffer depends upon the variable @defopt reftex-initialize-temporary-buffers Non-@code{nil} means do initializations even when visiting file -temporarily. When @code{nil}, @b{Ref@TeX{}} may turn off find-file hooks and +temporarily. When @code{nil}, @RefTeX{} may turn off find-file hooks and other stuff to briefly visit a file. When @code{t}, the full default initializations are done (@code{find-file-hook} etc.). Instead of @code{t} or @code{nil}, this variable may also be a list of hook @@ -4923,12 +5086,12 @@ functions to do a minimal initialization. List of regular expressions to exclude certain input files from parsing. If the name of a file included via @code{\include} or @code{\input} is matched by any of the regular expressions in this list, that file is not -parsed by @b{Ref@TeX{}}. +parsed by @RefTeX{}. @end defopt @defopt reftex-enable-partial-scans Non-@code{nil} means, re-parse only 1 file when asked to re-parse. -Re-parsing is normally requested with a @kbd{C-u} prefix to many @b{Ref@TeX{}} +Re-parsing is normally requested with a @kbd{C-u} prefix to many @RefTeX{} commands, or with the @kbd{r} key in menus. When this option is @code{t} in a multifile document, we will only parse the current buffer, or the file associated with the label or section heading near point in a @@ -4958,7 +5121,7 @@ This extension is added to the base name of the master file. @end defopt @defopt reftex-allow-automatic-rescan -Non-@code{nil} means, @b{Ref@TeX{}} may rescan the document when this seems +Non-@code{nil} means, @RefTeX{} may rescan the document when this seems necessary. Applies (currently) only in rare cases, when a new label cannot be placed with certainty into the internal label list. @end defopt @@ -5092,8 +5255,8 @@ map. @xref{Key Bindings}. @end defopt @defopt reftex-plug-into-AUCTeX -Plug-in flags for AUCTeX interface. This variable is a list of -5 boolean flags. When a flag is non-@code{nil}, @b{Ref@TeX{}} +Plug-in flags for @AUCTeX{} interface. This variable is a list of +5 boolean flags. When a flag is non-@code{nil}, @RefTeX{} will @example @@ -5110,7 +5273,7 @@ Supplying labels in new sections and environments applies when creating sections with @kbd{C-c C-s} and environments with @kbd{C-c C-e}.@* Supplying macro arguments applies when you insert such a macro interactively with @kbd{C-c @key{RET}}.@* -See the AUCTeX documentation for more information. +See the @AUCTeX{} documentation for more information. @end defopt @defopt reftex-revisit-to-follow @@ -5130,10 +5293,10 @@ argument. @section Keymaps and Hooks @cindex Keymaps -@b{Ref@TeX{}} has the usual general keymap and load-- and mode-hook. +@RefTeX{} has the usual general keymap, load hook and mode hook. @deffn Keymap reftex-mode-map -The keymap for @b{Ref@TeX{}} mode. +The keymap for @RefTeX{} mode. @end deffn @deffn {Normal Hook} reftex-load-hook @@ -5141,20 +5304,54 @@ Normal hook which is being run when loading @file{reftex.el}. @end deffn @deffn {Normal Hook} reftex-mode-hook -Normal hook which is being run when turning on @b{Ref@TeX{}} mode. +Normal hook which is being run when turning on @RefTeX{} mode. @end deffn -Furthermore, the 4 modes used for referencing labels, creating +Furthermore, the four modes used for referencing labels, creating citations, the table of contents buffer and the phrases buffer have their own keymaps and mode hooks. See the respective sections. There are many more hooks which are described in the relevant sections about -options for a specific part of @b{Ref@TeX{}}. +options for a specific part of @RefTeX{}. @node Changes, GNU Free Documentation License, Keymaps and Hooks, Top @chapter Changes @cindex Changes -Here is a list of recent changes to @b{Ref@TeX{}}. +Here is a list of recent changes to @RefTeX{}. + +@noindent @b{Version 4.33} + +@itemize @bullet +@item +Update to GPLv3. +@item +Parse files are created in a way that does not interfere with recentf +mode. +@end itemize + +@noindent @b{Version 4.32} + +@itemize @bullet +@item +First release by @AUCTeX{} project. +@item +Installation routine rewritten after structure of source package +changed. +@item +Activation of @RefTeX{} changed, so make sure you read the installation +instructions and remove obsolete cruft related to @RefTeX{} from your +init file. +@item +Fixed bug where point would end up in the wrong buffer when jumping +between several @LaTeX{} and phrases buffers. +@item +Fixed bug where @BibTeX{} keys with hyphens were parsed incorrectly. +@item +Some performance improvements. +@item +The separator used between multiple citations in a \cite macro can now +be changed by customizing the variable @code{reftex-cite-key-separator}. +@end itemize @noindent @b{Version 4.28} @itemize @bullet @@ -5504,7 +5701,7 @@ Option @code{reftex-bibfile-ignore-list} renamed to @code{-regexps}. @item Expansion of recursive tex and bib path rewritten. @item -Fixed problem where @b{Ref@TeX{}} did not scan unsaved buffers. +Fixed problem where @RefTeX{} did not scan unsaved buffers. @item Fixed bug with section numbering after *-red sections. @end itemize @@ -5571,15 +5768,15 @@ variable @code{reftex-auto-view-crossref}. AUCTeX interface updates: @itemize @minus @item -AUCTeX 9.9c and later notifies @b{Ref@TeX{}} about new sections. +AUCTeX 9.9c and later notifies @RefTeX{} about new sections. @item -@b{Ref@TeX{}} notifies AUCTeX about new labels. +@RefTeX{} notifies AUCTeX about new labels. @item @code{TeX-arg-ref} no longer used (introduction was unnecessary). @item @code{reftex-arg-label} and @code{reftex-arg-cite} fixed up. @item -Settings added to @b{Ref@TeX{}} via style files remain local. +Settings added to @RefTeX{} via style files remain local. @end itemize @item Fixed bug with @code{reftex-citation} in non-latex buffers. @@ -5601,7 +5798,7 @@ Fixed bug with empty context strings. @noindent @b{Version 3.21} @itemize @bullet @item -New options for all faces used by @b{Ref@TeX{}}. They're in the +New options for all faces used by @RefTeX{}. They're in the customization group @code{reftex-fontification-configurations}. @end itemize @@ -5627,7 +5824,7 @@ Fixed some problems regarding the interaction with VIPER mode. @item Follow-mode is now only used after point motion. @item -@b{Ref@TeX{}} now finally does not fontify temporary files anymore. +@RefTeX{} now finally does not fontify temporary files anymore. @end itemize @noindent @b{Version 3.17} @@ -5740,7 +5937,7 @@ Search for input and @file{.bib} files with recursive path definitions. @noindent @b{Version 3.00} @itemize @bullet @item -@b{Ref@TeX{}} should work better for very large projects: +@RefTeX{} should work better for very large projects: @item The new parser works without creating a master buffer. @item @@ -5748,19 +5945,19 @@ Rescanning can be limited to a part of a multifile document. @item Information from the parser can be stored in a file. @item -@b{Ref@TeX{}} can deal with macros having a naked label as an argument. +@RefTeX{} can deal with macros having a naked label as an argument. @item Macros may have white space and newlines between arguments. @item Multiple identical section headings no longer confuse @code{reftex-toc}. @item -@b{Ref@TeX{}} should work correctly in combination with buffer-altering +@RefTeX{} should work correctly in combination with buffer-altering packages like outline, folding, x-symbol, iso-cvt, isotex, etc. @item All labeled environments discussed in @emph{The LaTeX Companion} by Goossens, Mittelbach & Samarin, Addison-Wesley 1994) are part of -@b{Ref@TeX{}}'s defaults. +@RefTeX{}'s defaults. @end itemize @noindent @b{Version 2.17} @@ -5858,7 +6055,7 @@ MS-DOS support. @noindent @b{Version 1.07} @itemize @bullet @item -@b{Ref@TeX{}} gets its own menu. +@RefTeX{} gets its own menu. @end itemize @noindent @b{Version 1.05} diff --git a/etc/ChangeLog b/etc/ChangeLog index 099d7ca044f..ad6c6395e49 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,46 @@ +2012-10-05 Douglas Lewan <d_lewan2000@yahoo.com> (tiny change) + + * tutorials/TUTORIAL.pt_BR: Fix typo. (Bug#12557) + +2012-10-01 Eric Ludlam <zappo@gnu.org> + + * srecode/cc.srt, srecode/ede-autoconf.srt: New files. + + * srecode/cpp.srt: Move parts to c.srt. + + * srecode/ede-make.srt: Extra templates for Arduino Makefiles. + +2012-10-01 Ralf Mattes <rm@mh-freiburg.de> (tiny change) + + * srecode/el.srt (variable-option): Add missing quote. + +2012-10-01 Chong Yidong <cyd@gnu.org> + + * images/icons/hicolor/32x32/apps/emacs22.png: + * images/icons/hicolor/16x16/apps/emacs22.png: + * images/icons/hicolor/48x48/apps/emacs22.png: + * images/icons/hicolor/24x24/apps/emacs22.png: Remove old icons + (Bug#12536). + +2012-10-01 Paul Eggert <eggert@cs.ucla.edu> + + Revert the FOLLOW-SYMLINKS change for file-attributes. + * NEWS: Undo last change. + +2012-09-30 Bastien Guerry <bzg@gnu.org> + + * refcards/orgcard.tex: Update version number. + +2012-09-30 Jambunathan K <kjambunathan@gmail.com> + + * org/OrgOdtContentTemplate.xml: + * org/OrgOdtStyles.xml: Add Listing-related entries. + +2012-09-30 Paul Eggert <eggert@cs.ucla.edu> + + file-attributes has a new optional arg FOLLOW-SYMLINKS. + * NEWS: Document the change. + 2012-09-30 Jan Djärv <jan.h.d@swipnet.se> * NEWS: The NS port supports fullscreen. @@ -160,6 +160,8 @@ On encountering a fatal error, Emacs now outputs a textual description of the fatal signal, and a short backtrace on platforms like glibc that support backtraces. +** `message-log-max' now defaults to 1000, not 100. + --- ** If your Emacs was built from a bzr checkout, the new variable `emacs-bzr-version' contains information about the bzr revision used. @@ -617,6 +619,8 @@ inefficiency, and not namespace-clean. * Incompatible Lisp Changes in Emacs 24.3 +** set-buffer-multibyte now signals an error in narrowed buffers. + +++ ** (random) by default now returns a different random sequence in every Emacs run. Use (random S), where S is a string, to set the @@ -682,7 +686,7 @@ are deprecated and will be removed eventually. **** inactivate-current-input-method-function -> deactivate-current-input-method-function -** Some obsolete functions and variables were removed: +** Some obsolete functions, variables, and faces were removed: *** `facemenu-unlisted-faces' *** `rmail-decode-mime-charset' @@ -701,6 +705,7 @@ are deprecated and will be removed eventually. *** `vc-ignore-vc-files' (use `vc-handled-backends' instead) *** `vc-master-templates' (use `vc-handled-backends' instead) *** `vc-checkout-carefully' +*** `modeline' * Lisp changes in Emacs 24.3 @@ -787,6 +792,7 @@ in Emacs 24.1: **** `special-display-buffer-names' **** `special-display-function' **** `display-buffer-function' +**** `dired-shrink-to-fit' ** Time --- @@ -818,7 +824,8 @@ This can significantly speed up execution of non-byte-compiled code, but can also bump into harmless and previously unnoticed cyclic dependencies. These should not be fatal: they will simply cause the macro-calls to be left for later expansion (as before), but will also -result in a warning describing the cycle. +result in a warning ("Eager macro-expansion skipped due to cycle") +describing the cycle. ** Misc new functions: @@ -850,6 +857,8 @@ See the "Face Attributes" section of the Elisp manual. *** `buffer-has-markers-at' *** `macro-declaration-function' (use `macro-declarations-alist'). *** `window-system-version' +*** `dired-pop-to-buffer' (use `dired-mark-pop-up') +*** `query-replace-interactive' * Changes in Emacs 24.3 on non-free operating systems diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index a5b88d3f451..c6851948368 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -5,267 +5,894 @@ See the end of the file for license conditions. Please send Org bug reports to emacs-orgmode@gnu.org. -* Incompatible changes - -** New keys for TODO sparse trees - :PROPERTIES: - :OrgVersion: 7.01 - :END: - - The key =C-c C-v= is now reserved for Org Babel action. TODO sparse - trees can still be made with =C-c / t= (all not-done states) and =C-c / - T= (specific states). - -** The Agenda =org-agenda-ndays= is now obsolete - :PROPERTIES: - :OrgVersion: 7.4 - :END: - - The variable =org-agenda-ndays= is obsolete - please use - =org-agenda-span= instead. - - Thanks to Julien Danjou for this. - -** Changes to the intended use of =org-export-latex-classes= - :PROPERTIES: - :OrgVersion: 6.35 - :END: - - So far this variable has been used to specify the complete header of the - LaTeX document, including all the =\usepackage= calls necessary for the - document. This setup makes it difficult to maintain the list of - packages that Org itself would like to call, for example for the special - symbol support it needs. - - First of all, you can *opt out of this change* in the following way: You - can say: /I want to have full control over headers, and I will take - responsibility to include the packages Org needs/. If that is what you - want, add this to your configuration and skip the rest of this section - (except maybe for the description of the =[EXTRA]= place holder): - - #+begin_src emacs-lisp - (setq org-export-latex-default-packages-alist nil - org-export-latex-packages-alist nil) - #+end_src - - /Continue to read here if you want to go along with the modified setup./ - - There are now two variables that should be used to list the LaTeX - packages that need to be included in all classes. The header definition - in =org-export-latex-classes= should then not contain the corresponding - =\usepackage= calls (see below). - - The two new variables are: - - 1. =org-export-latex-default-packages-alist= :: This is the variable - where Org-mode itself puts the packages it needs. Normally you - should not change this variable. The only reason to change it - anyway is when one of these packages causes a conflict with another - package you want to use. Then you can remove that packages and - hope that you are not using Org-mode functionality that needs it. - - 2. =org-export-latex-packages-alist= :: This is the variable where you - can put the packages that you'd like to use across all classes. - - The sequence how these customizations will show up in the LaTeX - document are: - - 1. Header from =org-export-latex-classes= - 2. =org-export-latex-default-packages-alist= - 3. =org-export-latex-packages-alist= - 4. Buffer-specific things set with =#+LaTeX_HEADER:= - - If you want more control about which segment is placed where, or if you - want, for a specific class, have full control over the header and - exclude some of the automatic building blocks, you can put the following - macro-like place holders into the header: - - #+begin_example - [DEFAULT-PACKAGES] \usepackage statements for default packages - [NO-DEFAULT-PACKAGES] do not include any of the default packages - [PACKAGES] \usepackage statements for packages - [NO-PACKAGES] do not include the packages - [EXTRA] the stuff from #+LaTeX_HEADER - [NO-EXTRA] do not include #+LaTeX_HEADER stuff - #+end_example - - If you have currently customized =org-export-latex-classes=, you should - revise that customization and remove any package calls that are covered - by =org-export-latex-default-packages-alist=. This applies to the - following packages: - - - inputenc - - fontenc - - fixltx2e - - graphicx - - longtable - - float - - wrapfig - - soul - - t1enc - - textcomp - - marvosym - - wasysym - - latexsym - - amssymb - - hyperref - - If one of these packages creates a conflict with another package you are - using, you can remove it from =org-export-latex-default-packages-alist=. - But then you risk that some of the advertised export features of Org - will not work properly. - - You can also consider moving packages that you use in all classes to - =org-export-latex-packages-alist=. If necessary, put the place holders - so that the packages get loaded in the right sequence. As said above, - for backward compatibility, if you omit the place holders, all the - variables will dump their content at the end of the header. - -** The constant =org-html-entities= is obsolete - :PROPERTIES: - :OrgVersion: 6.35 - :END: - - Its content is now part of the new constant =org-entities=, which is - defined in the file org-entities.el. =org-html-entities= was an internal - variable, but it is possible that some users did write code using it. - -** `org-bbdb-anniversary-format-alist' has changed - :PROPERTIES: - :OrgVersion: 7.5 - :END: - - Please check the docstring and update your settings accordingly. - -** Deleted =org-mode-p= - :PROPERTIES: - :OrgVersion: 7.8 - :END: - - This function has been deleted: please update your code. - -* Important new features - -** New Org to ODT exporter - :PROPERTIES: - :OrgVersion: 7.8 - :END: - - Jambunathan's Org to ODT exporter is now part of Org. - - To use it, it `C-c C-e o' in an Org file. See the documentation for more - information on how to customize it. - -** org-capture.el is now the default capture system - :PROPERTIES: - :OrgVersion: 7.01 - :END: - - This replaces the earlier system org-remember. The manual only describes - org-capture, but for people who prefer to continue to use org-remember, - we keep a static copy of the former manual section [[http://orgmode.org/org-remember.pdf][chapter about - remember]]. - - The new system has a technically cleaner implementation and more - possibilities for capturing different types of data. See [[http://thread.gmane.org/gmane.emacs.orgmode/26441/focus%3D26441][Carsten's - announcement]] for more details. - - To switch over to the new system: - - 1. Run - - : M-x org-capture-import-remember-templates RET - - to get a translated version of your remember templates into the - new variable =org-capture-templates=. This will "mostly" work, - but maybe not for all cases. At least it will give you a good - place to modify your templates. After running this command, - enter the customize buffer for this variable with - - : M-x customize-variable RET org-capture-templates RET +* Version 7.9.2 - and convince yourself that everything is OK. Then save the - customization. +** New ELPA repository for Org packages - 2. Bind the command =org-capture= to a key, similar to what you did - with org-remember: +You can now add the Org ELPA repository like this: - : (define-key global-map "\C-cc" 'org-capture) +#+BEGIN_SRC emacs-lisp +(add-to-list 'package-archives '("org" . "http://orgmode.org/elpa/") t) +#+END_SRC - If your fingers prefer =C-c r=, you can also use this key once - you have decided to move over completely to the new - implementation. During a test time, there is nothing wrong - with using both system in parallel. +It contains both the =org-*.tar= package (the core Org distribution, also +available through http://elpa.gnu.org) and the =org-plus*.tar= package (the +extended Org distribution, with non-GNU packages from the =contrib/= +directory.) -* New libraries +See http://orgmode.org/elpa/ -** New Org libraries -*** org-eshell.el (Konrad Hinsen) - :PROPERTIES: - :OrgVersion: 7.8 - :END: +** Overview of the new keybindings - Implement links to eshell buffers. + | Keybinding | Speedy | Command | + |-----------------+--------+-----------------------------| + | =C-c C-x C-z= | | [[doc::org-clock-resolve][org-clock-resolve]] | + | =C-c C-x C-q= | | [[doc::org-clock-cancel][org-clock-cancel]] | + | =C-c C-x C-x= | | [[doc::org-clock-in-last][org-clock-in-last]] | + | =M-h= | | [[doc::org-mark-element][org-mark-element]] | + | =*= | | [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] | + | =C-c C-M-l= | | [[doc::org-insert-all-links][org-insert-all-links]] | + | =C-c C-x C-M-v= | | [[doc::org-redisplay-inline-images][org-redisplay-inline-images]] | + | =C-c C-x E= | =E= | [[doc::org-inc-effort][org-inc-effort]] | + | | =#= | [[doc::org-toggle-comment][org-toggle-comment]] | + | | =:= | [[doc::org-columns][org-columns]] | + | | =W= | Set =APPT_WARNTIME= | + | =k= | | [[doc::org-agenda-capture][org-agenda-capture]] | + | C-c , | , | [[doc::org-priority][org-priority]] | -*** org-special-blocks (Carsten Dominik) - :PROPERTIES: - :OrgVersion: 7.8 - :END: +** New package and Babel langage -This package generalizes the #+begin_foo and #+end_foo tokens. +*** =org-eshell.el= by Konrad Hinsen is now in Org -To use, put the following in your init file: + =org-eshell.el= allows you to create links from [[http://www.gnu.org/software/emacs/manual/html_node/eshell/index.html][Eshell]]. -#+BEGIN_EXAMPLE +*** Support for execution of Scala code blocks (see ob-scala.el) +*** Support for execution of IO code blocks (see ob-io.el) + +** Incompatible changes + + - If your code relies on =org-write-agenda=, please use + [[doc::org-agenda-write][org-agenda-write]] from now on. + + - If your code relies on =org-make-link=, please use =concat= + instead. + + - =org-link-to-org-use-id= has been renamed to + =org-id-link-to-org-use-id= and its default value is nil. The + previous default was =create-if-interactive-and-no-custom-id=. + +** New features and user-visible changes + +*** Org Element + + =org-element.el= is a toolbox for parsing and analyzing "elements" + in an Org-mode buffer. This has been written by Nicolas Goaziou + and has been tested for quite some time. It is now part of Org's + core and many core functions rely on this package. + + Two functions might be particularly handy for users: + =org-element-at-point= and =org-element-context=. + + See the docstrings for more details. + + Below is a list of editing and navigating commands that now rely + on =org-element.el=. + +**** [[doc::org-fill-paragraph][org-fill-paragraph]] has been completely rewritten + + The filling mechanisms now rely on org-element, trying to do the + right thing on each element in various contexts. E.g. filling in + a list item will preserve indentation; filling in message-mode + will fall back on the relevant filling functions; etc. + +**** [[doc::org-metaup][org-metaup]] and [[doc::org-metadown][org-metadown]] will drag the element backward/forward + + If you want to get the old behavior (i.e. moving a line up and + down), you can first select the line as an active region, then + =org-metaup= or =org-metadown= to move the region backward or + forward. This also works with regions bigger than just one line. + +**** [[doc::org-up-element][org-up-element]] and [[doc::org-down-element][org-down-element]] (respectively =C-c C-^= and =C-c C-_=) + + This will move the point up/down in the hierarchy of elements. + +**** [[doc::org-backward-element][org-backward-element]] and [[doc::org-forward-element][org-forward-element]] (respectively =M-{= and =M-}=) + + This will move the point backward/forward in the hierarchy of + elements. + +**** [[doc::org-narrow-to-element][org-narrow-to-element]] will narrow to the element at point +**** [[doc::org-mark-element][org-mark-element]] will mark the element at point + + This command is bound to =M-h= and will mark the element at + point. If the point is at a paragraph, it will mark the + paragraph. If the point is at a list item, it will mark the list + item. Etc. + + Note that if point is at the beginning of a list, it will mark + the whole list. + + To mark a subtree, you can either use =M-h= on the headline + (since there is no ambiguity about the element you're at) or + [[doc::org-mark-subtree][org-mark-subtree]] (=C-c @=) anywhere in the subtree. + + Invoking [[doc::org-mark-element][org-mark-element]] repeatedly will try to mark the next + element on top of the previous one(s). E.g. hitting =M-h= twice + on a headline will mark the current subtree and the next one on + the same level. + +*** Org Agenda + +**** New option [[doc::org-agenda-sticky][org-agenda-sticky]] + + There is a new option =org-agenda-sticky= which enables "sticky" + agendas. Sticky agendas remain opened in the background so that + you don't need to regenerate them each time you hit the + corresponding keystroke. This is a big time saver. + + When [[doc::org-agenda-sticky][org-agenda-sticky]] is =non-nil=, the agenda buffer will be + named using the agenda key and its description. In sticky + agendas, the =q= key will just bury the agenda buffers and + further agenda commands will show existing buffer instead of + generating new ones. + + If [[doc::org-agenda-sticky][org-agenda-sticky]] is set to =nil=, =q= will kill the single + agenda buffer. + +**** New option [[doc::org-agenda-custom-commands-contexts][org-agenda-custom-commands-contexts]] + + Setting this option allows you to define specific context where + agenda commands should be available from. For example, when set + to this value + + #+BEGIN_SRC emacs-lisp + (setq org-agenda-custom-commands-contexts + '(("p" (in-file . "\\.txt")))) +#+END_SRC + + then the =p= agenda command will only be available from buffers + visiting *.txt files. See the docstring and the manual for more + details on how to use this. + +**** Changes in bulk actions + + The set of commands starting with =k ...= as been deleted and the + features have been merged into the "bulk action" feature. + + After you marked some entries in the agenda, if you call =B s=, + the agenda entries will be rescheduled using the date at point if + on a date header. If you are on an entry with a timestamp, you + will be prompted for a date to reschedule your marked entries to, + using the timestamp at point as the default prompt. + + You can now use =k= to capture the marked entry and use the date + at point as an overriding date for the capture template. + + To bind this behavior to =M-x org-capture RET= (or its + keybinding), set the new option [[doc::org-capture-use-agenda-date][org-capture-use-agenda-date]] to + =t=. + +**** =N= and =P= in the agenda will move to the next/previous item + +**** New command [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] to mark all items + + This new command is bound to =*= in agenda mode. + + There is also a new option [[doc::org-agenda-bulk-mark-char][org-agenda-bulk-mark-char]] to set the + character to use as a mark for bulk actions. + +**** New option [[doc::org-agenda-persistent-marks][org-agenda-persistent-marks]] + + When set to =non-nil=, marks will remain visible after a bulk + action. You can temporarily toggle this by pressing =p= when + invoking [[doc::org-agenda-bulk-action][org-agenda-bulk-action]]. Marks are deleted if your + rebuild the agenda buffer or move to another date/span (e.g. with + =f= or =w=). + +**** New option [[doc::org-agenda-skip-timestamp-if-deadline-is-shown][org-agenda-skip-timestamp-if-deadline-is-shown]] + + =Non-nil= means skip timestamp line if same entry shows because + of deadline. + + In the agenda of today, an entry can show up multiple times + because it has both a plain timestamp and has a nearby deadline. + When this variable is t, then only the deadline is shown and the + fact that the entry has a timestamp for or including today is not + shown. When this variable is =nil=, the entry will be shown + several times. + +**** New =todo-unblocked= and =nottodo-unblocked= skip conditions + + See the [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3Df426da][git commit]] for more explanations. + +**** Allow category filtering in the agenda + + You can now filter the agenda by category. Pressing "<" will + filter by the category of the item on the current line, and + pressing "<" again will remove the filter. You can combine tag + filters and category filters. + + You can use =org-agenda-category-filter= in your custom agenda + views and =org-agenda-category-filter-preset= in your main + configuration. + + See also the new command [[doc::org-agenda-filter-by-top-category][org-agenda-filter-by-top-category]]: + hitting =^= will filter by "Top" category: only show entries that + are of the same category than the Top category of the entry at + point. + +*** Org Links + +**** Inserting links + + When inserting links through [[doc::org-insert-link][org-insert-link]], the description is + now displayed first, followed by the literal link, as the + description is often more useful when you look for the link you + want to insert. + + Completion now complete both literal links and description. If + you complete a description, the literal link and its description + will be inserted directly, whereas when you complete the literal + link, you will be prompted for a description (as with Org 7.8.) + + In the completion buffer, links to the current buffer are now + highlighted. + +**** New templates =%h= and =%(sexp)= for abbreviated links + + On top of =%s= template, which is replaced by the link tag in + abbreviated links, you can now use =%h= (which does the same than =%s= + but does not hexify the tag) and =%(sexp)= (which can run a function + that takes the tag as its own argument.) + +**** New link type =help= + + You can now create links from =help= buffers. + + For example, if you request help for the command [[doc::org-agenda][org-agenda]] with + =C-h f org-agenda RET=, creating a link from this buffer will let + you go back to the same buffer. + +**** New command [[doc::org-insert-all-links][org-insert-all-links]] + + This will insert all links as list items. With a universal + prefix argument, links will not be deleted from the variable + =org-stored-links=. + + This new command is bound to =C-c C-M-l=. + +**** New option [[doc::org-url-hexify-p][org-url-hexify-p]] + + When set to =nil=, the =URL= part of a link will not be hexified. + +**** Org can now open multiple shell links + +**** New option [[doc::org-doi-server-url][org-doi-server-url]] to specify an alternate DOI server + +**** RET now follows time stamps links + +*** Org Editing + +**** [[doc::org-todo][org-todo]] and =org-archive-*= can now loop in the active region + + When [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is =non-nil=, using + [[doc::org-todo][org-todo]] or =org-archive-*= commands in the active region will + loop over headlines. This is handy if you want to set the TODO + keyword for several items, or archive them quickly. + +**** You can now set tags for headlines in a region + + If [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is =non-nil=, then + selecting the region and hitting =C-c C-q= will set the tags for + all headlines in the region. + +**** New command [[doc::org-insert-drawer][org-insert-drawer]] to insert a drawer interactively + +**** Comments start with "^[ \t]*# " anywhere on a line + + Note that the space after the hashtag is mandatory. Comments + with "^#+" are not supported anymore. + +**** New speed key =#= to toggle the COMMENT cookie on a headline + +**** =indent-region-function= is now set to [[doc::org-indent-region][org-indent-region]] + + =C-M-\= should now produce useful results. + + You can unindent the buffer with [[doc::org-unindent-buffer][org-unindent-buffer]]. + +**** New option [[doc::org-allow-promoting-top-level-subtree][org-allow-promoting-top-level-subtree]] + + When =non-nil=, =S-M-<left>= will promote level-1 subtrees + containing other subtrees. The level-1 headline will be + commented out. You can revert to the previous state with =M-x + undo RET=. + +*** Org Clock + +**** New keybinding =C-c C-x C-z= for [[doc::org-clock-resolve][org-clock-resolve]] + +**** New keybinding =C-c C-x C-q= for [[doc::org-clock-cancel][org-clock-cancel]] + +**** New command [[doc::org-clock-in-last][org-clock-in-last]] to clock in the last clocked item + + This command is bound to =C-c C-x C-x= and will clock in the last + clocked entry, if any. + +**** =C-u M-x= [[doc::org-clock-out][org-clock-out]] =RET= now prompts for a state to switch to + +**** =S-M-<up/down>= on a clock timestamps adjusts the previous/next clock + +**** New option [[doc::org-clock-continuously][org-clock-continuously]] + + When set to =nil=, clocking in a task will first try to find the + last clocked out task and restart from when that task was clocked + out. + + You can temporarily activate continuous clocking with =C-u C-u + C-u M-x= [[doc::org-clock-in][org-clock-in]] =RET= (three universal prefix arguments) + and =C-u C-u M-x= [[org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix + arguments). + + +**** New option [[doc::org-clock-frame-title-format][org-clock-frame-title-format]] + + This option sets the value of =frame-title-format= when clocking + in. + +**** New options for controlling the clockreport display + + [[doc::org-clock-file-time-cell-format][org-clock-file-time-cell-format]]: Format string for the file time + cells in clockreport. + + [[doc::org-clock-total-time-cell-format][org-clock-total-time-cell-format]]: Format string for the total + time cells in clockreport. + + +**** New options for controlling the clock/timer display + + [[doc::org-clock-clocked-in-display][org-clock-clocked-in-display]]: control whether the current clock + is displayed in the mode line and/or frame title. + + [[doc::org-timer-display][org-timer-display]]: control whether the current timer is displayed + in the mode line and/or frame title. + + This allows the clock and timer to be displayed in the frame + title instead of, or as well as, the mode line. This is useful + for people with limited space in the mode line but with ample + space in the frame title. + +*** Org Appearance + +**** New option [[doc::org-custom-properties][org-custom-properties]] + + The visibility of properties listed in this options can be turn + on/off with [[doc::org-toggle-custom-properties-visibility][org-toggle-custom-properties-visibility]]. This might + be useful for properties used by third-part tools or that you + don't want to see temporarily. + +**** New command [[doc::org-redisplay-inline-images][org-redisplay-inline-images]] + + This will redisplay all images. It is bound to =C-c C-x C-M-v=. + +**** New entities in =org-entities.el= + + There are these new entities: + + : ("tilde" "\\~{}" nil "˜" "~" "~" "~") + : ("slash" "/" nil "/" "/" "/" "/") + : ("plus" "+" nil "+" "+" "+" "+") + : ("under" "\\_" nil "_" "_" "_" "_") + : ("equal" "=" nil "=" "=" "=" "=") + : ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^") + +**** New face =org-list-dt= for definition terms +**** New face =org-date-selected= for the selected calendar day +**** New face value for =org-document-title= + + The face is back to a normal height. + +*** Org Columns + +**** New speed command =:= to activate the column view +**** New special property =CLOCKSUM_T= to display today's clocked time + + You can use =CLOCKSUM_T= the same way you use =CLOCKSUM=. It + will display the time spent on tasks for today only. + +**** Use the =:COLUMNS:= property in columnview dynamic blocks + + If the =:COLUMNS:= is set in a subtree, the columnview dynamic + block will use its value as the column format. + +**** Consider inline tasks when computing a sum + +*** Org Dates and Time Stamps + +**** Enhanced [[doc::org-sparse-tree][org-sparse-tree]] + + =C-c /= can now check for time ranges. + + When checking for dates with =C-c /= it is useful to change the + type of dates that you are interested in. You can now do this + interactively with =c= after =C-c /= and/or by setting + [[doc::org-sparse-tree-default-date-type][org-sparse-tree-default-date-type]] to the default value you want. + +**** Support for hourly repeat cookies + + You can now use + + : SCHEDULED: <2012-08-20 lun. 08:00 +1h> + + if you want to add an hourly repeater to an entry. + +**** =C-u C-u C-c .= inserts a time-stamp with no prompt + +**** When (setq [[doc::org-read-date-prefer-future][org-read-date-prefer-future]] 'time), accept days in the prompt + + "8am Wed" and "Wed 8am" are now acceptable values when entering a + date from the prompt. If [[doc::org-read-date-prefer-future][org-read-date-prefer-future]] is set to + =time=, this will produce the expected prompt indication. + +**** New option [[doc::org-datetree-add-timestamp][org-datetree-add-timestamp]] + + When set to =non-nil=, datetree entries will also have a + timestamp. This is useful if you want to see these entries in a + sparse tree with =C-c /=. + +*** Org Capture + +**** New command [[doc::org-capture-string][org-capture-string]] + + M-x [[doc::org-capture-string][org-capture-string]] RET will prompt for a string and a capture + template. The string will be used as an annotation for the + template. This is useful when capturing in batch mode as it lets + you define the content of the template without being in Emacs. + +**** New option [[doc::org-capture-templates-contexts][org-capture-templates-contexts]] + + Setting this option allows you to define specific context where + capture templates should be available from. For example, when + set to this value + + #+BEGIN_SRC emacs-lisp + (setq org-capture-templates-contexts + '(("c" (in-mode . "message-mode")))) +#+END_SRC + + then the =c= capture template will only be available from + =message-mode= buffers. See the docstring and the manual for + more details on how to use this. + +**** New =%l= template to insert the literal link +**** New option [[doc::org-capture-bookmark][org-capture-bookmark]] + + Org used to automatically add a bookmark with capture a note. + You can now turn this on by setting [[doc::org-capture-bookmark][org-capture-bookmark]] to + =nil=. + +**** Expand =%<num>= escape sequences into text entered for <num>'th =%^{PROMPT}= escape + + See the manual for more explanations. + +**** More control over empty lines + + You can use =:empty-lines-before= and =:empty-lines-after= to + control the insertion of empty lines. Check the manual for more + explanations. + +**** New hook [[doc::org-capture-prepare-finalize-hook][org-capture-prepare-finalize-hook]] + + This new hook runs before the finalization process starts. + +*** Org Export + +**** New functions =orgtbl-to-table.el= and =orgtbl-to-unicode= + + =orgtbl-to-table.el= convert the table to a =table.el= table, and + =orgtbl-to-unicode= will use =ascii-art-to-unicode.el= (when + available) to print beautiful tables. + +**** [[doc::org-table-export][org-table-export]] now a bit clever about the target format + + When you specify a file name like =table.csv=, [[doc::org-table-export][org-table-export]] + will now suggest =orgtbl-to-csv= the default method for exporting + the table. + +**** New option [[doc::org-export-date-timestamp-format][org-export-date-timestamp-format]] + + The option allows to set a time string format for Org timestamps + in the #+DATE option. + +**** LaTeX: New options for exporting table rules :tstart, :hline and :tend + + See [[doc::org-export-latex-tables-hline][org-export-latex-tables-hline]] and [[doc::org-export-latex-tables-tend][org-export-latex-tables-tend]]. + +**** LaTeX: You can now set =:hfmt= from =#+ATTR_LaTeX= +**** Beamer: Add support and keybinding for the =exampleblock= environment + + Add support for these languages in [[doc::org-export-language-setup][org-export-language-setup]]. + More languages are always welcome. + +**** Beamer: New option [[doc::org-beamer-inherited-properties][org-beamer-inherited-properties]] + + This option allows Beamer export to inherit some properties. + Thanks to Carsten for implementing this. + +**** ODT: Add support for ODT export in org-bbdb.el +**** ODT: Add support for indented tables (see [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3De9fd33][this commit]] for details) +**** ODT: Improve the conversion from ODT to other formats +**** ASCII: Swap the level-1/level-2 characters to underline the headlines +**** Support for Chinese, simplified Chinese, Russian, Ukrainian and Japanese +**** HTML: New option [[doc::org-export-html-date-format-string][org-export-html-date-format-string]] + + Format string to format the date and time in HTML export. Thanks + to Sébastien Vauban for this patch. + +*** Org Babel + +**** New =:results drawer= parameter + +=:results drawer= replaces =:results wrap=, which is deprecated but still +supported. + +**** =:results org= now put results in a =#+BEGIN_SRC org= block + +=:results org= used to put results in a =#+BEGIN_ORG= block but it now puts +results in a =#+BEGIN_SRC org= block, with comma-escaped lines. + +=#+BEGIN_ORG= blocks are obsolete. + +**** Exporting =#+BEGIN_SRC org= blocks exports the code + +It used to exports the results of the code. + +*** Miscellaneous + +**** New menu entry for [[doc::org-refile][org-refile]] +**** Allow capturing to encrypted entries + +If you capture to an encrypted entry, it will be decrypted before +inserting the template then re-encrypted after finalizing the capture. + +**** Inactive timestamps are now handled in tables + +Calc can do computation on active time-stamps like <2012-09-29 sat.>. +Inactive time-stamps in a table's cell are now internally deactivated so +that Calc formulas can operate on them. + +**** [[doc::org-table-number-regexp][org-table-number-regexp]] can now accept comma as decimal mark +**** Org allows a new property =APPT_WARNTIME= + + You can set it with the =W= speedy key or set it manually. When + set, exporting to iCalendar and [[doc::org-agenda-to-appt][org-agenda-to-appt]] will use the + value of this property as the number of minutes for the warning + alarm. + +**** New command [[doc::org-inc-effort][org-inc-effort]] + + This will increment the effort value. + + It is bound to =C-c C-x E= and to =E= as a speedy command. + +**** Attach: Add support for creating symbolic links + + =org-attach-method= now supports a new method =lns=, allowing to + attach symbolic links. + +**** Archive: you can now archive to a datetree + +**** New option [[doc::org-inlinetask-show-first-star][org-inlinetask-show-first-star]] + + =Non-nil= means display the first star of an inline task as + additional marker. When =nil=, the first star is not shown. + +**** New option [[doc::org-latex-preview-ltxpng-directory][org-latex-preview-ltxpng-directory]] + + This lets you define the path for the =ltxpng/= directory. + +**** You can now use imagemagick instead of dvipng to preview LaTeX fragments +**** You can now turn off [[doc::orgstruct++-mode][orgstruct++-mode]] safely +**** =C-u C-c C-c= on list items to add check boxes + + =C-u C-c C-c= will add an empty check box on a list item. + + When hit from the top of the list, it will add check boxes for + all top level list items. + +**** =org-list-ending-method= and =org-list-end-regexp= are now obsolete + + Fall back on using =org-list-end-re= only, which see. + +**** org-feed.el now expands =%(sexp)= templates +**** New option [[doc::org-protocol-data-separator][org-protocol-data-separator]] + +**** New option [[doc::org-ditaa-jar-option][org-ditaa-jar-option]] to specify the ditaa jar file + +**** New possible value for [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] + + When [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is set to + =start-level=, the command will loop over the active region but + will only act upon entries that are of the same level than the + first headline in the region. + +**** New option [[doc::org-habit-show-all-today][org-habit-show-all-today]] + + When set to =t=, show all (even unscheduled) habits on today's + agenda. + +** Important bug fixes + +*** M-TAB on options keywords perform completion correctly again + + If you hit =M-TAB= on keywords like =#+TITLE=, Org will try to + perform completion with meaningful values. + +*** Add licenses to javascript embedded and external code snippets + + Embedded javascript code produced when exporting an Org file to + HTML is now licensed under GPLv3 (or later), and the copyright is + owned by the Free Software Foundation, Inc. + + The javascript code for embedding MathJax in the browser mentions + the MathJax copyright and the Apache 2.0 license. + + The javascript code for embedding =org-injo.js= in the browser + mentions the copyright of Sebastian Rose and the GPLv3 (or later) + license. + + =org-export-html-scripts= is now a variable, so that you can adapt + the code and the license to your needs. + + See http://www.gnu.org/philosophy/javascript-trap.html for + explanations on why these changes were necessary. + +* Version 7.8.11 + +** Incompatible changes + +*** Emacs 21 support has been dropped + + Do not use Org mode 7.xx with Emacs 21, use [[http://orgmode.org/org-6.36c.zip][version 6.36c]] instead. + +*** XEmacs support requires the XEmacs development version + + To use Org mode 7.xx with XEmacs, you need to run the developer + version of XEmacs. We were about to drop XEmacs support entirely, + but Michael Sperber stepped in and made changes to XEmacs that + made it easier to keep the support. Thanks to Michael for this + last-minute save. + +*** New keys for TODO sparse trees + + The key =C-c C-v= is now reserved for Org Babel action. TODO + sparse trees can still be made with =C-c / t= (all not-done + states) and =C-c / T= (specific states). + +*** The Agenda =org-agenda-ndays= is now obsolete + + The variable =org-agenda-ndays= is obsolete - please use + =org-agenda-span= instead. + + Thanks to Julien Danjou for this. + +*** Changes to the intended use of =org-export-latex-classes= + + So far this variable has been used to specify the complete header + of the LaTeX document, including all the =\usepackage= calls + necessary for the document. This setup makes it difficult to + maintain the list of packages that Org itself would like to call, + for example for the special symbol support it needs. + + First of all, you can *opt out of this change* in the following + way: You can say: /I want to have full control over headers, and I + will take responsibility to include the packages Org needs/. If + that is what you want, add this to your configuration and skip the + rest of this section (except maybe for the description of the + =[EXTRA]= place holder): + + #+begin_src emacs-lisp + (setq org-export-latex-default-packages-alist nil + org-export-latex-packages-alist nil) + #+end_src + + /Continue to read here if you want to go along with the modified + setup./ + + There are now two variables that should be used to list the LaTeX + packages that need to be included in all classes. The header + definition in =org-export-latex-classes= should then not contain + the corresponding =\usepackage= calls (see below). + + The two new variables are: + + 1. =org-export-latex-default-packages-alist= :: This is the + variable where Org-mode itself puts the packages it needs. + Normally you should not change this variable. The only + reason to change it anyway is when one of these packages + causes a conflict with another package you want to use. Then + you can remove that packages and hope that you are not using + Org-mode functionality that needs it. + + 2. =org-export-latex-packages-alist= :: This is the variable where + you can put the packages that you'd like to use across all + classes. + + The sequence how these customizations will show up in the LaTeX + document are: + + 1. Header from =org-export-latex-classes= + 2. =org-export-latex-default-packages-alist= + 3. =org-export-latex-packages-alist= + 4. Buffer-specific things set with =#+LaTeX_HEADER:= + + If you want more control about which segment is placed where, or + if you want, for a specific class, have full control over the + header and exclude some of the automatic building blocks, you can + put the following macro-like place holders into the header: + + #+begin_example + [DEFAULT-PACKAGES] \usepackage statements for default packages + [NO-DEFAULT-PACKAGES] do not include any of the default packages + [PACKAGES] \usepackage statements for packages + [NO-PACKAGES] do not include the packages + [EXTRA] the stuff from #+LaTeX_HEADER + [NO-EXTRA] do not include #+LaTeX_HEADER stuff + #+end_example + + If you have currently customized =org-export-latex-classes=, you + should revise that customization and remove any package calls that + are covered by =org-export-latex-default-packages-alist=. This + applies to the following packages: + + - inputenc + - fontenc + - fixltx2e + - graphicx + - longtable + - float + - wrapfig + - soul + - t1enc + - textcomp + - marvosym + - wasysym + - latexsym + - amssymb + - hyperref + + If one of these packages creates a conflict with another package + you are using, you can remove it from + =org-export-latex-default-packages-alist=. But then you risk that + some of the advertised export features of Org will not work + properly. + + You can also consider moving packages that you use in all classes + to =org-export-latex-packages-alist=. If necessary, put the place + holders so that the packages get loaded in the right sequence. As + said above, for backward compatibility, if you omit the place + holders, all the variables will dump their content at the end of + the header. + +*** The constant =org-html-entities= is obsolete + + Its content is now part of the new constant =org-entities=, which + is defined in the file org-entities.el. =org-html-entities= was + an internal variable, but it is possible that some users did write + code using it. + +*** =org-bbdb-anniversary-format-alist= has changed + + Please check the docstring and update your settings accordingly. + +*** Deleted =org-mode-p= + + This function has been deleted: please update your code. + +** Important new features + +*** New Org to ODT exporter + + Jambunathan's Org to ODT exporter is now part of Org. + + To use it, it `C-c C-e o' in an Org file. See the documentation + for more information on how to customize it. + +*** org-capture.el is now the default capture system + + This replaces the earlier system org-remember. The manual only + describes org-capture, but for people who prefer to continue to + use org-remember, we keep a static copy of the former manual + section [[http://orgmode.org/org-remember.pdf][chapter about remember]]. + + The new system has a technically cleaner implementation and more + possibilities for capturing different types of data. See + [[http://thread.gmane.org/gmane.emacs.orgmode/26441/focus%3D26441][Carsten's announcement]] for more details. + + To switch over to the new system: + + 1. Run + + : M-x org-capture-import-remember-templates RET + + to get a translated version of your remember templates into the + new variable =org-capture-templates=. This will "mostly" work, + but maybe not for all cases. At least it will give you a good + place to modify your templates. After running this command, + enter the customize buffer for this variable with + + : M-x customize-variable RET org-capture-templates RET + + and convince yourself that everything is OK. Then save the + customization. + + 2. Bind the command =org-capture= to a key, similar to what you did + with org-remember: + + : (define-key global-map "\C-cc" 'org-capture) + + If your fingers prefer =C-c r=, you can also use this key once + you have decided to move over completely to the new + implementation. During a test time, there is nothing wrong + with using both system in parallel. + +** New libraries + +*** New Org libraries +**** org-eshell.el (Konrad Hinsen) + + Implement links to eshell buffers. + +**** org-special-blocks (Carsten Dominik) + + This package generalizes the #+begin_foo and #+end_foo tokens. + + To use, put the following in your init file: + + #+BEGIN_EXAMPLE (require 'org-special-blocks) #+END_EXAMPLE -The tokens #+begin_center, #+begin_verse, etc. existed previously. This -package generalizes them (at least for the LaTeX and html exporters). When -a #+begin_foo token is encountered by the LaTeX exporter, it is expanded -into \begin{foo}. The text inside the environment is not protected, as -text inside environments generally is. When #+begin_foo is encountered by -the html exporter, a div with class foo is inserted into the HTML file. It -is up to the user to add this class to his or her stylesheet if this div is -to mean anything. + The tokens #+begin_center, #+begin_verse, etc. existed + previously. This package generalizes them (at least for the + LaTeX and html exporters). When a #+begin_foo token is + encountered by the LaTeX exporter, it is expanded + into \begin{foo}. The text inside the environment is not + protected, as text inside environments generally is. + When #+begin_foo is encountered by the html exporter, a div with + class foo is inserted into the HTML file. It is up to the user + to add this class to his or her stylesheet if this div is to mean + anything. -*** org-taskjuggler.el (Christian Egli) - :PROPERTIES: - :OrgVersion: 7.01 - :END: +**** org-taskjuggler.el (Christian Egli) - Christian Egli's /org-taskjuggler.el/ module is now part of Org. He - also wrote a [[http://orgmode.org/worg/org-tutorials/org-taskjuggler.php][tutorial]] for it. + Christian Egli's /org-taskjuggler.el/ module is now part of Org. + He also wrote a [[http://orgmode.org/worg/org-tutorials/org-taskjuggler.php][tutorial]] for it. -*** org-ctags.el (Paul Sexton) - :PROPERTIES: - :OrgVersion: 6.34 - :END: +**** org-ctags.el (Paul Sexton) - Targets like =<<my target>>= can now be found by Emacs' etag - functionality, and Org-mode links can be used to to link to etags, also - in non-Org-mode files. For details, see the file /org-ctags.el/. + Targets like =<<my target>>= can now be found by Emacs' etag + functionality, and Org-mode links can be used to to link to + etags, also in non-Org-mode files. For details, see the file + /org-ctags.el/. - This feature uses a new hook =org-open-link-functions= which will call - function to do something special with text links. + This feature uses a new hook =org-open-link-functions= which will + call function to do something special with text links. - Thanks to Paul Sexton for this contribution. + Thanks to Paul Sexton for this contribution. -*** org-docview.el (Jan Böcker) - :PROPERTIES: - :OrgVersion: 6.34 - :END: +**** org-docview.el (Jan Böcker) - This new module allows links to various file types using docview, where - Emacs displays images of document pages. Docview link types can point - to a specific page in a document, for example to page 131 of the - Org-mode manual: + This new module allows links to various file types using docview, where + Emacs displays images of document pages. Docview link types can point + to a specific page in a document, for example to page 131 of the + Org-mode manual: - : [[docview:~/.elisp/org/doc/org.pdf::131][Org-Mode Manual]] + : [[docview:~/.elisp/org/doc/org.pdf::131][Org-Mode Manual]] - Thanks to Jan Böcker for this contribution. + Thanks to Jan Böcker for this contribution. -** New Babel libraries +*** New Babel libraries - ob-picolisp.el (Thorsten Jolitz) - ob-fortran.el (Sergey Litvinov) @@ -275,674 +902,531 @@ to mean anything. - ob-lilypond.el (Martyn Jago) - ob-awk.el (Eric Schulte) -* Other new features and various enhancements +** Other new features and various enhancements -** Hyperlinks +*** Hyperlinks -*** Org-Bibtex -- major improvements - :PROPERTIES: - :OrgVersion: 7.6 - :END: +**** Org-Bibtex -- major improvements - Provides support for managing bibtex bibliographical references - data in headline properties. Each headline corresponds to a - single reference and the relevant bibliographic meta-data is - stored in headline properties, leaving the body of the headline - free to hold notes and comments. Org-bibtex is aware of all - standard bibtex reference types and fields. + Provides support for managing bibtex bibliographical references + data in headline properties. Each headline corresponds to a + single reference and the relevant bibliographic meta-data is + stored in headline properties, leaving the body of the headline + free to hold notes and comments. Org-bibtex is aware of all + standard bibtex reference types and fields. - The key new functions are + The key new functions are -- org-bibtex-check :: queries the user to flesh out all required - (and with prefix argument optional) bibtex fields available - for the specific reference =type= of the current headline. + - org-bibtex-check :: queries the user to flesh out all required + (and with prefix argument optional) bibtex fields available + for the specific reference =type= of the current headline. -- org-bibtex-create :: Create a new entry at the given level, - using org-bibtex-check to flesh out the relevant fields. + - org-bibtex-create :: Create a new entry at the given level, + using org-bibtex-check to flesh out the relevant fields. -- org-bibtex-yank :: Yank a bibtex entry on the kill ring as a - formatted Org-mode headline into the current buffer + - org-bibtex-yank :: Yank a bibtex entry on the kill ring as a + formatted Org-mode headline into the current buffer -- org-bibtex-export-to-kill-ring :: Export the current headline - to the kill ring as a formatted bibtex entry. + - org-bibtex-export-to-kill-ring :: Export the current headline + to the kill ring as a formatted bibtex entry. +**** org-gnus.el now allows link creation from messages + You can now create links from messages. This is particularly + useful when the user wants to stored messages that he sends, for + later check. Thanks to Ulf Stegemann for the patch. -*** org-gnus.el now allows link creation from messages - :PROPERTIES: - :OrgVersion: 7.5 - :END: +**** Modified link escaping - You can now create links from messages. This is particularly - useful when the user wants to stored messages that he sends, for - later check. Thanks to Ulf Stegemann for the patch. + David Maus worked on `org-link-escape'. See [[http://article.gmane.org/gmane.emacs.orgmode/37888][his message]]: + : Percent escaping is used in Org mode to escape certain characters + : in links that would either break the parser (e.g. square brackets + : in link target oder description) or are not allowed to appear in + : a particular link type (e.g. non-ascii characters in a http: + : link). + : + : With this change in place Org will apply percent escaping and + : unescaping more consistently especially for non-ascii characters. + : Additionally some of the outstanding bugs or glitches concerning + : percent escaped links are solved. + Thanks a lot to David for this work. -*** Modified link escaping - :PROPERTIES: - :OrgVersion: 7.5 - :END: +**** Make =org-store-link= point to directory in a dired buffer - David Maus worked on `org-link-escape'. See [[http://article.gmane.org/gmane.emacs.orgmode/37888][his message]]: + When, in a dired buffer, the cursor is not in a line listing a + file, `org-store-link' will store a link to the directory. -: Percent escaping is used in Org mode to escape certain characters -: in links that would either break the parser (e.g. square brackets -: in link target or description) or are not allowed to appear in -: a particular link type (e.g. non-ascii characters in a http: -: link). -: -: With this change in place Org will apply percent escaping and -: unescaping more consistently especially for non-ascii characters. -: Additionally some of the outstanding bugs or glitches concerning -: percent escaped links are solved. + Patch by Stephen Eglen. - Thanks a lot to David for this work. +**** Allow regexps in =org-file-apps= to capture link parameters + The way extension regexps in =org-file-apps= are handled has + changed. Instead of matching against the file name, the regexps + are now matched against the whole link, and you can use grouping + to extract link parameters which you can then use in a command + string to be executed. + For example, to allow linking to PDF files using the syntax + =file:/doc.pdf::<page number>=, you can add the following entry + to org-file-apps: -*** Make =org-store-link= point to directory in a dired buffer - :PROPERTIES: - :OrgVersion: 6.35 - :END: + #+begin_example + Extension: \.pdf::\([0-9]+\)\' + Command: evince "%s" -p %1 + #+end_example - When, in a dired buffer, the cursor is not in a line listing a - file, `org-store-link' will store a link to the directory. + Thanks to Jan Böcker for a patch to this effect. - Patch by Stephen Eglen. +*** Dates and time +**** Allow relative time when scheduling/adding a deadline + You can now use relative duration strings like "-2d" or "++3w" + when calling =org-schedule= or =org-deadline=: it will schedule + (or set the deadline for) the item respectively two days before + today and three weeks after the current timestamp, if any. -*** Allow regexps in =org-file-apps= to capture link parameters - :PROPERTIES: - :OrgVersion: 6.35 - :END: + You can use this programmatically: =(org-schedule nil "+2d")= + will work on the current entry. - The way extension regexps in =org-file-apps= are handled has - changed. Instead of matching against the file name, the regexps - are now matched against the whole link, and you can use grouping - to extract link parameters which you can then use in a command - string to be executed. + You can also use this while (bulk-)rescheduling and + (bulk-)resetting the deadline of (several) items from the agenda. - For example, to allow linking to PDF files using the syntax - =file:/doc.pdf::<page number>=, you can add the following entry to - org-file-apps: + Thanks to Memnon Anon for a heads up about this! - #+begin_example - Extension: \.pdf::\([0-9]+\)\' - Command: evince "%s" -p %1 - #+end_example +**** American-style dates are now understood by =org-read-date= - Thanks to Jan Böcker for a patch to this effect. + So when you are prompted for a date, you can now answer like this -** Dates and time + #+begin_example + 2/5/3 --> 2003-02-05 + 2/5 --> <CURRENT-YEAR>-02-05 + #+end_example -*** Allow relative time when scheduling/adding a deadline - :PROPERTIES: - :OrgVersion: 7.7 - :END: +*** Agenda - You can now use relative duration strings like "-2d" or "++3w" - when calling =org-schedule= or =org-deadline=: it will schedule - (or set the deadline for) the item respectively two days before - today and three weeks after the current timestamp, if any. +**** =org-agenda-custom-commands= has a default value - You can use this programmatically: =(org-schedule nil "+2d")= - will work on the current entry. + This option used to be `nil' by default. This now has a default + value, displaying an agenda and all TODOs. See the docstring for + details. Thanks to Carsten for this. - You can also use this while (bulk-)rescheduling and - (bulk-)resetting the deadline of (several) items from the agenda. +**** Improved filtering through =org-agenda-to-appt= - Thanks to Memnon Anon for a heads up about this! + The new function allows the user to refine the scope of entries + to pass to =org-agenda-get-day-entries= and allows to filter out + entries using a function. + Thanks to Peter Münster for raising a related issue and to + Tassilo Horn for this idea. Also thanks to Peter Münster for + [[git:68ffb7a7][fixing a small bug]] in the final implementation. +**** Allow ap/pm times in agenda time grid + Times in the agenda can now be displayed in am/pm format. See + the new variable =org-agenda-timegrid-use-ampm=. Thanks to + C. A. Webber for a patch to this effect. -*** American-style dates are now understood by =org-read-date= - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Agenda: Added a bulk "scattering" command - So when you are prompted for a date, you can now answer like this + =B S= in the agenda buffer will cause tasks to be rescheduled a + random number of days into the future, with 7 as the default. + This is useful if you've got a ton of tasks scheduled for today, + you realize you'll never deal with them all, and you just want + them to be distributed across the next N days. When called with + a prefix arg, rescheduling will avoid weekend days. - #+begin_example - 2/5/3 --> 2003-02-05 - 2/5 --> <CURRENT-YEAR>-02-05 - #+end_example + Thanks to John Wiegley for this. -** Agenda +*** Exporting -*** =org-agenda-custom-commands= has a default value - :PROPERTIES: - :OrgVersion: 7.8 - :END: +**** Simplification of org-export-html-preamble/postamble - This option used to be `nil' by default. This now has a default - value, displaying an agenda and all TODOs. See the docstring for - details. Thanks to Carsten for this. + When set to `t', export the preamble/postamble as usual, honoring + the =org-export-email/author/creator-info= variables. + When set to a formatting string, insert this string. See the + docstring of these variable for details about available + %-sequences. -*** Improved filtering through =org-agenda-to-appt= - :PROPERTIES: - :OrgVersion: 7.8 - :END: + You can set =:html-preamble= in publishing project in the same + way: `t' means to honor =:email/creator/author-info=, and a + formatting string will insert a string. - The new function allows the user to refine the scope of entries - to pass to =org-agenda-get-day-entries= and allows to filter out - entries using a function. +**** New exporters to Latin-1 and UTF-8 - Thanks to Peter Münster for raising a related issue and to - Tassilo Horn for this idea. Also thanks to Peter Münster for - [[git:68ffb7a7][fixing a small bug]] in the final implementation. + While Ulf Stegemann was going through the entities list to + improve the LaTeX export, he had the great idea to provide + representations for many of the entities in Latin-1, and for all + of them in UTF-8. This means that we can now export files rich + in special symbols to Latin-1 and to UTF-8 files. These new + exporters can be reached with the commands =C-c C-e n= and =C-c + C-e u=, respectively. + When there is no representation for a given symbol in the + targeted coding system, you can choose to keep the TeX-macro-like + representation, or to get an "explanatory" representation. For + example, =\simeq= could be represented as "[approx. equal to]". + Please use the variable =org-entities-ascii-explanatory= to state + your preference. +**** HTML export: Add class to outline containers using property -*** Allow ap/pm times in agenda time grid - :PROPERTIES: - :OrgVersion: 7.4 - :END: + The =HTML_CONTAINER_CLASS= property can now be used to add a + class name to the outline container of a node in HTML export. - Times in the agenda can now be displayed in am/pm format. See the new - variable =org-agenda-timegrid-use-ampm=. Thanks to C. A. Webber for - a patch to this effect. +**** Throw an error when creating an image from a LaTeX snippet fails + This behavior can be configured with the new option variable + =org-format-latex-signal-error=. +**** Support for creating BEAMER presentations from Org-mode documents -*** Agenda: Added a bulk "scattering" command - :PROPERTIES: - :OrgVersion: 7.4 - :END: + Org-mode documents or subtrees can now be converted directly in + to BEAMER presentation. Turning a tree into a simple + presentations is straight forward, and there is also quite some + support to make richer presentations as well. See the [[http://orgmode.org/manual/Beamer-class-export.html#Beamer-class-export][BEAMER + section]] in the manual for more details. - =B S= in the agenda buffer will cause tasks to be rescheduled a random - number of days into the future, with 7 as the default. This is useful - if you've got a ton of tasks scheduled for today, you realize you'll - never deal with them all, and you just want them to be distributed - across the next N days. When called with a prefix arg, rescheduling - will avoid weekend days. + Thanks to everyone who has contributed to the discussion about + BEAMER support and how it should work. This was a great example + for how this community can achieve a much better result than any + individual could. - Thanks to John Wiegley for this. +*** Refiling -** Exporting +**** Refile targets can now be cached -*** Simplification of org-export-html-preamble/postamble - :PROPERTIES: - :OrgVersion: 7.5 - :END: + You can turn on caching of refile targets by setting the variable + =org-refile-use-cache=. This should speed up refiling if you + have many eligible targets in many files. If you need to update + the cache because Org misses a newly created entry or still + offers a deleted one, press =C-0 C-c C-w=. - When set to `t', export the preamble/postamble as usual, honoring the - =org-export-email/author/creator-info= variables. +**** New logging support for refiling - When set to a formatting string, insert this string. See the docstring - of these variable for details about available %-sequences. + Whenever you refile an item, a time stamp and even a note can be + added to this entry. For details, see the new option + =org-log-refile=. - You can set =:html-preamble= in publishing project in the same way: `t' - means to honor =:email/creator/author-info=, and a formatting string - will insert a string. + Thanks to Charles Cave for this idea. -*** New exporters to Latin-1 and UTF-8 - :PROPERTIES: - :OrgVersion: 6.35 - :END: +*** Completion - While Ulf Stegemann was going through the entities list to improve the - LaTeX export, he had the great idea to provide representations for many - of the entities in Latin-1, and for all of them in UTF-8. This means - that we can now export files rich in special symbols to Latin-1 and to - UTF-8 files. These new exporters can be reached with the commands =C-c - C-e n= and =C-c C-e u=, respectively. +**** In-buffer completion is now done using John Wiegley's pcomplete.el - When there is no representation for a given symbol in the targeted - coding system, you can choose to keep the TeX-macro-like - representation, or to get an "explanatory" representation. For - example, =\simeq= could be represented as "[approx. equal to]". Please - use the variable =org-entities-ascii-explanatory= to state your - preference. + Thanks to John Wiegley for much of this code. -*** HTML export: Add class to outline containers using property - :PROPERTIES: - :OrgVersion: 6.35 - :END: +*** Tables - The =HTML_CONTAINER_CLASS= property can now be used to add a class name - to the outline container of a node in HTML export. +**** New command =org-table-transpose-table-at-point= -*** Throw an error when creating an image from a LaTeX snippet fails - :PROPERTIES: - :OrgVersion: 6.35 - :END: + See the docstring. This hack from Juan Pechiar is now part of + Org's core. Thanks to Juan! - This behavior can be configured with the new option variable - =org-format-latex-signal-error=. +**** Display field's coordinates when editing it with =C-c `= -*** Support for creating BEAMER presentations from Org-mode documents - :PROPERTIES: - :OrgVersion: 6.34 - :END: + When editing a field with =C-c `=, the field's coordinate will + the displayed in the buffer. - Org-mode documents or subtrees can now be converted directly in to - BEAMER presentation. Turning a tree into a simple presentations is - straight forward, and there is also quite some support to make richer - presentations as well. See the [[http://orgmode.org/manual/Beamer-class-export.html#Beamer-class-export][BEAMER section]] in the manual for more - details. + Thanks to Michael Brand for a patch to this effect. - Thanks to everyone who has contributed to the discussion about BEAMER - support and how it should work. This was a great example for how this - community can achieve a much better result than any individual could. +**** Spreadsheet computation of durations and time values -** Refiling + If you want to compute time values use the =T= flag, either in + Calc formulas or Elisp formulas: -*** Refile targets can now be cached - :PROPERTIES: - :OrgVersion: 7.01 - :END: + | Task 1 | Task 2 | Total | + |--------+--------+---------| + | 35:00 | 35:00 | 1:10:00 | + #+TBLFM: @2$3=$1+$2;T - You can turn on caching of refile targets by setting the variable - =org-refile-use-cache=. This should speed up refiling if you have many - eligible targets in many files. If you need to update the cache - because Org misses a newly created entry or still offers a deleted one, - press =C-0 C-c C-w=. + Values must be of the form =[HH:]MM:SS=, where hours are + optional. -*** New logging support for refiling - :PROPERTIES: - :OrgVersion: 6.35 - :END: + Thanks to Martin Halder, Eric Schulte and Carsten for code and + feedback on this. - Whenever you refile an item, a time stamp and even a note can be added - to this entry. For details, see the new option =org-log-refile=. +**** Implement formulas applying to field ranges - Thanks to Charles Cave for this idea. + Carsten implemented this field-ranges formulas. -** Completion + : A frequently requested feature for tables has been to be able to define + : row formulas in a way similar to column formulas. The patch below allows + : things like + : + : @3= + : @2$2..@5$7= + : @I$2..@II$4= + : + : as the left hand side for table formulas in order to write a formula that + : is valid for an entire column or for a rectangular section in a + : table. -*** In-buffer completion is now done using John Wiegley's pcomplete.el - :PROPERTIES: - :OrgVersion: 7.4 - :END: + Thanks a lot to Carsten for this. - Thanks to John Wiegley for much of this code. +**** Sending radio tables from org buffers is now allowed -** Tables + Org radio tables can no also be sent inside Org buffers. Also, + there is a new hook which get called after a table has been sent. -*** New command =org-table-transpose-table-at-point= - :PROPERTIES: - :OrgVersion: 7.8 - :END: + Thanks to Seweryn Kokot. - See the docstring. This hack from Juan Pechiar is now part of Org's - core. Thanks to Juan! +*** Lists -*** Display field's coordinates when editing it with =C-c `= - :PROPERTIES: - :OrgVersion: 7.7 - :END: +**** Improved handling of lists - When editing a field with =C-c `=, the field's coordinate will the - displayed in the buffer. + Nicolas Goaziou extended and improved the way Org handles lists. - Thanks to Michael Brand for a patch to this effect. + 1. Indentation of text determines again end of items in + lists. So, some text less indented than the previous item + doesn't close the whole list anymore, only all items more + indented than it. -*** Spreadsheet computation of durations and time values - :PROPERTIES: - :OrgVersion: 7.6 - :END: + 2. Alphabetical bullets are implemented, through the use of the + variable `org-alphabetical-lists'. This also adds alphabetical + counters like [@c] or [@W]. - If you want to compute time values use the =T= flag, either in Calc - formulas or Elisp formulas: + 3. Lists can now safely contain drawers, inline tasks, or various + blocks, themselves containing lists. Two variables are + controlling this: `org-list-forbidden-blocks', and + `org-list-export-context'. - | Task 1 | Task 2 | Total | - |--------+--------+---------| - | 35:00 | 35:00 | 1:10:00 | - #+TBLFM: @2$3=$1+$2;T + 4. Improve `newline-and-indent' (C-j): used in an item, it will + keep text from moving at column 0. This allows to split text + and make paragraphs and still not break the list. - Values must be of the form =[HH:]MM:SS=, where hours are optional. + 5. Improve `org-toggle-item' (C-c -): used on a region with + standard text, it will change the region into one item. With a + prefix argument, it will fallback to the previous behavior and + make every line in region an item. It permits to easily + integrate paragraphs inside a list. - Thanks to Martin Halder, Eric Schulte and Carsten for code and feedback - on this. + 6. `fill-paragraph' (M-q) now understands lists. It can freely be + used inside items, or on text just after a list, even with no + blank line around, without breaking list structure. -*** Implement formulas applying to field ranges - :PROPERTIES: - :OrgVersion: 7.5 - :END: + Thanks a lot to Nicolas for all this! - Carsten implemented this field-ranges formulas. +*** Inline display of linked images - : A frequently requested feature for tables has been to be able to define - : row formulas in a way similar to column formulas. The patch below allows - : things like - : - : @3= - : @2$2..@5$7= - : @I$2..@II$4= - : - : as the left hand side for table formulas in order to write a formula that - : is valid for an entire column or for a rectangular section in a - : table. + Images can now be displayed inline. The key C-c C-x C-v does + toggle the display of such images. Note that only image links + that have no description part will be inlined. - Thanks a lot to Carsten for this. +*** Implement offsets for ordered lists -*** Sending radio tables from org buffers is now allowed - :PROPERTIES: - :OrgVersion: 7.4 - :END: + If you want to start an ordered plain list with a number different + from 1, you can now do it like this: - Org radio tables can no also be sent inside Org buffers. Also, there - is a new hook which get called after a table has been sent. + : 1. [@start:12] will star a lit a number 12 - Thanks to Seweryn Kokot. +*** Babel: code block body expansion for table and preview -** Lists + In org-babel, code is "expanded" prior to evaluation. I.e. the + code that is actually evaluated comprises the code block contents, + augmented with the extra code which assigns the referenced data to + variables. It is now possible to preview expanded contents, and + also to expand code during during tangling. This expansion takes + into account all header arguments, and variables. -*** Improved handling of lists - :PROPERTIES: - :OrgVersion: 7.5 - :END: + A new keybinding `C-c M-b p' bound to `org-babel-expand-src-block' + can be used from inside of a source code block to preview its + expanded contents (which can be very useful for debugging). + tangling - Nicolas Goaziou extended and improved the way Org handles lists. + The expanded body can now be tangled, this includes variable + values which may be the results of other source-code blocks, or + stored in headline properties or tables. One possible use for this + is to allow those using org-babel for their emacs initialization + to store values (e.g. usernames, passwords, etc...) in headline + properties or in tables. - 1. Indentation of text determines again end of items in lists. So, some - text less indented than the previous item doesn't close the whole - list anymore, only all items more indented than it. + Org-babel now supports three new header arguments, and new default + behavior for handling horizontal lines in tables (hlines), column + names, and rownames across all languages. - 2. Alphabetical bullets are implemented, through the use of the - variable `org-alphabetical-lists'. This also adds alphabetical - counters like [@c] or [@W]. +*** Editing Convenience and Appearance - 3. Lists can now safely contain drawers, inline tasks, or various - blocks, themselves containing lists. Two variables are controlling - this: `org-list-forbidden-blocks', and `org-list-export-context'. +**** New command =org-copy-visible= (=C-c C-x v=) - 4. Improve `newline-and-indent' (C-j): used in an item, it will keep - text from moving at column 0. This allows to split text and make - paragraphs and still not break the list. + This command will copy the visible text in the region into the + kill ring. Thanks to Florian Beck for this function and to + Carsten for adding it to org.el and documenting it! - 5. Improve `org-toggle-item' (C-c -): used on a region with standard - text, it will change the region into one item. With a prefix - argument, it will fallback to the previous behavior and make every - line in region an item. It permits to easily integrate paragraphs - inside a list. +**** Make it possible to protect hidden subtrees from being killed by =C-k= - 6. `fill-paragraph' (M-q) now understands lists. It can freely be used - inside items, or on text just after a list, even with no blank line - around, without breaking list structure. + See the new variable =org-ctrl-k-protect-subtree=. This was a + request by Scott Otterson. - Thanks a lot to Nicolas for all this! +**** Implement pretty display of entities, sub-, and superscripts. -** Inline display of linked images - :PROPERTIES: - :OrgVersion: 6.36 - :END: - - Images can now be displayed inline. The key C-c C-x C-v does toggle the - display of such images. Note that only image links that have no - description part will be inlined. + The command =C-c C-x \= toggles the display of Org's special + entities like =\alpha= as pretty unicode characters. Also, sub + and superscripts are displayed in a pretty way (raised/lower + display, in a smaller font). If you want to exclude sub- and + superscripts, see the variable + =org-pretty-entities-include-sub-superscripts=. -** Implement offsets for ordered lists - :PROPERTIES: - :OrgVersion: 6.36 - :END: - - If you want to start an ordered plain list with a number different from - 1, you can now do it like this: - - : 1. [@start:12] will star a lit a number 12 + Thanks to Eric Schulte and Ulf Stegeman for making this possible. -** Babel: code block body expansion for table and preview - :PROPERTIES: - :OrgVersion: 6.36 - :END: - - In org-babel, code is "expanded" prior to evaluation. I.e. the code that - is actually evaluated comprises the code block contents, augmented with - the extra code which assigns the referenced data to variables. It is now - possible to preview expanded contents, and also to expand code during - during tangling. This expansion takes into account all header arguments, - and variables. - - A new key-binding `C-c M-b p' bound to `org-babel-expand-src-block' can - be used from inside of a source code block to preview its expanded - contents (which can be very useful for debugging). tangling - - The expanded body can now be tangled, this includes variable values - which may be the results of other source-code blocks, or stored in - headline properties or tables. One possible use for this is to allow - those using org-babel for their emacs initialization to store values - (e.g. usernames, passwords, etc...) in headline properties or in tables. - - Org-babel now supports three new header arguments, and new default - behavior for handling horizontal lines in tables (hlines), column names, - and rownames across all languages. - -** Editing Convenience and Appearance +**** New faces for title, date, author and email address lines -*** New command =org-copy-visible= (=C-c C-x v=) - :PROPERTIES: - :OrgVersion: 7.7 - :END: + The keywords in these lines are now dimmed out, and the title is + displayed in a larger font, and a special font is also used for + author, date, and email information. This is implemented by the + following new faces: - This command will copy the visible text in the region into the kill - ring. Thanks to Florian Beck for this function and to Carsten for - adding it to org.el and documenting it! + =org-document-title= + =org-document-info= + =org-document-info-keyword= -*** Make it possible to protect hidden subtrees from being killed by =C-k= - :PROPERTIES: - :OrgVersion: 7.01 - :END: + In addition, the variable =org-hidden-keywords= can be used to + make the corresponding keywords disappear. - See the new variable =org-ctrl-k-protect-subtree=. This was a request - by Scott Otterson. + Thanks to Dan Davison for this feature. -*** Implement pretty display of entities, sub-, and superscripts. - :PROPERTIES: - :OrgVersion: 7.01 - :END: +**** Simpler way to specify faces for tags and todo keywords - The command =C-c C-x \= toggles the display of Org's special entities - like =\alpha= as pretty unicode characters. Also, sub and superscripts - are displayed in a pretty way (raised/lower display, in a smaller - font). If you want to exclude sub- and superscripts, see the variable - =org-pretty-entities-include-sub-superscripts=. - - Thanks to Eric Schulte and Ulf Stegeman for making this possible. - -*** New faces for title, date, author and email address lines - :PROPERTIES: - :OrgVersion: 6.35 - :END: - - The keywords in these lines are now dimmed out, and the title is - displayed in a larger font, and a special font is also used for author, - date, and email information. This is implemented by the following new - faces: - - =org-document-title= - =org-document-info= - =org-document-info-keyword= - - In addition, the variable =org-hidden-keywords= can be used to make the - corresponding keywords disappear. + The variables =org-todo-keyword-faces=, =org-tag-faces=, and + =org-priority-faces= now accept simple color names as + specifications. The colors will be used as either foreground or + background color for the corresponding keyword. See also the + variable =org-faces-easy-properties=, which governs which face + property is affected by this setting. - Thanks to Dan Davison for this feature. - -*** Simpler way to specify faces for tags and todo keywords - :PROPERTIES: - :OrgVersion: 6.35 - :END: - - The variables =org-todo-keyword-faces=, =org-tag-faces=, and - =org-priority-faces= now accept simple color names as specifications. - The colors will be used as either foreground or background color for - the corresponding keyword. See also the variable - =org-faces-easy-properties=, which governs which face property is - affected by this setting. + This is really a great simplification for setting keyword faces. + The change is based on an idea and patch by Ryan Thompson. - This is really a great simplification for setting keyword faces. The - change is based on an idea and patch by Ryan Thompson. - -*** <N> in tables now means fixed width, not maximum width - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** <N> in tables now means fixed width, not maximum width - Requested by Michael Brand. + Requested by Michael Brand. -*** Better level cycling function - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Better level cycling function - =TAB= in an empty headline cycles the level of that headline through - likely states. Ryan Thompson implemented an improved version of this - function, which does not depend upon when exactly this command is used. - Thanks to Ryan for this improvement. + =TAB= in an empty headline cycles the level of that headline + through likely states. Ryan Thompson implemented an improved + version of this function, which does not depend upon when exactly + this command is used. Thanks to Ryan for this improvement. -*** Adaptive filling - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Adaptive filling - For paragraph text, =org-adaptive-fill-function= did not handle the - base case of regular text which needed to be filled. This is now - fixed. Among other things, it allows email-style ">" comments to be - filled correctly. + For paragraph text, =org-adaptive-fill-function= did not handle + the base case of regular text which needed to be filled. This is + now fixed. Among other things, it allows email-style ">" + comments to be filled correctly. - Thanks to Dan Hackney for this patch. + Thanks to Dan Hackney for this patch. -*** `org-reveal' (=C-c C-r=) also decrypts encrypted entries (org-crypt.el) - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** `org-reveal' (=C-c C-r=) also decrypts encrypted entries (org-crypt.el) - Thanks to Richard Riley for triggering this change. + Thanks to Richard Riley for triggering this change. -*** Better automatic letter selection for TODO keywords - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Better automatic letter selection for TODO keywords - When all first letters of keywords have been used, Org now assigns more - meaningful characters based on the keywords. + When all first letters of keywords have been used, Org now + assigns more meaningful characters based on the keywords. - Thanks to Mikael Fornius for this patch. + Thanks to Mikael Fornius for this patch. -** Clocking +*** Clocking -*** Clock: Allow synchronous update of timestamps in CLOCK log - :PROPERTIES: - :OrgVersion: 7.7 - :END: +**** Clock: Allow synchronous update of timestamps in CLOCK log - Using =S-M-<up/down>= on CLOCK log timestamps will increase/decrease - the two timestamps on this line so that duration will keep the same. - Note that duration can still be slightly modified in case a timestamp - needs some rounding. + Using =S-M-<up/down>= on CLOCK log timestamps will + increase/decrease the two timestamps on this line so that + duration will keep the same. Note that duration can still be + slightly modified in case a timestamp needs some rounding. - Thanks to Rainer Stengele for this idea. + Thanks to Rainer Stengele for this idea. -*** Localized clock tables - :PROPERTIES: - :OrgVersion: 7.5 - :END: +**** Localized clock tables - Clock tables now support a new new =:lang= parameter, allowing the user - to customize the localization of the table headers. See the variable - =org-clock-clocktable-language-setup= which controls available - translated strings. + Clock tables now support a new new =:lang= parameter, allowing + the user to customize the localization of the table headers. See + the variable =org-clock-clocktable-language-setup= which controls + available translated strings. -*** Show clock overruns in mode line - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Show clock overruns in mode line - When clocking an item with a planned effort, overrunning the planned - time is now made visible in the mode line, for example using the new - face =org-mode-line-clock-overrun=, or by adding an extra string given - by =org-task-overrun-text=. + When clocking an item with a planned effort, overrunning the + planned time is now made visible in the mode line, for example + using the new face =org-mode-line-clock-overrun=, or by adding an + extra string given by =org-task-overrun-text=. - Thanks to Richard Riley for a patch to this effect. + Thanks to Richard Riley for a patch to this effect. -*** Clock reports can now include the running, incomplete clock - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Clock reports can now include the running, incomplete clock - If you have a clock running, and the entry being clocked falls into the - scope when creating a clock table, the time so far spent can be added - to the total. This behavior depends on the setting of - =org-clock-report-include-clocking-task=. The default is =nil=. + If you have a clock running, and the entry being clocked falls + into the scope when creating a clock table, the time so far spent + can be added to the total. This behavior depends on the setting + of =org-clock-report-include-clocking-task=. The default is + =nil=. - Thanks to Bernt Hansen for this useful addition. + Thanks to Bernt Hansen for this useful addition. -** Misc +*** Misc -*** Improvements with inline tasks and indentation - :PROPERTIES: - :OrgVersion: 7.4 - :END: +**** Improvements with inline tasks and indentation - There is now a configurable way on how to export inline tasks. See the - new variable =org-inlinetask-export-templates=. + There is now a configurable way on how to export inline tasks. + See the new variable =org-inlinetask-export-templates=. - Thanks to Nicolas Goaziou for coding these changes. + Thanks to Nicolas Goaziou for coding these changes. -*** A property value of "nil" now means to unset a property - :PROPERTIES: - :OrgVersion: 7.01 - :END: +**** A property value of "nil" now means to unset a property - This can be useful in particular with property inheritance, if some - upper level has the property, and some grandchild of it would like to - have the default settings (i.e. not overruled by a property) back. + This can be useful in particular with property inheritance, if + some upper level has the property, and some grandchild of it + would like to have the default settings (i.e. not overruled by a + property) back. - Thanks to Robert Goldman and Bernt Hansen for suggesting this change. + Thanks to Robert Goldman and Bernt Hansen for suggesting this + change. -*** New helper functions in org-table.el - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** New helper functions in org-table.el - There are new functions to access and write to a specific table field. - This is for hackers, and maybe for the org-babel people. + There are new functions to access and write to a specific table field. + This is for hackers, and maybe for the org-babel people. - #+begin_example - org-table-get - org-table-put - org-table-current-line - org-table-goto-line - #+end_example + #+begin_example + org-table-get + org-table-put + org-table-current-line + org-table-goto-line + #+end_example -*** Archiving: Allow to reverse order in target node - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Archiving: Allow to reverse order in target node - The new option =org-archive-reversed-order= allows to have archived - entries inserted in a last-on-top fashion in the target node. + The new option =org-archive-reversed-order= allows to have + archived entries inserted in a last-on-top fashion in the target + node. - This was requested by Tom. + This was requested by Tom. -*** Org-reveal: Double prefix arg shows the entire subtree of the parent - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Org-reveal: Double prefix arg shows the entire subtree of the parent - This can help to get out of an inconsistent state produced for example - by viewing from the agenda. + This can help to get out of an inconsistent state produced for + example by viewing from the agenda. - This was a request by Matt Lundin. + This was a request by Matt Lundin. * License -This file is part of GNU Emacs. + This file is part of GNU Emacs. -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. + GNU Emacs is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. + GNU Emacs is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + You should have received a copy of the GNU General Public License + along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. diff --git a/etc/images/icons/README b/etc/images/icons/README index 664c52906ac..d71641684cd 100644 --- a/etc/images/icons/README +++ b/etc/images/icons/README @@ -9,13 +9,6 @@ Copyright (C) 2007-2012 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) -Files: hicolor/16x16/apps/emacs22.png hicolor/24x24/apps/emacs22.png - hicolor/32x32/apps/emacs22.png hicolor/48x48/apps/emacs22.png - -Author: Andrew Zhilin <andrew_zhilin@yahoo.com> -Copyright (C) 2005-2012 Free Software Foundation, Inc. -License: GNU General Public License version 3 or later (see COPYING) - Files: allout-widgets-dark-bg/closed.png allout-widgets-dark-bg/closed.xpm allout-widgets-dark-bg/empty.png diff --git a/etc/images/icons/hicolor/16x16/apps/emacs22.png b/etc/images/icons/hicolor/16x16/apps/emacs22.png Binary files differdeleted file mode 100644 index b419b01b4ee..00000000000 --- a/etc/images/icons/hicolor/16x16/apps/emacs22.png +++ /dev/null diff --git a/etc/images/icons/hicolor/24x24/apps/emacs22.png b/etc/images/icons/hicolor/24x24/apps/emacs22.png Binary files differdeleted file mode 100644 index 790ec7e2bff..00000000000 --- a/etc/images/icons/hicolor/24x24/apps/emacs22.png +++ /dev/null diff --git a/etc/images/icons/hicolor/32x32/apps/emacs22.png b/etc/images/icons/hicolor/32x32/apps/emacs22.png Binary files differdeleted file mode 100644 index 31fbb47c0d2..00000000000 --- a/etc/images/icons/hicolor/32x32/apps/emacs22.png +++ /dev/null diff --git a/etc/images/icons/hicolor/48x48/apps/emacs22.png b/etc/images/icons/hicolor/48x48/apps/emacs22.png Binary files differdeleted file mode 100644 index f0df0fb6594..00000000000 --- a/etc/images/icons/hicolor/48x48/apps/emacs22.png +++ /dev/null diff --git a/etc/org/OrgOdtContentTemplate.xml b/etc/org/OrgOdtContentTemplate.xml index cd7ff0e1564..55e1b787066 100644 --- a/etc/org/OrgOdtContentTemplate.xml +++ b/etc/org/OrgOdtContentTemplate.xml @@ -256,6 +256,7 @@ <text:sequence-decl text:display-outline-level="0" text:name="Drawing"/> <text:sequence-decl text:display-outline-level="0" text:name="Equation"/> <text:sequence-decl text:display-outline-level="0" text:name="Figure"/> + <text:sequence-decl text:display-outline-level="0" text:name="Listing"/> </text:sequence-decls> </office:text> </office:body> diff --git a/etc/org/OrgOdtStyles.xml b/etc/org/OrgOdtStyles.xml index 84125c96d8a..5dfcfa83890 100644 --- a/etc/org/OrgOdtStyles.xml +++ b/etc/org/OrgOdtStyles.xml @@ -319,6 +319,11 @@ <style:style style:name="Table" style:family="paragraph" style:parent-style-name="Caption" style:class="extra"> <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/> </style:style> + <style:style style:name="Listing" style:family="paragraph" style:parent-style-name="Caption" style:class="extra"> + <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false" fo:keep-with-next="always"> + <style:tab-stops/> + </style:paragraph-properties> + </style:style> <style:style style:name="Horizontal_20_Line" style:display-name="Horizontal Line" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="html"> <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.499cm" style:border-line-width-bottom="0.002cm 0.035cm 0.002cm" fo:padding="0cm" fo:border-left="none" fo:border-right="none" fo:border-top="none" fo:border-bottom="0.039cm double #808080" text:number-lines="false" text:line-number="0" style:join-border="false"/> <style:text-properties fo:font-size="6pt" style:font-size-asian="6pt" style:font-size-complex="6pt"/> diff --git a/etc/refcards/orgcard.pdf b/etc/refcards/orgcard.pdf Binary files differindex 2b474bf4e93..2f004418443 100644 --- a/etc/refcards/orgcard.pdf +++ b/etc/refcards/orgcard.pdf diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 60e81f36d3e..45b8ef04732 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{7.8.11} +\def\orgversionnumber{7.9.2} \def\versionyear{2012} % latest update \input emacsver.tex diff --git a/etc/srecode/c.srt b/etc/srecode/c.srt new file mode 100644 index 00000000000..14d51ed02e6 --- /dev/null +++ b/etc/srecode/c.srt @@ -0,0 +1,164 @@ +;;; c.srt --- SRecode templates for c-mode + +;; Copyright (C) 2007, 2008, 2009, 2010, 2012 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +set mode "c-mode" + +set comment_start "/**" +set comment_end " */" +set comment_prefix " *" + +;; OVERRIDE THIS in your user or project template file to whatever +;; you use for your project. +set HEADEREXT ".h" + +context file + +template empty :time :user :file :c +---- +{{>:filecomment}} + +{{#NOTHEADER}} + +{{^}} +{{/NOTHEADER}} +{{#HEADER}} +{{>:header_guard}} +{{/HEADER}} +---- + +template header_guard :file :blank +---- +#ifndef {{FILENAME_SYMBOL}} +#define {{FILENAME_SYMBOL}} 1 + +{{^}} + +#endif // {{FILENAME_SYMBOL}} +---- + +context misc + +template arglist +"Insert an argument list for a function. +@todo - Support smart CR in a buffer for not too long lines." +---- +({{#ARGS}}{{TYPE}} {{NAME}}{{#NOTLAST}},{{/NOTLAST}}{{/ARGS}}) +---- + +context declaration + +prompt TYPE "Return Type: " + +template function :indent :blank +"Insert a function declaration." +---- +{{?TYPE}} {{?NAME}}{{>:misc:arglist}} +{{#INITIALIZERS}}{{>B:initializers}}{{/INITIALIZERS}} +{ +{{^}} +} +---- +bind "f" + +template function-prototype :indent :blank +"Insert a function declaration." +---- +{{?TYPE}} {{?NAME}}{{>:misc:arglist}}; +---- + + +prompt TYPE "Data Type: " + +template variable :indent :blank +"Insert a variable declaration." +---- +{{?TYPE}} {{?NAME}}{{#HAVEDEFAULT}} = {{DEFAULT}}{{/HAVEDEFAULT}}; +---- +bind "v" + +template variable-prototype :indent :blank +"Insert a variable declaration." +---- +{{?TYPE}} {{?NAME}}; +---- +bind "v" + + +template include :blank +"An include statement." +---- +#include "{{?NAME}}" +---- +bind "i" + +template system-include :blank +"An include statement." +---- +#include <{{?NAME}}> +---- +bind "i" + +template label :blank :indent +---- + {{?NAME}}: +---- + +context declaration + +template comment-function :indent :blank +"Used to put a nice comment in front of a function. +Override this with your own preference to avoid using doxygen" +---- +{{>A:declaration:doxygen-function}} +---- + +;;; DOXYGEN FEATURES +;; +;; +context declaration + +template doxygen-function :indent :blank +---- +/** + * @name {{NAME}} - {{DOC}}{{^}}{{#ARGS}} + * @param {{NAME}} - {{DOC}}{{/ARGS}} + * @return {{TYPE}} + */ +---- + +template doxygen-variable-same-line +---- +/**< {{DOC}}{{^}} */ +---- + +template doxygen-section-comment :blank :indent +"Insert a comment that separates sections of an Emacs Lisp file." +---- + +/** {{?TITLE}} + * + * {{^}} + */ + +---- + + +;; end diff --git a/etc/srecode/cpp.srt b/etc/srecode/cpp.srt index 16cfc535761..f73dcd2a1ca 100644 --- a/etc/srecode/cpp.srt +++ b/etc/srecode/cpp.srt @@ -25,82 +25,8 @@ set comment_start "/**" set comment_end " */" set comment_prefix " *" -;; OVERRIDE THIS in your user or project template file to whatever -;; you use for your project. -set HEADEREXT ".h" - -context file - -template empty :time :user :file :cpp ----- -{{>:filecomment}} - -{{#NOTHEADER}} - -{{^}} -{{/NOTHEADER}} -{{#HEADER}} -{{>:header_guard}} -{{/HEADER}} ----- - -template header_guard :file :blank ----- -#ifndef {{FILENAME_SYMBOL}} -#define {{FILENAME_SYMBOL}} 1 - -{{^}} - -#endif // {{FILENAME_SYMBOL}} ----- - -context misc - -template arglist -"Insert an argument list for a function. -@todo - Support smart CR in a buffer for not too long lines." ----- -({{#ARGS}}{{TYPE}} {{NAME}}{{#NOTLAST}},{{/NOTLAST}}{{/ARGS}}) ----- - context declaration -prompt TYPE "Return Type: " - -template function :indent :blank -"Insert a function declaration." ----- -{{?TYPE}} {{?NAME}}{{>:misc:arglist}} -{{#INITIALIZERS}}{{>B:initializers}}{{/INITIALIZERS}} -{ -{{^}} -} ----- -bind "f" - -template function-prototype :indent :blank -"Insert a function declaration." ----- -{{?TYPE}} {{?NAME}}{{>:misc:arglist}}; ----- - - -prompt TYPE "Data Type: " - -template variable :indent :blank -"Insert a variable declaration." ----- -{{?TYPE}} {{?NAME}}{{#HAVEDEFAULT}} = {{DEFAULT}}{{/HAVEDEFAULT}}; ----- -bind "v" - -template variable-prototype :indent :blank -"Insert a variable declaration." ----- -{{?TYPE}} {{?NAME}}; ----- -bind "v" - template class :indent :blank "Insert a C++ class. For use by user insertion. Override this template to change contents of a class. @@ -146,18 +72,6 @@ template method :indent :blank } ---- -template include :blank -"An include statement." ----- -#include "{{?NAME}}" ----- -bind "i" - -template label :blank :indent ----- - {{?NAME}}: ----- - context classdecl template constructor-tag :indent :blank @@ -196,15 +110,6 @@ Override this with your own preference to avoid using doxygen." {{>A:classdecl:doxygen-function-group-end}} ---- -context declaration - -template comment-function :indent :blank -"Used to put a nice comment in front of a function. -Override this with your own preference to avoid using doxygen" ----- -{{>A:declaration:doxygen-function}} ----- - ;;; DOXYGEN FEATURES ;; ;; @@ -229,32 +134,4 @@ template doxygen-function-group-end :indent :blank ---- -context declaration - -template doxygen-function :indent :blank ----- -/** - * @name {{NAME}} - {{DOC}}{{^}}{{#ARGS}} - * @param {{NAME}} - {{DOC}}{{/ARGS}} - * @return {{TYPE}} - */ ----- - -template doxygen-variable-same-line ----- -/**< {{DOC}}{{^}} */ ----- - -template doxygen-section-comment :blank :indent -"Insert a comment that separates sections of an Emacs Lisp file." ----- - -/** {{?TITLE}} - * - * {{^}} - */ - ----- - - ;; end diff --git a/etc/srecode/ede-autoconf.srt b/etc/srecode/ede-autoconf.srt new file mode 100644 index 00000000000..daefd532dff --- /dev/null +++ b/etc/srecode/ede-autoconf.srt @@ -0,0 +1,54 @@ +;; ede/templates/autoconf.srt --- Templates for autoconf used by EDE. +;; +;; Copyright (C) 2010 Eric M. Ludlam +;; +;; Author: Eric M. Ludlam <eric@siege-engine.com> +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +set mode "autoconf-mode" +set escape_start "{{" +set escape_end "}}" +set comment_start "#" +set comment_prefix "#" +set application "ede" + +context file + +template ede-empty +"Start a new EDE generated configure.in/ac file." +---- +{{comment_prefix}} Automatically Generated/Maintained {{FILE}} by EDE. +{{comment_prefix}} +{{comment_prefix}} YOU MAY MODIFY THIS FILE +{{comment_prefix}} Hand made changes in some sections will be preserved +{{comment_prefix}} by EDE when this file is updated. +{{comment_prefix}} +{{comment_prefix}} EDE is the Emacs Development Environment. +{{comment_prefix}} http://cedet.sourceforge.net/ede.shtml +{{comment_prefix}} +{{comment_prefix}} Process this file with autoconf to produce a configure script + +AC_INIT({{TEST_FILE}}) +AM_INIT_AUTOMAKE([{{PROGRAM}}], 0) +AM_CONFIG_HEADER(config.h) + +{{comment_prefix}} End the configure script. +AC_OUTPUT(Makefile, [date > stamp-h] ) +---- + + +;; end diff --git a/etc/srecode/ede-make.srt b/etc/srecode/ede-make.srt index 97725f4ff56..0b024cd30e4 100644 --- a/etc/srecode/ede-make.srt +++ b/etc/srecode/ede-make.srt @@ -46,4 +46,36 @@ template ede-vars {{NAME}}={{#VALUE}} {{VAL}}{{/VALUE}}{{/VARIABLE}} ---- +;; Some extra templates for Arduino based Makefiles. +;; Perhaps split this out someday in the future. +context arduino + +template ede-empty :file +---- +# Automatically Generated {{FILE}} by EDE. +# For use with Make for an Arduino project. +# +# DO NOT MODIFY THIS FILE OR YOUR CHANGES MAY BE LOST. +# EDE is the Emacs Development Environment. +# http://cedet.sourceforge.net/ede.shtml + +ARDUINO_DIR = {{ARDUINO_HOME}} + +TARGET = {{TARGET}} +ARDUINO_LIBS = {{ARDUINO_LIBS}} + +MCU = {{MCU}} +F_CPU = {{F_CPU}} +ARDUINO_PORT = {{PORT}} +BOARD_TAG = {{BOARD}} + +AVRDUDE_ARD_BAUDRATE = {{AVRDUDE_ARD_BAUDRATE}} +AVRDUDE_ARD_PROGRAMMER = {{AVRDUDE_ARD_PROGRAMMER}} + +include {{ARDUINO_MK}} + +# End of Makefile +---- + + ;; end diff --git a/etc/srecode/el.srt b/etc/srecode/el.srt index cc5af736f15..34a8983b29f 100644 --- a/etc/srecode/el.srt +++ b/etc/srecode/el.srt @@ -197,7 +197,7 @@ template variable-option :el :el-custom :indent :blank ---- (defcustom $?NAME$ $^$ "*$DOC$" - :group $GROUP$ + :group '$GROUP$ :type $?CUSTOMTYPE$) ---- bind "o" diff --git a/etc/tutorials/TUTORIAL.pt_BR b/etc/tutorials/TUTORIAL.pt_BR index 139789b1d2a..f28f86b3105 100644 --- a/etc/tutorials/TUTORIAL.pt_BR +++ b/etc/tutorials/TUTORIAL.pt_BR @@ -46,7 +46,7 @@ META, EDIT ou ALT). Os comandos a seguir são úteis para visualizar telas inteiras C-v Move para tela inteira posterior - M-x Move para tela inteira anterior + M-v Move para tela inteira anterior C-l Limpa a tela e re-mostrá todo o texto, movendo o texto ao redor do cursor para o centro da tela. (Isso é control-L, não control-1.) diff --git a/etc/tutorials/TUTORIAL.ru b/etc/tutorials/TUTORIAL.ru index 0d7405eb1e6..13c79b99f1f 100644 --- a/etc/tutorials/TUTORIAL.ru +++ b/etc/tutorials/TUTORIAL.ru @@ -406,7 +406,7 @@ C-k удалит две Ñтроки, а также завершающие их текÑта). Ð’Ñ‹ можете воÑÑтановить убитый текÑÑ‚ в меÑте ÑƒÐ´Ð°Ð»ÐµÐ½Ð¸Ñ Ð¸Ð»Ð¸ в любой другой точке редактируемого текÑта или даже в другом файле. Ð’Ñ‹ можете воÑÑтановить текÑÑ‚ неÑколько раз и получить неÑколько копий данного текÑта. -Ðекоторые редактора называют операции "убить" и "воÑÑтановить" как +Ðекоторые редакторы называют операции "убить" и "воÑÑтановить" иначе: "вырезать" (cutting) и "вÑтавить" (pasting) (ознакомьтеÑÑŒ Ñ Ð³Ð»Ð¾ÑÑарием (Glossary) в руководÑтве по Emacs). diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 4c25f54545d..2a8ac9b8131 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,15 @@ +2012-10-01 Fabrice Popineau <fabrice.popineau@gmail.com> + + * make-docfile.c (write_globals): Special-case + Fexit_recursive_edit and Fabort_recursive_edit as well, as + functions that are _Noreturn, to be consistent with + src/keyboard.c. + +2012-09-30 Eli Zaretskii <eliz@gnu.org> + + * ntlib.c (gettimeofday): Copy from src/w32.c. lib/gettime.c + needs this function. + 2012-09-26 Juanma Barranquero <lekktu@gmail.com> * makefile.w32-in (obj): Add profiler.o. diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 2654387fb37..411b7057861 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -659,7 +659,9 @@ write_globals (void) special hacks. */ if (strcmp (globals[i].name, "Fthrow") == 0 || strcmp (globals[i].name, "Ftop_level") == 0 - || strcmp (globals[i].name, "Fkill_emacs") == 0) + || strcmp (globals[i].name, "Fkill_emacs") == 0 + || strcmp (globals[i].name, "Fexit_recursive_edit") == 0 + || strcmp (globals[i].name, "Fabort_recursive_edit") == 0) fprintf (outfile, "_Noreturn "); fprintf (outfile, "EXFUN (%s, ", globals[i].name); if (globals[i].value == -1) diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c index 2cc791fb56a..feaad1c1bb7 100644 --- a/lib-src/ntlib.c +++ b/lib-src/ntlib.c @@ -29,9 +29,16 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <sys/stat.h> #include <errno.h> #include <ctype.h> +#include <sys/timeb.h> #include "ntlib.h" +struct timezone +{ + int tz_minuteswest; /* minutes west of Greenwich */ + int tz_dsttime; /* type of dst correction */ +}; + #define MAXPATHLEN _MAX_PATH /* Emulate sleep...we could have done this with a define, but that @@ -202,6 +209,29 @@ getpass (const char * prompt) return NULL; } +/* This is needed because lib/gettime.c calls gettimeofday, which MSVC + doesn't have. Copied from w32.c. */ +void +gettimeofday (struct timeval *tv, struct timezone *tz) +{ + struct _timeb tb; + _ftime (&tb); + + tv->tv_sec = tb.time; + tv->tv_usec = tb.millitm * 1000L; + /* Implementation note: _ftime sometimes doesn't update the dstflag + according to the new timezone when the system timezone is + changed. We could fix that by using GetSystemTime and + GetTimeZoneInformation, but that doesn't seem necessary, since + Emacs always calls gettimeofday with the 2nd argument NULL (see + current_emacs_time). */ + if (tz) + { + tz->tz_minuteswest = tb.timezone; /* minutes west of Greenwich */ + tz->tz_dsttime = tb.dstflag; /* type of dst correction */ + } +} + int fchown (int fd, unsigned uid, unsigned gid) { diff --git a/lib/gnulib.mk b/lib/gnulib.mk index e79fe35622c..23749331a83 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -857,6 +857,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \ -e 's|@''REPLACE_MBTOWC''@|$(REPLACE_MBTOWC)|g' \ -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \ + -e 's|@''REPLACE_PTSNAME''@|$(REPLACE_PTSNAME)|g' \ -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \ -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ -e 's|@''REPLACE_RANDOM_R''@|$(REPLACE_RANDOM_R)|g' \ diff --git a/lib/pselect.c b/lib/pselect.c index d8ebc70f6c6..1b6d099dccf 100644 --- a/lib/pselect.c +++ b/lib/pselect.c @@ -33,6 +33,8 @@ pointer parameter stands for no descriptors, an infinite timeout, or an unaffected signal mask. */ +#if !HAVE_PSELECT + int pselect (int nfds, fd_set *restrict rfds, fd_set *restrict wfds, fd_set *restrict xfds, @@ -74,3 +76,35 @@ pselect (int nfds, fd_set *restrict rfds, return select_result; } + +#else /* HAVE_PSELECT */ +# include <unistd.h> +# undef pselect + +int +rpl_pselect (int nfds, fd_set *restrict rfds, + fd_set *restrict wfds, fd_set *restrict xfds, + struct timespec const *restrict timeout, + sigset_t const *restrict sigmask) +{ + int i; + + /* FreeBSD 8.2 has a bug: it does not always detect invalid fds. */ + if (nfds < 0 || nfds > FD_SETSIZE) + { + errno = EINVAL; + return -1; + } + for (i = 0; i < nfds; i++) + { + if (((rfds && FD_ISSET (i, rfds)) + || (wfds && FD_ISSET (i, wfds)) + || (xfds && FD_ISSET (i, xfds))) + && dup2 (i, i) != i) + return -1; + } + + return pselect (nfds, rfds, wfds, xfds, timeout, sigmask); +} + +#endif diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 1d67ec64c66..65558402bf3 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -457,10 +457,19 @@ _GL_WARN_ON_USE (posix_openpt, "posix_openpt is not portable - " #if @GNULIB_PTSNAME@ /* Return the pathname of the pseudo-terminal slave associated with the master FD is open on, or NULL on errors. */ -# if !@HAVE_PTSNAME@ +# if @REPLACE_PTSNAME@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef ptsname +# define ptsname rpl_ptsname +# endif +_GL_FUNCDECL_RPL (ptsname, char *, (int fd)); +_GL_CXXALIAS_RPL (ptsname, char *, (int fd)); +# else +# if !@HAVE_PTSNAME@ _GL_FUNCDECL_SYS (ptsname, char *, (int fd)); -# endif +# endif _GL_CXXALIAS_SYS (ptsname, char *, (int fd)); +# endif _GL_CXXALIASWARN (ptsname); #elif defined GNULIB_POSIXCHECK # undef ptsname diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6704b26cf7d..87b54707e0a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -3,6 +3,422 @@ * international/characters.el: Fix simple mistake ((car chars) -> elt), delete duplicated code. +2012-10-06 Glenn Morris <rgm@gnu.org> + + * subr.el (read-passwd): Allow C-u to erase entry. (Bug#12570) + +2012-10-06 Julian Scheid <julians37@gmail.com> (tiny change) + + * color.el (color-hsl-to-rgb): Fix incorrect results for + small and large hue values. (Bug#12559) + +2012-10-05 Fabián Ezequiel Gallina <fgallina@cuca> + + Enhancements to docstring formatting when filling paragraphs. + * progmodes/python.el (python-fill-docstring-style): Rename from + python-fill-string-style. Added new style. + (python-fill-string): Use new style. Better checks for + docstrings. + +2012-10-05 Glenn Morris <rgm@gnu.org> + + * net/newst-treeview.el (newsticker-group-move-feed): Doc fix. + + * color.el (color-name-to-rgb, color-rgb-to-hex) + (color-hue-to-rgb, color-hsl-to-rgb, color-rgb-to-hsv) + (color-rgb-to-hsl, color-srgb-to-xyz, color-saturate-hsl) + (color-desaturate-hsl, color-desaturate-name, color-lighten-hsl) + (color-lighten-name, color-darken-hsl, color-darken-name): Doc fixes. + + * emacs-lisp/timer.el (with-timeout): Add missing progn. (Bug#12577) + +2012-10-05 Juanma Barranquero <lekktu@gmail.com> + + * ido.el (ido-directory-too-big-p): Pass dir through file-truename + to get the correct size across symlinks. + + * ido.el (ido-buffer-disable-smart-matches): Fix typo in docstring. + +2012-10-04 Juri Linkov <juri@jurta.org> + + * replace.el (query-replace-interactive): Declare obsolete. + (query-replace-read-from): Add the last incremental search string + to the list of default values accessible via M-n. + (map-query-replace-regexp): Use `read-regexp'. + (query-replace, query-replace-regexp, query-replace-regexp-eval) + (map-query-replace-regexp, replace-string, replace-regexp): + Fix docstrings to replace mentions of `query-replace-interactive' + with alternatives. (Bug#12526) + +2012-10-04 Juri Linkov <juri@jurta.org> + + * dired.el (dired-shrink-to-fit): Declare obsolete. (Bug#1806) + (dired-pop-to-buffer): Declare obsolete. + (dired-mark-pop-up): Doc fix. + +2012-10-04 Fabián Ezequiel Gallina <fgallina@cuca> + + Allow user to set docstring style for fill-paragraph. + * progmodes/python.el + (python-fill-comment-function, python-fill-string-function) + (python-fill-decorator-function, python-fill-paren-function): + Remove :safe for defcustoms. + (python-fill-string-style): New defcustom + (python-fill-paragraph-function): Enhanced context detection. + (python-fill-string): Honor python-fill-string-style settings. + +2012-10-04 Martin Rudalics <rudalics@gmx.at> + + * emacs-lisp/edebug.el (edebug-pop-to-buffer): Select window + after setting its buffer (Bug#10805). + +2012-10-03 Fabián Ezequiel Gallina <fgallina@cuca> + + Fix cornercase for string syntax. + * progmodes/python.el (python-syntax-propertize-function): + Simplify and enhance the regexp for unescaped quotes. Now it also + matches quotes in weird situations like the single quote in + "something\"'". + (python-syntax-stringify): Simplify num-quotes detecting code. + +2012-10-03 Glenn Morris <rgm@gnu.org> + + * help-macro.el (three-step-help): + Revert 2012-09-29 change. (Bug#12567) + +2012-10-03 Martin Rudalics <rudalics@gmx.at> + + * menu-bar.el (kill-this-buffer): Don't do anything when + `menu-frame' is not alive or visible (Bug#8184). + + * emacs-lisp/debug.el (debug): When quitting the debugger window + restore current buffer (Bug#12502). + +2012-10-02 Chong Yidong <cyd@gnu.org> + + * progmodes/hideif.el (hif-lookup, hif-defined): Handle + semantic-c-takeover-hideif. + +2012-10-02 Paul Eggert <eggert@cs.ucla.edu> + + Change sampling interval units from ms to ns. + * profiler.el (profiler-sampling-interval): Change units + from ms to ns, multiplying the default by 1000000 so that + it remains 1 ms. + (profiler-report-cpu-line-format): Give enough room for + the maximum counters on 64-bit hosts. + (profiler-report-render-calltree-1): Call them "CPU samples", + not "Time (ms)", since they are not milliseconds now (and + never really were). + +2012-10-02 Sergio Durigan Junior <sergiodj@riseup.net> (tiny change) + + * net/eudcb-bbdb.el (eudc-bbdb-format-record-as-result): Fix + querying BBDB for entries without a last name (Bug#11580). + +2012-10-02 Chong Yidong <cyd@gnu.org> + + * emacs-lisp/eieio.el: Restore Version header. + +2012-10-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/diff-mode.el (diff--auto-refine-data): New var. + (diff-hunk): Use it to delay refinement. + (diff-mode): Remove overlays when we turn off font-lock. + + * textmodes/table.el: Use lexical-binding, dolist, define-minor-mode. + (table-initialize-table-fixed-width-mode) + (table-set-table-fixed-width-mode): Remove functions. + (table-command-list): Move initialization into declaration. + (table--tweak-menu-for-xemacs): Move defun outside mapcar. + (table-with-cache-buffer): Use `declare'. + (table-span-cell): Simplify via CSE. + (table-fixed-width-mode): Use define-minor-mode. + (table-call-interactively, table-funcall, table-apply): Remove. + (table-function): New function, to replace them. + + * bookmark.el (bookmark-search-pattern): Remove var. + (bookmark-read-search-input): Remove function. + (bookmark-bmenu-search): Reimplement using a minibuffer. + + * faces.el (modeline): Remove obsolete face name. + + * vc/add-log.el (add-log-buffer-file-name-function): Demote to defvar + and give a non-nil default value. + (add-change-log-entry): Simplify accordingly. + +2012-10-01 Dmitry Gutov <dgutov@yandex.ru> + + * vc/vc-git.el (vc-git-log-edit-toggle-signoff): New function. + (vc-git-log-edit-toggle-amend): New function. + (vc-git-log-edit-toggle-signoff): New function. + (vc-git-log-edit-mode): New major mode. + (vc-git-log-edit-mode-map): Keymap for it. + (vc-git-checkin): Handle "Amend" and "Sign-Off" headers. + + * vc/log-edit.el (log-edit-font-lock-keywords): Allow hyphens in + header names. + (log-edit-toggle-header): New function. + (log-edit-extract-headers): Accept function values in HEADERS alist. + +2012-10-01 David Engster <deng@randomsample.de> + + * emacs-lisp/eieio-opt.el (eieio-describe-class): Add filename + from symbol property and change message to be more consistent with + Emacs proper. + (eieio-describe-generic): Add filename for each implementation. + Fix indices for generic and normal methods. + (eieio-method-def, eieio-class-def): New buttons. + (eieio-help-find-method-definition) + (eieio-help-find-class-definition): New functions. + (eieio-help-mode-augmentation-maybee): Add buttons to filenames of + class, constructor and method definitions. + + * emacs-lisp/eieio.el (eieiomt-add, eieio-defclass): Save file + information in symbol property. + (scoped-class): Remove. + (eieio-slot-name-index, call-next-method): Check if it is bound. + +2012-10-01 Leo P. White <lpw25@cam.ac.uk> + + * emacs-lisp/eieio-custom.el (eieio-custom-mode-map): New option. + (eieio-custom-mode): New major mode. + (eieio-customize-object): Use it. + +2012-10-01 Eric Ludlam <zappo@gnu.org> + + * emacs-lisp/eieio-base.el (eieio-persistent-read): New input args + specifying the expected class, and whether subclassing is allowed. + (eieio-persistent-convert-list-to-object): + (eieio-persistent-validate/fix-slot-value) + (eieio-persistent-slot-type-is-class-p): New functions. + (eieio-named::slot-missing): Doc fix. + + * emacs-lisp/eieio-datadebug.el (data-debug/eieio-insert-slots): + Stop using unused publd variable. + + * emacs-lisp/eieio-speedbar.el (eieio-speedbar-handle-click): + (eieio-speedbar-description, eieio-speedbar-derive-line-path) + (eieio-speedbar-object-buttonname, eieio-speedbar-make-tag-line) + (eieio-speedbar-handle-click): Do not specify a class for the + method. Fixes method invocation order problems with EDE. + +2012-10-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/bytecomp.el (byte-compiler-abbreviate-file): New function. + (byte-compile-warning-prefix, byte-compile-file): Use it (bug#12508). + +2012-10-01 Karl Fogel <kfogel@red-bean.com> + + * bookmark.el (bookmark-version-control): Give tags in the + :type choices (Bug#12309), and improve doc string. + (bookmark-write-file): Bind `print-circle' to `t' to allow + circular custom bookmark types. (Bug#12503) + +2012-10-01 Paul Eggert <eggert@cs.ucla.edu> + + Revert the FOLLOW-SYMLINKS change for file-attributes. + * files.el (remote-file-name-inhibit-cache, after-find-file): + * time.el (display-time-file-nonempty-p): Undo last change. + + * profiler.el (profiler-sampling-interval): Change default back to 1. + See Stefan Monnier in + <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00863.html>. + +2012-10-01 Fabián Ezequiel Gallina <fgallina@cuca> + + Shell output catching a la gud-gdb. + * progmodes/python.el (python-shell-fetch-lines-in-progress) + (python-shell-fetch-lines-string, python-shell-fetched-lines): + New Vars. + (python-shell-fetch-lines-filter): New function. + (python-shell-send-string-no-output): Use them. + +2012-09-30 Tomohiro Matsuyama <tomo@cx4a.org> + + * profiler.el (profiler-sampling-interval): Rename from + profiler-sample-interval. + (profiler-sampling-interval): Default to 10. + (profiler-find-profile): New command (was profiler-find-log). + (profiler-find-profile-other-window): New command. + (profiler-find-profile-other-frame): New command. + (profiler-profile): Introduce API-level data structure. + +2012-09-30 Paul Eggert <eggert@cs.ucla.edu> + + file-attributes has a new optional arg FOLLOW-SYMLINKS. + * files.el (remote-file-name-inhibit-cache): + * time.el (display-time-file-nonempty-p): Use it. + * files.el (after-find-file): Don't chase links before calling + file-exists-p, as file-exists-p already does the right thing. + +2012-09-30 Ralf Angeli <angeli@caeruleus.net> + + Merge from standalone RefTeX repository. + + The following ChangeLog entries are shortened versions of the + original ones with file paths adapted. A not so strongly edited + version of the original ChangeLog can be found in the commit log. + + * textmodes/reftex-auc.el: Move `provide' call to bottom of file. + (reftex-arg-cite): Use `reftex-cite-key-separator'. + Correctly handle new value type returned by `reftex-citation'. + + * textmodes/reftex-cite.el (reftex-create-bibtex-file): Make sure + that entries with whitespace at various places are found. + Doc fix. Include entries that are cross-referenced from cited entries. + Include @String definitions in the resulting bib file. Add header + and footer defined in `reftex-create-bibtex-header' and + `reftex-create-bibtex-footer'. + (reftex-do-citation): Make it possible again to insert + non-existent entries. Save match data when asking for optional + arguments. Return all keys, not just the first one. + (reftex-all-used-citation-keys): Fix regexp to correctly extract + all citations in the same line. + (reftex-parse-bibtex-entry): Accept additional optional argument + `raw' and keep quotes or braces if it is non-nil. Match fields + containing hyphens besides word constituents. + (reftex-get-string-refs): New function. + (reftex-extract-bib-entries): Check if BibTeX file changed on disk + and ask if it should be reread in case it did. + (reftex-pop-to-bibtex-entry) + (reftex-extract-bib-entries-from-thebibliography): Match \bibitem + entries with spaces or tabs in front of arguments. + (reftex-pop-to-bibtex-entry, reftex-extract-bib-entries) + (reftex-parse-bibtex-entry, reftex-create-bibtex-file): + Match entries containing numbers and symbol constituents. + (reftex-do-citation, reftex-figure-out-cite-format): + Use `reftex-cite-key-separator'. + + * textmodes/reftex-dcr.el: Move provide statement to end of file. + (reftex-mouse-view-crossref): Explain why point is set. + + * textmodes/reftex-global.el: Whitespace changes. + + * textmodes/reftex-index.el: Move provide statement to end of + file. + (reftex-index-selection-or-word): Use `reftex-region-active-p'. + (reftex-index-visit-phrases-buffer): Set marker when visiting + buffer. This allows for returning from the phrases file to the + file one was just editing instead of the file where the last + phrases was added from. + (reftex-index-phrases-syntax-table): New variable. Give ?\" + punctuation syntax as it usually is not used as string quote in + TeX-related modes and may occur unmatched. The change also + prevents fontification of quoted content. + (reftex-index-phrases-mode): Use it. + + * textmodes/reftex-parse.el (reftex-parse-from-file): + Move backward one char if a `\' was matched after a section macro. + (reftex-parse-from-file): Use beginning of match instead of end as + bound. + + * textmodes/reftex-ref.el: Adapt creation of + `reftex-<package>-<macro>' functions to new structure of + `reftex-ref-style-alist'. + (reftex-reference): Use `reftex-ref-style-list' function. + Adapt to new structure of `reftex-ref-style-alist'. Prompt for a + reference macro if `reftex-ref-macro-prompt' is non-nil. + (reftex-reference): Pass refstyle to `reftex-format-special'. + Determine reference macro by looking at + `reftex-ref-style-default-list' and `reftex-ref-style-alist'. + Use only one special format function. + (reftex-varioref-vref, reftex-fancyref-fref) + (reftex-fancyref-Fref): Remove definitions. The functions are now + generated from `reftex-ref-style-alist'. + (reftex-format-vref, reftex-format-Fref, reftex-format-fref): + Remove. + (reftex-format-special): New function. + + * textmodes/reftex-sel.el + (reftex-select-cycle-ref-style-internal): Adapt to new structure + of `reftex-ref-style-alist'. Remove code for testing macro type. + (reftex-select-toggle-varioref) + (reftex-select-toggle-fancyref): Remove. + (reftex-select-cycle-ref-style-internal) + (reftex-select-cycle-ref-style-forward) + (reftex-select-cycle-ref-style-backward): New functions. + (reftex-select-label-map): Use `v' and `V' for general cycling + through reference styles. Add `p' for switching between number + and page reference types. + + * textmodes/reftex-toc.el (reftex-re-enlarge): + Call `enlarge-window' only if there is something to do because in Emacs + the horizontal version throws an error even if the parameter is 0. + + * textmodes/reftex-vars.el (reftex-label-alist): Doc fix. + (reftex-plug-into-AUCTeX): Doc fix. + (reftex-vref-is-default, reftex-fref-is-default): Adapt doc + string. Adapt to new name. + (reftex-ref-style-alist): Change structure so that it is not + possible to use multiple different package names within a style. + Remove the symbols for symbols for macro type distinction. + Add characters for macro selection. + (reftex-ref-macro-prompt, reftex-create-bibtex-header) + (reftex-create-bibtex-footer): New variables. + (reftex-format-ref-function): Mention third argument of special + format function. + (reftex-ref-style-alist, reftex-ref-style-default-list): + New variables. + (reftex-vref-is-default, reftex-fref-is-default): Adapt doc string + to new implementation. Mark as obsolete. Add compatibility code + for honoring the variable values in case they are set. + (reftex-cite-format-builtin, reftex-bibliography-commands): + Add support for ConTeXt. + (reftex-format-ref-function, reftex-format-cite-function): + Fix custom type. + (reftex-cite-key-separator): New variable. + + * textmodes/reftex.el (reftex-syntax-table-for-bib) + (reftex-mode): Do not derive `reftex-syntax-table-for-bib' from + `reftex-syntax-table' because parens have to retain their paren + syntax in order for parsing of BibTeX entries like @book(...) to + work. + (reftex-in-comment): Do not error out if `comment-start-skip' is + not set. Deal correctly with escaped comment characters. + (reftex-tie-multifile-symbols): Add doc string. + Initialize `reftex-ref-style-list'. + (reftex-untie-multifile-symbols): Add doc string. + (reftex-add-index-macros): Doc fix. + (reftex-ref-style-activate, reftex-ref-style-toggle) + (reftex-ref-style-list): New functions. + (reftex-mode-menu): Use them. Adapt to new structure of + `reftex-ref-style-alist'. + (reftex-select-with-char): Kill the RefTeX Select buffer when + done. + (reftex-remove-if): New function. + (reftex-erase-all-selection-and-index-buffers) + (reftex-mode-menu): Reference styles are now computed from + `reftex-ref-style-alist'. Fix typo. + (reftex-report-bug): New function. + (reftex-uniquify, reftex-uniquify-by-car): Replace O(n^2) + algorithms with O(n log n). Introduce optional argument SORT (not + yet used). + +2012-09-30 Fabián Ezequiel Gallina <fgallina@cuca> + + Enhancements for triple-quote string syntax. + * progmodes/python.el (python-syntax-propertize-function): + Match both quote cases in one regexp. + (python-syntax-stringify): Handle matches properly. + +2012-09-30 Juri Linkov <juri@jurta.org> + + * arc-mode.el (archive-summarize): Let-bind `buffer-file-truename' + to nil around the call to `insert' to prevent + directory time modification by lock_file. (Bug#2295) + * tar-mode.el (tar-summarize-buffer): Idem. + +2012-09-30 Juri Linkov <juri@jurta.org> + + * facemenu.el (list-colors-sort): Add option "Luminance". + (list-colors-sort-key): Implement it. + + * vc/diff-mode.el (diff-refine-removed): + * vc/ediff-init.el (ediff-fine-diff-A): + * vc/smerge-mode.el (smerge-refined-removed): + Change background color "#ffaaaa" to "#ffbbbb". (Bug#10181) + 2012-09-30 Jan Djärv <jan.h.d@swipnet.se> * term/ns-win.el (x-file-dialog): New function. @@ -17,10 +433,10 @@ In buffer display functions handle window-height/window-width alist entries. Suggested by Juri Linkov as fix for Bug#1806. - * window.el (window--display-buffer): New argument ALIST. Obey - window-height and window-width alist entries. - (window--try-to-split-window): New argument ALIST. Bind - window-combination-limit to t when the window's size shall be + * window.el (window--display-buffer): New argument ALIST. + Obey window-height and window-width alist entries. + (window--try-to-split-window): New argument ALIST. + Bind window-combination-limit to t when the window's size shall be changed and window-combination-limit equals `window-size'. (display-buffer-in-atom-window) (display-buffer-in-major-side-window) @@ -43,8 +459,8 @@ temp-buffer-resize-regexps. Use fit-frame-to-buffer instead of temp-buffer-resize-frames. - * dired.el (dired-mark-pop-up): Call - display-buffer-below-selected with a fit-window-to-buffer alist + * dired.el (dired-mark-pop-up): + Call display-buffer-below-selected with a fit-window-to-buffer alist entry. 2012-09-30 Chong Yidong <cyd@gnu.org> @@ -142,8 +558,8 @@ 2012-09-28 Leo Liu <sdl.web@gmail.com> - * pcomplete.el (pcomplete-show-completions): Use - minibuffer-message to make pcomplete usable in minibuffer. + * pcomplete.el (pcomplete-show-completions): + Use minibuffer-message to make pcomplete usable in minibuffer. * ido.el (ido-set-matches-1): Fix 2012-09-11 change. @@ -2681,8 +3097,9 @@ * register.el (copy-to-register, copy-rectangle-to-register): Deactivate the mark, and use indicate-copied-region (Bug#10056). - (append-to-register, prepend-to-register): - Call 2012-07-29 Juri Linkov <juri@jurta.org> + (append-to-register, prepend-to-register): Call indicate-copied-region. + +2012-07-29 Juri Linkov <juri@jurta.org> * simple.el (async-shell-command-buffer): New defcustom. (shell-command): Use it. (Bug#4719) @@ -7971,7 +8388,8 @@ 2012-03-18 Leo Liu <sdl.web@gmail.com> - * net/rcirc.el (rcirc-cmd-quit): Allow quiting all servers with prefix. + * net/rcirc.el (rcirc-cmd-quit): Allow quitting all servers with + prefix. 2012-03-17 Eli Zaretskii <eliz@gnu.org> diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index d94d72d0f3c..c9085827f7b 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -5492,7 +5492,7 @@ 2003-02-14 Dave Love <fx@gnu.org> - * international/code-pages.el: Undo `Trailing whitepace deleted.' + * international/code-pages.el: Undo `Trailing whitespace deleted.' damage. (cp1125, mik): Nullify mime-charset. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index a97a052dc08..c04cd8dcf9d 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -787,7 +787,8 @@ is visible (and the real data of the buffer is hidden). Optional argument SHUT-UP, if non-nil, means don't print messages when parsing the archive." (widen) - (let ((inhibit-read-only t)) + (let ((buffer-file-truename nil) ; avoid changing dir mtime by lock_file + (inhibit-read-only t)) (setq archive-proper-file-start (copy-marker (point-min) t)) (set (make-local-variable 'change-major-mode-hook) 'archive-desummarize) (or shut-up diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 26ba1dec00f..838e5a5ec00 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -99,12 +99,14 @@ To specify the file in which to save them, modify the variable (defcustom bookmark-version-control 'nospecial "Whether or not to make numbered backups of the bookmark file. -It can have four values: t, nil, `never', and `nospecial'. +It can have four values: t, nil, `never', or `nospecial'. The first three have the same meaning that they do for the -variable `version-control', and the final value `nospecial' means just -use the value of `version-control'." - :type '(choice (const nil) (const never) (const nospecial) - (other t)) +variable `version-control'; the value `nospecial' (the default) means +just use the value of `version-control'." + :type '(choice (const :tag "If existing" nil) + (const :tag "Never" never) + (const :tag "Use value of option `version-control'" nospecial) + (other :tag "Always" t)) :group 'bookmark) @@ -1357,7 +1359,12 @@ for a file, defaulting to the file defined by variable (goto-char (point-min)) (delete-region (point-min) (point-max)) (let ((print-length nil) - (print-level nil)) + (print-level nil) + ;; See bug #12503 for why we bind `print-circle'. Users + ;; can define their own bookmark types, which can result in + ;; arbitrary Lisp objects being stored in bookmark records, + ;; and some users create objects containing circularities. + (print-circle t)) (bookmark-insert-file-format-version-stamp) (insert "(") ;; Rather than a single call to `pp' we make one per bookmark. @@ -2003,32 +2010,6 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\ ;;; Bookmark-bmenu search -;; Store keyboard input for incremental search. -(defvar bookmark-search-pattern) - -(defun bookmark-read-search-input () - "Read each keyboard input and add it to `bookmark-search-pattern'." - (let ((prompt (propertize "Pattern: " 'face 'minibuffer-prompt)) - ;; (inhibit-quit t) ; inhibit-quit is evil. Use it with extreme care! - (tmp-list ())) - (while - (let ((char (read-key (concat prompt bookmark-search-pattern)))) - (pcase char - ((or ?\e ?\r) nil) ; RET or ESC break the search loop. - (?\C-g (setq bookmark-quit-flag t) nil) - (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL - (_ - (if (characterp char) - (push char tmp-list) - (setq unread-command-events - (nconc (mapcar 'identity - (this-single-command-raw-keys)) - unread-command-events)) - nil)))) - (setq bookmark-search-pattern - (apply 'string (reverse tmp-list)))))) - - (defun bookmark-bmenu-filter-alist-by-regexp (regexp) "Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list." (let ((bookmark-alist @@ -2043,19 +2024,23 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\ "Incremental search of bookmarks, hiding the non-matches as we go." (interactive) (let ((bmk (bookmark-bmenu-bookmark)) - (bookmark-search-pattern "") - (timer (run-with-idle-timer - bookmark-search-delay 'repeat - #'(lambda () - (bookmark-bmenu-filter-alist-by-regexp - bookmark-search-pattern))))) + (timer nil)) (unwind-protect - (bookmark-read-search-input) - (cancel-timer timer) - (message nil) - (when bookmark-quit-flag ; C-g hit restore menu list. - (bookmark-bmenu-list) (bookmark-bmenu-goto-bookmark bmk)) - (setq bookmark-quit-flag nil)))) + (minibuffer-with-setup-hook + (lambda () + (setq timer (run-with-idle-timer + bookmark-search-delay 'repeat + #'(lambda (buf) + (with-current-buffer buf + (bookmark-bmenu-filter-alist-by-regexp + (minibuffer-contents)))) + (current-buffer)))) + (read-string "Pattern: ") + (when timer (cancel-timer timer) (setq timer nil))) + (when timer ;; Signalled an error or a `quit'. + (cancel-timer timer) + (bookmark-bmenu-list) + (bookmark-bmenu-goto-bookmark bmk))))) (defun bookmark-bmenu-goto-bookmark (name) "Move point to bookmark with name NAME." diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 925bde8a193..e066368d011 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,501 @@ +2012-10-02 Chong Yidong <cyd@gnu.org> + + * srecode.el, ede.el: Restore Version header. + +2012-10-01 Chong Yidong <cyd@gnu.org> + + * semantic/bovine/c-by.el: Regenerate. + * semantic/bovine/make-by.el: + * semantic/bovine/scm-by.el: + * semantic/grammar-wy.el: + * semantic/wisent/javat-wy.el: + * semantic/wisent/js-wy.el: + * srecode/srt-wy.el: + +2012-10-01 Eric Ludlam <zappo@gnu.org> + + * cedet.el (cedet-version, cedet-packages): Update. + + * cedet-global.el (cedet-gnu-global-version-check): Support newer + versions that have extra (parens) in the version string. + + * cedet-idutils.el (cedet-idutils-version-check): Make sure a + version number was found before calling inversion-check-version. + + * data-debug.el (data-debug-insert-thing): Bind inhibit-read-only + while inserting the thing, then clear modified bit. + (data-debug-map): Suppress the keymap. + (data-debug-mode, data-debug-new-buffer): Make buffer read-only. + (data-debug-contract-current-line): Inhibit read-only, then clear + modified bit. + + * ede.el (ede-buffer-belongs-to-project-p): Use ede-object-project + to allow use in more kinds of buffers. + (ede-project-forms-menu): Add `Default configuration' menu item. + (ede-configuration-forms-menu): New, for use in above. + (ede-project-configurations-set): New command used from menu. + (ede-java-classpath): New conveninece for Java support. + (ede-apply-object-keymap): Combine keybindings from the project + and the target, not just whatever is local to the buffer. + (ede-apply-target-options): Call fcn to apply project local + variables. + (ede-reset-all-buffers): Remove arg. + (ede, ede-rescan-toplevel): Callers changed. + (ede-new-target): Fix bug where you couldn't call this from Dired. + (ede-add-file): Replace assignment of ede-object with generic call + to re-init the buffer. + (ede-find-target): If ede-object is set, run short-cut code + instead of `or' shortcut. + (ede-project-buffers): Return buffers belonging to input project, + not any buffer belonging to any project. + (ede-system-include-path, ede-apply-project-local-variables) + (ede-set-project-local-variable): New functions. + (ede-make-project-local-variable): Apply to toplevel if none + specified. + (ede-set): Make it interactive. + + * ede/auto.el (ede-project-autoload): New class. + (ede-do-dirmatch): New method. + (ede-project-dirmatch-p): New function. + (ede-project-root-directory): Call it. + (ede-dir-to-projectfile): Don't call project file function if we + didn't match the root. + (ede-project-root-directory): Don't call a project's root function + if the tool in question isn't installed. + (ede-dir-to-projectfile): Don't call project file function if we + didn't match the root. + + * ede/autoconf-edit.el (autoconf-parameter-strip): Remove any + trailing `\' mid string, and replace with a space. + (autoconf-parameter-count): New function. + (autoconf-set-version): Use it. + + * ede/base.el (ede-project): The :type of targets is now a list of + target base classes. + + * ede/emacs.el (ede-emacs-load): Fix typo. + + * ede/files.el (ede-flush-project-hash, ede-flush-directory-hash): + Protect against missing locator object. + (ede-get-locator-object): Protect against missing project. + (ede-flush-directory-hash): New command. + (ede-get-locator-object): Protect against missing project. + + * ede/generic.el (ede-generic-config): Add configurable + `run-command' slot. + (project-compile-project, project-compile-target) + (project-debug-target, project-run-target): New methods. + (ede-generic-get-configuration): Specify the class to load. + (ede-generic-new-autoloader): Use ede-add-project-autoload. + (ede-enable-generic-projects): Rename projects so as to never + match the edeproject-* projects. + + * ede/makefile-edit.el (makefile-macro-file-list): Case sensitive + searches. Protect against "SUBDIRS=$(subdirs)" infloop. + + * ede/proj-elisp.el (ede-proj-tweak-autoconf) + (ede-proj-flush-autoconf): Disable local variables when loading + the autoconf lisp compile script. + + * ede/proj.el (ede-proj-target-aux, -elisp, -elisp-autoloads) + (-scheme, -makefile-misc, ede-proj-target-makefile-program) + (-makefile-archive, -makefile-shared-object) + (ede-proj-target-makefile-info, -grammar): New autoloads. + (ede-proj-project): Inherit from eieio-persistent-read. Specify + extension and header line. + (ede-proj-load, ede-proj-save): Replace with impl using + eieio-persistent-read. + + * ede/project-am.el (project-add-file): Use ede-target-parent + instead of loading the project file. + + * semantic.el (semantic-version): Update. + (semantic-new-buffer-setup-functions): Add f90-mode, texinfo-mode. + (navigate-menu): Add menu item for Stickyfunc mode. + + * semantic/analyze/debug.el + (semantic-analyzer-debug-insert-include-summary): Before + dereferencing tableinner, make sure it has a value. + + * semantic/analyze/refs.el + (semantic-analyze-tag-references-default): When doing a lookup, + specify noerror. + (semantic--analyze-refs-full-lookup): Add optional noerror input + argument. Pass to to full-lookup-simple. + (semantic-analyze-refs-impl, semantic-analyze-refs-proto): Ignore + :typemodifiers during compare. + + * semantic/bovine/c.el (semantic-lex-cpp-define): Specify limits + to looking back for comment chars. + (semantic--tag-similar-names-p, semantic--tag-similar-names-p-default) + (semantic--tag-attribute-similar-p): New. + (semantic-c-describe-environment): Handle list value of ede-object. + (semantic-lex-c-preprocessor-symbol-map-builtin): Add + __attribute_pure__. + + * semantic/bovine/scm.el (semantic-format-tag-prototype): Add + parent and color argument. Pass them through. + + * semantic/complete.el (semantic-collector-calculate-completions): + Search for more matches if new prefix is a substring of old one. + (semantic-complete-inline-project): New function. + + * semantic/db-el.el (object-print): New method. + + * semantic/db-file.el (semanticdb-load-database): Specify class. + + * semantic/db-typecache.el + (semanticdb-abstract-table::semanticdb-typecache-find-method): + Allow proxied tags to be resolved during the search. + (semanticdb-typecache-complete-flush): Support missing or empty + pointmax slot, to allow for more database types. + + * semantic/db.el (semanticdb-abstract-table): Add db-refs slot. + (object-print): Allow child classes to overwrite the display of + the (%d tags) extra string. + (semanticdb-project-database): Specify :type for table. + (semanticdb-create-table-for-file): Specify file-truename. + (semanticdb-synchronize, semanticdb-partial-synchronize): Restore + code that refreshes references to include files. + + * semantic/decorate/include.el + (semantic-decoration-on-fileless-includes): New face. + (semantic-decoration-on-fileless-include-map) + (semantic-decoration-on-fileless-include-menu): New variables. + (semantic-decoration-on-includes-highlight-default): Support + includes that have a table, but are not associated with a file. + (semantic-decoration-fileless-include-describe) + (semantic-decoration-fileless-include-menu): New functions. + (semantic-decoration-all-include-summary): Add arrows to indicate + the file associated with an include name. + + * semantic/find.el + (semantic-find-tags-by-scope-protection-default): Also filter on + package protection of the slot. + + * semantic/java.el (semantic-java-expand-tag): If some type has a + fully qualified name, bust it up into one package and the type + with a short name. + + * semantic/lex.el (define-lex-block-analyzer): Protect against + random extra close parenthesis. + + * semantic/symref.el (semantic-symref-result-get-tags): Make sure + the cursor is on the matched name. + + * semantic/symref/list.el (semantic-symref-results-mode-map): + Suppress keymap. + + * semantic/tag-ls.el (semantic--tag-similar-names-p) + (semantic--tag-attribute-similar-p) + (semantic--tag-similar-types-p): New functions. + (semantic-tag-similar-ignorable-attributes): New variable. + (semantic-tag-protection-default): Add package concept to return + value. + (semantic-tag-package-protected-p): New function. + (semantic-tag-full-package): New overload method. + (semantic-tag-full-package-default): New default for above. + (semantic-tag-full-name-default): Look for the full package name. + + * semantic/tag.el (semantic-create-tag-proxy) + (semantic-tag-set-proxy, semantic-tag-resolve-proxy): New. + + * semantic/util.el (semantic-describe-buffer): Add + semantic-new-buffer-fcn-was-run. + + * semantic/wisent/java-tags.el (semantic-get-local-variables): Add + `this' to the local variable context. + (semantic-analyze-split-name, semantic-analyze-unsplit-name): New. + + * semantic/wisent/python.el (semantic-python-expand-tag): New + function. + + * srecode/compile.el (srecode-compile-templates): Add "framework" + special variable support. + (srecode-compile-template-table): Support framework specifier. + + * srecode/cpp.el (srecode-semantic-handle-:c) + (srecode-semantic-handle-:cpp): New functions. + (srecode-semantic-apply-tag-to-dict): Move from cpp-mode function + to c-mode function. + (srecode-c-apply-templates): Renamed from srecode-cpp-apply-templates. + + * srecode/dictionary.el (initialize-instance): Remove bogus error + condition. + (srecode-create-section-dictionary): Remove unused function. + + * srecode/java.el (srecode-semantic-handle-:java): Fix filename as + package variable. Add current_package variable. + + * srecode/map.el (srecode-map-update-map): Specify the class. + + * srecode/mode.el (srecode-minor-mode): Support the m3 menu. + + * srecode/semantic.el (srecode-semantic-insert-tag): Support + system includes. + + * srecode/srt-mode.el (srecode-font-lock-keywords): Update. + + * srecode/table.el (srecode-template-table): Add :framework slot. + (srecode-dump): Dump it. + (srecode-mode-table): Add new modetables slot. + (srecode-get-mode-table): Find the mode, but also find all parent + modes, and merge the tables together in :tables from :modetables. + (srecode-make-mode-table): Init :modetables + (srecode-mode-table-find): Search in modetables. + (srecode-mode-table-new): Merge the differet files into the + modetables slot. + +2012-10-01 David Engster <deng@randomsample.de> + + * ede.el (ede-apply-preprocessor-map): Check that + `semantic-lex-spp-macro-symbol-obarray' is non-nil. + (global-ede-mode): Fix call to `ede-reset-all-buffers'. + + * ede/cpp-root.el (ede-preprocessor-map): Make sure we add the + lexical-table even when the table doesn't need to be refreshed. + + * ede/dired.el (ede-dired-minor-mode): Use called-interactively-p. + + * ede/pmake.el (ede-pmake-insert-variable-once): Wrap in + save-excursion. + + * ede/proj-comp.el (ede-proj-makefile-insert-rules): Fix insertion + of phony rule. + + * ede/proj-elisp.el (ede-proj-target-elisp): Remove + ede-emacs-preload-compiler. + (ede-proj-makefile-insert-rules, ede-proj-makefile-dependencies): + New methods. + (ede-emacs-compiler): Add 'require' macro to variables and pattern + rule. Add .elc object extension. + (ede-proj-elisp-packages-to-loadpath): Allow longer relative names. + (ede-proj-makefile-insert-variables): Do not insert preload items. + (ede-proj-target-elisp-autoloads): Don't depend on cedet-autogen. + + * ede/util.el (ede-make-buffer-writable): + * semantic/debug.el (semantic-debug-mode): Set buffer-read-only + instead of calling toggle-read-only. + + * semantic.el (semantic-fetch-tags): Use progress reporter only + when called interactively. + (semantic-submode-list): Add debugging modes. + (semantic-mode): Remove Semantic from after-change-functions. + Delete the cache, call semantic--tag-unlink-cache-from-buffer, and + set semantic-new-buffer-fcn-was-run to nil. + + * semantic/analyze/fcn.el (semantic-analyze-tag-prototype-p) + (semantic-analyze-tag-prototype-p-default): Remove. + (semantic-analyze-type, semantic-analyze-dereference-metatype-1): + Use semantic-tag-prototype-p. + + * semantic/bovine/c.el (semantic-c-reset-preprocessor-symbol-map): + Ensure semantic-mode is on before getting preprocessor symbols. + (semantic-c-skip-conditional-section): Use c-scan-conditionals. + (semantic-c-convert-spp-value-to-hideif-value) + (semantic-c-evaluate-symbol-for-hideif, semantic-c-hideif-lookup) + (semantic-c-hideif-defined): Revive hideif code from CEDET trunk. + (semantic-lex-c-if, semantic-c-do-lex-ifdef): Revert changes for + regular expression parsing. + (semantic-cpp-lexer): Add semantic-lex-c-ifdef. + (semantic-expand-c-tag): Check if tag is non-nil before adding it + to return list + (semantic-expand-c-extern-C, semantic-expand-c-complex-type): New + functions, copied from semantic-expand-c-tag. + (semantic-find-tags-included): New override which also searches + for include tags inside of namespaces. + (semantic-c-dereference-typedef): Use semantic-tag-prototype-p. + (semanticdb-find-table-for-include): New override. + + * semantic/bovine/el.el: Remove emacs-lisp-mode-hook. + + * semantic/complete.el (semantic-complete-post-command-hook): Exit + completion when user has deleted all characters from the prefix. + (semantic-displayor-focus-request): Return to previous window when + focussing tags. + + * semantic/db-el.el (semanticdb-normalize-one-tag): Make obsolete. + (semanticdb-elisp-sym->tag): Use help-function-arglist instead. + + * semantic/db-file.el (semanticdb-create-database): Use + semantic-tag-version instead of just semantic-version as the + initializer for the :semantic-tag-version slot. + + * semantic/db-find.el (semanticdb-find-tags-by-class-method): + Delegate `include' to semantic-find-tags-included, which by + default will just call semantic-find-tags-by-class. + + * semantic/db.el (semanticdb-refresh-table): Do not print warnings + when calling semantic-find-file-noselect. This avoids the "file + is write protected" messages when parsing system header files, + which might easily be mistaken to mean the currently loaded file. + (semanticdb-save-current-db, semanticdb-save-all-db): Only emit + message when running interactively. + + * semantic/decorate/mode.el (semantic-decoration-mode): Activate + decoration of includes by default. + + * semantic/doc.el (semantic-doc-snarf-comment-for-tag): Remove + comment delimiter at the end of the text. + + * semantic/ede-grammar.el (semantic-ede-proj-target-grammar): + Change aux- and pre-load-packages. + (ede-proj-makefile-dependencies): Update pattern rule so that + resulting parsers are also byte-compiled. + (semantic-ede-grammar-compiler-bovine) + (semantic-ede-source-grammar-wisent): Remove .elc from gargage + pattern, since this is already covered by the elisp compiler. + (project-compile-target): Add compatibility code for Emacs 23, + which does not have `byte-recompile-file'. + (ede-proj-makefile-insert-rules): Add target specific EMACSFLAGS + to raise max-specpdl-size and max-lisp-eval-depth. + + * semantic/find.el (semantic-find-tags-included): Make + overridable. + + * semantic/fw.el (semantic-alias-obsolete) + (semantic-varalias-obsolete): Use byte-compile-warn. + (semantic-find-file-noselect): Disable font lock by calling + global-font-lock-mode. + + * semantic/grammar.el (semantic-grammar-create-package): Fix + message. + (semantic-grammar-batch-build-one-package): When generating + parsers in batch-mode, ignore version control and make sure we do + not use cached versions. + + * semantic/ia.el (semantic-ia-complete-symbol-menu): Bring back. + + * semantic/lex-spp.el (semantic-lex-spp-symbol-merge): New fun. + (semantic-lex-spp-token-macro-to-macro-stream): Use it. + (semantic-lex-spp-lex-text-string): Instead of only setting the + lexer, call the major mode's setup function. + + * semantic/scope.el (semantic-analyze-scoped-types-default): Use + semantic-tag-prototype-p. + (semantic-analyze-scope-nested-tags-default): Make sure we don't + return tags we already have in scopetypes. + + * semantic/symref/filter.el + (semantic-symref-test-count-hits-in-tag): Restore. + + * semantic/wisent/comp.el (wisent-BITS-PER-WORD): Use + most-positive-fixnum if available. + + * semantic/wisent/javascript.el (semantic-tag-protection) + (semantic-analyze-scope-calculate-access) + (semantic-ctxt-current-symbol): New overrides. + + * semantic/wisent/python.el (wisent-python-lex-beginning-of-line): + Rewrite to fix byte-compiler warning. + +2012-10-01 Robert Jarzmik <robert.jarzmik@free.fr> + + * ede/linux.el (project-linux): New group. + (project-linux-compile-target-command) + (project-linux-compile-project-command): New options. + (project-compile-project, project-compiler-target): New methods. + + * inversion.el (inversion-decoders): New regexps for SXEmacs. + (inversion-package-version): More verbose error message. + (inversion-<): Deal with new special cases. + (inversion-require-emacs): New argument sxemacs-ver; use it. + +2012-10-01 Nelson Ferreira <nelson.ferreira@ieee.org> + + * ede/emacs.el (ede-emacs-version): Detect SXEmacs. + +2012-10-01 William Xu <william.xwl@gmail.com> + + * semantic/bovine/gcc.el (semantic-gcc-query): Returns status when + there is an error. + (semantic-gcc-setup): If the first attempt at calling cpp fails, + try straight GCC. + +2012-10-01 Jan Moringen <jan.moringen@uni-bielefeld.de> + + * semantic/idle.el + (semantic-idle-breadcrumbs--display-in-header-line): Escape + %-characters to avoid erroneous expansion in header line. + (semantic-idle-breadcrumbs--display-in-mode-line): Likewise. + + * semantic/wisent/python.el (wisent-python-reconstitute-function-tag) + (wisent-python-reconstitute-class-tag, semantic-python-special-p) + (semantic-python-private-p, semantic-python-instance-variable-p) + (semantic-python-docstring-p): New functions. + + * srecode/find.el (srecode-user-template-p): New function. + (srecode-all-template-hash): Accept new optional argument + predicate; return only templates matching the predicate. + (srecode-read-template-name): Only retrieve templates matching + srecode-user-template-p. + + * srecode/insert.el (srecode-insert-show-error-report) + (srecode-insert-report-error): New functions. + (srecode-insert-variable-secondname-handler) + (srecode-insert-method, srecode-insert-ask-default) + (srecode-insert-variable-secondname-handler) + (srecode-insert-subtemplate, srecode-insert-method-helper) + (srecode-insert-include-lookup): Use them. + +2012-10-01 Thomas Bach <thbach@students.uni-mainz.de> + + * semantic/wisent/python.el + (semantic-python-get-system-include-path): Add Python3k support. + +2012-10-01 Alexander Haeckel <_@_> (tiny change) + + * srecode/getset.el (srecode-query-for-field): Return the first + tag found by name from all children tags. + +2012-10-01 Dale Sedivec <dale@codefu.org> + + * semantic/wisent/python.el (wisent-python-string-start-re) + (wisent-python-string-re, wisent-python-forward-string) + (wisent-python-forward-line,wisent-python-lex-string): New + variables. + (wisent-python-forward-balanced-expression): New function. + +2012-10-01 Pete Beardmore <elbeardmorez@msn.com> + + * semantic/complete.el (semantic-collector-calculate-completions): + Search for additional matches if new prefix is a substring of the + old prefix. + (semantic-displayor-next-action): Immediately show more + completions after user presses TAB the first time. + (semantic-displayor-tooltip-mode) + (semantic-displayor-tooltip-initial-max-tags) + (semantic-displayor-tooltip-max-tags): New defcustoms. + (semantic-displayor-tooltip): Use new variables as initforms. Use + new slot `mode' instead of `force-show'. Rename `max-tags' to + `max-tags-initial'. + (semantic-displayor-show-request): Display completions according + to new modes, and make variable names clearer. + (semantic-displayor-tooltip::semantic-displayor-scroll-request): + Use new max-tags-initial slot. + + * semantic/idle.el (semantic-idle-local-symbol-highlight): Make + sure there actually is a tag at point. + (semantic-idle-completion-list-default): Report errors as messages + if semantic-idle-scheduler-verbose-flag is non-nil. + +2012-10-01 Richard Kim <emacs18@gmail.com> + + * semantic/db-global.el (semanticdb-enable-gnu-global-databases): + Add optional NOERROR argument. + +2012-10-01 Alex Ott <alexott@gmail.com> + + * semantic/idle.el (semantic-idle-scheduler-enabled-p): Fix + file-checking. + +2012-10-01 Darren Hoo <darren.hoo@gmail.com> (tiny change) + + * semantic/db-find.el (semanticdb-find-default-throttle): Make + buffer-local. + (semanticdb-strip-find-results): Check for existing :filename + attribute, so that file information from GNU Global is not lost. + 2012-08-07 Andreas Schwab <schwab@linux-m68k.org> * ede/base.el (ede-with-projectfile): Use backquote forms. diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el index ae384b005f3..fe954a07712 100644 --- a/lisp/cedet/cedet-cscope.el +++ b/lisp/cedet/cedet-cscope.el @@ -28,7 +28,7 @@ (declare-function inversion-check-version "inversion") -(defvar cedet-cscope-min-version "16.0" +(defvar cedet-cscope-min-version "15.7" "Minimum version of CScope required.") (defcustom cedet-cscope-command "cscope" diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el index a6e94dcd5d9..d953d8c0980 100644 --- a/lisp/cedet/cedet-global.el +++ b/lisp/cedet/cedet-global.el @@ -147,7 +147,7 @@ return nil." nil) (with-current-buffer b (goto-char (point-min)) - (re-search-forward "GNU GLOBAL \\([0-9.]+\\)" nil t) + (re-search-forward "(?GNU GLOBAL)? \\([0-9.]+\\)" nil t) (setq rev (match-string 1)) (if (inversion-check-version rev nil cedet-global-min-version) (if noerror diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el index b35035a58b6..db9f3c08c7e 100644 --- a/lisp/cedet/cedet-idutils.el +++ b/lisp/cedet/cedet-idutils.el @@ -179,8 +179,9 @@ return nil." nil) (with-current-buffer b (goto-char (point-min)) - (re-search-forward "fnid - \\([0-9.]+\\)" nil t) - (setq rev (match-string 1)) + (if (re-search-forward "fnid - \\([0-9.]+\\)" nil t) + (setq rev (match-string 1)) + (setq rev "0")) (if (inversion-check-version rev nil cedet-idutils-min-version) (if noerror nil diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el index 6da3b5de547..5c21e4ab538 100644 --- a/lisp/cedet/cedet.el +++ b/lisp/cedet/cedet.el @@ -35,19 +35,22 @@ (declare-function inversion-find-version "inversion") -(defconst cedet-version "1.0" +(defconst cedet-version "1.1" "Current version of CEDET.") (defconst cedet-packages `( - ;;PACKAGE MIN-VERSION - (cedet ,cedet-version) - (eieio "1.3") - (semantic "2.0") - (srecode "1.0") - (ede "1.0") - (speedbar "1.0")) - "Table of CEDET packages installed.") + ;;PACKAGE MIN-VERSION INSTALLDIR DOCDIR + (cedet ,cedet-version "common" "common" ) + (eieio "1.4" nil "eieio" ) + (semantic "2.1" nil "semantic/doc") + (srecode "1.1" nil "srecode" ) + (ede "1.1" nil "ede" ) + (speedbar "1.0.4" nil "speedbar" ) + (cogre "1.1" nil "cogre" ) + (cedet-contrib "1.1" "contrib" nil ) + ) + "Table of CEDET packages to install.") (defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu") (let ((map (make-sparse-keymap "CEDET menu"))) diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index 03dca6ceccc..19d0e98aa00 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -821,20 +821,30 @@ FCN is a function that will display stuff in the data debug buffer." PREBUTTONTEXT is some text to insert between prefix and the thing that is not included in the indentation calculation of any children. If PARENT is non-nil, it is somehow related as a parent to thing." - (when (catch 'done - (dolist (test data-debug-thing-alist) - (when (funcall (car test) thing) - (condition-case nil - (funcall (cdr test) thing prefix prebuttontext parent) - (error - (funcall (cdr test) thing prefix prebuttontext))) - (throw 'done nil)) - ) - nil) - (data-debug-insert-simple-thing (format "%S" thing) - prefix - prebuttontext - 'bold))) + (let ((inhibit-read-only t)) + (when (catch 'done + (dolist (test data-debug-thing-alist) + (when (funcall (car test) thing) + (condition-case nil + (progn + (funcall (cdr test) thing prefix prebuttontext parent) + (throw 'done nil)) + (error + (condition-case nil + (progn + (funcall (cdr test) thing prefix prebuttontext) + (throw 'done nil)) + (error nil)))) + ;; Only throw the 'done if no error was caught. + ;; If an error was caught, skip this predicate as being + ;; unsuccessful, and move on. + )) + nil) + (data-debug-insert-simple-thing (format "%S" thing) + prefix + prebuttontext + 'bold))) + (set-buffer-modified-p nil)) ;;; MAJOR MODE ;; @@ -861,6 +871,7 @@ If PARENT is non-nil, it is somehow related as a parent to thing." (defvar data-debug-map (let ((km (make-sparse-keymap))) + (suppress-keymap km) (define-key km [mouse-2] 'data-debug-expand-or-contract-mouse) (define-key km " " 'data-debug-expand-or-contract) (define-key km "\C-m" 'data-debug-expand-or-contract) @@ -885,7 +896,8 @@ If PARENT is non-nil, it is somehow related as a parent to thing." (setq major-mode 'data-debug-mode mode-name "DATA-DEBUG" comment-start ";;" - comment-end "") + comment-end "" + buffer-read-only t) (set (make-local-variable 'comment-start-skip) "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") (set-syntax-table data-debug-mode-syntax-table) @@ -902,6 +914,7 @@ If PARENT is non-nil, it is somehow related as a parent to thing." (let ((b (get-buffer-create name))) (pop-to-buffer b) (set-buffer b) + (setq buffer-read-only nil) ; disable read-only (erase-buffer) (data-debug-mode) b)) @@ -964,7 +977,8 @@ Do nothing if already expanded." (when (or (not (data-debug-line-expandable-p)) (not (data-debug-current-line-expanded-p))) ;; If the next line is the same or less indentation, expand. - (let ((fcn (get-text-property (point) 'ddebug-function))) + (let ((fcn (get-text-property (point) 'ddebug-function)) + (inhibit-read-only t)) (when fcn (funcall fcn (point)) (beginning-of-line) @@ -977,6 +991,7 @@ Do nothing if already contracted." ;; Don't contract if the current line is not expandable. (get-text-property (point) 'ddebug-function)) (let ((ti (current-indentation)) + (inhibit-read-only t) ) ;; If next indentation is larger, collapse. (end-of-line) @@ -995,7 +1010,8 @@ Do nothing if already contracted." (error (setq end (point-max)))) (delete-region start end) (forward-char -1) - (beginning-of-line))))) + (beginning-of-line)))) + (set-buffer-modified-p nil)) (defun data-debug-expand-or-contract () "Expand or contract anything at the current point." @@ -1080,7 +1096,4 @@ If the result is a list or vector, then use the data debugger to display it." (provide 'data-debug) -(if (featurep 'eieio) - (require 'eieio-datadebug)) - ;;; data-debug.el ends here diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index cc8b6f53242..22fe362d5d9 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -4,7 +4,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make -;; Version: 1.0pre7 +;; Version: 1.0 ;; This file is part of GNU Emacs. @@ -194,7 +194,6 @@ Argument LIST-O-O is the list of objects to choose from." (define-key pmap "t" 'ede-new-target) (define-key pmap "g" 'ede-rescan-toplevel) (define-key pmap "s" 'ede-speedbar) - (define-key pmap "l" 'ede-load-project-file) (define-key pmap "f" 'ede-find-file) (define-key pmap "C" 'ede-compile-project) (define-key pmap "c" 'ede-compile-target) @@ -252,7 +251,7 @@ Argument LIST-O-O is the list of objects to choose from." (defun ede-buffer-belongs-to-project-p () "Return non-nil if this buffer belongs to at least one project." (if (or (null ede-object) (consp ede-object)) nil - (obj-of-class-p ede-object ede-project))) + (obj-of-class-p ede-object-project ede-project))) (defun ede-menu-obj-of-class-p (class) "Return non-nil if some member of `ede-object' is a child of CLASS." @@ -343,6 +342,7 @@ Argument MENU-DEF is the menu definition to use." (append '( [ "Add Target" ede-new-target (ede-current-project) ] [ "Remove Target" ede-delete-target ede-object ] + ( "Default configuration" :filter ede-configuration-forms-menu ) "-") menu )) @@ -350,6 +350,41 @@ Argument MENU-DEF is the menu definition to use." menu) ))))) +(defun ede-configuration-forms-menu (menu-def) + "Create a submenu for selecting the default configuration for this project. +The current default is in the current object's CONFIGURATION-DEFAULT slot. +All possible configurations are in CONFIGURATIONS. +Argument MENU-DEF specifies the menu being created." + (easy-menu-filter-return + (easy-menu-create-menu + "Configurations" + (let* ((obj (ede-current-project)) + (conf (when obj (oref obj configurations))) + (cdef (when obj (oref obj configuration-default))) + (menu nil)) + (dolist (C conf) + (setq menu (cons (vector C (list 'ede-project-configurations-set C) + :style 'toggle + :selected (string= C cdef)) + menu)) + ) + (nreverse menu))))) + +(defun ede-project-configurations-set (newconfig) + "Set the current project's current configuration to NEWCONFIG. +This function is designed to be used by `ede-configuration-forms-menu' +but can also be used interactively." + (interactive + (list (let* ((proj (ede-current-project)) + (configs (oref proj configurations))) + (completing-read "New configuration: " + configs nil t + (oref proj configuration-default))))) + (oset (ede-current-project) configuration-default newconfig) + (message "%s will now build in %s mode." + (object-name (ede-current-project)) + newconfig)) + (defun ede-customize-forms-menu (menu-def) "Create a menu of the project, and targets that can be customized. Argument MENU-DEF is the definition of the current menu." @@ -377,9 +412,14 @@ Argument MENU-DEF is the definition of the current menu." "Add target specific keybindings into the local map. Optional argument DEFAULT indicates if this should be set to the default version of the keymap." - (let ((object (or ede-object ede-selected-object))) + (let ((object (or ede-object ede-selected-object)) + (proj ede-object-project)) (condition-case nil (let ((keys (ede-object-keybindings object))) + ;; Add keys for the project to whatever is in the current object + ;; so long as it isn't the same. + (when (not (eq object proj)) + (setq keys (append keys (ede-object-keybindings proj)))) (while keys (local-set-key (concat "\C-c." (car (car keys))) (cdr (car keys))) @@ -415,8 +455,8 @@ If optional argument CURRENT is non-nil, return sub-menu code." (defun ede-apply-target-options () "Apply options to the current buffer for the active project/target." - (if (ede-current-project) - (ede-set-project-variables (ede-current-project))) + (ede-apply-project-local-variables) + ;; Apply keymaps and preprocessor symbols. (ede-apply-object-keymap) (ede-apply-preprocessor-map) ) @@ -493,9 +533,9 @@ Sets buffer local variables for EDE." (ede-apply-target-options))))) -(defun ede-reset-all-buffers (onoff) - "Reset all the buffers due to change in EDE. -ONOFF indicates enabling or disabling the mode." +(defun ede-reset-all-buffers () + "Reset all the buffers due to change in EDE." + (interactive) (let ((b (buffer-list))) (while b (when (buffer-file-name (car b)) @@ -533,7 +573,7 @@ an EDE controlled project." (add-hook 'dired-mode-hook 'ede-turn-on-hook) (add-hook 'kill-emacs-hook 'ede-save-cache) (ede-load-cache) - (ede-reset-all-buffers 1)) + (ede-reset-all-buffers)) ;; Turn off global-ede-mode (define-key cedet-menu-map [cedet-menu-separator] nil) (remove-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p) @@ -543,7 +583,7 @@ an EDE controlled project." (remove-hook 'dired-mode-hook 'ede-turn-on-hook) (remove-hook 'kill-emacs-hook 'ede-save-cache) (ede-save-cache) - (ede-reset-all-buffers -1))) + (ede-reset-all-buffers))) (defvar ede-ignored-file-alist '( "\\.cvsignore$" @@ -632,8 +672,7 @@ Otherwise, create a new project for DIR." ;; the user chooses. (if (ede-check-project-directory dir) (progn - ;; If there is a project in DIR, load it, otherwise do - ;; nothing. + ;; Load the project in DIR, or make one. (ede-load-project-file dir) ;; Check if we loaded anything on the previous line. @@ -643,7 +682,7 @@ Otherwise, create a new project for DIR." ;; buffers may also be referring to this project. ;; Resetting all the buffers will get them to also point ;; at this new open project. - (ede-reset-all-buffers 1) + (ede-reset-all-buffers) ;; ELSE ;; There was no project, so switch to `ede-new' which is how @@ -785,7 +824,7 @@ ARGS are additional arguments to pass to method SYM." (ede-deep-rescan t)) (project-rescan (ede-load-project-file toppath)) - (ede-reset-all-buffers 1)))) + (ede-reset-all-buffers)))) (defun ede-new-target (&rest args) "Create a new target specific to this type of project file. @@ -794,9 +833,11 @@ Typically you can specify NAME, target TYPE, and AUTOADD, where AUTOADD is a string \"y\" or \"n\", which answers the y/n question done interactively." (interactive) (apply 'project-new-target (ede-current-project) args) - (setq ede-object nil) - (setq ede-object (ede-buffer-object (current-buffer))) - (ede-apply-target-options)) + (when (and buffer-file-name + (not (file-directory-p buffer-file-name))) + (setq ede-object nil) + (setq ede-object (ede-buffer-object (current-buffer))) + (ede-apply-target-options))) (defun ede-new-target-custom () "Create a new target specific to this type of project file." @@ -837,7 +878,10 @@ a string \"y\" or \"n\", which answers the y/n question done interactively." (project-add-file target (buffer-file-name)) (setq ede-object nil) - (setq ede-object (ede-buffer-object (current-buffer))) + + ;; Setup buffer local variables. + (ede-initialize-state-current-buffer) + (when (not ede-object) (error "Can't add %s to target %s: Wrong file type" (file-name-nondirectory (buffer-file-name)) @@ -1188,16 +1232,24 @@ could become slow in time." (defmethod ede-find-target ((proj ede-project) buffer) "Fetch the target in PROJ belonging to BUFFER or nil." (with-current-buffer buffer - (or ede-object - (if (ede-buffer-mine proj buffer) - proj - (let ((targets (oref proj targets)) - (f nil)) - (while targets - (if (ede-buffer-mine (car targets) buffer) - (setq f (cons (car targets) f))) - (setq targets (cdr targets))) - f))))) + + ;; We can do a short-ut if ede-object local variable is set. + (if ede-object + ;; If the buffer is already loaded with good EDE stuff, make sure the + ;; saved project is the project we're looking for. + (when (and ede-object-project (eq proj ede-object-project)) ede-object) + + ;; If the variable wasn't set, then we are probably initializing the buffer. + ;; In that case, search the file system. + (if (ede-buffer-mine proj buffer) + proj + (let ((targets (oref proj targets)) + (f nil)) + (while targets + (if (ede-buffer-mine (car targets) buffer) + (setq f (cons (car targets) f))) + (setq targets (cdr targets))) + f))))) (defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source) "Return non-nil if object THIS is in BUFFER to a SOURCE list. @@ -1225,8 +1277,8 @@ This includes buffers controlled by a specific target of PROJECT." (pl nil)) (while bl (with-current-buffer (car bl) - (if (ede-buffer-belongs-to-project-p) - (setq pl (cons (car bl) pl)))) + (when (and ede-object (ede-find-target project (car bl))) + (setq pl (cons (car bl) pl)))) (setq bl (cdr bl))) pl)) @@ -1301,9 +1353,28 @@ Return the first non-nil value returned by PROC." ;; ;; These items are needed by ede-cpp-root to add better support for ;; configuring items for Semantic. + +;; Generic paths +(defmethod ede-system-include-path ((this ede-project)) + "Get the system include path used by project THIS." + nil) + +(defmethod ede-system-include-path ((this ede-target)) + "Get the system include path used by project THIS." + nil) + +(defmethod ede-source-paths ((this ede-project) mode) + "Get the base to all source trees in the current project for MODE. +For example, <root>/src for sources of c/c++, Java, etc, +and <root>/doc for doc sources." + nil) + +;; C/C++ (defun ede-apply-preprocessor-map () "Apply preprocessor tables onto the current buffer." - (when (and ede-object (boundp 'semantic-lex-spp-macro-symbol-obarray)) + (when (and ede-object + (boundp 'semantic-lex-spp-macro-symbol-obarray) + semantic-lex-spp-macro-symbol-obarray) (let* ((objs ede-object) (map (ede-preprocessor-map (if (consp objs) (car objs) @@ -1324,27 +1395,66 @@ Return the first non-nil value returned by PROC." "Get the pre-processor map for project THIS." nil) -(defmethod ede-system-include-path ((this ede-target)) - "Get the system include path used by project THIS." - nil) - (defmethod ede-preprocessor-map ((this ede-target)) "Get the pre-processor map for project THIS." nil) +;; Java +(defmethod ede-java-classpath ((this ede-project)) + "Return the classpath for this project." + ;; @TODO - Can JDEE add something here? + nil) + ;;; Project-local variables -;; + +(defun ede-set (variable value &optional proj) + "Set the project local VARIABLE to VALUE. +If VARIABLE is not project local, just use set. Optional argument PROJ +is the project to use, instead of `ede-current-project'." + (interactive "sVariable: \nxExpression: ") + (let ((p (or proj (ede-toplevel))) + a) + ;; Make the change + (ede-make-project-local-variable variable p) + (ede-set-project-local-variable variable value p) + (ede-commit-local-variables p) + + ;; This is a heavy hammer, but will apply variables properly + ;; based on stacking between the toplevel and child projects. + (ede-map-buffers 'ede-apply-project-local-variables) + + value)) + +(defun ede-apply-project-local-variables (&optional buffer) + "Apply project local variables to the current buffer." + (with-current-buffer (or buffer (current-buffer)) + ;; Always apply toplevel variables. + (if (not (eq (ede-current-project) (ede-toplevel))) + (ede-set-project-variables (ede-toplevel))) + ;; Next apply more local project's variables. + (if (ede-current-project) + (ede-set-project-variables (ede-current-project))) + )) + (defun ede-make-project-local-variable (variable &optional project) "Make VARIABLE project-local to PROJECT." - (if (not project) (setq project (ede-current-project))) + (if (not project) (setq project (ede-toplevel))) (if (assoc variable (oref project local-variables)) nil (oset project local-variables (cons (list variable) - (oref project local-variables))) - (dolist (b (ede-project-buffers project)) - (with-current-buffer b - (make-local-variable variable))))) + (oref project local-variables))))) + +(defun ede-set-project-local-variable (variable value &optional project) + "Set VARIABLE to VALUE for PROJECT. +If PROJ isn't specified, use the current project. +This function only assigns the value within the project structure. +It does not apply the value to buffers." + (if (not project) (setq project (ede-toplevel))) + (let ((va (assoc variable (oref project local-variables)))) + (unless va + (error "Cannot set project variable until it is added with `ede-make-project-local-variable'")) + (setcdr va value))) (defmethod ede-set-project-variables ((project ede-project) &optional buffer) "Set variables local to PROJECT in BUFFER." @@ -1352,25 +1462,8 @@ Return the first non-nil value returned by PROC." (with-current-buffer buffer (dolist (v (oref project local-variables)) (make-local-variable (car v)) - ;; set its value here? (set (car v) (cdr v))))) -(defun ede-set (variable value &optional proj) - "Set the project local VARIABLE to VALUE. -If VARIABLE is not project local, just use set. Optional argument PROJ -is the project to use, instead of `ede-current-project'." - (let ((p (or proj (ede-current-project))) - a) - (if (and p (setq a (assoc variable (oref p local-variables)))) - (progn - (setcdr a value) - (dolist (b (ede-project-buffers p)) - (with-current-buffer b - (set variable value)))) - (set variable value)) - (ede-commit-local-variables p)) - value) - (defmethod ede-commit-local-variables ((proj ede-project)) "Commit change to local variables in PROJ." nil) diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el index a5ea8178858..152f8130ad7 100644 --- a/lisp/cedet/ede/auto.el +++ b/lisp/cedet/ede/auto.el @@ -34,6 +34,84 @@ (declare-function ede-directory-safe-p "ede") (declare-function ede-add-project-to-global-list "ede") +(defclass ede-project-autoload-dirmatch () + ((fromconfig :initarg :fromconfig + :initform nil + :documentation + "A config file within which the match pattern lives.") + (configregex :initarg :configregex + :initform nil + :documentation + "A regexp to identify the dirmatch pattern.") + (configregexidx :initarg :configregexidx + :initform nil + :documentation + "An index into the match-data of `configregex'.") + (configdatastash :initform nil + :documentation + "Save discovered match string.") + ) + "Support complex matches for projects that live in named directories. +For most cases, a simple string is sufficient. If, however, a project +location is varied dependent on other complex criteria, this class +can be used to define that match without loading the specific project +into memory.") + +(defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch)) + "Return non-nil if the tool DIRMATCH might match is installed on the system." + (let ((fc (oref dirmatch fromconfig))) + + (cond + ;; If the thing to match is stored in a config file. + ((stringp fc) + (file-exists-p fc)) + + ;; Add new types of dirmatches here. + + ;; Error for weird stuff + (t (error "Unknown dirmatch type."))))) + + +(defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file) + "Does DIRMATCH match the filename FILE." + (let ((fc (oref dirmatch fromconfig))) + + (cond + ;; If the thing to match is stored in a config file. + ((stringp fc) + (when (file-exists-p fc) + (let ((matchstring (oref dirmatch configdatastash))) + (unless matchstring + (save-current-buffer + (let* ((buff (get-file-buffer fc)) + (readbuff + (let ((find-file-hook nil)) ;; Disable ede from recursing + (find-file-noselect fc)))) + (set-buffer readbuff) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward (oref dirmatch configregex) nil t) + (setq matchstring + (match-string (or (oref dirmatch configregexidx) 0))))) + (if (not buff) (kill-buffer readbuff)))) + ;; Save what we find in our cache. + (oset dirmatch configdatastash matchstring)) + ;; Match against our discovered string + (and matchstring (string-match (regexp-quote matchstring) file)) + ))) + + ;; Add new matches here + ;; ((stringp somenewslot ...) + ;; ) + + ;; Error if none others known + (t + (error "Unknown dirmatch object match style."))) + )) + +(declare-function ede-directory-safe-p "ede") +(declare-function ede-add-project-to-global-list "ede") + (defclass ede-project-autoload () ((name :initarg :name :documentation "Name of this project type") @@ -41,6 +119,13 @@ :documentation "The lisp file belonging to this class.") (proj-file :initarg :proj-file :documentation "Name of a project file of this type.") + (proj-root-dirmatch :initarg :proj-root-dirmatch + :initform "" + :type (or string ede-project-autoload-dirmatch) + :documentation + "To avoid loading a project, check if the directory matches this. +For projects that use directory name matches, a function would load that project. +Specifying this matcher will allow EDE to check without loading the project.") (proj-root :initarg :proj-root :type function :documentation "A function symbol to call for the project root. @@ -57,6 +142,11 @@ associated with a single object class, based on the initializers used.") :documentation "Fn symbol used to load this project file.") (class-sym :initarg :class-sym :documentation "Symbol representing the project class to use.") + (generic-p :initform nil + :documentation + "Generic projects are added to the project list at the end. +The add routine will set this to non-nil so that future non-generic placement will +be successful.") (new-p :initarg :new-p :initform t :documentation @@ -93,11 +183,56 @@ type is required and the load function used.") :proj-file "Makefile.am" :load-type 'project-am-load :class-sym 'project-am-makefile - :new-p nil)) + :new-p nil + :safe-p t) + ) "List of vectors defining how to determine what type of projects exist.") (put 'ede-project-class-files 'risky-local-variable t) +(defun ede-add-project-autoload (projauto &optional flag) + "Add PROJAUTO, an EDE autoload definition to `ede-project-class-files'. +Optional argument FLAG indicates how this autoload should be +added. Possible values are: + 'generic - A generic project type. Keep this at the very end. + 'unique - A unique project type for a specific project. Keep at the very + front of the list so more generic projects don't get priority." + ;; First, can we identify PROJAUTO as already in the list? If so, replace. + (let ((projlist ede-project-class-files) + (projname (object-name-string projauto))) + (while (and projlist (not (string= (object-name-string (car projlist)) projname))) + (setq projlist (cdr projlist))) + + (if projlist + ;; Stick the new one into the old slot. + (setcar projlist projauto) + + ;; Else, see where to insert it. + (cond ((and flag (eq flag 'unique)) + ;; Unique items get stuck right onto the front. + (setq ede-project-class-files + (cons projauto ede-project-class-files))) + + ;; Generic Projects go at the very end of the list. + ((and flag (eq flag 'generic)) + (oset projauto generic-p t) + (setq ede-project-class-files + (append ede-project-class-files + (list projauto)))) + + ;; Normal projects go at the end of the list, but + ;; before the generic projects. + (t + (let ((prev nil) + (next ede-project-class-files)) + (while (and next (not (oref (car next) generic-p))) + (setq prev next + next (cdr next))) + (when (not prev) + (error "ede-project-class-files not initialized")) + ;; Splice into the list. + (setcdr prev (cons projauto next)))))))) + ;;; EDE project-autoload methods ;; (defmethod ede-project-root ((this ede-project-autoload)) @@ -105,6 +240,21 @@ type is required and the load function used.") Allows for one-project-object-for-a-tree type systems." nil) +(defun ede-project-dirmatch-p (file dirmatch) + "Return non-nil if FILE matches DIRMATCH. +DIRMATCH could be nil (no match), a string (regexp match), +or an `ede-project-autoload-dirmatch' object." + ;; If dirmatch is a string, then we simply match it against + ;; the file we are testing. + (if (stringp dirmatch) + (string-match dirmatch file) + ;; if dirmatch is instead a dirmatch object, we test against + ;; that object instead. + (if (ede-project-autoload-dirmatch-p dirmatch) + (ede-do-dirmatch dirmatch file) + (error "Unknown project directory match type.")) + )) + (defmethod ede-project-root-directory ((this ede-project-autoload) &optional file) "If a project knows its root, return it here. @@ -114,12 +264,36 @@ the current buffer." (when (not file) (setq file default-directory)) (when (slot-boundp this :proj-root) - (let ((rootfcn (oref this proj-root))) + (let ((dirmatch (oref this proj-root-dirmatch)) + (rootfcn (oref this proj-root)) + (callfcn t)) (when rootfcn - (condition-case nil - (funcall rootfcn file) - (error - (funcall rootfcn))) + (if ;; If the dirmatch (an object) is not installed, then we + ;; always skip doing a match. + (and (ede-project-autoload-dirmatch-p dirmatch) + (not (ede-dirmatch-installed dirmatch))) + (setq callfcn nil) + ;; Other types of dirmatch: + (when (and + ;; If the Emacs Lisp file handling this project hasn't + ;; been loaded, we will use the quick dirmatch feature. + (not (featurep (oref this file))) + ;; If the dirmatch is an empty string, then we always + ;; skip doing a match. + (not (and (stringp dirmatch) (string= dirmatch ""))) + ) + ;; If this file DOES NOT match dirmatch, we set the callfcn + ;; to nil, meaning don't load the ede support file for this + ;; type of project. If it does match, we will load the file + ;; and use a more accurate programmatic match from there. + (unless (ede-project-dirmatch-p file dirmatch) + (setq callfcn nil)))) + ;; Call into the project support file for a match. + (when callfcn + (condition-case nil + (funcall rootfcn file) + (error + (funcall rootfcn)))) )))) (defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir) @@ -128,10 +302,20 @@ Return nil if the project file does not exist." (let* ((d (file-name-as-directory dir)) (root (ede-project-root-directory this d)) (pf (oref this proj-file)) + (dm (oref this proj-root-dirmatch)) (f (cond ((stringp pf) (expand-file-name pf (or root d))) ((and (symbolp pf) (fboundp pf)) - (funcall pf (or root d))))) + ;; If there is a symbol to call, lets make extra + ;; sure we really can call it without loading in + ;; other EDE projects. This happens if the file is + ;; already loaded, or if there is a dirmatch, but + ;; root is empty. + (when (and (featurep (oref this file)) + (or (not (stringp dm)) + (not (string= dm ""))) + root) + (funcall pf (or root d)))))) ) (when (and f (file-exists-p f)) f))) diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el index e3c9d2cb4f8..ebfb4154d81 100644 --- a/lisp/cedet/ede/autoconf-edit.el +++ b/lisp/cedet/ede/autoconf-edit.el @@ -165,6 +165,9 @@ items such as CHECK_HEADERS." (setq param (substring param (match-end 0)))) (when (string-match "\\s-*\\]?\\s-*\\'" param) (setq param (substring param 0 (match-beginning 0)))) + ;; Look for occurrences of backslash newline + (while (string-match "\\s-*\\\\\\s-*\n\\s-*" param) + (setq param (replace-match " " t t param))) param) (defun autoconf-parameters-for-macro (macro &optional ignore-bol ignore-case) @@ -373,6 +376,38 @@ Optional argument BODY is the code to execute which edits the autoconf file." (string= autoconf-deleted-text autoconf-inserted-text)) (set-buffer-modified-p nil)))) +(defun autoconf-parameter-count () + "Return the number of parameters to the function on the current line." + (save-excursion + (beginning-of-line) + (let* ((end-of-cmd + (save-excursion + (if (re-search-forward "(" (point-at-eol) t) + (progn + (forward-char -1) + (forward-sexp 1) + (point)) + ;; Else, just return EOL. + (point-at-eol)))) + (cnt 0)) + (save-restriction + (narrow-to-region (point-at-bol) end-of-cmd) + (condition-case nil + (progn + (down-list 1) + (while (re-search-forward ", ?" end-of-cmd t) + (setq cnt (1+ cnt))) + (cond ((> cnt 1) + ;; If the # is > 1, then there is one fewer , than args. + (1+ cnt)) + ((not (looking-at "\\s-*)")) + ;; If there are 0 args, then we have to see if there is one arg. + (1+ cnt)) + (t + ;; Else, just return the 0. + cnt))) + (error 0)))))) + (defun autoconf-delete-parameter (index) "Delete the INDEXth parameter from the macro starting on the current line. Leaves the cursor where a new parameter can be inserted. @@ -396,12 +431,19 @@ INDEX starts at 1." "Set the version used with automake to VERSION." (if (not (stringp version)) (signal 'wrong-type-argument '(stringp version))) - (if (not (autoconf-find-last-macro "AM_INIT_AUTOMAKE")) - (error "Cannot update version") - ;; Move to correct position. + (if (and (autoconf-find-last-macro "AM_INIT_AUTOMAKE") + (>= (autoconf-parameter-count) 2)) + ;; We can edit right here. + nil + ;; Else, look for AC init instead. + (if (not (and (autoconf-find-last-macro "AC_INIT") + (>= (autoconf-parameter-count) 2))) + (error "Cannot update version"))) + + ;; Perform the edit. (autoconf-edit-cycle (autoconf-delete-parameter 2) - (autoconf-insert version)))) + (autoconf-insert (concat "[" version "]")))) (defun autoconf-set-output (outputlist) "Set the files created in AC_OUTPUT to OUTPUTLIST. diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index ce3d4a036f3..fe12720500b 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -163,7 +163,7 @@ and querying them will cause the actual project to get loaded.") :documentation "Sub projects controlled by this project. For Automake based projects, each directory is treated as a project.") (targets :initarg :targets - :type list + :type ede-target-list :custom (repeat (object :objectcreatefcn ede-new-target-custom)) :label "Local Targets" :group (targets) @@ -287,10 +287,7 @@ All specific project types must derive from this project." "For the project in which OBJ resides, execute FORMS." `(save-window-excursion (let* ((pf (if (obj-of-class-p ,obj ede-target) - ;; @todo -I think I can change - ;; this to not need ede-load-project-file - ;; but I'm not sure how to test well. - (ede-load-project-file (oref ,obj path)) + (ede-target-parent ,obj) ,obj)) (dbka (get-file-buffer (oref pf file)))) (if (not dbka) (find-file (oref pf file)) diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el index e6fd92759de..48b83f30bb0 100644 --- a/lisp/cedet/ede/cpp-root.el +++ b/lisp/cedet/ede/cpp-root.el @@ -85,7 +85,7 @@ ;; file name for a header in your project where most of your CPP ;; macros reside. Doing this can be easier than listing everything in ;; the :spp-table option. The files listed in :spp-files should not -;; start with a /, and are relative to something in :include-path.;; +;; start with a /, and are relative to something in :include-path. ;; ;; If you want to override the file-finding tool with your own ;; function you can do this: @@ -135,7 +135,8 @@ ;; :proj-file 'MY-FILE-FOR-DIR ;; :proj-root 'MY-ROOT-FCN ;; :load-type 'MY-LOAD -;; :class-sym 'ede-cpp-root) +;; :class-sym 'ede-cpp-root-project +;; :safe-p t) ;; t) ;; ;;; TODO @@ -238,16 +239,20 @@ ROOTPROJ is nil, since there is only one project." (ede-cpp-root-file-existing dir)) ;;;###autoload -(add-to-list 'ede-project-class-files - (ede-project-autoload "cpp-root" - :name "CPP ROOT" - :file 'ede/cpp-root - :proj-file 'ede-cpp-root-project-file-for-dir - :proj-root 'ede-cpp-root-project-root - :load-type 'ede-cpp-root-load - :class-sym 'ede-cpp-root - :new-p nil) - t) +(ede-add-project-autoload + (ede-project-autoload "cpp-root" + :name "CPP ROOT" + :file 'ede-cpp-root + :proj-file 'ede-cpp-root-project-file-for-dir + :proj-root 'ede-cpp-root-project-root + :load-type 'ede-cpp-root-load + :class-sym 'ede-cpp-root + :new-p nil + :safe-p t) + ;; When a user creates one of these, it should override any other project + ;; type that might happen to be in this directory, so force this to the + ;; very front. + 'unique) ;;; CLASSES ;; @@ -439,6 +444,7 @@ This knows details about or source tree." ;; Else, do the usual. (setq ans (call-next-method))) ))) + ;; TODO - does this call-next-method happen twice. Is that bad?? Why is it here? (or ans (call-next-method)))) (defmethod ede-project-root ((this ede-cpp-root-project)) @@ -500,16 +506,16 @@ Also set up the lexical preprocessor map." (table (when expfile (semanticdb-file-table-object expfile))) ) - (when (not table) - (message "Cannot find file %s in project." F)) - (when (and table (semanticdb-needs-refresh-p table)) - (semanticdb-refresh-table table) + (if (not table) + (message "Cannot find file %s in project." F) + (when (semanticdb-needs-refresh-p table) + (semanticdb-refresh-table table)) (setq spp (append spp (oref table lexical-table)))))) (oref this spp-files)) spp)) (defmethod ede-system-include-path ((this ede-cpp-root-target)) - "Get the system include path used by project THIS." + "Get the system include path used by target THIS." (ede-system-include-path (ede-target-parent this))) (defmethod ede-preprocessor-map ((this ede-cpp-root-target)) diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el index bf9ab272785..fa56a9ac5ca 100644 --- a/lisp/cedet/ede/dired.el +++ b/lisp/cedet/ede/dired.el @@ -64,7 +64,7 @@ negative, force off." (setq ede-dired-minor-mode nil) (error "Not in DIRED mode")) (unless (or (ede-directory-project-p default-directory) - (interactive-p)) + (called-interactively-p 'any)) (setq ede-dired-minor-mode nil))) (defun ede-dired-add-to-target (target) diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index e3afe30063c..e3a5789cf3b 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -99,6 +99,17 @@ emacs_beta_version=\\([0-9]+\\)") (match-string 2) "." (match-string 3))) ) + ((file-exists-p "sxemacs.pc.in") + (setq emacs "SXEmacs") + (insert-file-contents "sxemacs_version.m4") + (goto-char (point-min)) + (re-search-forward "m4_define(\\[SXEM4CS_MAJOR_VERSION\\], \\[\\([0-9]+\\)\\]) +m4_define(\\[SXEM4CS_MINOR_VERSION\\], \\[\\([0-9]+\\)\\]) +m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])") + (setq ver (concat (match-string 1) "." + (match-string 2) "." + (match-string 3))) + ) ;; Insert other Emacs here... ;; Vaguely recent version of GNU Emacs? @@ -125,28 +136,29 @@ Argument DIR is the directory it is created for. ROOTPROJ is nil, since there is only one project." (or (ede-emacs-file-existing dir) ;; Doesn't already exist, so let's make one. - (let* ((vertuple (ede-emacs-version dir))) - (ede-emacs-project (car vertuple) - :name (car vertuple) - :version (cdr vertuple) - :directory (file-name-as-directory dir) - :file (expand-file-name "src/emacs.c" - dir))) - (ede-add-project-to-global-list this) - ) - ) + (let* ((vertuple (ede-emacs-version dir)) + (proj (ede-emacs-project + (car vertuple) + :name (car vertuple) + :version (cdr vertuple) + :directory (file-name-as-directory dir) + :file (expand-file-name "src/emacs.c" + dir)))) + (ede-add-project-to-global-list proj)))) ;;;###autoload -(add-to-list 'ede-project-class-files - (ede-project-autoload "emacs" - :name "EMACS ROOT" - :file 'ede/emacs - :proj-file "src/emacs.c" - :proj-root 'ede-emacs-project-root - :load-type 'ede-emacs-load - :class-sym 'ede-emacs-project - :new-p nil) - t) +(ede-add-project-autoload + (ede-project-autoload "emacs" + :name "EMACS ROOT" + :file 'ede/emacs + :proj-file "src/emacs.c" + :proj-root-dirmatch "emacs[^/]*" + :proj-root 'ede-emacs-project-root + :load-type 'ede-emacs-load + :class-sym 'ede-emacs-project + :new-p nil + :safe-p t) + 'unique) (defclass ede-emacs-target-c (ede-target) () diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index 02aeffc5e2b..e5d75234b49 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -63,7 +63,8 @@ the current EDE project." (interactive) (require 'ede/locate) (let* ((loc (ede-get-locator-object (ede-current-project)))) - (ede-locate-flush-hash loc))) + (when loc + (ede-locate-flush-hash loc)))) ;;; Placeholders for ROOT directory scanning on base objects ;; @@ -110,7 +111,7 @@ of the anchor file for the project." (when (not ans) (if (equal (ede--project-inode SP) inode) (setq ans SP) - (ede-find-subproject-for-directory SP dir))))) + (setq ans (ede-find-subproject-for-directory SP dir)))))) ans))) ;;; DIRECTORY IN OPEN PROJECT @@ -219,6 +220,18 @@ Does not check subprojects." :test 'equal) "A hash of directory names and associated EDE objects.") +(defun ede-flush-directory-hash () + "Flush the project directory hash. +Do this only when developing new projects that are incorrectly putting +'nomatch tokens into the hash." + (interactive) + (setq ede-project-directory-hash (make-hash-table :test 'equal)) + ;; Also slush the current project's locator hash. + (let ((loc (ede-get-locator-object ede-object))) + (when loc + (ede-locate-flush-hash loc))) + ) + (defun ede-project-directory-remove-hash (dir) "Reset the directory hash for DIR. Do this whenever a new project is created, as opposed to loaded." @@ -368,10 +381,11 @@ Get it from the toplevel project. If it doesn't have one, make one." ;; Make sure we have a location object available for ;; caching values, and for locating things more robustly. (let ((top (ede-toplevel proj))) - (when (not (slot-boundp top 'locate-obj)) - (ede-enable-locate-on-project top)) - (oref top locate-obj) - )) + (when top + (when (not (slot-boundp top 'locate-obj)) + (ede-enable-locate-on-project top)) + (oref top locate-obj) + ))) (defmethod ede-expand-filename ((this ede-project) filename &optional force) "Return a fully qualified file name based on project THIS. diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el index 67ef63f662e..c4fc5c6b6a9 100644 --- a/lisp/cedet/ede/generic.el +++ b/lisp/cedet/ede/generic.el @@ -79,6 +79,7 @@ (require 'eieio-opt) (require 'ede) +(require 'ede/shell) (require 'semantic/db) ;;; Code: @@ -105,6 +106,13 @@ :group (default build) :documentation "Command used for debugging this project.") + (run-command :initarg :run-command + :initform nil + :type (or null string) + :custom string + :group (default build) + :documentation + "Command used to run something related to this project.") ;; C target customizations (c-include-path :initarg :c-include-path :initform nil @@ -196,7 +204,7 @@ The class allocated value is replace by different sub classes.") (oref proj :directory)))) (if (file-exists-p fname) ;; Load in the configuration - (setq config (eieio-persistent-read fname)) + (setq config (eieio-persistent-read fname 'ede-generic-config)) ;; Create a new one. (setq config (ede-generic-config "Configuration" @@ -321,6 +329,44 @@ If one doesn't exist, create a new one for this directory." (config (ede-generic-get-configuration proj))) (oref config c-include-path))) +;;; Commands +;; +(defmethod project-compile-project ((proj ede-generic-project) &optional command) + "Compile the entire current project PROJ. +Argument COMMAND is the command to use when compiling." + (let* ((config (ede-generic-get-configuration proj)) + (comp (oref config :build-command))) + (compile comp))) + +(defmethod project-compile-target ((obj ede-generic-target) &optional command) + "Compile the current target OBJ. +Argument COMMAND is the command to use for compiling the target." + (project-compile-project (ede-current-project) command)) + +(defmethod project-debug-target ((target ede-generic-target)) + "Run the current project derived from TARGET in a debugger." + (let* ((proj (ede-target-parent target)) + (config (ede-generic-get-configuration proj)) + (debug (oref config :debug-command)) + (cmd (read-from-minibuffer + "Debug Command: " + debug)) + (cmdsplit (split-string cmd " " t)) + ;; @TODO - this depends on the user always typing in something good + ;; like "gdb" or "dbx" which also exists as a useful Emacs command. + ;; Is there a better way? + (cmdsym (intern-soft (car cmdsplit)))) + (call-interactively cmdsym t))) + +(defmethod project-run-target ((target ede-generic-target)) + "Run the current project derived from TARGET." + (require 'ede-shell) + (let* ((proj (ede-target-parent target)) + (config (ede-generic-get-configuration proj)) + (run (concat "./" (oref config :run-command))) + (cmd (read-from-minibuffer "Run (like this): " run))) + (ede-shell-run-something target cmd))) + ;;; Customization ;; (defmethod ede-customize ((proj ede-generic-project)) @@ -365,27 +411,31 @@ PROJECTFILE is a file name that identifies a project of this type to EDE, such a a Makefile, or SConstruct file. CLASS is the EIEIO class that is used to track this project. It should subclass the class `ede-generic-project' project." - (add-to-list 'ede-project-class-files - (ede-project-autoload internal-name - :name external-name - :file 'ede/generic - :proj-file projectfile - :load-type 'ede-generic-load - :class-sym class - :new-p nil) - ;; Generics must go at the end, since more specific types - ;; can create Makefiles also. - t)) + (ede-add-project-autoload + (ede-project-autoload internal-name + :name external-name + :file 'ede/generic + :proj-file projectfile + :load-type 'ede-generic-load + :class-sym class + :new-p nil + :safe-p nil) ; @todo - could be + ; safe if we do something + ; about the loading of the + ; generic config file. + ;; Generics must go at the end, since more specific types + ;; can create Makefiles also. + 'generic)) ;;;###autoload (defun ede-enable-generic-projects () "Enable generic project loaders." (interactive) - (ede-generic-new-autoloader "edeproject-makefile" "Make" + (ede-generic-new-autoloader "generic-makefile" "Make" "Makefile" 'ede-generic-makefile-project) - (ede-generic-new-autoloader "edeproject-scons" "SCons" + (ede-generic-new-autoloader "generic-scons" "SCons" "SConstruct" 'ede-generic-scons-project) - (ede-generic-new-autoloader "edeproject-cmake" "CMake" + (ede-generic-new-autoloader "generic-cmake" "CMake" "CMakeLists" 'ede-generic-cmake-project) ) diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el index 70cd9498f69..7cd066f8b3b 100644 --- a/lisp/cedet/ede/linux.el +++ b/lisp/cedet/ede/linux.el @@ -33,11 +33,29 @@ ;; * Add website (require 'ede) +(require 'ede/make) + (declare-function semanticdb-file-table-object "semantic/db") (declare-function semanticdb-needs-refresh-p "semantic/db") (declare-function semanticdb-refresh-table "semantic/db") ;;; Code: +(defgroup project-linux nil + "File and tag browser frame." + :group 'tools + :group 'ede + ) + +(defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s") + "*Default command used to compile a target." + :group 'project-linux + :type 'string) + +(defcustom project-linux-compile-project-command (concat ede-make-command " -k -C %s") + "*Default command used to compile a project." + :group 'project-linux + :type 'string) + (defvar ede-linux-project-list nil "List of projects created by option `ede-linux-project'.") @@ -95,6 +113,7 @@ DIR is the directory to search from." "Project Type for the Linux source code." :method-invocation-order :depth-first) +;;;###autoload (defun ede-linux-load (dir &optional rootproj) "Return an Linux Project object if there is a match. Return nil if there isn't one. @@ -102,27 +121,29 @@ Argument DIR is the directory it is created for. ROOTPROJ is nil, since there is only one project." (or (ede-linux-file-existing dir) ;; Doesn't already exist, so let's make one. - (ede-linux-project "Linux" - :name "Linux" - :version (ede-linux-version dir) - :directory (file-name-as-directory dir) - :file (expand-file-name "scripts/ver_linux" - dir)) - (ede-add-project-to-global-list this) - ) - ) + (let ((proj (ede-linux-project + "Linux" + :name "Linux" + :version (ede-linux-version dir) + :directory (file-name-as-directory dir) + :file (expand-file-name "scripts/ver_linux" + dir)))) + (ede-add-project-to-global-list proj)) + )) ;;;###autoload -(add-to-list 'ede-project-class-files - (ede-project-autoload "linux" - :name "LINUX ROOT" - :file 'ede/linux - :proj-file "scripts/ver_linux" - :proj-root 'ede-linux-project-root - :load-type 'ede-linux-load - :class-sym 'ede-linux-project - :new-p nil) - t) +(ede-add-project-autoload + (ede-project-autoload "linux" + :name "LINUX ROOT" + :file 'ede/linux + :proj-file "scripts/ver_linux" + :proj-root-dirmatch "linux[^/]*" + :proj-root 'ede-linux-project-root + :load-type 'ede-linux-load + :class-sym 'ede-linux-project + :new-p nil + :safe-p t) + 'unique) (defclass ede-linux-target-c (ede-target) () @@ -238,6 +259,42 @@ Knows about how the Linux source tree is organized." ) (or F (call-next-method)))) +(defmethod project-compile-project ((proj ede-linux-project) + &optional command) + "Compile the entire current project. +Argument COMMAND is the command to use when compiling." + (let* ((dir (ede-project-root-directory proj))) + + (require 'compile) + (if (not project-linux-compile-project-command) + (setq project-linux-compile-project-command compile-command)) + (if (not command) + (setq command + (format + project-linux-compile-project-command + dir))) + + (compile command))) + +(defmethod project-compile-target ((obj ede-linux-target-c) &optional command) + "Compile the current target. +Argument COMMAND is the command to use for compiling the target." + (let* ((proj (ede-target-parent obj)) + (root (ede-project-root proj)) + (dir (ede-project-root-directory root)) + (subdir (oref obj path))) + + (require 'compile) + (if (not project-linux-compile-project-command) + (setq project-linux-compile-project-command compile-command)) + (if (not command) + (setq command + (format + project-linux-compile-target-command + dir subdir))) + + (compile command))) + (provide 'ede/linux) ;; Local variables: diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el index afa1c7200ec..739b774ee52 100644 --- a/lisp/cedet/ede/makefile-edit.el +++ b/lisp/cedet/ede/makefile-edit.el @@ -99,7 +99,8 @@ STOP-BEFORE is a regular expression matching a file name." "Return a list of all files in MACRO." (save-excursion (goto-char (point-min)) - (let ((lst nil)) + (let ((lst nil) + (case-fold-search nil)) (while (makefile-move-to-macro macro t) (let ((e (save-excursion (makefile-end-of-command) diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el index bd5400bb615..c638a5f0307 100644 --- a/lisp/cedet/ede/pmake.el +++ b/lisp/cedet/ede/pmake.el @@ -265,12 +265,13 @@ Execute BODY in a location where a value can be placed." "Add VARNAME into the current Makefile if it doesn't exist. Execute BODY in a location where a value can be placed." `(let ((addcr t) (v ,varname)) - (unless (re-search-backward (concat "^" v "\\s-*=") nil t) - (insert v "=") - ,@body - (if addcr (insert "\n")) - (goto-char (point-max))) - )) + (unless + (save-excursion + (re-search-backward (concat "^" v "\\s-*=") nil t)) + (insert v "=") + ,@body + (when addcr (insert "\n")) + (goto-char (point-max))))) (put 'ede-pmake-insert-variable-once 'lisp-indent-function 1) ;;; SOURCE VARIABLE NAME CONSTRUCTION diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el index 8277f58a5e0..87a722ef9be 100644 --- a/lisp/cedet/ede/proj-comp.el +++ b/lisp/cedet/ede/proj-comp.el @@ -319,7 +319,7 @@ Not all compilers do this." (defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule)) "Insert rules needed for THIS rule object." - (if (oref this phony) (insert ".PHONY: (oref this target)\n")) + (if (oref this phony) (insert ".PHONY: " (oref this target) "\n")) (insert (oref this target) ": " (oref this dependencies) "\n\t" (mapconcat (lambda (c) c) (oref this rules) "\n\t") "\n\n")) @@ -331,15 +331,16 @@ compiler it decides to use after inserting in the rule." (when (slot-boundp this 'commands) (with-slots (commands) this (mapc - (lambda (obj) (insert "\t" - (cond ((stringp obj) - obj) - ((and (listp obj) - (eq (car obj) 'lambda)) - (funcall obj)) - (t - (format "%S" obj))) - "\n")) + (lambda (obj) (insert + (if (bolp) "\t" " ") + (cond ((stringp obj) + obj) + ((and (listp obj) + (eq (car obj) 'lambda)) + (funcall obj)) + (t + (format "%S" obj))) + "\n")) commands)) (insert "\n"))) diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 78200acff7d..db8803fa002 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -45,10 +45,37 @@ There should only be one toplevel package per auxiliary tool needed. These packages location is found, and added to the compile time load path." - )) + ) + (pre-load-packages :initarg :pre-load-packages + :initform nil + :type list + :custom (repeat string) + :documentation "Additional packages to pre-load. +Each package name will be loaded with `require'. +Each package's directory should also appear in :aux-packages via a package name.") + ) "This target consists of a group of lisp files. A lisp target may be one general program with many separate lisp files in it.") +(defmethod ede-proj-makefile-insert-rules :after ((this ede-proj-target-elisp)) + "Insert rules needed by THIS target. +This inserts the PRELOADS target-local variable." + (let ((preloads (oref this pre-load-packages))) + (when preloads + (insert (format "%s: PRELOADS=%s\n" + (oref this name) + (mapconcat 'identity preloads " "))))) + (insert "\n")) + +(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp)) + "Return a string representing the dependencies for THIS. +Some compilers only use the first element in the dependencies, others +have a list of intermediates (object files), and others don't care. +This allows customization of how these elements appear. +For Emacs Lisp, return addsuffix command on source files." + (format "$(addsuffix c, $(%s))" + (ede-proj-makefile-sourcevar this))) + (defvar ede-source-emacs (ede-sourcecode "ede-emacs-source" :name "Emacs Lisp" @@ -61,18 +88,17 @@ A lisp target may be one general program with many separate lisp files in it.") "ede-emacs-compiler" :name "emacs" :variables '(("EMACS" . "emacs") - ("EMACSFLAGS" . "-batch --no-site-file")) - :commands - '("@echo \"(add-to-list 'load-path nil)\" > $@-compile-script" - "for loadpath in . ${LOADPATH}; do \\" - " echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> $@-compile-script; \\" - "done;" - "@echo \"(setq debug-on-error t)\" >> $@-compile-script" - "\"$(EMACS)\" $(EMACSFLAGS) -l $@-compile-script -f batch-byte-compile $^" - ) + ("EMACSFLAGS" . "-batch --no-site-file --eval '(setq debug-on-error t)'") + ("require" . "$(foreach r,$(1),(require (quote $(r))))")) + :rules (list (ede-makefile-rule + "elisp-inference-rule" + :target "%.elc" + :dependencies "%.el" + :rules '("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \ +--eval '(progn $(call require, $(PRELOADS)))' -f batch-byte-compile $^"))) :autoconf '("AM_PATH_LISPDIR") :sourcetype '(ede-source-emacs) -; :objectextention ".elc" + :objectextention ".elc" ) "Compile Emacs Lisp programs.") @@ -112,7 +138,7 @@ Lays claim to all .elc files that match .el files in this target." (full nil) ) ;; Make sure the relative name isn't to far off - (when (string-match "^\\.\\./\\.\\./\\.\\./\\.\\." rel) + (when (string-match "^\\.\\./\\.\\./\\.\\./\\.\\./\\.\\." rel) (setq full fnd)) ;; Do the setup. (setq paths (cons (or full rel) paths) @@ -129,9 +155,20 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)." (mapc (lambda (src) (let* ((fsrc (expand-file-name src dir)) (elc (concat (file-name-sans-extension fsrc) ".elc"))) - (if (eq (byte-recompile-file fsrc nil 0) t) - (setq comp (1+ comp)) - (setq utd (1+ utd))))) + (with-no-warnings + (if (< emacs-major-version 24) + ;; Does not have `byte-recompile-file' + (if (or (not (file-exists-p elc)) + (file-newer-than-file-p fsrc elc)) + (progn + (setq comp (1+ comp)) + (byte-compile-file fsrc)) + (setq utd (1+ utd))) + + (if (eq (byte-recompile-file fsrc nil 0) t) + (setq comp (1+ comp)) + (setq utd (1+ utd))))))) + (oref obj source)) (message "All Emacs Lisp sources are up to date in %s" (object-name obj)) (cons comp utd))) @@ -185,8 +222,7 @@ is found, such as a `-version' variable, or the standard header." "Insert variables needed by target THIS." (let ((newitems (if (oref this aux-packages) (ede-proj-elisp-packages-to-loadpath - (oref this aux-packages)))) - ) + (oref this aux-packages))))) (ede-proj-makefile-insert-loadpath-items newitems))) (defun ede-proj-elisp-add-path (path) @@ -211,7 +247,8 @@ is found, such as a `-version' variable, or the standard header." "Tweak the configure file (current buffer) to accommodate THIS." (call-next-method) ;; Ok, now we have to tweak the autoconf provided `elisp-comp' program. - (let ((ec (ede-expand-filename this "elisp-comp" 'newfile))) + (let ((ec (ede-expand-filename this "elisp-comp" 'newfile)) + (enable-local-variables nil)) (if (or (not ec) (not (file-exists-p ec))) (message "No elisp-comp file. There may be compile errors? Rerun a second time.") (save-excursion @@ -235,7 +272,7 @@ is found, such as a `-version' variable, or the standard header." "Flush the configure file (current buffer) to accommodate THIS." ;; Remove crufty old paths from elisp-compile (let ((ec (ede-expand-filename this "elisp-comp" 'newfile)) - ) + (enable-local-variables nil)) (if (and ec (file-exists-p ec)) (with-current-buffer (find-file-noselect ec t) (goto-char (point-min)) @@ -251,8 +288,8 @@ is found, such as a `-version' variable, or the standard header." ;; (defclass ede-proj-target-elisp-autoloads (ede-proj-target-elisp) ((availablecompilers :initform '(ede-emacs-cedet-autogen-compiler)) - (aux-packages :initform ("cedet-autogen")) (phony :initform t) + (rules :initform nil) (autoload-file :initarg :autoload-file :initform "loaddefs.el" :type string @@ -287,15 +324,14 @@ Lays claim to all .elc files that match .el files in this target." (ede-compiler "ede-emacs-autogen-compiler" :name "emacs" - :variables '(("EMACS" . "emacs")) + :variables '(("EMACS" . "emacs") + ("EMACSFLAGS" . "-batch --no-site-file --eval '(setq debug-on-error t)'") + ("require" . "$(foreach r,$(1),(require (quote $(r))))")) :commands - '("@echo \"(add-to-list 'load-path nil)\" > $@-compile-script" - "for loadpath in . ${LOADPATH}; do \\" - " echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> $@-compile-script; \\" - "done;" - "@echo \"(require 'cedet-autogen)\" >> $@-compile-script" - "\"$(EMACS)\" -batch --no-site-file -l $@-compile-script -f cedet-batch-update-autoloads $(LOADDEFS) $(LOADDIRS)" - ) + '("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \ +--eval '(setq generated-autoload-file \"$(abspath $(LOADDEFS))\")' \ +-f batch-update-autoloads $(abspath $(LOADDIRS))") + :rules (list (ede-makefile-rule "clean-autoloads" :target "clean-autoloads" :phony t :rules '("rm -f $(LOADDEFS)"))) :sourcetype '(ede-source-emacs) ) "Build an autoloads file.") diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index a8afe9ec804..8d81b825565 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el @@ -53,6 +53,39 @@ (autoload 'ede-proj-target-makefile-info "ede/proj-info" "Target class for info files." nil nil) +(eieio-defclass-autoload 'ede-proj-target-aux '(ede-proj-target) + "ede/proj-aux" + "Target class for a group of lisp files.") +(eieio-defclass-autoload 'ede-proj-target-elisp '(ede-proj-target-makefile) + "ede/proj-elisp" + "Target class for a group of lisp files.") +(eieio-defclass-autoload 'ede-proj-target-elisp-autoloads '(ede-proj-target-elisp) + "ede/proj-elisp" + "Target class for generating autoload files.") +(eieio-defclass-autoload 'ede-proj-target-scheme '(ede-proj-target) + "ede/proj-scheme" + "Target class for a group of lisp files.") +(eieio-defclass-autoload 'ede-proj-target-makefile-miscelaneous '(ede-proj-target-makefile) + "ede/proj-misc" + "Target class for a group of miscellaneous w/ a special makefile.") +(eieio-defclass-autoload 'ede-proj-target-makefile-program '(ede-proj-target-makefile-objectcode) + "ede/proj-prog" + "Target class for building a program.") +(eieio-defclass-autoload 'ede-proj-target-makefile-archive '(ede-proj-target-makefile-objectcode) + "ede/proj-archive" + "Target class for building an archive of object code.") +(eieio-defclass-autoload 'ede-proj-target-makefile-shared-object '(ede-proj-target-makefile-program) + "ede/proj-shared" + "Target class for building a shared object.") +(eieio-defclass-autoload 'ede-proj-target-makefile-info '(ede-proj-target-makefile) + "ede/proj-info" + "Target class for info files.") + +;; Not in ede/ , but part of semantic. +(eieio-defclass-autoload 'semantic-ede-proj-target-grammar '(ede-proj-target-elisp) + "semantic/ede-grammar" + "Target classfor Semantic grammar files.") + ;;; Class Definitions: (defclass ede-proj-target (ede-target) ((auxsource :initarg :auxsource @@ -181,8 +214,10 @@ This enables the creation of your target type." (setq ede-proj-target-alist (cons (cons name class) ede-proj-target-alist))))) -(defclass ede-proj-project (ede-project) - ((makefile-type :initarg :makefile-type +(defclass ede-proj-project (eieio-persistent ede-project) + ((extension :initform ".ede") + (file-header-line :initform ";; EDE Project Files are auto generated: Do Not Edit") + (makefile-type :initarg :makefile-type :initform Makefile :type symbol :custom (choice (const Makefile) @@ -259,23 +294,16 @@ If optional ROOTPROJ is provided then ROOTPROJ is the root project for the tree being read in. If ROOTPROJ is nil, then assume that the PROJECT being read in is the root project." (save-excursion - (let ((ret nil) + (let ((ret (eieio-persistent-read (concat project "Project.ede") + ede-proj-project)) (subdirs (directory-files project nil "[^.].*" nil))) - (set-buffer (get-buffer-create " *tmp proj read*")) - (unwind-protect - (progn - (insert-file-contents (concat project "Project.ede") - nil nil nil t) - (goto-char (point-min)) - (setq ret (read (current-buffer))) - (if (not (eq (car ret) 'ede-proj-project)) - (error "Corrupt project file")) - (setq ret (eval ret)) - (oset ret file (concat project "Project.ede")) - (oset ret directory project) - (oset ret rootproject rootproj) - ) - (kill-buffer " *tmp proj read*")) + (if (not (object-of-class-p ret 'ede-proj-project)) + (error "Corrupt project file")) + (oset ret directory project) + (oset ret rootproject rootproj) + + ;; Load the project file of each subdirectory containing a + ;; loadable Project.ede. (while subdirs (let ((sd (file-name-as-directory (expand-file-name (car subdirs) project)))) @@ -291,22 +319,13 @@ the PROJECT being read in is the root project." "Write out object PROJECT into its file." (save-excursion (if (not project) (setq project (ede-current-project))) - (let ((b (set-buffer (get-buffer-create " *tmp proj write*"))) - (cfn (oref project file)) - (cdir (oref project directory))) + (let ((cdir (oref project directory))) (unwind-protect - (save-excursion - (erase-buffer) - (let ((standard-output (current-buffer))) - (oset project file (file-name-nondirectory cfn)) - (slot-makeunbound project :directory) - (object-write project ";; EDE project file.")) - (write-file cfn nil) - ) - ;; Restore the :file on exit. - (oset project file cfn) - (oset project directory cdir) - (kill-buffer b))))) + (progn + (slot-makeunbound project :directory) + (eieio-persistent-save project)) + ;; Restore the directory slot + (oset project directory cdir))) )) (defmethod ede-commit-local-variables ((proj ede-proj-project)) "Commit change to local variables in PROJ." @@ -670,6 +689,8 @@ Optional argument FORCE will force items to be regenerated." (let ((root (or (ede-project-root this) this)) ) (setq ede-projects (delq root ede-projects)) + ;; NOTE : parent function double-checks that this dir was + ;; already in memory once. (ede-load-project-file (ede-project-root-directory root)) )) diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index e951598ba55..5053701192e 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -205,7 +205,7 @@ OT is the object target. DIR is the directory to start in." (oref amf targets)) nil t)))) ;; The input target might be new. See if we can find it. - (amf (ede-load-project-file (oref ot path))) + (amf (ede-target-parent ot)) (ot (object-assoc target 'name (oref amf targets))) (ofn (file-name-nondirectory (buffer-file-name)))) (if (not ot) diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el index 05688aa56ff..489c4d3dbf1 100644 --- a/lisp/cedet/ede/util.el +++ b/lisp/cedet/ede/util.el @@ -87,7 +87,7 @@ their sources to VERSION." If BUFFER isn't specified, use the current buffer." (save-excursion (if buffer (set-buffer buffer)) - (toggle-read-only -1))) + (setq buffer-read-only nil))) (provide 'ede/util) diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el index 877ed54566c..6b0f007916b 100644 --- a/lisp/cedet/inversion.el +++ b/lisp/cedet/inversion.el @@ -79,15 +79,20 @@ (defconst inversion-decoders '( - (alpha "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*\\.?alpha\\([0-9]+\\)?$" 3) - (beta "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*\\.?beta\\([0-9]+\\)?$" 3) - (beta "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*(beta\\([0-9]+\\)?)" 3) + (alpha "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]*\\)?\\s-*\\.?alpha\\([0-9]+\\)?$" 4) + (beta "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]*\\)?\\s-*\\.?beta\\([0-9]+\\)?$" 4) + (beta "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]*\\)?\\s-*\\.?(beta\\([0-9]+\\)?)$" 4) + (beta "^[^/]+/\\w+--\\w+--\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)--patch-\\([0-9]+\\)" 4) + (beta "^\\w+: v\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)-\\([0-9]+\\)-\\(.*\\)" 5) (prerelease "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*\\.?pre\\([0-9]+\\)?$" 3) - (full "^\\([0-9]+\\)\\.\\([0-9]+\\)$" 2) + (full "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?$" 3) (fullsingle "^\\([0-9]+\\)$" 1) - (patch "^\\([0-9]+\\)\\.\\([0-9]+\\) (patch \\([0-9]+\\))" 3) + (patch "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?\\s-*(patch \\([0-9]+\\))" 4) (point "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" 3) + (point "^\\w+: v\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)-\\(0\\)-\\(.*\\)" 5) (build "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\).\\([0-9]+\\)$" 4) + (full "^[^/]+/\\w+--\\w+--\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)--version-\\([0-9]+\\)" 4) + (full "^\\w+: v\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)" 5) ) "List of decoders for version strings. Each decoder is of the form: @@ -140,7 +145,7 @@ where RELEASE is a symbol such as `full', or `beta'." ;; Decode the code (setq code (inversion-decode-version ver)) (unless code - (error "%S-version value cannot be decoded" package)) + (error "%S-version value (%s) cannot be decoded" package ver)) code)) (defun inversion-package-incompatibility-version (package) @@ -195,24 +200,25 @@ not an indication of new features or bug fixes." (v2-3 (nth 3 ver2)) (v2-4 (nth 4 ver2)) ) - (or (and (= v1-0 v2-0) - (= v1-1 v2-1) - (= v1-2 v2-2) - (= v1-3 v2-3) - v1-4 v2-4 ; all or nothing if elt - is = + + (cond ((and (equal (list v1-1 v1-2 v1-3 v1-4) + (list v2-1 v2-2 v2-3 v2-4)) + v1-0 v2-0) + (< v1-0 v2-0)) + ((and (equal v1-1 v2-1) + (equal v1-2 v2-2) + (equal v1-3 v2-3) + v1-4 v2-4) ; all or nothing if elt - is = (< v1-4 v2-4)) - (and (= v1-0 v2-0) - (= v1-1 v2-1) - (= v1-2 v2-2) - v1-3 v2-3 ; all or nothing if elt - is = + ((and (equal v1-1 v2-1) + (equal v1-2 v2-2) + v1-3 v2-3) ; all or nothing if elt - is = (< v1-3 v2-3)) - (and (= v1-1 v2-1) + ((and (equal v1-1 v2-1) + v1-2 v2-2) (< v1-2 v2-2)) - (and (< v1-1 v2-1)) - (and (< v1-0 v2-0) - (= v1-1 v2-1) - (= v1-2 v2-2) - ) + ((and v1-1 v2-1) + (< v1-1 v2-1)) ))) (defun inversion-check-version (version incompatible-version @@ -340,13 +346,17 @@ Optional argument RESERVED is saved for later use." ;; Return the package symbol that was required. package)) -(defun inversion-require-emacs (emacs-ver xemacs-ver) - "Declare that you need either EMACS-VER, or XEMACS-VER. +;;;###autoload +(defun inversion-require-emacs (emacs-ver xemacs-ver sxemacs-ver) + "Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver. Only checks one based on which kind of Emacs is being run." (let ((err (inversion-test 'emacs - (if (featurep 'xemacs) - xemacs-ver - emacs-ver)))) + (cond ((featurep 'sxemacs) + sxemacs-ver) + ((featurep 'xemacs) + xemacs-ver) + (t + emacs-ver))))) (if err (error err) ;; Something nice... t))) diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index aeb5241b2d0..5182a38327c 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -38,7 +38,7 @@ (require 'semantic/tag) (require 'semantic/lex) -(defvar semantic-version "2.0" +(defvar semantic-version "2.1beta" "Current version of Semantic.") (declare-function inversion-test "inversion") @@ -273,7 +273,9 @@ setup to use Semantic." (js-mode . wisent-javascript-setup-parser) (python-mode . wisent-python-default-setup) (scheme-mode . semantic-default-scheme-setup) + (f90-mode . semantic-default-f90-setup) (srecode-template-mode . srecode-template-setup-parser) + (texinfo-mode . semantic-default-texi-setup) (makefile-automake-mode . semantic-default-make-setup) (makefile-gmake-mode . semantic-default-make-setup) (makefile-makepp-mode . semantic-default-make-setup) @@ -623,16 +625,18 @@ was marked unparseable, then do nothing, and return the cache." ;;;; Parse the whole system. ((semantic-parse-tree-needs-rebuild-p) - ;; Use Emacs's built-in progress-reporter - (let ((semantic--progress-reporter - (and (>= (point-max) semantic-minimum-working-buffer-size) - (eq semantic-working-type 'percent) - (make-progress-reporter - (semantic-parser-working-message (buffer-name)) - 0 100)))) - (setq res (semantic-parse-region (point-min) (point-max))) - (if semantic--progress-reporter - (progress-reporter-done semantic--progress-reporter))) + ;; Use Emacs's built-in progress-reporter (only interactive). + (if noninteractive + (setq res (semantic-parse-region (point-min) (point-max))) + (let ((semantic--progress-reporter + (and (>= (point-max) semantic-minimum-working-buffer-size) + (eq semantic-working-type 'percent) + (make-progress-reporter + (semantic-parser-working-message (buffer-name)) + 0 100)))) + (setq res (semantic-parse-region (point-min) (point-max))) + (if semantic--progress-reporter + (progress-reporter-done semantic--progress-reporter)))) ;; Clear the caches when we see there were no errors. ;; But preserve the unmatched syntax cache and warnings! @@ -986,6 +990,12 @@ Throw away all the old tags, and recreate the tag database." :help "Highlight the tag at point" :visible semantic-mode :button (:toggle . global-semantic-highlight-func-mode))) + (define-key cedet-menu-map [global-semantic-stickyfunc-mode] + '(menu-item "Stick Top Tag to Headerline" global-semantic-stickyfunc-mode + :help "Stick the tag scrolled off the top of the buffer into the header line" + :visible semantic-mode + :button (:toggle . (bound-and-true-p + global-semantic-stickyfunc-mode)))) (define-key cedet-menu-map [global-semantic-decoration-mode] '(menu-item "Decorate Tags" global-semantic-decoration-mode :help "Decorate tags based on tag attributes" @@ -1031,7 +1041,12 @@ Prevent this load system from loading files in twice.") global-semantic-idle-scheduler-mode global-semanticdb-minor-mode global-semantic-idle-summary-mode - global-semantic-mru-bookmark-mode) + global-semantic-mru-bookmark-mode + global-cedet-m3-minor-mode + global-semantic-idle-local-symbol-highlight-mode + global-semantic-highlight-edits-mode + global-semantic-show-unmatched-syntax-mode + global-semantic-show-parser-state-mode) "List of auxiliary minor modes in the Semantic package.") ;;;###autoload @@ -1048,7 +1063,17 @@ The possible elements of this list include the following: `global-semantic-highlight-func-mode' - Highlight the current tag. `global-semantic-stickyfunc-mode' - Show current fun in header line. `global-semantic-mru-bookmark-mode' - Provide `switch-to-buffer'-like - keybinding for tag names." + keybinding for tag names. + `global-cedet-m3-minor-mode' - A mouse 3 context menu. + `global-semantic-idle-local-symbol-highlight-mode' - Highlight references + of the symbol under point. +The following modes are more targeted at people who want to see + some internal information of the semantic parser in action: + `global-semantic-highlight-edits-mode' - Visualize incremental parser by + highlighting not-yet parsed changes. + `global-semantic-show-unmatched-syntax-mode' - Highlight unmatched lexical + syntax tokens. + `global-semantic-show-parser-state-mode' - Display the parser cache state." :group 'semantic :type `(set ,@(mapcar (lambda (c) (list 'const c)) semantic-submode-list))) @@ -1095,16 +1120,27 @@ Semantic mode. (dolist (b (buffer-list)) (with-current-buffer b (semantic-new-buffer-fcn)))) - ;; Disable all Semantic features. + ;; Disable Semantic features. Removing everything Semantic has + ;; introduced in the buffer is pretty much futile, but we have to + ;; clean the hooks and delete Semantic-related overlays, so that + ;; Semantic can be re-activated cleanly. (remove-hook 'mode-local-init-hook 'semantic-new-buffer-fcn) (remove-hook 'completion-at-point-functions 'semantic-completion-at-point-function) + (remove-hook 'after-change-functions + 'semantic-change-function) (define-key cedet-menu-map [cedet-menu-separator] nil) (define-key cedet-menu-map [semantic-options-separator] nil) ;; FIXME: handle semanticdb-load-ebrowse-caches (dolist (mode semantic-submode-list) (if (and (boundp mode) (eval mode)) - (funcall mode -1))))) + (funcall mode -1))) + ;; Unlink buffer and clear cache + (semantic--tag-unlink-cache-from-buffer) + (setq semantic--buffer-cache nil) + ;; Make sure we run the setup function if Semantic gets + ;; re-activated. + (setq semantic-new-buffer-fcn-was-run nil))) (defun semantic-completion-at-point-function () 'semantic-ia-complete-symbol) @@ -1141,6 +1177,11 @@ minor mode can be turned on only if semantic feature is available and the current buffer was set up for parsing. Return non-nil if the minor mode is enabled." t nil) +(autoload 'global-semantic-idle-local-symbol-highlight-mode "semantic/idle" + "Highlight the tag and symbol references of the symbol under point. +Call `semantic-analyze-current-context' to find the reference tag. +Call `semantic-symref-hits-in-region' to identify local references." t nil) + (autoload 'srecode-template-setup-parser "srecode/srecode-template" "Set up buffer for parsing SRecode template files." t nil) diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el index 5fe0078478d..19c61cb74c7 100644 --- a/lisp/cedet/semantic/analyze/debug.el +++ b/lisp/cedet/semantic/analyze/debug.el @@ -443,7 +443,7 @@ or implementing a version specific to ") (semanticdb-file-table-object fileinner t)))) (cond ((not fileinner) (setq unknown (1+ unknown))) - ((number-or-marker-p (oref tableinner pointmax)) + ((and tableinner (number-or-marker-p (oref tableinner pointmax))) (setq ok (1+ ok))) (t (setq unparsed (1+ unparsed)))))) diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el index a27356c784b..d780327b7e9 100644 --- a/lisp/cedet/semantic/analyze/fcn.el +++ b/lisp/cedet/semantic/analyze/fcn.el @@ -37,24 +37,6 @@ ;; ;; These queries allow a major mode to help the analyzer make decisions. ;; -(define-overloadable-function semantic-analyze-tag-prototype-p (tag) - "Non-nil if TAG is a prototype." - ) - -(defun semantic-analyze-tag-prototype-p-default (tag) - "Non-nil if TAG is a prototype." - (let ((p (semantic-tag-get-attribute tag :prototype-flag))) - (cond - ;; Trust the parser author. - (p p) - ;; Empty types might be a prototype. - ((eq (semantic-tag-class tag) 'type) - (not (semantic-tag-type-members tag))) - ;; No other heuristics. - (t nil)) - )) - -;;------------------------------------------------------------ (define-overloadable-function semantic-analyze-split-name (name) "Split a tag NAME into a sequence. @@ -219,7 +201,7 @@ used by the analyzer debugger." (if (and type-declaration (semantic-tag-p type-declaration) (semantic-tag-of-class-p type-declaration 'type) - (not (semantic-analyze-tag-prototype-p type-declaration)) + (not (semantic-tag-prototype-p type-declaration)) ) ;; We have an anonymous type for TAG with children. ;; Use this type directly. @@ -312,7 +294,7 @@ SCOPE is the current scope." (when (and (semantic-tag-p ans) (eq (semantic-tag-class ans) 'type)) ;; We have a tag. - (if (semantic-analyze-tag-prototype-p ans) + (if (semantic-tag-prototype-p ans) ;; It is a prototype.. find the real one. (or (and scope (car-safe diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el index 09a4c08c059..05ac56eac69 100644 --- a/lisp/cedet/semantic/analyze/refs.el +++ b/lisp/cedet/semantic/analyze/refs.el @@ -87,7 +87,7 @@ Use `semantic-analyze-current-tag' to debug this fcn." (semantic-go-to-tag tag db) (setq scope (semantic-calculate-scope)) - (setq allhits (semantic--analyze-refs-full-lookup tag scope)) + (setq allhits (semantic--analyze-refs-full-lookup tag scope t)) (semantic-analyze-references (semantic-tag-name tag) :tag tag @@ -115,7 +115,10 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti (aDB (car ans)) ) (when (and (not (semantic-tag-prototype-p aT)) - (semantic-tag-similar-p tag aT :prototype-flag :parent)) + (semantic-tag-similar-p tag aT + :prototype-flag + :parent + :typemodifiers)) (when in-buffer (save-excursion (semantic-go-to-tag aT aDB))) (push aT impl)))) allhits) @@ -135,7 +138,10 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti (aDB (car ans)) ) (when (and (semantic-tag-prototype-p aT) - (semantic-tag-similar-p tag aT :prototype-flag :parent)) + (semantic-tag-similar-p tag aT + :prototype-flag + :parent + :typemodifiers)) (when in-buffer (save-excursion (semantic-go-to-tag aT aDB))) (push aT proto)))) allhits) @@ -143,14 +149,15 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti ;;; LOOKUP ;; -(defun semantic--analyze-refs-full-lookup (tag scope) +(defun semantic--analyze-refs-full-lookup (tag scope &optional noerror) "Perform a full lookup for all occurrences of TAG in the current project. TAG should be the tag currently under point. SCOPE is the scope the cursor is in. From this a list of parents is -derived. If SCOPE does not have parents, then only a simple lookup is done." +derived. If SCOPE does not have parents, then only a simple lookup is done. +Optional argument NOERROR means don't error if the lookup fails." (if (not (oref scope parents)) ;; If this tag has some named parent, but is not - (semantic--analyze-refs-full-lookup-simple tag) + (semantic--analyze-refs-full-lookup-simple tag noerror) ;; We have some sort of lineage we need to consider when we do ;; our side lookup of tags. diff --git a/lisp/cedet/semantic/bovine/c-by.el b/lisp/cedet/semantic/bovine/c-by.el index b47dac49a52..96e12bba900 100644 --- a/lisp/cedet/semantic/bovine/c-by.el +++ b/lisp/cedet/semantic/bovine/c-by.el @@ -19,17 +19,21 @@ ;;; Commentary: ;; -;; This file was generated from etc/grammars/c.by. +;; This file was generated from admin/grammars/c.by. ;;; Code: (require 'semantic/lex) (eval-when-compile (require 'semantic/bovine)) - + +;;; Prologue +;; (declare-function semantic-c-reconstitute-token "semantic/bovine/c") (declare-function semantic-c-reconstitute-template "semantic/bovine/c") (declare-function semantic-expand-c-tag "semantic/bovine/c") - + +;;; Declarations +;; (defconst semantic-c-by--keyword-table (semantic-lex-make-keyword-table '(("extern" . EXTERN) @@ -42,6 +46,7 @@ ("inline" . INLINE) ("virtual" . VIRTUAL) ("mutable" . MUTABLE) + ("explicit" . EXPLICIT) ("struct" . STRUCT) ("union" . UNION) ("enum" . ENUM) @@ -124,6 +129,7 @@ ("enum" summary "Enumeration Type Declaration: enum [name] { ... };") ("union" summary "Union Type Declaration: union [name] { ... };") ("struct" summary "Structure Type Declaration: struct [name] { ... };") + ("explicit" summary "Forbids implicit type conversion: explicit <constructor>") ("mutable" summary "Member Declaration Modifier: mutable <type> <name> ...") ("virtual" summary "Method Modifier: virtual <type> <name>(...) ...") ("inline" summary "Function Modifier: inline <return type> <name>(...) {...};") @@ -486,6 +492,12 @@ ) (template) (using) + (spp-include + ,(semantic-lambda + (semantic-tag + (nth 0 vals) + 'include :inside-ns t)) + ) ( ;;EMPTY ) ) ;; end namespacesubparts @@ -1987,6 +1999,15 @@ "*" (nth 2 vals)))) ) + (open-paren + "(" + symbol + close-paren + ")" + ,(semantic-lambda + (list + (nth 1 vals))) + ) ) ;; end function-pointer (fun-or-proto-end @@ -2186,6 +2207,10 @@ semantic-flex-keywords-obarray semantic-c-by--keyword-table semantic-equivalent-major-modes '(c-mode c++-mode) )) + + +;;; Analyzers +;; ;;; Epilogue ;; diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 886b15d183e..02ad6e05d1a 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -27,10 +27,13 @@ (require 'semantic) (require 'semantic/analyze) +(require 'semantic/bovine) (require 'semantic/bovine/gcc) (require 'semantic/idle) (require 'semantic/lex-spp) (require 'semantic/bovine/c-by) +(require 'semantic/db-find) +(require 'hideif) (eval-when-compile (require 'semantic/find)) @@ -103,8 +106,13 @@ NOTE: In process of obsoleting this." '( ("__THROW" . "") ("__const" . "const") ("__restrict" . "") + ("__attribute_pure__" . "") + ("__attribute_malloc__" . "") + ("__nonnull" . "") + ("__wur" . "") ("__declspec" . ((spp-arg-list ("foo") 1 . 2))) ("__attribute__" . ((spp-arg-list ("foo") 1 . 2))) + ("__asm" . ((spp-arg-list ("foo") 1 . 2))) ) "List of symbols to include by default.") @@ -118,7 +126,15 @@ part of the preprocessor map.") (defun semantic-c-reset-preprocessor-symbol-map () "Reset the C preprocessor symbol map based on all input variables." - (when (featurep 'semantic/bovine/c) + (when (and semantic-mode + (featurep 'semantic/bovine/c)) + (remove-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map) + ;; Initialize semantic-lex-spp-macro-symbol-obarray with symbols. + (setq-mode-local c-mode + semantic-lex-spp-macro-symbol-obarray + (semantic-lex-make-spp-table + (append semantic-lex-c-preprocessor-symbol-map-builtin + semantic-lex-c-preprocessor-symbol-map))) (let ((filemap nil) ) (when (and (not semantic-c-in-reset-preprocessor-table) @@ -141,17 +157,17 @@ part of the preprocessor map.") (error (message "Error updating tables for %S" (object-name table))))) (setq filemap (append filemap (oref table lexical-table))) - ) - )))) - - (setq-mode-local c-mode - semantic-lex-spp-macro-symbol-obarray - (semantic-lex-make-spp-table - (append semantic-lex-c-preprocessor-symbol-map-builtin - semantic-lex-c-preprocessor-symbol-map - filemap)) - ) - ))) + ;; Update symbol obarray + (setq-mode-local c-mode + semantic-lex-spp-macro-symbol-obarray + (semantic-lex-make-spp-table + (append semantic-lex-c-preprocessor-symbol-map-builtin + semantic-lex-c-preprocessor-symbol-map + filemap))))))))))) + +;; Make sure the preprocessor symbols are set up when mode-local kicks +;; in. +(add-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map) (defcustom semantic-lex-c-preprocessor-symbol-map nil "Table of C Preprocessor keywords used by the Semantic C lexer. @@ -236,6 +252,7 @@ Return the defined symbol as a special spp lex token." nil (let* ((name (buffer-substring-no-properties (match-beginning 1) (match-end 1))) + (beginning-of-define (match-end 1)) (with-args (save-excursion (goto-char (match-end 0)) (looking-at "("))) @@ -246,7 +263,13 @@ Return the defined symbol as a special spp lex token." (raw-stream (semantic-lex-spp-stream-for-macro (save-excursion (semantic-c-end-of-macro) - (point)))) + ;; HACK - If there's a C comment after + ;; the macro, do not parse it. + (if (looking-back "/\\*.*" beginning-of-define) + (progn + (goto-char (match-beginning 0)) + (1- (point))) + (point))))) ) ;; Only do argument checking if the paren was immediately after @@ -295,8 +318,10 @@ Moves completely over balanced #if blocks." (cond ((looking-at "^\\s-*#\\s-*if") ;; We found a nested if. Skip it. - ;; @TODO - can we use the new c-scan-conditionals - (c-forward-conditional 1)) + (if (fboundp 'c-scan-conditionals) + (goto-char (c-scan-conditionals 1)) + ;; For older Emacsen, but this will set the mark. + (c-forward-conditional 1))) ((looking-at "^\\s-*#\\s-*elif") ;; We need to let the preprocessor analyze this one. (beginning-of-line) @@ -315,34 +340,207 @@ Moves completely over balanced #if blocks." ;; We found an elif. Stop here. (setq done t)))))) +;;; HIDEIF USAGE: +;; NOTE: All hideif using code was contributed by Brian Carlson as +;; copies from hideif plus modifications and additions. +;; Eric then converted things to use hideif functions directly, +;; deleting most of that code, and added the advice. + +;;; SPP SYM EVAL +;; +;; Convert SPP symbols into values usable by hideif. +;; +;; @TODO - can these conversion fcns be a part of semantic-lex-spp.el? +;; -- TRY semantic-lex-spp-one-token-to-txt +(defun semantic-c-convert-spp-value-to-hideif-value (symbol macrovalue) + "Convert an spp macro SYMBOL MACROVALUE, to something that hideif can use. +Take the first interesting thing and convert it." + ;; Just warn for complex macros. + (when (> (length macrovalue) 1) + (semantic-push-parser-warning + (format "Complex macro value (%s) may be improperly evaluated. " + symbol) 0 0)) + + (let* ((lextoken (car macrovalue)) + (key (semantic-lex-token-class lextoken)) + (value (semantic-lex-token-text lextoken))) + (cond + ((eq key 'number) (string-to-number value)) + ((eq key 'symbol) (semantic-c-evaluate-symbol-for-hideif value)) + ((eq key 'string) + (if (string-match "^[0-9]+L?$" value) + ;; If it matches a number expression, then + ;; convert to a number. + (string-to-number value) + value)) + (t (semantic-push-parser-warning + (format "Unknown macro value. Token class = %s value = %s. " key value) + 0 0) + nil) + ))) + +(defun semantic-c-evaluate-symbol-for-hideif (spp-symbol) + "Lookup the symbol SPP-SYMBOL (a string) to something hideif can use. +Pulls out the symbol list, and call `semantic-c-convert-spp-value-to-hideif-value'." + (interactive "sSymbol name: ") + (when (symbolp spp-symbol) (setq spp-symbol (symbol-name spp-symbol))) + + (if (semantic-lex-spp-symbol-p spp-symbol ) + ;; Convert the symbol into a stream of tokens from the macro which we + ;; can then interpret. + (let ((stream (semantic-lex-spp-symbol-stream spp-symbol))) + (cond + ;; Empty string means defined, so t. + ((null stream) t) + ;; A list means a parsed macro stream. + ((listp stream) + ;; Convert the macro to something we can return. + (semantic-c-convert-spp-value-to-hideif-value spp-symbol stream)) + + ;; Strings might need to be turned into numbers + ((stringp stream) + (if (string-match "^[0-9]+L?$" stream) + ;; If it matches a number expression, then convert to a + ;; number. + (string-to-number stream) + stream)) + + ;; Just return the stream. A user might have just stuck some + ;; value in it directly. + (t stream) + )) + ;; Else, store an error, return nil. + (progn + (semantic-push-parser-warning + (format "SPP Symbol %s not available" spp-symbol) + (point) (point)) + nil))) + +;;; HIDEIF HACK support fcns +;; +;; These fcns can replace the impl of some hideif features. +;; +;; @TODO - Should hideif and semantic-c merge? +;; I picture a grammar just for CPP that expands into +;; a second token stream for the parser. +(defun semantic-c-hideif-lookup (var) + "Replacement for `hif-lookup'. +I think it just gets the value for some CPP variable VAR." + (let ((val (semantic-c-evaluate-symbol-for-hideif + (cond + ((stringp var) var) + ((symbolp var) (symbol-name var)) + (t "Unable to determine var"))))) + (if val + val + ;; Real hideif will return the right undefined symbol. + nil))) + +(defun semantic-c-hideif-defined (var) + "Replacement for `hif-defined'. +I think it just returns t/nil dependent on if VAR has been defined." + (let ((var-symbol-name + (cond + ((symbolp var) (symbol-name var)) + ((stringp var) var) + (t "Not A Symbol")))) + (if (not (semantic-lex-spp-symbol-p var-symbol-name)) + (progn + (semantic-push-parser-warning + (format "Skip %s" (buffer-substring-no-properties + (point-at-bol) (point-at-eol))) + (point-at-bol) (point-at-eol)) + nil) + t))) + +;;; HIDEIF ADVICE +;; +;; Advise hideif functions to use our lexical tables instead. +(defvar semantic-c-takeover-hideif nil + "Non-nil when Semantic is taking over hideif features.") + +;; (defadvice hif-defined (around semantic-c activate) +;; "Is the variable defined?" +;; (if semantic-c-takeover-hideif +;; (setq ad-return-value +;; (semantic-c-hideif-defined (ad-get-arg 0))) +;; ad-do-it)) + +;; (defadvice hif-lookup (around semantic-c activate) +;; "Is the argument defined? Return true or false." +;; (let ((ans nil)) +;; (when semantic-c-takeover-hideif +;; (setq ans (semantic-c-hideif-lookup (ad-get-arg 0)))) +;; (if (null ans) +;; ad-do-it +;; (setq ad-return-value ans)))) + +;;; #if macros +;; +;; Support #if macros by evaluating the values via use of hideif +;; logic. See above for hacks to make this work. (define-lex-regex-analyzer semantic-lex-c-if "Code blocks wrapped up in #if, or #ifdef. Uses known macro tables in SPP to determine what block to skip." - "^\\s-*#\\s-*\\(if\\|ifndef\\|ifdef\\|elif\\)\\s-+\\(!?defined(\\|\\)\\s-*\\(\\(\\sw\\|\\s_\\)+\\)\\(\\s-*)\\)?\\s-*$" + "^\\s-*#\\s-*\\(if\\|elif\\).*$" (semantic-c-do-lex-if)) (defun semantic-c-do-lex-if () + "Handle lexical CPP if statements. +Enables a takeover of some hideif functions, then uses hideif to +evaluate the #if expression and enables us to make decisions on which +code to parse." + ;; Enable our advice, and use hideif to parse. + (let* ((semantic-c-takeover-hideif t) + (hif-ifx-regexp (concat hif-cpp-prefix "\\(elif\\|if\\(n?def\\)?\\)[ \t]+")) + (parsedtokelist + (condition-case nil + ;; This is imperfect, so always assume on error. + (hif-canonicalize) + (error nil)))) + + (let ((eval-form (eval parsedtokelist))) + (if (or (not eval-form) + (and (numberp eval-form) + (equal eval-form 0)));; ifdefline resulted in false + + ;; The if indicates to skip this preprocessor section + (let ((pt nil)) + (semantic-push-parser-warning (format "Skip %s" (buffer-substring-no-properties (point-at-bol) (point-at-eol))) + (point-at-bol) (point-at-eol)) + (beginning-of-line) + (setq pt (point)) + ;; This skips only a section of a conditional. Once that section + ;; is opened, encountering any new #else or related conditional + ;; should be skipped. + (semantic-c-skip-conditional-section) + (setq semantic-lex-end-point (point)) + + ;; @TODO -somewhere around here, we also need to skip + ;; other sections of the conditional. + + nil) + ;; Else, don't ignore it, but do handle the internals. + (end-of-line) + (setq semantic-lex-end-point (point)) + nil)))) + +(define-lex-regex-analyzer semantic-lex-c-ifdef + "Code blocks wrapped up in #ifdef. +Uses known macro tables in SPP to determine what block to skip." + "^\\s-*#\\s-*\\(ifndef\\|ifdef\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)$" + (semantic-c-do-lex-ifdef)) + +(defun semantic-c-do-lex-ifdef () "Handle lexical CPP if statements." (let* ((sym (buffer-substring-no-properties - (match-beginning 3) (match-end 3))) - (defstr (buffer-substring-no-properties - (match-beginning 2) (match-end 2))) - (defined (string= defstr "defined(")) - (notdefined (string= defstr "!defined(")) + (match-beginning 2) (match-end 2))) (ift (buffer-substring-no-properties (match-beginning 1) (match-end 1))) - (ifdef (or (string= ift "ifdef") - (and (string= ift "if") defined) - (and (string= ift "elif") defined) - )) - (ifndef (or (string= ift "ifndef") - (and (string= ift "if") notdefined) - (and (string= ift "elif") notdefined) - )) + (ifdef (string= ift "ifdef")) + (ifndef (string= ift "ifndef")) ) - (if (or (and (or (string= ift "if") (string= ift "elif")) - (string= sym "0")) - (and ifdef (not (semantic-lex-spp-symbol-p sym))) + (if (or (and ifdef (not (semantic-lex-spp-symbol-p sym))) (and ifndef (semantic-lex-spp-symbol-p sym))) ;; The if indicates to skip this preprocessor section. (let ((pt nil)) @@ -556,6 +754,7 @@ Use semantic-cpp-lexer for parsing text inside a CPP macro." ;; C preprocessor features semantic-lex-cpp-define semantic-lex-cpp-undef + semantic-lex-c-ifdef semantic-lex-c-if semantic-lex-c-macro-else semantic-lex-c-macrobits @@ -724,6 +923,8 @@ the regular parser." ;; Hack in mode-local (activate-mode-local-bindings) + ;; Setup C parser + (semantic-default-c-setup) ;; CHEATER! The following 3 lines are from ;; `semantic-new-buffer-fcn', but we don't want to turn ;; on all the other annoying modes for this little task. @@ -800,51 +1001,18 @@ now. ) ;; Expand an EXTERN C first. (when (eq (semantic-tag-class tag) 'extern) - (let* ((mb (semantic-tag-get-attribute tag :members)) - (ret mb)) - (while mb - (let ((mods (semantic-tag-get-attribute (car mb) :typemodifiers))) - (setq mods (cons "extern" (cons "\"C\"" mods))) - (semantic-tag-put-attribute (car mb) :typemodifiers mods)) - (setq mb (cdr mb))) - (setq return-list ret))) + (setq return-list (semantic-expand-c-extern-C tag)) + ;; The members will be expanded in the next iteration. The + ;; 'extern' tag itself isn't needed anymore. + (setq tag nil)) - ;; Function or variables that have a :type that is some complex - ;; thing, extract it, and replace it with a reference. - ;; - ;; Thus, struct A { int a; } B; - ;; - ;; will create 2 toplevel tags, one is type A, and the other variable B - ;; where the :type of B is just a type tag A that is a prototype, and - ;; the actual struct info of A is its own toplevel tag. + ;; Check if we have a complex type (when (or (semantic-tag-of-class-p tag 'function) (semantic-tag-of-class-p tag 'variable)) - (let* ((basetype (semantic-tag-type tag)) - (typeref nil) - (tname (when (consp basetype) - (semantic-tag-name basetype)))) - ;; Make tname be a string. - (when (consp tname) (setq tname (car (car tname)))) - ;; Is the basetype a full type with a name of its own? - (when (and basetype (semantic-tag-p basetype) - (not (semantic-tag-prototype-p basetype)) - tname - (not (string= tname ""))) - ;; a type tag referencing the type we are extracting. - (setq typeref (semantic-tag-new-type - (semantic-tag-name basetype) - (semantic-tag-type basetype) - nil nil - :prototype t)) - ;; Convert original tag to only have a reference. - (setq tag (semantic-tag-copy tag)) - (semantic-tag-put-attribute tag :type typeref) - ;; Convert basetype to have the location information. - (semantic--tag-copy-properties tag basetype) - (semantic--tag-set-overlay basetype - (semantic-tag-overlay tag)) - ;; Store the base tag as part of the return list. - (setq return-list (cons basetype return-list))))) + (setq tag (semantic-expand-c-complex-type tag)) + ;; Extract new basetag + (setq return-list (car tag)) + (setq tag (cdr tag))) ;; Name of the tag is a list, so expand it. Tag lists occur ;; for variables like this: int var1, var2, var3; @@ -865,13 +1033,63 @@ now. ;; If we didn't have a list, but the return-list is non-empty, ;; that means we still need to take our existing tag, and glom ;; it onto our extracted type. - (if (consp return-list) + (if (and tag (consp return-list)) (setq return-list (cons tag return-list))) ) ;; Default, don't change the tag means returning nil. return-list)) +(defun semantic-expand-c-extern-C (tag) + "Expand TAG containing an 'extern \"C\"' statement. +This will return all members of TAG with 'extern \"C\"' added to +the typemodifiers attribute." + (when (eq (semantic-tag-class tag) 'extern) + (let* ((mb (semantic-tag-get-attribute tag :members)) + (ret mb)) + (while mb + (let ((mods (semantic-tag-get-attribute (car mb) :typemodifiers))) + (setq mods (cons "extern" (cons "\"C\"" mods))) + (semantic-tag-put-attribute (car mb) :typemodifiers mods)) + (setq mb (cdr mb))) + (nreverse ret)))) + +(defun semantic-expand-c-complex-type (tag) + "Check if TAG has a full :type with a name on its own. +If so, extract it, and replace it with a reference to that type. +Thus, 'struct A { int a; } B;' will create 2 toplevel tags, one +is type A, and the other variable B where the :type of B is just +a type tag A that is a prototype, and the actual struct info of A +is its own toplevel tag. This function will return (cons A B)." + (let* ((basetype (semantic-tag-type tag)) + (typeref nil) + (ret nil) + (tname (when (consp basetype) + (semantic-tag-name basetype)))) + ;; Make tname be a string. + (when (consp tname) (setq tname (car (car tname)))) + ;; Is the basetype a full type with a name of its own? + (when (and basetype (semantic-tag-p basetype) + (not (semantic-tag-prototype-p basetype)) + tname + (not (string= tname ""))) + ;; a type tag referencing the type we are extracting. + (setq typeref (semantic-tag-new-type + (semantic-tag-name basetype) + (semantic-tag-type basetype) + nil nil + :prototype t)) + ;; Convert original tag to only have a reference. + (setq tag (semantic-tag-copy tag)) + (semantic-tag-put-attribute tag :type typeref) + ;; Convert basetype to have the location information. + (semantic--tag-copy-properties tag basetype) + (semantic--tag-set-overlay basetype + (semantic-tag-overlay tag)) + ;; Store the base tag as part of the return list. + (setq ret (cons basetype ret))) + (cons ret tag))) + (defun semantic-expand-c-tag-namelist (tag) "Expand TAG whose name is a list into a list of tags, or nil." (cond ((semantic-tag-of-class-p tag 'variable) @@ -1238,6 +1456,22 @@ Override function for `semantic-tag-protection'." 'public nil)))) +(define-mode-local-override semantic-find-tags-included c-mode + (&optional table) + "Find all tags in TABLE that are of the 'include class. +TABLE is a tag table. See `semantic-something-to-tag-table'. +For C++, we also have to search namespaces for include tags." + (let ((tags (semantic-find-tags-by-class 'include table)) + (namespaces (semantic-find-tags-by-type "namespace" table))) + (dolist (cur namespaces) + (setq tags + (append tags + (semantic-find-tags-by-class + 'include + (semantic-tag-get-attribute cur :members))))) + tags)) + + (define-mode-local-override semantic-tag-components c-mode (tag) "Return components for TAG." (if (and (eq (semantic-tag-class tag) 'type) @@ -1342,7 +1576,7 @@ SCOPE is not used, and TYPE-DECLARATION is used only if TYPE is not a typedef." (string= (semantic-tag-type type) "typedef")) (let ((dt (semantic-tag-get-attribute type :typedef))) (cond ((and (semantic-tag-p dt) - (not (semantic-analyze-tag-prototype-p dt))) + (not (semantic-tag-prototype-p dt))) ;; In this case, DT was declared directly. We need ;; to clone DT and apply a filename to it. (let* ((fname (semantic-tag-file-name type)) @@ -1656,6 +1890,58 @@ For types with a :parent, create faux namespaces to put TAG into." ;; Else, return tag unmodified. tag))) +(define-mode-local-override semanticdb-find-table-for-include c-mode + (includetag &optional table) + "For a single INCLUDETAG found in TABLE, find a `semanticdb-table' object +INCLUDETAG is a semantic TAG of class 'include. +TABLE is a semanticdb table that identifies where INCLUDETAG came from. +TABLE is optional if INCLUDETAG has an overlay of :filename attribute. + +For C++, we also have to check if the include is inside a +namespace, since this means all tags inside this include will +have to be wrapped in that namespace." + (let ((inctable (semanticdb-find-table-for-include-default includetag table)) + (inside-ns (semantic-tag-get-attribute includetag :inside-ns)) + tags newtags namespaces prefix parenttable newtable) + (if (or (null inside-ns) + (not inctable) + (not (slot-boundp inctable 'tags))) + inctable + (when (and (eq inside-ns t) + ;; Get the table which has this include. + (setq parenttable + (semanticdb-find-table-for-include-default + (semantic-tag-new-include + (semantic--tag-get-property includetag :filename) nil))) + table) + ;; Find the namespace where this include is located. + (setq namespaces + (semantic-find-tags-by-type "namespace" parenttable)) + (when (and namespaces + (slot-boundp inctable 'tags)) + (dolist (cur namespaces) + (when (semantic-find-tags-by-name + (semantic-tag-name includetag) + (semantic-tag-get-attribute cur :members)) + (setq inside-ns (semantic-tag-name cur)) + ;; Cache the namespace value. + (semantic-tag-put-attribute includetag :inside-ns inside-ns))))) + (unless (semantic-find-tags-by-name + inside-ns + (semantic-find-tags-by-type "namespace" inctable)) + (setq tags (oref inctable tags)) + ;; Wrap tags inside namespace tag + (setq newtags + (list (semantic-tag-new-type inside-ns "namespace" tags nil))) + ;; Create new semantic-table for the wrapped tags, since we don't want + ;; the namespace to actually be a part of the header file. + (setq newtable (semanticdb-table "include with context")) + (oset newtable tags newtags) + (oset newtable parent-db (oref inctable parent-db)) + (oset newtable file (oref inctable file))) + newtable))) + + (define-mode-local-override semantic-get-local-variables c++-mode () "Do what `semantic-get-local-variables' does, plus add `this' if needed." (let* ((origvar (semantic-get-local-variables-default)) @@ -1693,6 +1979,52 @@ For types with a :parent, create faux namespaces to put TAG into." txt) (semantic-idle-summary-current-symbol-info-default)))) +(define-mode-local-override semantic--tag-similar-names-p c-mode (tag1 tag2 blankok) + "Compare the names of TAG1 and TAG2. +If BLANKOK is false, then the names must exactly match. +If BLANKOK is true, then always return t, as for C, the names don't matter +for arguments compared." + (if blankok t (semantic--tag-similar-names-p-default tag1 tag2 nil))) + +(define-mode-local-override semantic--tag-similar-types-p c-mode (tag1 tag2) + "For c-mode, deal with TAG1 and TAG2 being used in different namespaces. +In this case, one type will be shorter than the other. Instead +of fully resolving all namespaces currently in scope for both +types, we simply compare as many elements as the shorter type +provides." + ;; First, we see if the default method fails + (if (semantic--tag-similar-types-p-default tag1 tag2) + t + (let* ((names + (mapcar + (lambda (tag) + (let ((type (semantic-tag-type tag))) + (unless (stringp type) + (setq type (semantic-tag-name type))) + (setq type (semantic-analyze-split-name type)) + (when (stringp type) + (setq type (list type))) + type)) + (list tag1 tag2))) + (len1 (length (car names))) + (len2 (length (cadr names)))) + (cond + ((<= len1 len2) + (equal (nthcdr len1 (cadr names)) (car names))) + ((< len2 len1) + (equal (nthcdr len2 (car names)) (cadr names))))))) + + +(define-mode-local-override semantic--tag-attribute-similar-p c-mode + (attr value1 value2 ignorable-attributes) + "For c-mode, allow function :arguments to ignore the :name attributes." + (cond ((eq attr :arguments) + (semantic--tag-attribute-similar-p-default attr value1 value2 + (cons :name ignorable-attributes))) + (t + (semantic--tag-attribute-similar-p-default attr value1 value2 + ignorable-attributes)))) + (defvar-mode-local c-mode semantic-orphaned-member-metaparent-type "struct" "When lost members are found in the class hierarchy generator, use a struct.") @@ -1725,6 +2057,12 @@ For types with a :parent, create faux namespaces to put TAG into." (defvar-mode-local c-mode senator-step-at-tag-classes '(function variable) "Tag classes where senator will stop at the end.") +(defvar-mode-local c-mode semantic-tag-similar-ignorable-attributes + '(:prototype-flag :parent :typemodifiers) + "Tag attributes to ignore during similarity tests. +:parent is here because some tags might specify a parent, while others are +actually in their parent which is not accessible.") + ;;;###autoload (defun semantic-default-c-setup () "Set up a buffer for semantic parsing of the C language." @@ -1736,6 +2074,8 @@ For types with a :parent, create faux namespaces to put TAG into." (setq semantic-lex-analyzer #'semantic-c-lexer) (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t) + (when (eq major-mode 'c++-mode) + (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__cplusplus" . ""))) ) ;;;###autoload @@ -1759,7 +2099,7 @@ For types with a :parent, create faux namespaces to put TAG into." (defun semantic-c-describe-environment () "Describe the Semantic features of the current C environment." (interactive) - (if (not (or (eq major-mode 'c-mode) (eq major-mode 'c++-mode))) + (if (not (member 'c-mode (mode-local-equivalent-mode-p major-mode))) (error "Not useful to query C mode in %s mode" major-mode)) (let ((gcc (when (boundp 'semantic-gcc-setup-data) semantic-gcc-setup-data)) @@ -1780,13 +2120,20 @@ For types with a :parent, create faux namespaces to put TAG into." (princ "\n\nInclude Path Summary:\n") (when (and (boundp 'ede-object) ede-object) (princ "\n This file's project include is handled by:\n") - (princ " ") - (princ (object-print ede-object)) - (princ "\n with the system path:\n") - (dolist (dir (ede-system-include-path ede-object)) - (princ " ") - (princ dir) - (princ "\n")) + (let ((objs (if (listp ede-object) + ede-object + (list ede-object)))) + (dolist (O objs) + (princ " EDE : ") + (princ (object-print O)) + (let ((ipath (ede-system-include-path O))) + (if (not ipath) + (princ "\n with NO specified system include path.\n") + (princ "\n with the system path:\n") + (dolist (dir ipath) + (princ " ") + (princ dir) + (princ "\n")))))) ) (when semantic-dependency-include-path diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index 818b8b581a4..7bad1483dc3 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -944,8 +944,6 @@ ELisp variables can be pretty long, so track this one too.") "Setup hook function for Emacs Lisp files and Semantic." ) -(add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup) - ;;; LISP MODE ;; ;; @TODO: Lisp supports syntaxes that Emacs Lisp does not. @@ -956,7 +954,7 @@ ELisp variables can be pretty long, so track this one too.") ;; (add-hook 'lisp-mode-hook 'semantic-default-elisp-setup) -(eval-after-load "semanticdb" +(eval-after-load "semantic/db" '(require 'semantic/db-el) ) diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index 8b47ae14eee..842ef0914fd 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -33,30 +33,32 @@ ;;; Code: (defun semantic-gcc-query (gcc-cmd &rest gcc-options) - "Return program output to both standard output and standard error. + "Return program output or error code in case error happens. GCC-CMD is the program to execute and GCC-OPTIONS are the options to give to the program." ;; $ gcc -v ;; - (let ((buff (get-buffer-create " *gcc-query*")) - (old-lc-messages (getenv "LC_ALL"))) + (let* ((buff (get-buffer-create " *gcc-query*")) + (old-lc-messages (getenv "LC_ALL")) + (options `(,nil ,(cons buff t) ,nil ,@gcc-options)) + (err 0)) (with-current-buffer buff (erase-buffer) (setenv "LC_ALL" "C") (condition-case nil - (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options) + (setq err (apply 'call-process gcc-cmd options)) (error ;; Some bogus directory for the first time perhaps? (let ((default-directory (expand-file-name "~/"))) (condition-case nil - (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options) + (setq err (apply 'call-process gcc-cmd options)) (error ;; gcc doesn't exist??? nil))))) (setenv "LC_ALL" old-lc-messages) (prog1 - (buffer-string) - (kill-buffer buff) - ) - ))) + (if (zerop err) + (buffer-string) + err) + (kill-buffer buff))))) ;;(semantic-gcc-get-include-paths "c") ;;(semantic-gcc-get-include-paths "c++") @@ -148,7 +150,14 @@ It should also include other symbols GCC was compiled with.") (interactive) (let* ((fields (or semantic-gcc-setup-data (semantic-gcc-fields (semantic-gcc-query "gcc" "-v")))) - (defines (semantic-cpp-defs (semantic-gcc-query "cpp" "-E" "-dM" "-x" "c++" null-device))) + (cpp-options `("-E" "-dM" "-x" "c++" ,null-device)) + (query (let ((q (apply 'semantic-gcc-query "cpp" cpp-options))) + (if (stringp q) + q + ;; `cpp' command in `semantic-gcc-setup' doesn't work on + ;; Mac, try `gcc'. + (apply 'semantic-gcc-query "gcc" cpp-options)))) + (defines (semantic-cpp-defs query)) (ver (cdr (assoc 'version fields))) (host (or (cdr (assoc 'target fields)) (cdr (assoc '--target fields)) @@ -156,13 +165,14 @@ It should also include other symbols GCC was compiled with.") (prefix (cdr (assoc '--prefix fields))) ;; gcc output supplied paths (c-include-path (semantic-gcc-get-include-paths "c")) - (c++-include-path (semantic-gcc-get-include-paths "c++"))) + (c++-include-path (semantic-gcc-get-include-paths "c++")) + (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable)) + ) ;; Remember so we don't have to call GCC twice. (setq semantic-gcc-setup-data fields) - (unless c-include-path + (when (and (not c-include-path) gcc-exe) ;; Fallback to guesses (let* ( ;; gcc include dirs - (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable)) (gcc-root (expand-file-name ".." (file-name-directory gcc-exe))) (gcc-include (expand-file-name "include" gcc-root)) (gcc-include-c++ (expand-file-name "c++" gcc-include)) @@ -196,20 +206,24 @@ It should also include other symbols GCC was compiled with.") (semantic-add-system-include D 'c-mode)) (dolist (D (semantic-gcc-get-include-paths "c++")) (semantic-add-system-include D 'c++-mode) - (let ((cppconfig (concat D "/bits/c++config.h"))) - ;; Presumably there will be only one of these files in the try-paths list... - (when (file-readable-p cppconfig) + (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h")))) + (dolist (cur cppconfig) + ;; Presumably there will be only one of these files in the try-paths list... + (when (file-readable-p cur) ;; Add it to the symbol file (if (boundp 'semantic-lex-c-preprocessor-symbol-file) ;; Add to the core macro header list - (add-to-list 'semantic-lex-c-preprocessor-symbol-file cppconfig) + (add-to-list 'semantic-lex-c-preprocessor-symbol-file cur) ;; Setup the core macro header - (setq semantic-lex-c-preprocessor-symbol-file (list cppconfig))) - ))) + (setq semantic-lex-c-preprocessor-symbol-file (list cur))) + )))) (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map)) (setq semantic-lex-c-preprocessor-symbol-map nil)) (dolist (D defines) (add-to-list 'semantic-lex-c-preprocessor-symbol-map D)) + ;; Needed for parsing OS X libc + (when (eq system-type 'darwin) + (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__i386__" . ""))) (when (featurep 'semantic/bovine/c) (semantic-c-reset-preprocessor-symbol-map)) nil)) diff --git a/lisp/cedet/semantic/bovine/make-by.el b/lisp/cedet/semantic/bovine/make-by.el index ac38d1707c3..59738188bbe 100644 --- a/lisp/cedet/semantic/bovine/make-by.el +++ b/lisp/cedet/semantic/bovine/make-by.el @@ -19,13 +19,12 @@ ;;; Commentary: ;; -;; This file was generated from etc/grammars/make.by. +;; This file was generated from admin/grammars/make.by. ;;; Code: (require 'semantic/lex) (eval-when-compile (require 'semantic/bovine)) - ;;; Prologue ;; @@ -380,6 +379,13 @@ semantic-flex-keywords-obarray semantic-make-by--keyword-table )) + +;;; Analyzers +;; + +;;; Epilogue +;; + (provide 'semantic/bovine/make-by) ;;; semantic/bovine/make-by.el ends here diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el index 4098b2c0374..041e1f11902 100644 --- a/lisp/cedet/semantic/bovine/make.el +++ b/lisp/cedet/semantic/bovine/make.el @@ -27,6 +27,7 @@ (require 'make-mode) (require 'semantic) +(require 'semantic/bovine) (require 'semantic/bovine/make-by) (require 'semantic/analyze) (require 'semantic/dep) diff --git a/lisp/cedet/semantic/bovine/scm-by.el b/lisp/cedet/semantic/bovine/scm-by.el index d580a5fb22e..476945fa8a3 100644 --- a/lisp/cedet/semantic/bovine/scm-by.el +++ b/lisp/cedet/semantic/bovine/scm-by.el @@ -1,4 +1,4 @@ -;;; semantic-scm-by.el --- Generated parser support file +;;; semantic/bovine/scm-by.el --- Generated parser support file ;; Copyright (C) 2001, 2003, 2009-2012 Free Software Foundation, Inc. @@ -19,12 +19,11 @@ ;;; Commentary: ;; -;; This file was generated from etc/grammars/scm.by. +;; This file was generated from admin/grammars/scm.by. ;;; Code: (require 'semantic/lex) - (eval-when-compile (require 'semantic/bovine)) ;;; Prologue @@ -185,6 +184,13 @@ semantic-flex-keywords-obarray semantic-scm-by--keyword-table )) + +;;; Analyzers +;; + +;;; Epilogue +;; + (provide 'semantic/bovine/scm-by) ;;; semantic/bovine/scm-by.el ends here diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el index 5c4e2ae6d60..cf2b1f0e212 100644 --- a/lisp/cedet/semantic/bovine/scm.el +++ b/lisp/cedet/semantic/bovine/scm.el @@ -24,6 +24,7 @@ ;; Use the Semantic Bovinator for Scheme (guile) (require 'semantic) +(require 'semantic/bovine) (require 'semantic/bovine/scm-by) (require 'semantic/format) (require 'semantic/dep) @@ -37,7 +38,7 @@ This should probably do some sort of search to see what is actually on the local machine.") -(define-mode-local-override semantic-format-tag-prototype scheme-mode (tag) +(define-mode-local-override semantic-format-tag-prototype scheme-mode (tag &optional parent color) "Return a prototype for the Emacs Lisp nonterminal TAG." (let* ((tok (semantic-tag-class tag)) (args (semantic-tag-components tag)) @@ -46,7 +47,7 @@ actually on the local machine.") (concat (semantic-tag-name tag) " (" (mapconcat (lambda (a) a) args " ") ")") - (semantic-format-tag-prototype-default tag)))) + (semantic-format-tag-prototype-default tag parent color)))) (define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional nosnarf) "Return the documentation string for TAG. diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 18d4052eb43..61760dd3fe8 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -113,6 +113,7 @@ (require 'semantic/ctxt) (require 'semantic/decorate) (require 'semantic/format) +(require 'semantic/idle) (eval-when-compile ;; For the semantic-find-tags-for-completion macro. @@ -685,7 +686,7 @@ a reasonable distance." (cond ;; EXIT when we are no longer in a good place. ((or (not (eq b (current-buffer))) - (< (point) s) + (<= (point) s) (> (point) e)) ;;(message "Exit: %S %S %S" s e (point)) (semantic-complete-inline-exit) @@ -904,13 +905,44 @@ a completion displayor object, and tracking the current progress of a completion." :abstract t) +;;; Smart completion collector +(defclass semantic-collector-analyze-completions (semantic-collector-abstract) + ((context :initarg :context + :type semantic-analyze-context + :documentation "An analysis context. +Specifies some context location from whence completion lists will be drawn." + ) + (first-pass-completions :type list + :documentation "List of valid completion tags. +This list of tags is generated when completion starts. All searches +derive from this list.") + ) + "Completion engine that uses the context analyzer to provide options. +The only options available for completion are those which can be logically +inserted into the current context.") + +(defmethod semantic-collector-calculate-completions-raw + ((obj semantic-collector-analyze-completions) prefix completionlist) + "calculate the completions for prefix from completionlist." + ;; if there are no completions yet, calculate them. + (if (not (slot-boundp obj 'first-pass-completions)) + (oset obj first-pass-completions + (semantic-analyze-possible-completions (oref obj context)))) + ;; search our cached completion list. make it look like a semanticdb + ;; results type. + (list (cons (with-current-buffer (oref (oref obj context) buffer) + semanticdb-current-table) + (semantic-find-tags-for-completion + prefix + (oref obj first-pass-completions))))) + (defmethod semantic-collector-cleanup ((obj semantic-collector-abstract)) "Clean up any mess this collector may have." nil) (defmethod semantic-collector-next-action ((obj semantic-collector-abstract) partial) - "What should we do next? OBJ can predict a next good action. + "What should we do next? OBJ can be used to determine the next action. PARTIAL indicates if we are doing a partial completion." (if (and (slot-boundp obj 'last-completion) (string= (semantic-completion-text) (oref obj last-completion))) @@ -966,21 +998,38 @@ Output must be in semanticdb Find result format." "Calculate completions for prefix as setup for other queries." (let* ((case-fold-search semantic-case-fold) (same-prefix-p (semantic-collector-last-prefix= obj prefix)) + (last-prefix (and (slot-boundp obj 'last-prefix) + (oref obj last-prefix))) (completionlist - (if (or same-prefix-p - (and (slot-boundp obj 'last-prefix) - (eq (compare-strings (oref obj last-prefix) 0 nil - prefix 0 (length prefix)) - t))) - ;; New prefix is subset of old prefix - (oref obj last-all-completions) - (semantic-collector-get-cache obj))) + (cond ((or same-prefix-p + (and last-prefix (eq (compare-strings + last-prefix 0 nil + prefix 0 (length last-prefix)) t))) + ;; We have the same prefix, or last-prefix is a + ;; substring of the of new prefix, in which case we are + ;; refining our symbol so just re-use cache. + (oref obj last-all-completions)) + ((and last-prefix + (> (length prefix) 1) + (eq (compare-strings + prefix 0 nil + last-prefix 0 (length prefix)) t)) + ;; The new prefix is a substring of the old + ;; prefix, and it's longer than one character. + ;; Perform a full search to pull in additional + ;; matches. + (let ((context (semantic-analyze-current-context (point)))) + ;; Set new context and make first-pass-completions + ;; unbound so that they are newly calculated. + (oset obj context context) + (when (slot-boundp obj 'first-pass-completions) + (slot-makeunbound obj 'first-pass-completions))) + nil))) ;; Get the result (answer (if same-prefix-p completionlist (semantic-collector-calculate-completions-raw - obj prefix completionlist)) - ) + obj prefix completionlist))) (completion nil) (complete-not-uniq nil) ) @@ -1153,7 +1202,7 @@ NEWCACHE is the new tag table, but we ignore it." (semantic-collector-buffer-abstract) () "Completion engine for tags in the current buffer. -When searching for a tag, uses semantic deep searche functions. +When searching for a tag, uses semantic deep search functions. Basics search only in the current buffer.") (defmethod semantic-collector-calculate-cache @@ -1225,37 +1274,6 @@ Uses semanticdb for searching all tags in the current project." (semantic-find-tags-for-completion prefix localstuff))))) ;(semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path)))) -;;; Smart completion collector -(defclass semantic-collector-analyze-completions (semantic-collector-abstract) - ((context :initarg :context - :type semantic-analyze-context - :documentation "An analysis context. -Specifies some context location from whence completion lists will be drawn." - ) - (first-pass-completions :type list - :documentation "List of valid completion tags. -This list of tags is generated when completion starts. All searches -derive from this list.") - ) - "Completion engine that uses the context analyzer to provide options. -The only options available for completion are those which can be logically -inserted into the current context.") - -(defmethod semantic-collector-calculate-completions-raw - ((obj semantic-collector-analyze-completions) prefix completionlist) - "calculate the completions for prefix from completionlist." - ;; if there are no completions yet, calculate them. - (if (not (slot-boundp obj 'first-pass-completions)) - (oset obj first-pass-completions - (semantic-analyze-possible-completions (oref obj context)))) - ;; search our cached completion list. make it look like a semanticdb - ;; results type. - (list (cons (with-current-buffer (oref (oref obj context) buffer) - semanticdb-current-table) - (semantic-find-tags-for-completion - prefix - (oref obj first-pass-completions))))) - ;;; ------------------------------------------------------------ ;;; Tag List Display Engines @@ -1300,8 +1318,9 @@ a collector, and tracking tables of completion to display." (defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract)) "The next action to take on the minibuffer related to display." (if (and (slot-boundp obj 'last-prefix) - (string= (oref obj last-prefix) (semantic-completion-text)) - (eq last-command this-command)) + (or (eq this-command 'semantic-complete-inline-TAB) + (and (string= (oref obj last-prefix) (semantic-completion-text)) + (eq last-command this-command)))) 'scroll 'display)) @@ -1477,7 +1496,7 @@ one in the source buffer." (nt (semanticdb-normalize-one-tag rtable rtag)) (tag (cdr nt)) (table (car nt)) - ) + (curwin (selected-window))) ;; If we fail to normalize, reset. (when (not tag) (setq table rtable tag rtag)) ;; Do the focus. @@ -1502,17 +1521,14 @@ one in the source buffer." (switch-to-buffer-other-window buf t) (select-window (get-buffer-window buf))) ;; Now do some positioning - (unwind-protect - (if (semantic-tag-with-position-p tag) - ;; Full tag positional information available - (progn - (goto-char (semantic-tag-start tag)) - ;; This avoids a dangerous problem if we just loaded a tag - ;; from a file, but the original position was not updated - ;; in the TAG variable we are currently using. - (semantic-momentary-highlight-tag (semantic-current-tag)) - )) - (select-window (minibuffer-window))) + (when (semantic-tag-with-position-p tag) + ;; Full tag positional information available + (goto-char (semantic-tag-start tag)) + ;; This avoids a dangerous problem if we just loaded a tag + ;; from a file, but the original position was not updated + ;; in the TAG variable we are currently using. + (semantic-momentary-highlight-tag (semantic-current-tag))) + (select-window curwin) ;; Calculate text difference between contents and the focus item. (let* ((mbc (semantic-completion-text)) (ftn (semantic-tag-name tag)) @@ -1530,32 +1546,64 @@ one in the source buffer." ;; * Safe compatibility for tooltip free systems. ;; * Don't use 'avoid package for tooltip positioning. +;;;###autoload +(defcustom semantic-displayor-tooltip-mode 'standard + "Mode for the tooltip inline completion. + +Standard: Show only `semantic-displayor-tooltip-initial-max-tags' +number of completions initially. Pressing TAB will show the +extended set. + +Quiet: Only show completions when we have narrowed all +possibilities down to a maximum of +`semantic-displayor-tooltip-initial-max-tags' tags. Pressing TAB +multiple times will also show completions. + +Verbose: Always show all completions available. + +The absolute maximum number of completions for all mode is +determined through `semantic-displayor-tooltip-max-tags'." + :group 'semantic + :type '(choice (const :tag "Standard" standard) + (const :tag "Quiet" quiet) + (const :tag "Verbose" verbose))) + +;;;###autoload +(defcustom semantic-displayor-tooltip-initial-max-tags 5 + "Maximum number of tags to be displayed initially. +See doc-string of `semantic-displayor-tooltip-mode' for details." + :group 'semantic + :type 'integer) + +(defcustom semantic-displayor-tooltip-max-tags 25 + "The maximum number of tags to be displayed. +Maximum number of completions where we have activated the +extended completion list through typing TAB or SPACE multiple +times. This limit needs to fit on your screen! + +Note: If available, customizing this variable increases +'x-max-tooltip-size' to force over-sized tooltips when necessary. +This will not happen if you directly set this variable via +`setq'." + :group 'semantic + :type 'integer + :set '(lambda (sym var) + (set-default sym var) + (when (boundp 'x-max-tooltip-size) + (setcdr x-max-tooltip-size (max (1+ var) (cdr x-max-tooltip-size)))))) + + (defclass semantic-displayor-tooltip (semantic-displayor-traditional) - ((max-tags :type integer - :initarg :max-tags - :initform 5 - :custom integer - :documentation - "Max number of tags displayed on tooltip at once. -If `force-show' is 1, this value is ignored with typing tab or space twice continuously. -if `force-show' is 0, this value is always ignored.") - (force-show :type integer - :initarg :force-show - :initform 1 - :custom (choice (const - :tag "Show when double typing" - 1) - (const - :tag "Show always" - 0) - (const - :tag "Show if the number of tags is less than `max-tags'." - -1)) - :documentation - "Control the behavior of the number of tags is greater than `max-tags'. --1 means tags are never shown. -0 means the tags are always shown. -1 means tags are shown if space or tab is typed twice continuously.") + ((mode :initarg :mode + :initform + (symbol-value 'semantic-displayor-tooltip-mode) + :documentation + "See `semantic-displayor-tooltip-mode'.") + (max-tags-initial :initarg max-tags-initial + :initform + (symbol-value 'semantic-displayor-tooltip-initial-max-tags) + :documentation + "See `semantic-displayor-tooltip-initial-max-tags'.") (typing-count :type integer :initform 0 :documentation @@ -1563,7 +1611,7 @@ if `force-show' is 0, this value is always ignored.") (shown :type boolean :initform nil :documentation - "Flag representing whether tags is shown once or not.") + "Flag representing whether tooltip has been shown yet.") ) "Display completions options in a tooltip. Display mechanism using tooltip for a list of possible completions.") @@ -1583,50 +1631,63 @@ Display mechanism using tooltip for a list of possible completions.") (call-next-method) (let* ((tablelong (semanticdb-strip-find-results (oref obj table))) (table (semantic-unique-tag-table-by-name tablelong)) - (l (mapcar semantic-completion-displayor-format-tag-function table)) - (ll (length l)) + (completions (mapcar semantic-completion-displayor-format-tag-function table)) + (numcompl (length completions)) (typing-count (oref obj typing-count)) - (force-show (oref obj force-show)) + (mode (oref obj mode)) + (max-tags (oref obj max-tags-initial)) (matchtxt (semantic-completion-text)) - msg) - (if (or (oref obj shown) - (< ll (oref obj max-tags)) - (and (<= 0 force-show) - (< (1- force-show) typing-count))) - (progn - (oset obj typing-count 0) - (oset obj shown t) - (if (eq 1 ll) - ;; We Have only one possible match. There could be two cases. - ;; 1) input text != single match. - ;; --> Show it! - ;; 2) input text == single match. - ;; --> Complain about it, but still show the match. - (if (string= matchtxt (semantic-tag-name (car table))) - (setq msg (concat "[COMPLETE]\n" (car l))) - (setq msg (car l))) - ;; Create the long message. - (setq msg (mapconcat 'identity l "\n")) - ;; If there is nothing, say so! - (if (eq 0 (length msg)) - (setq msg "[NO MATCH]"))) - (semantic-displayor-tooltip-show msg)) - ;; The typing count determines if the user REALLY REALLY - ;; wanted to show that much stuff. Only increment - ;; if the current command is a completion command. - (if (and (stringp (this-command-keys)) - (string= (this-command-keys) "\C-i")) - (oset obj typing-count (1+ typing-count))) - ;; At this point, we know we have too many items. - ;; Let's be brave, and truncate l - (setcdr (nthcdr (oref obj max-tags) l) nil) - (setq msg (mapconcat 'identity l "\n")) + msg msg-tail) + ;; Keep a count of the consecutive completion commands entered by the user. + (if (and (stringp (this-command-keys)) + (string= (this-command-keys) "\C-i")) + (oset obj typing-count (1+ (oref obj typing-count))) + (oset obj typing-count 0)) + (cond + ((eq mode 'quiet) + ;; Switch back to standard mode if user presses key more than 5 times. + (when (>= (oref obj typing-count) 5) + (oset obj mode 'standard) + (setq mode 'standard) + (message "Resetting inline-mode to 'standard'.")) + (when (and (> numcompl max-tags) + (< (oref obj typing-count) 2)) + ;; Discretely hint at completion availability. + (setq msg "..."))) + ((eq mode 'verbose) + ;; Always show extended match set. + (oset obj max-tags semantic-displayor-tooltip-max-tags) + (setq max-tags semantic-displayor-tooltip-max-tags))) + (unless msg + (oset obj shown t) (cond - ((= force-show -1) - (semantic-displayor-tooltip-show (concat msg "\n..."))) - ((= force-show 1) - (semantic-displayor-tooltip-show (concat msg "\n(TAB for more)"))) - ))))) + ((> numcompl max-tags) + ;; We have too many items, be brave and truncate 'completions'. + (setcdr (nthcdr (1- max-tags) completions) nil) + (if (= max-tags semantic-displayor-tooltip-initial-max-tags) + (setq msg-tail (concat "\n[<TAB> " (number-to-string (- numcompl max-tags)) " more]")) + (setq msg-tail (concat "\n[<n/a> " (number-to-string (- numcompl max-tags)) " more]")) + (when (>= (oref obj typing-count) 2) + (message "Refine search to display results beyond the '%s' limit" + (symbol-name 'semantic-complete-inline-max-tags-extended))))) + ((= numcompl 1) + ;; two possible cases + ;; 1. input text != single match - we found a unique completion! + ;; 2. input text == single match - we found no additional matches, it's just the input text! + (when (string= matchtxt (semantic-tag-name (car table))) + (setq msg "[COMPLETE]\n"))) + ((zerop numcompl) + (oset obj shown nil) + ;; No matches, say so if in verbose mode! + (when semantic-idle-scheduler-verbose-flag + (setq msg "[NO MATCH]")))) + ;; Create the tooltip text. + (setq msg (concat msg (mapconcat 'identity completions "\n")))) + ;; Add any tail info. + (setq msg (concat msg msg-tail)) + ;; Display tooltip. + (when (not (eq msg "")) + (semantic-displayor-tooltip-show msg))))) ;;; Compatibility ;; @@ -1644,8 +1705,10 @@ Display mechanism using tooltip for a list of possible completions.") "Return the location of POINT as positioned on the selected frame. Return a cons cell (X . Y)" (let* ((frame (selected-frame)) - (left (frame-parameter frame 'left)) - (top (frame-parameter frame 'top)) + (left (or (car-safe (cdr-safe (frame-parameter frame 'left))) + (frame-parameter frame 'left))) + (top (or (car-safe (cdr-safe (frame-parameter frame 'top))) + (frame-parameter frame 'top))) (point-pix-pos (posn-x-y (posn-at-point))) (edges (window-inside-pixel-edges (selected-window)))) (cons (+ (car point-pix-pos) (car edges) left) @@ -1668,7 +1731,7 @@ Return a cons cell (X . Y)" (defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip)) "A request to for the displayor to scroll the completion list (if needed)." ;; Do scrolling in the tooltip. - (oset obj max-tags 30) + (oset obj max-tags-initial 30) (semantic-displayor-show-request obj) ) @@ -2151,6 +2214,23 @@ use `semantic-complete-analyze-inline' to complete." (error nil)) )) +;;;;###autoload +(defun semantic-complete-inline-project () + "Perform inline completion for any symbol in the current project. +`semantic-analyze-possible-completions' is used to determine the +possible values. +The function returns immediately, leaving the buffer in a mode that +will perform the completion." + (interactive) + ;; Only do this if we are not already completing something. + (if (not (semantic-completion-inline-active-p)) + (semantic-complete-inline-tag-project)) + ;; Report a message if things didn't startup. + (if (and (called-interactively-p 'interactive) + (not (semantic-completion-inline-active-p))) + (message "Inline completion not needed.")) + ) + (provide 'semantic/complete) ;; Local variables: diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 23410b1eb1b..281479045ea 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -39,6 +39,7 @@ (require 'eieio-base)) (declare-function semantic-elisp-desymbolify "semantic/bovine/el") +(declare-function semantic-tag-similar-p "semantic/tag-ls") ;;; Code: @@ -57,6 +58,11 @@ It does not need refreshing." "Return nil, we never need a refresh." nil) +(defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings) + "Pretty printer extension for `semanticdb-table-emacs-lisp'. +Adds the number of tags in this file to the object print name." + (apply 'call-next-method obj (cons " (proxy)" strings))) + (defclass semanticdb-project-database-emacs-lisp (semanticdb-project-database eieio-singleton) ((new-table-class :initform semanticdb-table-emacs-lisp @@ -66,6 +72,15 @@ It does not need refreshing." ) "Database representing Emacs core.") +(defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings) + "Pretty printer extension for `semanticdb-table-emacs-lisp'. +Adds the number of tags in this file to the object print name." + (let ((count 0)) + (mapatoms (lambda (sym) (setq count (1+ count)))) + (apply 'call-next-method obj (cons + (format " (%d known syms)" count) + strings)))) + ;; Create the database, and add it to searchable databases for Emacs Lisp mode. (defvar-mode-local emacs-lisp-mode semanticdb-project-system-databases (list @@ -159,9 +174,9 @@ If Emacs cannot resolve this symbol to a particular file, then return nil." (setq file (concat file ".gz")))) (let* ((tab (semanticdb-file-table-object file)) - (alltags (semanticdb-get-tags tab)) - (newtags (semanticdb-find-tags-by-name-method - tab (semantic-tag-name tag))) + (alltags (when tab (semanticdb-get-tags tab))) + (newtags (when tab (semanticdb-find-tags-by-name-method + tab (semantic-tag-name tag)))) (match nil)) ;; Find the best match. (dolist (T newtags) @@ -171,32 +186,12 @@ If Emacs cannot resolve this symbol to a particular file, then return nil." (when (not match) (setq match (car newtags))) ;; Return it. - (cons tab match))))) - -(defun semanticdb-elisp-sym-function-arglist (sym) - "Get the argument list for SYM. -Deal with all different forms of function. -This was snarfed out of eldoc." - (let* ((prelim-def - (let ((sd (and (fboundp sym) - (symbol-function sym)))) - (and (symbolp sd) - (condition-case err - (setq sd (indirect-function sym)) - (error (setq sd nil)))) - sd)) - (def (if (eq (car-safe prelim-def) 'macro) - (cdr prelim-def) - prelim-def)) - (arglist (cond ((null def) nil) - ((byte-code-function-p def) - ;; This is an eieio compatibility function. - ;; We depend on EIEIO, so use this. - (eieio-compiled-function-arglist def)) - ((eq (car-safe def) 'lambda) - (nth 1 def)) - (t nil)))) - arglist)) + (when tab (cons tab match)))))) + +(autoload 'help-function-arglist "help-fns") +(defalias 'semanticdb-elisp-sym-function-arglist 'help-function-arglist) +(make-obsolete 'semanticdb-elisp-sym-function-arglist + 'help-function-arglist "CEDET 1.1") (defun semanticdb-elisp-sym->tag (sym &optional toktype) "Convert SYM into a semantic tag. @@ -210,7 +205,7 @@ TOKTYPE is a hint to the type of tag desired." (symbol-name sym) nil ;; return type (semantic-elisp-desymbolify - (semanticdb-elisp-sym-function-arglist sym)) ;; arg-list + (help-function-arglist sym)) ;; arg-list :user-visible-flag (condition-case nil (interactive-form sym) (error nil)) diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index c487e39c7b2..7b4a47bd260 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -29,6 +29,9 @@ (require 'semantic/db) (require 'cedet-files) +(eval-when-compile + (require 'data-debug)) + (defvar semanticdb-file-version semantic-version "Version of semanticdb we are writing files to disk with.") (defvar semanticdb-file-incompatible-version "1.4" @@ -140,7 +143,7 @@ If DIRECTORY doesn't exist, create a new one." directory)) "/") :file fn :tables nil - :semantic-tag-version semantic-version + :semantic-tag-version semantic-tag-version :semanticdb-version semanticdb-file-version))) ;; Set this up here. We can't put it in the constructor because it ;; would be saved, and we want DB files to be portable. @@ -154,7 +157,7 @@ If DIRECTORY doesn't exist, create a new one." (defun semanticdb-load-database (filename) "Load the database FILENAME." (condition-case foo - (let* ((r (eieio-persistent-read filename)) + (let* ((r (eieio-persistent-read filename semanticdb-project-database-file)) (c (semanticdb-get-database-tables r)) (tv (oref r semantic-tag-version)) (fv (oref r semanticdb-version)) diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index 15ef3b09238..d42ecf7c4fc 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -123,6 +123,7 @@ (defvar data-debug-thing-alist) (declare-function data-debug-insert-stuff-list "data-debug") +(declare-function data-debug-new-buffer "data-debug") ;;;(declare-function data-debug-insert-tag-list "adebug") (declare-function semantic-scope-reset-cache "semantic/scope") (declare-function semanticdb-typecache-notify-reset "semantic/db-typecache") @@ -167,6 +168,8 @@ the following keys: :group 'semanticdb :type semanticdb-find-throttle-custom-list) +(make-variable-buffer-local 'semanticdb-find-default-throttle) + (defun semanticdb-find-throttle-active-p (access-type) "Non-nil if ACCESS-TYPE is an active throttle type." (or (memq access-type semanticdb-find-default-throttle) @@ -879,8 +882,9 @@ instead." ;; Find-file-match allows a tool to make sure the tag is ;; 'live', somewhere in a buffer. (cond ((eq find-file-match 'name) - (let ((f (semanticdb-full-filename nametable))) - (semantic--tag-put-property ntag :filename f))) + (or (semantic--tag-get-property ntag :filename) + (let ((f (semanticdb-full-filename nametable))) + (semantic--tag-put-property ntag :filename f)))) ((and find-file-match ntab) (semanticdb-get-buffer ntab)) ) @@ -1322,7 +1326,12 @@ Returns a table of all matching tags." "In TABLE, find all occurrences of tags of CLASS. Optional argument TAGS is a list of tags to search. Returns a table of all matching tags." - (semantic-find-tags-by-class class (or tags (semanticdb-get-tags table)))) + ;; Delegate 'include' to the overridable + ;; `semantic-find-tags-included', which by default will just call + ;; `semantic-find-tags-by-class'. + (if (eq class 'include) + (semantic-find-tags-included (or tags (semanticdb-get-tags table))) + (semantic-find-tags-by-class class (or tags (semanticdb-get-tags table))))) (defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags) "In TABLE, find all occurrences of tags whose parent is the PARENT type. diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el index eceb830341f..a7bb130810e 100644 --- a/lisp/cedet/semantic/db-global.el +++ b/lisp/cedet/semantic/db-global.el @@ -40,10 +40,17 @@ ;;; Code: ;;;###autoload -(defun semanticdb-enable-gnu-global-databases (mode) +(defun semanticdb-enable-gnu-global-databases (mode &optional noerror) "Enable the use of the GNU Global SemanticDB back end for all files of MODE. This will add an instance of a GNU Global database to each buffer -in a GNU Global supported hierarchy." +in a GNU Global supported hierarchy. + +Two sanity checks are performed to assure (a) that GNU global program exists +and (b) that the GNU global program version is compatibility with the database +version. If optional NOERROR is nil, then an error may be signalled on version +mismatch. If NOERROR is not nil, then no error will be signaled. Instead +return value will indicate success or failure with non-nil or nil respective +values." (interactive (list (completing-read "Enable in Mode: " obarray @@ -51,17 +58,18 @@ in a GNU Global supported hierarchy." t (symbol-name major-mode)))) ;; First, make sure the version is ok. - (cedet-gnu-global-version-check) - - ;; Make sure mode is a symbol. - (when (stringp mode) - (setq mode (intern mode))) - - (let ((ih (mode-local-value mode 'semantic-init-mode-hook))) - (eval `(setq-mode-local - ,mode semantic-init-mode-hook - (cons 'semanticdb-enable-gnu-global-hook ih)))) - + (if (not (cedet-gnu-global-version-check noerror)) + nil + ;; Make sure mode is a symbol. + (when (stringp mode) + (setq mode (intern mode))) + + (let ((ih (mode-local-value mode 'semantic-init-mode-hook))) + (eval `(setq-mode-local + ,mode semantic-init-mode-hook + (cons 'semanticdb-enable-gnu-global-hook ih)))) + t + ) ) (defun semanticdb-enable-gnu-global-hook () @@ -72,6 +80,8 @@ MODE is the major mode to support." (defclass semanticdb-project-database-global ;; @todo - convert to one DB per directory. (semanticdb-project-database eieio-instance-tracker) + + ;; @todo - use instance tracker symbol. () "Database representing a GNU Global tags file.") @@ -102,6 +112,11 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error." ) "A table for returning search results from GNU Global.") +(defmethod object-print ((obj semanticdb-table-global) &rest strings) + "Pretty printer extension for `semanticdb-table-global'. +Adds the number of tags in this file to the object print name." + (apply 'call-next-method obj (cons " (proxy)" strings))) + (defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer) "Return t, pretend that this table's mode is equivalent to BUFFER. Equivalent modes are specified by the `semantic-equivalent-major-modes' diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el index 4698949b5e0..0da98a6d357 100644 --- a/lisp/cedet/semantic/db-typecache.el +++ b/lisp/cedet/semantic/db-typecache.el @@ -483,6 +483,11 @@ found tag to be loaded." (setq ans nil))) ) + ;; The typecache holds all the known types and elements. Some databases + ;; may provide tags that are simplified by name, and are proxies. These + ;; proxies must be resolved in order to extract type members. + (setq ans (semantic-tag-resolve-proxy ans)) + (push ans calculated-scope) ;; Track most recent file. @@ -577,7 +582,11 @@ If there isn't one, create it. (interactive) (let* ((path (semanticdb-find-translate-path nil nil))) (dolist (P path) - (oset P pointmax nil) + (condition-case nil + (oset P pointmax nil) + ;; Pointmax may not exist for all tables discovered in the + ;; path. + (error nil)) (semantic-reset (semanticdb-get-typecache P))))) (defun semanticdb-typecache-dump () diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 4e09f9fc3f2..afac974d7fb 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -33,8 +33,15 @@ (require 'eieio-base) (require 'semantic) +(eval-when-compile + (require 'semantic/find)) + (declare-function semantic-lex-spp-save-table "semantic/lex-spp") +;; Use autoload to avoid recursive require of semantic/db-ref +(autoload 'semanticdb-refresh-references "semantic/db-ref" + "Refresh references to DBT in other files.") + ;;; Variables: (defgroup semanticdb nil "Parser Generator Persistent Database interface." @@ -80,6 +87,11 @@ same major mode as the current buffer.") :accessor semanticdb-get-tags :printer semantic-tag-write-list-slot-value :documentation "The tags belonging to this table.") + (db-refs :initform nil + :documentation + "List of `semanticdb-table' objects refering to this one. +These aren't saved, but are instead recalculated after load. +See the file semanticdb-ref.el for how this slot is used.") (index :type semanticdb-abstract-search-index :documentation "The search index. Used by semanticdb-find to store additional information about @@ -148,13 +160,16 @@ them to convert TAG into a more complete form." (cons obj tag)) (defmethod object-print ((obj semanticdb-abstract-table) &rest strings) - "Pretty printer extension for `semanticdb-table'. + "Pretty printer extension for `semanticdb-abstract-table'. Adds the number of tags in this file to the object print name." - (apply 'call-next-method obj - (cons (format " (%d tags)" - (length (semanticdb-get-tags obj)) - ) - strings))) + (if (or (not strings) + (and (= (length strings) 1) (stringp (car strings)) + (string= (car strings) ""))) + ;; Else, add a tags quantifier. + (call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj)))) + ;; Pass through. + (apply 'call-next-method obj strings) + )) ;;; Index Cache ;; @@ -201,8 +216,7 @@ If one doesn't exist, create it." ;; a semanticdb-table associated with a file. ;; (defclass semanticdb-search-results-table (semanticdb-abstract-table) - ( - ) + () "Table used for search results when there is no file or table association. Examples include search results from external sources such as from Emacs's own symbol table, or from external libraries.") @@ -299,7 +313,8 @@ If OBJ's file is not loaded, read it in first." "Pretty printer extension for `semanticdb-table'. Adds the number of tags in this file to the object print name." (apply 'call-next-method obj - (cons (if (oref obj dirty) ", DIRTY" "") strings))) + (cons (format " (%d tags)" (length (semanticdb-get-tags obj))) + (cons (if (oref obj dirty) ", DIRTY" "") strings)))) ;;; DATABASE BASE CLASS ;; @@ -324,7 +339,7 @@ so your cache will need to be recalculated at runtime. Note: This index will not be saved in a persistent file.") (tables :initarg :tables - :type list + :type semanticdb-abstract-table-list ;; Need this protection so apps don't try to access ;; the tables without using the accessor. :accessor semanticdb-get-database-tables @@ -416,7 +431,7 @@ If FILENAME exists in the database already, return that. If there is no database for the table to live in, create one." (let ((cdb nil) (tbl nil) - (dd (file-name-directory filename)) + (dd (file-name-directory (file-truename filename))) ) ;; Allow a database override function (setq cdb (semanticdb-create-database semanticdb-new-database-class @@ -555,7 +570,7 @@ This will call `semantic-fetch-tags' if that file is in memory." ;; semanticdb-create-table-for-file-not-in-buffer (save-excursion (let ((buff (semantic-find-file-noselect - (semanticdb-full-filename obj)))) + (semanticdb-full-filename obj) t))) (set-buffer buff) (semantic-fetch-tags) ;; Kill off the buffer if it didn't exist when we were called. @@ -620,7 +635,7 @@ The file associated with OBJ does not need to be in a buffer." ) ;; Update cross references - ;; (semanticdb-refresh-references table) + (semanticdb-refresh-references table) ) (defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table) @@ -650,8 +665,8 @@ The file associated with OBJ does not need to be in a buffer." ) ;; Update cross references - ;;(when (semantic-find-tags-by-class 'include new-tags) - ;; (semanticdb-refresh-references table)) + (when (semantic-find-tags-by-class 'include new-tags) + (semanticdb-refresh-references table)) ) ;;; SAVE/LOAD @@ -667,9 +682,11 @@ form." (defun semanticdb-save-current-db () "Save the current tag database." (interactive) - (message "Saving current tag summaries...") + (unless noninteractive + (message "Saving current tag summaries...")) (semanticdb-save-db semanticdb-current-database) - (message "Saving current tag summaries...done")) + (unless noninteractive + (message "Saving current tag summaries...done"))) ;; This prevents Semanticdb from querying multiple times if the users ;; answers "no" to creating the Semanticdb directory. @@ -678,10 +695,12 @@ form." (defun semanticdb-save-all-db () "Save all semantic tag databases." (interactive) - (message "Saving tag summaries...") + (unless noninteractive + (message "Saving tag summaries...")) (let ((semanticdb--inhibit-make-directory nil)) (mapc 'semanticdb-save-db semanticdb-database-list)) - (message "Saving tag summaries...done")) + (unless noninteractive + (message "Saving tag summaries...done"))) (defun semanticdb-save-all-db-idle () "Save all semantic tag databases from idle time. diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el index e88517b15ce..3c0bf877728 100644 --- a/lisp/cedet/semantic/debug.el +++ b/lisp/cedet/semantic/debug.el @@ -308,13 +308,13 @@ Argument ONOFF is non-nil when we are entering debug mode. ;; Install our map onto this buffer (use-local-map semantic-debug-mode-map) ;; Make the buffer read only - (toggle-read-only 1) + (setq buffer-read-only t) (set-buffer (oref iface source-buffer)) ;; Use our map in the source buffer also (use-local-map semantic-debug-mode-map) ;; Make the buffer read only - (toggle-read-only 1) + (setq buffer-read-only t) ;; Hooks (run-hooks 'semantic-debug-mode-hook) ) diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el index 50b50398e16..0c2c5e3ce37 100644 --- a/lisp/cedet/semantic/decorate/include.el +++ b/lisp/cedet/semantic/decorate/include.el @@ -175,6 +175,69 @@ Used by the decoration style: `semantic-decoration-on-unknown-includes'." :help "Add an include path for this session." ]) )) +;;; Includes with no file, but a table +;; +(defface semantic-decoration-on-fileless-includes + '((((class color) (background dark)) + (:background "#009000")) + (((class color) (background light)) + (:background "#f0fdf0"))) + "*Face used to show includes that have no file, but do have a DB table. +Used by the decoration style: `semantic-decoration-on-fileless-includes'." + :group 'semantic-faces) + +(defvar semantic-decoration-on-fileless-include-map + (let ((km (make-sparse-keymap))) + ;(define-key km [ mouse-2 ] 'semantic-decoration-fileless-include-describe) + (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-fileless-include-menu) + km) + "Keymap used on unparsed includes.") + +(defvar semantic-decoration-on-fileless-include-menu nil + "Menu used for unparsed include headers.") + +(easy-menu-define + semantic-decoration-on-fileless-include-menu + semantic-decoration-on-fileless-include-map + "Fileless Include Menu" + (list + "Fileless Include" + (semantic-menu-item + ["What Is This?" semantic-decoration-fileless-include-describe + :active t + :help "Describe why this include has been marked this way." ]) + (semantic-menu-item + ["List all unknown includes" semanticdb-find-adebug-lost-includes + :active t + :help "Show a list of all includes semantic cannot find for this file." ]) + "---" + (semantic-menu-item + ["Summarize includes current buffer" semantic-decoration-all-include-summary + :active t + :help "Show a summary for the current buffer containing this include." ]) + (semantic-menu-item + ["List found includes (load unparsed)" semanticdb-find-test-translate-path + :active t + :help "List all includes found for this file, and parse unparsed files." ]) + (semantic-menu-item + ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading + :active t + :help "List all includes found for this file, do not parse unparsed files." ]) + "---" + (semantic-menu-item + ["Customize System Include Path" semantic-customize-system-include-path + :active (get 'semantic-dependency-system-include-path major-mode) + :help "Run customize for the system include path for this major mode." ]) + (semantic-menu-item + ["Add a System Include Path" semantic-add-system-include + :active t + :help "Add an include path for this session." ]) + (semantic-menu-item + ["Remove a System Include Path" semantic-remove-system-include + :active t + :help "Add an include path for this session." ]) + )) + ;;; Includes that need to be parsed. ;; (defface semantic-decoration-on-unparsed-includes @@ -272,17 +335,22 @@ This mode provides a nice context menu on the include statements." (defun semantic-decoration-on-includes-highlight-default (tag) "Highlight the include TAG to show that semantic can't find it." (let* ((file (semantic-dependency-tag-file tag)) - (table (when file - (semanticdb-file-table-object file t))) + (table (semanticdb-find-table-for-include tag (current-buffer))) (face nil) (map nil) ) (cond - ((not file) + ((and (not file) (not table)) ;; Cannot find this header. (setq face 'semantic-decoration-on-unknown-includes map semantic-decoration-on-unknown-include-map) ) + ((and (not file) table) + ;; There is no file, but the language supports a table for this + ;; include. Import perhaps? System include with no file? + (setq face 'semantic-decoration-on-fileless-includes + map semantic-decoration-on-fileless-include-map) + ) ((and table (number-or-marker-p (oref table pointmax))) ;; A found and parsed file. (setq face 'semantic-decoration-on-includes @@ -319,7 +387,7 @@ This mode provides a nice context menu on the include statements." ;;; Regular Include Functions ;; (defun semantic-decoration-include-describe () - "Describe what unparsed includes are in the current buffer. + "Describe the current include tag. Argument EVENT is the mouse clicked event." (interactive) (let* ((tag (or (semantic-current-tag) @@ -421,7 +489,7 @@ Argument EVENT describes the event that caused this function to be called." ;;; Unknown Include functions ;; (defun semantic-decoration-unknown-include-describe () - "Describe what unknown includes are in the current buffer. + "Describe the current unknown include. Argument EVENT is the mouse clicked event." (interactive) (let ((tag (semantic-current-tag)) @@ -484,7 +552,7 @@ See the Semantic manual node on SemanticDB for more about search paths.") ))) (defun semantic-decoration-unknown-include-menu (event) - "Popup a menu that can help a user understand unparsed includes. + "Popup a menu that can help a user understand unknown includes. Argument EVENT describes the event that caused this function to be called." (interactive "e") (let* ((startwin (selected-window)) @@ -501,6 +569,49 @@ Argument EVENT describes the event that caused this function to be called." (select-window startwin))) +;;; Fileless Include functions +;; +(defun semantic-decoration-fileless-include-describe () + "Describe the current fileless include. +Argument EVENT is the mouse clicked event." + (interactive) + (let* ((tag (semantic-current-tag)) + (table (semanticdb-find-table-for-include tag (current-buffer))) + (mm major-mode)) + (with-output-to-temp-buffer (help-buffer) ; "*Help*" + (help-setup-xref (list #'semantic-decoration-fileless-include-describe) + (called-interactively-p 'interactive)) + (princ "Include Tag: ") + (princ (semantic-format-tag-name tag nil t)) + (princ "\n\n") + (princ "This header tag has been marked \"Fileless\". +This means that Semantic cannot find a file associated with this tag +on disk, but a database table of tags has been associated with it. + +This means that the include will still be used to find tags for +searches, but you cannot visit this include.\n\n") + (princ "This Header is now represented by the following database table:\n\n ") + (princ (object-print table)) + ))) + +(defun semantic-decoration-fileless-include-menu (event) + "Popup a menu that can help a user understand fileless includes. +Argument EVENT describes the event that caused this function to be called." + (interactive "e") + (let* ((startwin (selected-window)) + ;; This line has an issue in XEmacs. + (win (semantic-event-window event)) + ) + (select-window win t) + (save-excursion + ;(goto-char (window-start win)) + (mouse-set-point event) + (sit-for 0) + (semantic-popup-menu semantic-decoration-on-fileless-include-menu) + ) + (select-window startwin))) + + ;;; Interactive parts of unparsed includes ;; (defun semantic-decoration-unparsed-include-describe () @@ -667,6 +778,9 @@ Argument EVENT describes the event that caused this function to be called." (dolist (tag unk) (princ " ") (princ (semantic-tag-name tag)) + (when (not (eq (semantic-tag-name tag) (semantic-tag-include-filename tag))) + (princ " -> ") + (princ (semantic-tag-include-filename tag))) (princ "\n")) )) diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index f67978a2620..69dfa119167 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -265,6 +265,8 @@ minor mode is enabled." (semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook) (add-hook 'semantic-after-toplevel-cache-change-hook 'semantic-decorate-tags-after-full-reparse nil t) + ;; Decorate includes by default + (require 'semantic/decorate/include) ;; Add decorations to available tags. The above hooks ensure ;; that new tags will be decorated when they become available. (semantic-decorate-add-decorations (semantic-fetch-available-tags))) diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el index ddf1518f539..8a4e61fbad2 100644 --- a/lisp/cedet/semantic/doc.el +++ b/lisp/cedet/semantic/doc.el @@ -115,7 +115,10 @@ If NOSNARF is 'lex, then return the lex token." ;; In case it's a real string, STRIPIT. (while (string-match "\\s-*\\s\"+\\s-*" ct) (setq ct (concat (substring ct 0 (match-beginning 0)) - (substring ct (match-end 0)))))) + (substring ct (match-end 0))))) + ;; Remove comment delimiter at the end of the string. + (when (string-match (concat (regexp-quote comment-end) "$") ct) + (setq ct (substring ct 0 (match-beginning 0))))) ;; Now return the text. ct)))) diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index 0fc1829566c..c92fcabecb1 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -32,7 +32,7 @@ (require 'semantic/grammar) ;;; Code: -(defclass semantic-ede-proj-target-grammar (ede-proj-target-makefile) +(defclass semantic-ede-proj-target-grammar (ede-proj-target-elisp) ((menu :initform nil) (keybindings :initform nil) (phony :initform t) @@ -44,15 +44,33 @@ (semantic-ede-grammar-compiler-wisent semantic-ede-grammar-compiler-bovine )) + (aux-packages :initform '("semantic" "cedet-compat")) + (pre-load-packages :initform '("cedet-compat" "semantic/grammar" "semantic/bovine/grammar" "semantic/wisent/grammar")) ) "This target consists of a group of grammar files. A grammar target consists of grammar files that build Emacs Lisp programs for parsing different languages.") +(defmethod ede-proj-makefile-dependencies ((this semantic-ede-proj-target-grammar)) + "Return a string representing the dependencies for THIS. +Some compilers only use the first element in the dependencies, others +have a list of intermediates (object files), and others don't care. +This allows customization of how these elements appear. +For Emacs Lisp, return addsuffix command on source files." + (let ((source (car (oref this source)))) + (cond + ((string-match "\\.wy$" source) + (format "$(addsuffix -wy.elc, $(basename $(%s)))" + (ede-proj-makefile-sourcevar this))) + ((string-match "\\.by$" source) + (format "$(addsuffix -by.elc, $(basename $(%s)))" + (ede-proj-makefile-sourcevar this)))))) + (defvar semantic-ede-source-grammar-wisent (ede-sourcecode "semantic-ede-grammar-source-wisent" :name "Wisent Grammar" :sourcepattern "\\.wy$" + :garbagepattern '("*-wy.el") ) "Semantic Grammar source code definition for wisent.") @@ -64,21 +82,17 @@ parsing different languages.") (semantic-ede-grammar-compiler-class "ede-emacs-wisent-compiler" :name "emacs" - :variables '(("EMACS" . "emacs")) - :commands - '( - "@echo \"(add-to-list 'load-path nil)\" > grammar-make-script" - "@for loadpath in . ${LOADPATH}; do \\" - " echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> grammar-make-script; \\" - "done;" - "@echo \"(require 'semantic/load)\" >> grammar-make-script" - "@echo \"(require 'semantic/grammar)\" >> grammar-make-script" - ;; "@echo \"(setq debug-on-error t)\" >> grammar-make-script" - "\"$(EMACS)\" -batch --no-site-file -l grammar-make-script -f semantic-grammar-batch-build-packages $^" - ) - ;; :autoconf '("AM_PATH_LISPDIR") + :variables '(("EMACS" . "emacs") + ("EMACSFLAGS" . "-batch --no-site-file --eval '(setq debug-on-error t)'") + ("require" . "$(foreach r,$(1),(require (quote $(r))))")) + :rules (list (ede-makefile-rule + "elisp-inference-rule" + :target "%-wy.el" + :dependencies "%.wy" + :rules '("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \ +--eval '(progn $(call require,$(PRELOADS)))' -f semantic-grammar-batch-build-packages $^"))) :sourcetype '(semantic-ede-source-grammar-wisent) - :objectextention "-wy.elc" + :objectextention "-wy.el" ) "Compile Emacs Lisp programs.") @@ -87,6 +101,7 @@ parsing different languages.") (ede-sourcecode "semantic-ede-grammar-source-bovine" :name "Bovine Grammar" :sourcepattern "\\.by$" + :garbagepattern '("*-by.el") ) "Semantic Grammar source code definition for the bovinator.") @@ -94,21 +109,17 @@ parsing different languages.") (semantic-ede-grammar-compiler-class "ede-emacs-wisent-compiler" :name "emacs" - :variables '(("EMACS" . "emacs")) - :commands - '( - "@echo \"(add-to-list 'load-path nil)\" > grammar-make-script" - "@for loadpath in . ${LOADPATH}; do \\" - " echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> grammar-make-script; \\" - "done;" - "@echo \"(require 'semantic/load)\" >> grammar-make-script" - "@echo \"(require 'semantic/grammar)\" >> grammar-make-script" - ;; "@echo \"(setq debug-on-error t)\" >> grammar-make-script" - "\"$(EMACS)\" -batch --no-site-file -l grammar-make-script -f semantic-grammar-batch-build-packages $^" - ) - ;; :autoconf '("AM_PATH_LISPDIR") + :variables '(("EMACS" . "emacs") + ("EMACSFLAGS" . "-batch --no-site-file --eval '(setq debug-on-error t)'") + ("require" . "$(foreach r,$(1),(require (quote $(r))))")) + :rules (list (ede-makefile-rule + "elisp-inference-rule" + :target "%-by.el" + :dependencies "%.by" + :rules '("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \ +--eval '(progn $(call require,$(PRELOADS)))' -f semantic-grammar-batch-build-packages $^"))) :sourcetype '(semantic-ede-source-grammar-bovine) - :objectextention "-by.elc" + :objectextention "-by.el" ) "Compile Emacs Lisp programs.") @@ -127,15 +138,34 @@ Lays claim to all -by.el, and -wy.el files." "Compile all sources in a Lisp target OBJ." (let* ((cb (current-buffer)) (proj (ede-target-parent obj)) - (default-directory (oref proj directory))) + (default-directory (oref proj directory)) + (comp 0) + (utd 0)) (mapc (lambda (src) (with-current-buffer (find-file-noselect src) (save-excursion (semantic-grammar-create-package)) + ;; After compile, the current buffer is the compiled grammar. + ;; Save and compile it. (save-buffer) - (byte-recompile-file (concat (semantic-grammar-package) ".el") nil 0))) - (oref obj source))) - (message "All Semantic Grammar sources are up to date in %s" (object-name obj))) + (let* ((src (buffer-file-name)) + (csrc (concat (file-name-sans-extension src) ".elc"))) + (if (< emacs-major-version 24) + ;; Does not have `byte-recompile-file' + (if (or (not (file-exists-p csrc)) + (file-newer-than-file-p src csrc)) + (progn + (setq comp (1+ comp)) + (byte-compile-file src)) + (setq utd (1+ utd))) + ;; Emacs 24 and newer + (with-no-warnings + (if (eq (byte-recompile-file src nil 0) t) + (setq comp (1+ comp)) + (setq utd (1+ utd)))))))) + (oref obj source)) + (message "All Semantic Grammar sources are up to date in %s" (object-name obj)) + (cons comp utd))) ;;; Makefile generation functions ;; @@ -164,18 +194,13 @@ Lays claim to all -by.el, and -wy.el files." " "))) ) -(defmethod ede-proj-makefile-insert-rules ((this semantic-ede-proj-target-grammar)) - "Insert rules needed by THIS target." - ;; Add in some dependencies. -;; (mapc (lambda (src) -;; (let ((nm (file-name-sans-extension src))) -;; (insert nm "-wy.el: " src "\n" -;; nm "-wy.elc: " nm "-wy.el\n\n") -;; )) -;; (oref this source)) - ;; Call the normal insertion of rules. - (call-next-method) - ) +(defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar)) + "Insert rules needed by THIS target. +This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be +needed for the compilation of the resulting parsers." + (insert (format "%s: EMACSFLAGS+= --eval '(setq max-specpdl-size 1500 \ +max-lisp-eval-depth 700)'\n" + (oref this name)))) (defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar)) "Insert dist dependencies, or intermediate targets. diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el index ce7ba9926d2..5c724a96d40 100644 --- a/lisp/cedet/semantic/find.el +++ b/lisp/cedet/semantic/find.el @@ -49,6 +49,7 @@ (require 'semantic/tag) (declare-function semantic-tag-protected-p "semantic/tag-ls") +(declare-function semantic-tag-package-protected-p "semantic/tag-ls") ;;; Overlay Search Routines ;; @@ -362,12 +363,19 @@ See `semantic-tag-protected-p' for details on which tags are returned." table (require 'semantic/tag-ls) (semantic--find-tags-by-macro - (not (semantic-tag-protected-p (car tags) scopeprotection parent)) + (not (and (semantic-tag-protected-p (car tags) scopeprotection parent) + (semantic-tag-package-protected-p (car tags) parent))) table))) -(defsubst semantic-find-tags-included (&optional table) +;;;###autoload +(define-overloadable-function semantic-find-tags-included (&optional table) "Find all tags in TABLE that are of the 'include class. -TABLE is a tag table. See `semantic-something-to-tag-table'." +TABLE is a tag table. See `semantic-something-to-tag-table'.") + +(defun semantic-find-tags-included-default (&optional table) + "Find all tags in TABLE that are of the 'include class. +TABLE is a tag table. See `semantic-something-to-tag-table'. +By default, just call `semantic-find-tags-by-class'." (semantic-find-tags-by-class 'include table)) ;;; Deep Searches diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 851d5cd9e8e..5a12047eb76 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -33,42 +33,140 @@ (load "semantic/loaddefs" nil 'nomessage) ;;; Compatibility - -(defalias 'semantic-buffer-local-value 'buffer-local-value) -(defalias 'semantic-overlay-live-p 'overlay-buffer) -(defalias 'semantic-make-overlay 'make-overlay) -(defalias 'semantic-overlay-put 'overlay-put) -(defalias 'semantic-overlay-get 'overlay-get) -(defalias 'semantic-overlay-properties 'overlay-properties) -(defalias 'semantic-overlay-move 'move-overlay) -(defalias 'semantic-overlay-delete 'delete-overlay) -(defalias 'semantic-overlays-at 'overlays-at) -(defalias 'semantic-overlays-in 'overlays-in) -(defalias 'semantic-overlay-buffer 'overlay-buffer) -(defalias 'semantic-overlay-start 'overlay-start) -(defalias 'semantic-overlay-end 'overlay-end) -(defalias 'semantic-overlay-size 'overlay-size) -(defalias 'semantic-overlay-next-change 'next-overlay-change) -(defalias 'semantic-overlay-previous-change 'previous-overlay-change) -(defalias 'semantic-overlay-lists 'overlay-lists) -(defalias 'semantic-overlay-p 'overlayp) -(defalias 'semantic-read-event 'read-event) -(defalias 'semantic-popup-menu 'popup-menu) -(defalias 'semantic-make-local-hook 'identity) -(defalias 'semantic-mode-line-update 'force-mode-line-update) -(defalias 'semantic-run-mode-hooks 'run-mode-hooks) -(defalias 'semantic-compile-warn 'byte-compile-warn) -(defalias 'semantic-menu-item 'identity) - -(defun semantic-event-window (event) - "Extract the window from EVENT." - (car (car (cdr event)))) +;; +(eval-and-compile + (if (featurep 'xemacs) + (progn + (defalias 'semantic-buffer-local-value 'symbol-value-in-buffer) + (defalias 'semantic-overlay-live-p + (lambda (o) + (and (extent-live-p o) + (not (extent-detached-p o)) + (bufferp (extent-buffer o))))) + (defalias 'semantic-make-overlay + (lambda (beg end &optional buffer &rest rest) + "Xemacs `make-extent', supporting the front/rear advance options." + (let ((ol (make-extent beg end buffer))) + (when rest + (set-extent-property ol 'start-open (car rest)) + (setq rest (cdr rest))) + (when rest + (set-extent-property ol 'end-open (car rest))) + ol))) + (defalias 'semantic-overlay-put 'set-extent-property) + (defalias 'semantic-overlay-get 'extent-property) + (defalias 'semantic-overlay-properties 'extent-properties) + (defalias 'semantic-overlay-move 'set-extent-endpoints) + (defalias 'semantic-overlay-delete 'delete-extent) + (defalias 'semantic-overlays-at + (lambda (pos) + (condition-case nil + (extent-list nil pos pos) + (error nil)) + )) + (defalias 'semantic-overlays-in + (lambda (beg end) (extent-list nil beg end))) + (defalias 'semantic-overlay-buffer 'extent-buffer) + (defalias 'semantic-overlay-start 'extent-start-position) + (defalias 'semantic-overlay-end 'extent-end-position) + (defalias 'semantic-overlay-size 'extent-length) + (defalias 'semantic-overlay-next-change 'next-extent-change) + (defalias 'semantic-overlay-previous-change 'previous-extent-change) + (defalias 'semantic-overlay-lists + (lambda () (list (extent-list)))) + (defalias 'semantic-overlay-p 'extentp) + (defalias 'semantic-event-window 'event-window) + (defun semantic-read-event () + (let ((event (next-command-event))) + (if (key-press-event-p event) + (let ((c (event-to-character event))) + (if (char-equal c (quit-char)) + (keyboard-quit) + c))) + event)) + (defun semantic-popup-menu (menu) + "Blocking version of `popup-menu'" + (popup-menu menu) + ;; Wait... + (while (popup-up-p) (dispatch-event (next-event)))) + ) + ;; Emacs Bindings + (defalias 'semantic-overlay-live-p 'overlay-buffer) + (defalias 'semantic-make-overlay 'make-overlay) + (defalias 'semantic-overlay-put 'overlay-put) + (defalias 'semantic-overlay-get 'overlay-get) + (defalias 'semantic-overlay-properties 'overlay-properties) + (defalias 'semantic-overlay-move 'move-overlay) + (defalias 'semantic-overlay-delete 'delete-overlay) + (defalias 'semantic-overlays-at 'overlays-at) + (defalias 'semantic-overlays-in 'overlays-in) + (defalias 'semantic-overlay-buffer 'overlay-buffer) + (defalias 'semantic-overlay-start 'overlay-start) + (defalias 'semantic-overlay-end 'overlay-end) + (defalias 'semantic-overlay-next-change 'next-overlay-change) + (defalias 'semantic-overlay-previous-change 'previous-overlay-change) + (defalias 'semantic-overlay-lists 'overlay-lists) + (defalias 'semantic-overlay-p 'overlayp) + (defalias 'semantic-read-event 'read-event) + (defalias 'semantic-popup-menu 'popup-menu) + (defun semantic-event-window (event) + "Extract the window from EVENT." + (car (car (cdr event)))) + + (if (> emacs-major-version 21) + (defalias 'semantic-buffer-local-value 'buffer-local-value) + + (defun semantic-buffer-local-value (sym &optional buf) + "Get the value of SYM from buffer local variable in BUF." + (cdr (assoc sym (buffer-local-variables buf))))) + ) + + + (if (and (not (featurep 'xemacs)) + (>= emacs-major-version 21)) + (defalias 'semantic-make-local-hook 'identity) + (defalias 'semantic-make-local-hook 'make-local-hook) + ) + + (if (featurep 'xemacs) + (defalias 'semantic-mode-line-update 'redraw-modeline) + (defalias 'semantic-mode-line-update 'force-mode-line-update)) + + ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to + ;; run major mode hooks. + (defalias 'semantic-run-mode-hooks + (if (fboundp 'run-mode-hooks) + 'run-mode-hooks + 'run-hooks)) + + ;; Fancy compat usage now handled in cedet-compat + (defalias 'semantic-subst-char-in-string 'subst-char-in-string) + ) (defun semantic-delete-overlay-maybe (overlay) "Delete OVERLAY if it is a semantic token overlay." (if (semantic-overlay-get overlay 'semantic) (semantic-overlay-delete overlay))) +;;; Menu Item compatibility +;; +(defun semantic-menu-item (item) + "Build an XEmacs compatible menu item from vector ITEM. +That is remove the unsupported :help stuff." + (if (featurep 'xemacs) + (let ((n (length item)) + (i 0) + slot l) + (while (< i n) + (setq slot (aref item i)) + (if (and (keywordp slot) + (eq slot :help)) + (setq i (1+ i)) + (setq l (cons slot l))) + (setq i (1+ i))) + (apply #'vector (nreverse l))) + item)) + ;;; Positional Data Cache ;; (defvar semantic-cache-data-overlays nil @@ -138,6 +236,23 @@ Remove self from `post-command-hook' if it is empty." (when ans (semantic-overlay-get ans 'cached-value))))) +(defun semantic-test-data-cache () + "Test the data cache." + (interactive) + (let ((data '(a b c))) + (save-current-buffer + (set-buffer (get-buffer-create " *semantic-test-data-cache*")) + (save-excursion + (erase-buffer) + (insert "The Moose is Loose") + (goto-char (point-min)) + (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5) + data 'moose 'exit-cache-zone) + (if (equal (semantic-get-cache-data 'moose) data) + (message "Successfully retrieved cached data.") + (error "Failed to retrieve cached data")) + )))) + ;;; Obsoleting various functions & variables ;; (defun semantic-overload-symbol-from-function (name) @@ -161,7 +276,7 @@ will throw a warning when it encounters this symbol." (not (string-match "cedet" byte-compile-current-file)) ) (make-obsolete-overload oldfnalias newfn when) - (semantic-compile-warn + (byte-compile-warn "%s: `%s' obsoletes overload `%s'" byte-compile-current-file newfn @@ -179,7 +294,7 @@ will throw a warning when it encounters this symbol." ;; Only throw this warning when byte compiling things. (when (and (boundp 'byte-compile-current-file) byte-compile-current-file) - (semantic-compile-warn + (byte-compile-warn "variable `%s' obsoletes, but isn't alias of `%s'" newvar oldvaralias) )))) @@ -276,6 +391,17 @@ calling this one." "Call `find-file-noselect' with various features turned off. Use this when referencing a file that will be soon deleted. FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'" + ;; Hack - + ;; Check if we are in set-auto-mode, and if so, warn about this. + (when (or (and (featurep 'emacs) (boundp 'keep-mode-if-same)) + (and (featurep 'xemacs) (boundp 'just-from-file-name))) + (let ((filename (or (and (boundp 'filename) filename) + "(unknown)"))) + (message "WARNING: semantic-find-file-noselect called for \ +%s while in set-auto-mode for %s. You should call the responsible function \ +into `mode-local-init-hook'." file filename) + (sit-for 1))) + (let* ((recentf-exclude '( (lambda (f) t) )) ;; This is a brave statement. Don't waste time loading in ;; lots of modes. Especially decoration mode can waste a lot @@ -285,8 +411,11 @@ FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'" (ede-auto-add-method 'never) ;; Ask font-lock to not colorize these buffers, nor to ;; whine about it either. - (font-lock-maximum-size 0) + (global-font-lock-mode nil) (font-lock-verbose nil) + ;; This forces flymake to ignore this buffer on find-file, and + ;; prevents flymake processes from being started. + (flymake-start-syntax-check-on-find-file nil) ;; Disable revision control (vc-handled-backends nil) ;; Don't prompt to insert a template if we visit an empty file diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el index 7408dd6702e..8a33c8c8a1a 100644 --- a/lisp/cedet/semantic/grammar-wy.el +++ b/lisp/cedet/semantic/grammar-wy.el @@ -2,9 +2,6 @@ ;; Copyright (C) 2002-2004, 2009-2012 Free Software Foundation, Inc. -;; Author: David Ponce <david@dponce.com> -;; Keywords: syntax - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -27,6 +24,10 @@ ;;; Code: (require 'semantic/lex) +(eval-when-compile (require 'semantic/bovine)) + +;;; Prologue +;; (defvar semantic-grammar-lex-c-char-re) ;; Current parsed nonterminal name. @@ -45,6 +46,7 @@ ("%left" . LEFT) ("%nonassoc" . NONASSOC) ("%package" . PACKAGE) + ("%provide" . PROVIDE) ("%prec" . PREC) ("%put" . PUT) ("%quotemode" . QUOTEMODE) @@ -109,7 +111,7 @@ (eval-when-compile (require 'semantic/wisent/comp)) (wisent-compile-grammar - '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT) + '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT) nil (grammar ((prologue)) @@ -133,6 +135,7 @@ ((no_default_prec_decl)) ((languagemode_decl)) ((package_decl)) + ((provide_decl)) ((precedence_decl)) ((put_decl)) ((quotemode_decl)) @@ -161,6 +164,10 @@ ((PACKAGE SYMBOL) `(wisent-raw-tag (semantic-tag-new-package ',$2 nil)))) + (provide_decl + ((PROVIDE SYMBOL) + `(wisent-raw-tag + (semantic-tag ',$2 'provide)))) (precedence_decl ((associativity token_type_opt items) `(wisent-raw-tag @@ -411,31 +418,17 @@ '((parse-stream . wisent-parse-stream))) (setq semantic-parser-name "LALR" semantic--parse-table semantic-grammar-wy--parse-table - semantic-debug-parser-source "semantic-grammar.wy" + semantic-debug-parser-source "grammar.wy" semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table semantic-lex-types-obarray semantic-grammar-wy--token-table) ;; Collect unmatched syntax lexical tokens (semantic-make-local-hook 'wisent-discarding-token-functions) (add-hook 'wisent-discarding-token-functions - 'wisent-collect-unmatched-syntax nil t)) + 'wisent-collect-unmatched-syntax nil t)) ;;; Analyzers - -(define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer - "sexp analyzer for <sexp> tokens." - "\\=" - 'SEXP) - -(define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer - "sexp analyzer for <qlist> tokens." - "\\s'\\s-*(" - 'PREFIXED_LIST) - -(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer - "keyword analyzer for <keyword> tokens." - "\\(\\sw\\|\\s_\\)+") - +;; (define-lex-block-type-analyzer semantic-grammar-wy--<block>-block-analyzer "block analyzer for <block> tokens." "\\s(\\|\\s)" @@ -451,17 +444,22 @@ nil 'CHARACTER) -(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer - "sexp analyzer for <string> tokens." - "\\s\"" - 'STRING) - (define-lex-regex-type-analyzer semantic-grammar-wy--<symbol>-regexp-analyzer "regexp analyzer for <symbol> tokens." ":?\\(\\sw\\|\\s_\\)+" '((PERCENT_PERCENT . "\\`%%\\'")) 'SYMBOL) +(define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer + "sexp analyzer for <qlist> tokens." + "\\s'\\s-*(" + 'PREFIXED_LIST) + +(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer + "sexp analyzer for <string> tokens." + "\\s\"" + 'STRING) + (define-lex-string-type-analyzer semantic-grammar-wy--<punctuation>-string-analyzer "string analyzer for <punctuation> tokens." "\\(\\s.\\|\\s$\\|\\s'\\)+" @@ -472,6 +470,22 @@ (COLON . ":")) 'punctuation) +(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer + "keyword analyzer for <keyword> tokens." + "\\(\\sw\\|\\s_\\)+") + +(define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer + "sexp analyzer for <sexp> tokens." + "\\=" + 'SEXP) + + +;;; Epilogue +;; + + + + (provide 'semantic/grammar-wy) ;;; semantic/grammar-wy.el ends here diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index ac28702787d..b85396a79ae 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -30,10 +30,12 @@ ;;; Code: (require 'semantic) +(require 'semantic/wisent) (require 'semantic/ctxt) (require 'semantic/format) (require 'semantic/grammar-wy) (require 'semantic/idle) + (declare-function semantic-momentary-highlight-tag "semantic/decorate") (declare-function semantic-analyze-context "semantic/analyze") (declare-function semantic-analyze-tags-of-class-list @@ -42,7 +44,8 @@ (eval-when-compile (require 'eldoc) (require 'semantic/edit) - (require 'semantic/find)) + (require 'semantic/find) + (require 'semantic/db)) ;;;; @@ -488,33 +491,27 @@ Also load the specified macro libraries." ;;;; (defvar semantic--grammar-input-buffer nil) (defvar semantic--grammar-output-buffer nil) +(defvar semantic--grammar-package nil) +(defvar semantic--grammar-provide nil) (defsubst semantic-grammar-keywordtable () "Return the variable name of the keyword table." - (concat (file-name-sans-extension - (semantic-grammar-buffer-file - semantic--grammar-output-buffer)) + (concat semantic--grammar-package "--keyword-table")) (defsubst semantic-grammar-tokentable () "Return the variable name of the token table." - (concat (file-name-sans-extension - (semantic-grammar-buffer-file - semantic--grammar-output-buffer)) + (concat semantic--grammar-package "--token-table")) (defsubst semantic-grammar-parsetable () "Return the variable name of the parse table." - (concat (file-name-sans-extension - (semantic-grammar-buffer-file - semantic--grammar-output-buffer)) + (concat semantic--grammar-package "--parse-table")) (defsubst semantic-grammar-setupfunction () "Return the name of the parser setup function." - (concat (file-name-sans-extension - (semantic-grammar-buffer-file - semantic--grammar-output-buffer)) + (concat semantic--grammar-package "--install-parser")) (defmacro semantic-grammar-as-string (object) @@ -592,6 +589,9 @@ Typically a DEFINE expression should look like this: ;; ;;; Code: + +(require 'semantic/lex) +(eval-when-compile (require 'semantic/bovine)) ") "Generated header template. The symbols in the template are local variables in @@ -642,7 +642,8 @@ The symbols in the list are local variables in "Return text of a generated standard footer." (let* ((file (semantic-grammar-buffer-file semantic--grammar-output-buffer)) - (libr (file-name-sans-extension file)) + (libr (or semantic--grammar-provide + semantic--grammar-package)) (out "")) (dolist (S semantic-grammar-footer-template) (cond ((stringp S) @@ -748,9 +749,7 @@ Block definitions are read from the current table of lexical types." ;; explicitly declared in a %type statement, and if at least the ;; syntax property has been provided. (when (and declared syntax) - (setq prefix (file-name-sans-extension - (semantic-grammar-buffer-file - semantic--grammar-output-buffer)) + (setq prefix semantic--grammar-package mtype (or (get type 'matchdatatype) 'regexp) name (intern (format "%s--<%s>-%s-analyzer" prefix type mtype)) doc (format "%s analyzer for <%s> tokens." mtype type)) @@ -801,7 +800,6 @@ Block definitions are read from the current table of lexical types." (with-current-buffer semantic--grammar-input-buffer (setq tokens (semantic-grammar-tokens) props (semantic-grammar-token-properties tokens))) - (insert "(require 'semantic/lex)\n\n") (let ((semantic-lex-types-obarray (semantic-lex-make-type-table tokens props)) semantic-grammar--lex-block-specs) @@ -833,10 +831,14 @@ Lisp code." ;; Values of the following local variables are obtained from ;; the grammar parsed tree in current buffer, that is before ;; switching to the output file. - (package (semantic-grammar-package)) - (output (concat package ".el")) + (semantic--grammar-package (semantic-grammar-package)) + (semantic--grammar-provide (semantic-grammar-first-tag-name 'provide)) + (output (concat (or semantic--grammar-provide + semantic--grammar-package) ".el")) (semantic--grammar-input-buffer (current-buffer)) - (semantic--grammar-output-buffer (find-file-noselect output)) + (semantic--grammar-output-buffer + (find-file-noselect + (file-name-nondirectory output))) (header (semantic-grammar-header)) (prologue (semantic-grammar-prologue)) (epilogue (semantic-grammar-epilogue)) @@ -847,7 +849,7 @@ Lisp code." (file-newer-than-file-p (buffer-file-name semantic--grammar-output-buffer) (buffer-file-name semantic--grammar-input-buffer))) - (message "Package `%s' is up to date." package) + (message "Package `%s' is up to date." semantic--grammar-package) ;; Create the package (set-buffer semantic--grammar-output-buffer) ;; Use Unix EOLs, so that the file is portable to all platforms. @@ -965,7 +967,11 @@ Return non-nil if there were no errors, nil if errors." (let ((packagename (condition-case err (with-current-buffer (find-file-noselect file) - (semantic-grammar-create-package)) + (let ((semantic-new-buffer-setup-functions nil) + (vc-handled-backends nil)) + (setq semanticdb-new-database-class 'semanticdb-project-database) + (semantic-mode 1) + (semantic-grammar-create-package))) (error (message "%s" (error-message-string err)) nil)))) @@ -1000,7 +1006,6 @@ See also the variable `semantic-grammar-file-regexp'." ;; Remove vc from find-file-hook. It causes bad stuff to ;; happen in Emacs 20. (find-file-hook (delete 'vc-find-file-hook find-file-hook))) - (message "Compiling Grammars from: %s" (locate-library "semantic-grammar")) (dolist (arg command-line-args-left) (unless (and arg (file-exists-p arg)) (error "Argument %s is not a valid file name" arg)) diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index 1aedc7b6d45..9f6a82159e8 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el @@ -37,9 +37,10 @@ (require 'semantic/analyze) (require 'semantic/format) (require 'pulse) +(require 'semantic/senator) +(require 'semantic/analyze/refs) (eval-when-compile (require 'semantic/analyze) - (require 'semantic/analyze/refs) (require 'semantic/find)) (declare-function imenu--mouse-menu "imenu") @@ -143,11 +144,50 @@ Completion options are calculated with `semantic-analyze-possible-completions'." (mapcar semantic-ia-completion-format-tag-function syms))))))))) (defcustom semantic-ia-completion-menu-format-tag-function - 'semantic-uml-concise-prototype-nonterminal + 'semantic-format-tag-uml-concise-prototype "*Function used to convert a tag to a string during completion." :group 'semantic :type semantic-format-tag-custom-list) +;;;###autoload +(defun semantic-ia-complete-symbol-menu (point) + "Complete the current symbol via a menu based at POINT. +Completion options are calculated with `semantic-analyze-possible-completions'." + (interactive "d") + (require 'imenu) + (let* ((a (semantic-analyze-current-context point)) + (syms (semantic-analyze-possible-completions a)) + ) + ;; Complete this symbol. + (if (not syms) + (progn + (message "No smart completions found. Trying Senator.") + (when (semantic-analyze-context-p a) + ;; This is a quick way of getting a nice completion list + ;; in the menu if the regular context mechanism fails. + (senator-completion-menu-popup))) + + (let* ((menu + (mapcar + (lambda (tag) + (cons + (funcall semantic-ia-completion-menu-format-tag-function tag) + (vector tag))) + syms)) + (ans + (imenu--mouse-menu + ;; XEmacs needs that the menu has at least 2 items. So, + ;; include a nil item that will be ignored by imenu. + (cons nil menu) + (senator-completion-menu-point-as-event) + "Completions"))) + (when ans + (if (not (semantic-tag-p ans)) + (setq ans (aref (cdr ans) 0))) + (delete-region (car (oref a bounds)) (cdr (oref a bounds))) + (semantic-ia-insert-tag ans)) + )))) + ;;; Completions Tip ;; ;; This functions shows how to get the list of completions, diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 7ed1612d592..57cb17a233e 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -41,6 +41,7 @@ (require 'semantic/format) (require 'semantic/tag) (require 'timer) +;;(require 'working) ;; For the semantic-find-tags-by-name macro. (eval-when-compile (require 'semantic/find)) @@ -150,12 +151,18 @@ all buffers regardless of their size." "Return non-nil if idle-scheduler is enabled for this buffer. idle-scheduler is disabled when debugging or if the buffer size exceeds the `semantic-idle-scheduler-max-buffer-size' threshold." - (and semantic-idle-scheduler-mode - (not (and (boundp 'semantic-debug-enabled) - semantic-debug-enabled)) - (not semantic-lex-debug) - (or (<= semantic-idle-scheduler-max-buffer-size 0) - (< (buffer-size) semantic-idle-scheduler-max-buffer-size)))) + (let* ((remote-file? (when (stringp buffer-file-name) (file-remote-p buffer-file-name)))) + (and semantic-idle-scheduler-mode + (not (and (boundp 'semantic-debug-enabled) + semantic-debug-enabled)) + (not semantic-lex-debug) + ;; local file should exist on disk + ;; remote file should have active connection + (or (and (null remote-file?) (stringp buffer-file-name) + (file-exists-p buffer-file-name)) + (and remote-file? (file-remote-p buffer-file-name nil t))) + (or (<= semantic-idle-scheduler-max-buffer-size 0) + (< (buffer-size) semantic-idle-scheduler-max-buffer-size))))) ;;;###autoload (define-minor-mode semantic-idle-scheduler-mode @@ -554,10 +561,11 @@ FORMS will be called during idle time after the current buffer's semantic tag information has been updated. This routine creates the following functions and variables:" (let ((global (intern (concat "global-" (symbol-name name) "-mode"))) - (mode (intern (concat (symbol-name name) "-mode"))) - (hook (intern (concat (symbol-name name) "-mode-hook"))) - (map (intern (concat (symbol-name name) "-mode-map"))) - (func (intern (concat (symbol-name name) "-idle-function")))) + (mode (intern (concat (symbol-name name) "-mode"))) + (hook (intern (concat (symbol-name name) "-mode-hook"))) + (map (intern (concat (symbol-name name) "-mode-map"))) + (setup (intern (concat (symbol-name name) "-mode-setup"))) + (func (intern (concat (symbol-name name) "-idle-function")))) `(eval-and-compile (define-minor-mode ,global @@ -607,7 +615,10 @@ turned on in every Semantic-supported buffer.") (symbol-name mode) "'.") ,@forms)))) (put 'define-semantic-idle-service 'lisp-indent-function 1) - +(add-hook 'edebug-setup-hook + (lambda () + (def-edebug-spec define-semantic-idle-service + (&define name stringp def-body)))) ;;; SUMMARY MODE ;; @@ -878,7 +889,7 @@ Call `semantic-symref-hits-in-region' to identify local references." ;; We use pulse, but we don't want the flashy version, ;; just the stable version. (pulse-flag nil)) - (when ctxt + (when (and ctxt tag) ;; Highlight the original tag? Protect against problems. (condition-case nil (semantic-idle-symbol-maybe-highlight target) @@ -932,15 +943,18 @@ doing fancy completions." "Calculate and display a list of completions." (when (and (semantic-idle-summary-useful-context-p) (semantic-idle-completions-end-of-symbol-p)) - ;; This mode can be fragile. Ignore problems. - ;; If something doesn't do what you expect, run - ;; the below command by hand instead. - (condition-case nil + ;; This mode can be fragile, hence don't raise errors, and only + ;; report problems if semantic-idle-scheduler-verbose-flag is + ;; non-nil. If something doesn't do what you expect, run the + ;; below command by hand instead. + (condition-case err (semanticdb-without-unloaded-file-searches ;; Use idle version. (semantic-complete-analyze-inline-idle) ) - (error nil)) + (error + (when semantic-idle-scheduler-verbose-flag + (message " %s" (error-message-string err))))) )) (define-semantic-idle-service semantic-idle-completions @@ -1133,7 +1147,7 @@ be called." ;; :active t ;; :style 'toggle ;; :selected '(let ((tag (semantic-current-tag))) - ;; (and tag (semantic-tag-folded-p tag))) + ;; (and tag (semantic-tag-folded-p tag))) ;; :help "Fold the current tag to one line")) "---" (semantic-menu-item @@ -1168,17 +1182,19 @@ be called." ;; Format TAG-LIST and put the formatted string into the header ;; line. (setq header-line-format - (concat - semantic-idle-breadcrumbs-header-line-prefix - (if tag-list - (semantic-idle-breadcrumbs--format-tag-list - tag-list - (- width - (length semantic-idle-breadcrumbs-header-line-prefix))) - (propertize - "<not on tags>" - 'face - 'font-lock-comment-face))))) + (replace-regexp-in-string ;; Since % is interpreted in the + "\\(%\\)" "%\\1" ;; mode/header line format, we + (concat ;; have to escape all occurrences. + semantic-idle-breadcrumbs-header-line-prefix + (if tag-list + (semantic-idle-breadcrumbs--format-tag-list + tag-list + (- width + (length semantic-idle-breadcrumbs-header-line-prefix))) + (propertize + "<not on tags>" + 'face + 'font-lock-comment-face)))))) ;; Update the header line. (force-mode-line-update)) @@ -1192,7 +1208,9 @@ TODO THIS FUNCTION DOES NOT WORK YET." (let ((width (- (nth 2 (window-edges)) (nth 0 (window-edges))))) (setq mode-line-format - (semantic-idle-breadcrumbs--format-tag-list tag-list width))) + (replace-regexp-in-string ;; see comment in + "\\(%\\)" "%\\1" ;; `semantic-idle-breadcrumbs--display-in-header-line' + (semantic-idle-breadcrumbs--format-tag-list tag-list width)))) (force-mode-line-update)) diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el index 8747d793ab8..e560e6ecab2 100644 --- a/lisp/cedet/semantic/java.el +++ b/lisp/cedet/semantic/java.el @@ -121,6 +121,7 @@ corresponding compound declaration." (setq clone (semantic-tag-clone tag (car dim)) xpand (cons clone xpand)) (semantic-tag-put-attribute clone :dereference (cdr dim))) + ((eq class 'variable) (or (consp elts) (setq elts (list (list elts)))) (setq dim (semantic-java-dim (semantic-tag-get-attribute tag :type)) @@ -139,7 +140,20 @@ corresponding compound declaration." (semantic-tag-put-attribute clone :type type) (semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim))) (semantic-tag-set-bounds clone start end))) - ) + + ((and (eq class 'type) (string-match "\\." (semantic-tag-name tag))) + ;; javap outputs files where the package name is stuck onto the class or interface + ;; name. To make this more regular, we extract the package name into a package statement, + ;; then make the class name regular. + (let* ((name (semantic-tag-name tag)) + (rsplit (nreverse (split-string name "\\." t))) + (newclassname (car rsplit)) + (newpkg (mapconcat 'identity (reverse (cdr rsplit)) "."))) + (semantic-tag-set-name tag newclassname) + (setq xpand + (list tag + (semantic-tag-new-package newpkg nil)))) + )) xpand)) ;;; Environment @@ -159,6 +173,15 @@ corresponding compound declaration." (semantic-find-tags-by-class 'type (semantic-find-tag-by-overlay point)))) +;; Tag Protection +;; +(define-mode-local-override semantic-tag-protection + java-mode (tag &optional parent) + "Return the protection of TAG in PARENT. +Override function for `semantic-tag-protection'." + (let ((prot (semantic-tag-protection-default tag parent))) + (or prot 'package))) + ;; Prototype handler ;; (defun semantic-java-prototype-function (tag &optional parent color) @@ -242,7 +265,6 @@ Optional argument COLOR indicates that color should be mixed in." (let ((name (semantic-tag-name tag))) (concat (mapconcat 'identity (split-string name "\\.") "/") ".java"))) - ;; Documentation handler ;; (defsubst semantic-java-skip-spaces-backward () diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 5f121d88ac6..406f2900563 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -497,7 +497,7 @@ and what valid VAL values are." ;; (symbol "name" 569 . 573) ;; (semantic-list "(int in)" 574 . 582)) ;; - ;; In the second case, a macro with an argument list as the a rgs as the + ;; In the second case, a macro with an argument list as the args as the ;; first entry. ;; ;; CASE 3: Symbol text merge @@ -577,13 +577,7 @@ and what valid VAL values are." (cond ;; CASE 3: Merge symbols together. ((eq (semantic-lex-token-class v) 'spp-symbol-merge) - ;; We need to merge the tokens in the 'text segment together, - ;; and produce a single symbol from it. - (let ((newsym - (mapconcat (lambda (tok) - (semantic-lex-spp-one-token-to-txt tok)) - txt - ""))) + (let ((newsym (semantic-lex-spp-symbol-merge txt))) (semantic-lex-push-token (semantic-lex-token 'symbol beg end newsym)) )) @@ -637,6 +631,27 @@ and what valid VAL values are." (semantic-lex-spp-symbol-pop A)) )) +(defun semantic-lex-spp-symbol-merge (txt) + "Merge the tokens listed in TXT. +TXT might contain further 'spp-symbol-merge, which will +be merged recursively." + ;; We need to merge the tokens in the 'text segment together, + ;; and produce a single symbol from it. + (mapconcat (lambda (tok) + (cond + ((eq (car tok) 'symbol) + (semantic-lex-spp-one-token-to-txt tok)) + ((eq (car tok) 'spp-symbol-merge) + ;; Call recursively for multiple merges, like + ;; #define FOO(a) foo##a##bar + (semantic-lex-spp-symbol-merge (cadr tok))) + (t + (message "Invalid merge macro encountered; \ +will return empty string instead.") + ""))) + txt + "")) + ;;; Macro Merging ;; ;; Used when token streams from different macros include each other. @@ -869,7 +884,14 @@ Parsing starts inside the parens, and ends at the end of TOKEN." (forward-char 1) (setq fresh-toks (semantic-lex-spp-stream-for-macro (1- end))) (dolist (tok fresh-toks) - (when (memq (semantic-lex-token-class tok) '(symbol semantic-list)) + ;; march 2011: This is too restrictive! For example "void" + ;; can't get through. What elements was I trying to expunge + ;; to put this in here in the first place? If I comment it + ;; out, does anything new break? + ;(when (memq (semantic-lex-token-class tok) '(symbol semantic-list)) + ;; It appears the commas need to be dumped. perhaps this is better, + ;; but will it cause more problems later? + (unless (eq (semantic-lex-token-class tok) 'punctuation) (setq toks (cons tok toks)))) (nreverse toks))))) @@ -890,6 +912,7 @@ and variable state from the current buffer." (fresh-toks nil) (toks nil) (origbuff (current-buffer)) + (analyzer semantic-lex-analyzer) (important-vars '(semantic-lex-spp-macro-symbol-obarray semantic-lex-spp-project-macro-symbol-obarray semantic-lex-spp-dynamic-macro-symbol-obarray @@ -913,6 +936,11 @@ and variable state from the current buffer." ;; Hack in mode-local (activate-mode-local-bindings) + ;; Call the major mode's setup function + (let ((entry (assq major-mode semantic-new-buffer-setup-functions))) + (when entry + (funcall (cdr entry)))) + ;; CHEATER! The following 3 lines are from ;; `semantic-new-buffer-fcn', but we don't want to turn ;; on all the other annoying modes for this little task. diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index e47cc1eaee9..d7ab5911a67 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -691,20 +691,6 @@ Return the overlay." (semantic-overlay-put o 'face 'highlight) o)) -(defsubst semantic-lex-debug-break (token) - "Break during lexical analysis at TOKEN." - (when semantic-lex-debug - (let ((o nil)) - (unwind-protect - (progn - (when token - (setq o (semantic-lex-highlight-token token))) - (semantic-read-event - (format "%S :: SPC - continue" token)) - ) - (when o - (semantic-overlay-delete o)))))) - ;;; Lexical analyzer creation ;; ;; Code for creating a lex function from lists of analyzers. @@ -754,6 +740,20 @@ a LOCAL option.") ;;(defvar semantic-lex-timeout 5 ;; "*Number of sections of lexing before giving up.") +(defsubst semantic-lex-debug-break (token) + "Break during lexical analysis at TOKEN." + (when semantic-lex-debug + (let ((o nil)) + (unwind-protect + (progn + (when token + (setq o (semantic-lex-highlight-token token))) + (semantic-read-event + (format "%S :: Depth: %d :: SPC - continue" token semantic-lex-current-depth)) + ) + (when o + (semantic-overlay-delete o)))))) + (defmacro define-lex (name doc &rest analyzers) "Create a new lexical analyzer with NAME. DOC is a documentation string describing this analyzer. @@ -1205,11 +1205,13 @@ symbols returned in open and close tokens." )) )) ((setq match (assoc text ',clist)) - (setq semantic-lex-current-depth (1- semantic-lex-current-depth)) - (semantic-lex-push-token - (semantic-lex-token - (nth 1 match) - (match-beginning 0) (match-end 0))))))) + (if (> semantic-lex-current-depth 0) + (progn + (setq semantic-lex-current-depth (1- semantic-lex-current-depth)) + (semantic-lex-push-token + (semantic-lex-token + (nth 1 match) + (match-beginning 0) (match-end 0))))))))) ))) ;;; Analyzers diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el index 4216e099857..d042ba42582 100644 --- a/lisp/cedet/semantic/mru-bookmark.el +++ b/lisp/cedet/semantic/mru-bookmark.el @@ -53,6 +53,7 @@ (declare-function data-debug-new-buffer "data-debug") (declare-function data-debug-insert-object-slots "eieio-datadebug") (declare-function semantic-momentary-highlight-tag "semantic/decorate") +(declare-function semantic-tag-similar-p "semantic/tag-ls") ;;; TRACKING CORE ;; diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el index c5b07b9d440..0882120fc65 100644 --- a/lisp/cedet/semantic/scope.el +++ b/lisp/cedet/semantic/scope.el @@ -56,6 +56,7 @@ (declare-function semantic-analyze-princ-sequence "semantic/analyze") (declare-function semanticdb-typecache-merge-streams "semantic/db-typecache") (declare-function semanticdb-typecache-add-dependant "semantic/db-typecache") +(declare-function semantic-tag-similar-p "semantic/tag-ls") ;;; Code: @@ -158,7 +159,7 @@ If nil, then the typescope is reset." ;; tag can be passed in and a scope derived from it. (defun semantic-scope-tag-clone-with-scope (tag scopetags) - "Close TAG, and return it. Add SCOPETAGS as a tag-local scope. + "Clone TAG, and return it. Add SCOPETAGS as a tag-local scope. Stores the SCOPETAGS as a set of tag properties on the cloned tag." (let ((clone (semantic-tag-clone tag)) ) @@ -197,7 +198,7 @@ Use `semantic-ctxt-scoped-types' to find types." (semanticdb-typecache-find (car sp))) ;(semantic-analyze-find-tag (car sp) 'type)) ((semantic-tag-p (car sp)) - (if (semantic-analyze-tag-prototype-p (car sp)) + (if (semantic-tag-prototype-p (car sp)) (semanticdb-typecache-find (semantic-tag-name (car sp))) ;;(semantic-analyze-find-tag (semantic-tag-name (car sp)) 'type) (car sp))) @@ -271,9 +272,11 @@ are from nesting data types." (setq stack (reverse stack)) ;; Add things to STACK until we cease finding tags of class type. (while (and stack (eq (semantic-tag-class (car stack)) 'type)) - ;; Otherwise, just add this to the returnlist. - (setq returnlist (cons (car stack) returnlist)) - (setq stack (cdr stack))) + ;; Otherwise, just add this to the returnlist, but make + ;; sure we didn't already have that tag in scopetypes + (unless (member (car stack) scopetypes) + (setq returnlist (cons (car stack) returnlist))) + (setq stack (cdr stack))) (setq returnlist (nreverse returnlist)) )) diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index 1c8063134d6..540c766cc94 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -185,7 +185,7 @@ to perform the search. This was added for use by a test harness." ;;;###autoload (defun semantic-symref-find-tags-by-name (name &optional scope) - "Find a list of references to NAME in the current project. + "Find a list of tags by NAME in the current project. Optional SCOPE specifies which file set to search. Defaults to 'project. Refers to `semantic-symref-tool', to determine the reference tool to use for the current buffer. @@ -389,9 +389,11 @@ already." (forward-line (1- line)) ;; Search forward for the matching text - (re-search-forward (regexp-quote txt) - (point-at-eol) - t) + (when (re-search-forward (regexp-quote txt) + (point-at-eol) + t) + (goto-char (match-beginning 0)) + ) (setq tag (semantic-current-tag)) diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el index 57d628b2681..c6aa48bfbc3 100644 --- a/lisp/cedet/semantic/symref/filter.el +++ b/lisp/cedet/semantic/symref/filter.el @@ -85,6 +85,27 @@ Search occurs in the current buffer between START and END." (funcall hookfcn start end prefix))))) (point))))))) +(defun semantic-symref-test-count-hits-in-tag () + "Lookup in the current tag the symbol under point. +the count all the other references to the same symbol within the +tag that contains point, and return that." + (interactive) + (let* ((ctxt (semantic-analyze-current-context)) + (target (car (reverse (oref ctxt prefix)))) + (tag (semantic-current-tag)) + (start (current-time)) + (Lcount 0)) + (when (semantic-tag-p target) + (semantic-symref-hits-in-region + target (lambda (start end prefix) (setq Lcount (1+ Lcount))) + (semantic-tag-start tag) + (semantic-tag-end tag)) + (when (called-interactively-p 'interactive) + (message "Found %d occurrences of %s in %.2f seconds" + Lcount (semantic-tag-name target) + (semantic-elapsed-time start (current-time)))) + Lcount))) + (defun semantic-symref-rename-local-variable () "Fancy way to rename the local variable under point. Depends on the SRecode Field editing API." diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 9a3cb1f524a..55ccf1c103f 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -120,6 +120,7 @@ Display the references in`semantic-symref-results-mode'." (defvar semantic-symref-results-mode-map (let ((km (make-sparse-keymap))) + (suppress-keymap km) (define-key km "\C-i" 'forward-button) (define-key km "\M-C-i" 'backward-button) (define-key km " " 'push-button) diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el index e4c248934c3..094ea554287 100644 --- a/lisp/cedet/semantic/tag-ls.el +++ b/lisp/cedet/semantic/tag-ls.el @@ -30,9 +30,217 @@ ;; the information. (require 'semantic) +(require 'semantic/find) ;;; Code: +;;; TAG SIMILARITY: +;; +;; Two tags that represent the same thing are "similar", but not the "same". +;; Similar tags might have the same name, but one is a :prototype, while +;; the other is an implementation. +;; +;; Each language will have different things that can be ignored +;; between two "similar" tags, so similarity checks involve a series +;; of mode overridable features. Some are "internal" features. +(defvar semantic-tag-similar-ignorable-attributes '(:prototype-flag) + "The tag attributes that can be ignored during a similarity test.") + +(define-overloadable-function semantic--tag-similar-names-p (tag1 tag2 blankok) + "Compare the names of TAG1 and TAG2. +If BLANKOK is false, then the names must exactly match. +If BLANKOK is true, then if either of TAG1 or TAG2 has blank +names, then that is ok, and this returns true, but if they both +have values, they must still match.") + +(defun semantic--tag-similar-names-p-default (tag1 tag2 blankok) + "Compare the names of TAG1 and TAG2. +If BLANKOK is false, then the names must exactly match. +If BLANKOK is true, then if either of TAG1 or TAG2 has blank +names, then that is ok, and this returns true, but if they both +have values, they must still match." + (let ((n1 (semantic-tag-name tag1)) + (n2 (semantic-tag-name tag2))) + (or (and blankok (or (null n1) (null n2) (string= n1 "") (string= n2 ""))) + (string= n1 n2)))) + +(define-overloadable-function semantic--tag-similar-types-p (tag1 tag2) + "Compare the types of TAG1 and TAG2. +This function can be overridden, for example to compare a fully +qualified with an unqualified type." + (cond + ((and (null (semantic-tag-type tag1)) + (null (semantic-tag-type tag2))) + t) + ((or (null (semantic-tag-type tag1)) + (null (semantic-tag-type tag2))) + nil) + (t + (:override)))) + +(defun semantic--tag-similar-types-p-default (tag1 tag2) + "Compare the types of TAG1 and TAG2. +This function can be overridden, for example to compare a fully +qualified with an unqualified type." + (semantic-tag-of-type-p tag1 (semantic-tag-type tag2))) + +(define-overloadable-function semantic--tag-attribute-similar-p (attr value1 value2 ignorable-attributes) + "Test to see if attribute ATTR is similar for VALUE1 and VALUE2. +IGNORABLE-ATTRIBUTES is described in `semantic-tag-similar-p'. +This function is internal, but allows customization of `semantic-tag-similar-p' +for a given mode at a more granular level. + +Note that :type, :name, and anything in IGNORABLE-ATTRIBUTES will +not be passed to this function. + +Modes that override this function can call `semantic--tag-attribute-similar-p-default' +to do the default equality tests if ATTR is not special for that mode.") + +(defun semantic--tag-attribute-similar-p-default (attr value1 value2 ignorable-attributes) + "For ATTR, VALUE1, VALUE2 and IGNORABLE-ATTRIBUTES, test for similarity." + (cond + ;; Tag sublists require special testing. + ((and (listp value1) (semantic-tag-p (car value1)) + (listp value2) (semantic-tag-p (car value2))) + (let ((ans t) + (taglist1 value1) + (taglist2 value2)) + (when (not (eq (length taglist1) (length taglist2))) + (setq ans nil)) + (while (and ans taglist1 taglist2) + (setq ans (apply 'semantic-tag-similar-p + (car taglist1) (car taglist2) + ignorable-attributes) + taglist1 (cdr taglist1) + taglist2 (cdr taglist2))) + ans)) + + ;; The attributes are not the same? + ((not (equal value1 value2)) + nil) + + (t t)) + ) + +(define-overloadable-function semantic-tag-similar-p (tag1 tag2 &rest ignorable-attributes) + "Test to see if TAG1 and TAG2 are similar. +Two tags are similar if their name, datatype, and various attributes +are the same. + +Similar tags that have sub-tags such as arg lists or type members, +are similar w/out checking the sub-list of tags. +Optional argument IGNORABLE-ATTRIBUTES are attributes to ignore while comparing similarity. +By default, `semantic-tag-similar-ignorable-attributes' is referenced for +attributes, and IGNORABLE-ATTRIBUTES will augment this list. + +Note that even though :name is not an attribute, it can be used to +to indicate lax comparison of names via `semantic--tag-similar-names-p'") + +;; Note: optional thing is because overloadable fcns don't handle this +;; quite right. +(defun semantic-tag-similar-p-default (tag1 tag2 &optional ignorable-attributes) + "Test to see if TAG1 and TAG2 are similar. +Two tags are similar if their name, datatype, and various attributes +are the same. + +IGNORABLE-ATTRIBUTES are tag attributes that can be ignored. + +See `semantic-tag-similar-p' for details." + (let* ((ignore (append ignorable-attributes semantic-tag-similar-ignorable-attributes)) + (A1 (and (semantic--tag-similar-names-p tag1 tag2 (memq :name ignore)) + (semantic--tag-similar-types-p tag1 tag2) + (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)))) + (attr1 (semantic-tag-attributes tag1)) + (attr2 (semantic-tag-attributes tag2)) + (A2 t) + (A3 t) + ) + ;; Test if there are non-ignorable attributes in A2 which are not present in A1 + (while (and A2 attr2) + (let ((a (car attr2))) + (unless (or (eq a :type) (memq a ignore)) + (setq A2 (semantic-tag-get-attribute tag1 a))) + (setq attr2 (cdr (cdr attr2))))) + (while (and A2 attr1 A3) + (let ((a (car attr1))) + + (cond ((or (eq a :type) ;; already tested above. + (memq a ignore)) ;; Ignore them... + nil) + + (t + (setq A3 + (semantic--tag-attribute-similar-p + a (car (cdr attr1)) (semantic-tag-get-attribute tag2 a) + ignorable-attributes))) + )) + (setq attr1 (cdr (cdr attr1)))) + (and A1 A2 A3))) + +;;; FULL NAMES +;; +;; For programmer convenience, a full name is not specified in source +;; code. Instead some abbreviation is made, and the local environment +;; will contain the info needed to determine the full name. +(define-overloadable-function semantic-tag-full-package (tag &optional stream-or-buffer) + "Return the fully qualified package name of TAG in a package hierarchy. +STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream', +but must be a toplevel semantic tag stream that contains TAG. +A Package Hierarchy is defined in UML by the way classes and methods +are organized on disk. Some languages use this concept such that a +class can be accessed via it's fully qualified name, (such as Java.) +Other languages qualify names within a Namespace (such as C++) which +result in a different package like structure. + +Languages which do not override this function will just search the +stream for a tag of class 'package, and return that." + (let ((stream (semantic-something-to-tag-table + (or stream-or-buffer tag)))) + (:override-with-args (tag stream)))) + +(defun semantic-tag-full-package-default (tag stream) + "Default method for `semantic-tag-full-package' for TAG. +Return the name of the first tag of class `package' in STREAM." + (let ((pack (car-safe (semantic-find-tags-by-class 'package stream)))) + (when (and pack (semantic-tag-p pack)) + (semantic-tag-name pack)))) + +(define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer) + "Return the fully qualified name of TAG in the package hierarchy. +STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream', +but must be a toplevel semantic tag stream that contains TAG. +A Package Hierarchy is defined in UML by the way classes and methods +are organized on disk. Some languages use this concept such that a +class can be accessed via it's fully qualified name, (such as Java.) +Other languages qualify names within a Namespace (such as C++) which +result in a different package like structure. + +Languages which do not override this function with +`tag-full-name' will combine `semantic-tag-full-package' and +`semantic-tag-name', separated with language separator character. +Override functions only need to handle STREAM-OR-BUFFER with a +tag stream value, or nil. + +TODO - this function should probably also take a PARENT to TAG to +resolve issues where a method in a class in a package is present." + (let ((stream (semantic-something-to-tag-table + (or stream-or-buffer tag)))) + (:override-with-args (tag stream)))) + +(make-obsolete-overload 'semantic-nonterminal-full-name + 'semantic-tag-full-name "23.2") + +(defun semantic-tag-full-name-default (tag stream) + "Default method for `semantic-tag-full-name'. +Return the name of TAG found in the toplevel STREAM." + (let ((pack (semantic-tag-full-package tag stream)) + (name (semantic-tag-name tag))) + (if pack + (concat pack + (car semantic-type-relation-separator-character) + name) + name))) + ;;; UML features: ;; ;; UML can represent several types of features of a tag @@ -93,10 +301,38 @@ See `semantic-tag-protection'." ((string= s "private") 'private) ((string= s "protected") - 'protected))))) + 'protected) + ((string= s "package") + 'package) + )))) (setq mods (cdr mods))) prot)) +(defun semantic-tag-package-protected-p (tag &optional parent currentpackage) + "Non-nil if TAG is not available via package access control. +For languages (such as Java) where a method is package protected, +this method will return nil if TAG, as found in PARENT is available +for access from a file in CURRENTPACKAGE. +If TAG is not protected by PACKAGE, also return t. Use +`semantic-tag-protected-p' instead. +If PARENT is not provided, it will be derived when passed to +`semantic-tag-protection'. +If CURRENTPACKAGE is not provided, it will be derived from the current +buffer." + (let ((tagpro (semantic-tag-protection tag parent))) + (if (not (eq tagpro 'package)) + t ;; protected + + ;; package protection, so check currentpackage. + ;; Deriving the package is better from the parent, as TAG is + ;; probably a field or method. + (if (not currentpackage) + (setq currentpackage (semantic-tag-full-package nil (current-buffer)))) + (let ((tagpack (semantic-tag-full-package (or parent tag)))) + (if (string= currentpackage tagpack) + nil + t)) ))) + (defun semantic-tag-protected-p (tag protection &optional parent) "Non-nil if TAG is protected. PROTECTION is a symbol which can be returned by the method @@ -213,36 +449,6 @@ something without an implementation." (t nil)) )) -;;; FULL NAMES -;; -;; For programmer convenience, a full name is not specified in source -;; code. Instead some abbreviation is made, and the local environment -;; will contain the info needed to determine the full name. - -(define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer) - "Return the fully qualified name of TAG in the package hierarchy. -STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream', -but must be a toplevel semantic tag stream that contains TAG. -A Package Hierarchy is defined in UML by the way classes and methods -are organized on disk. Some language use this concept such that a -class can be accessed via it's fully qualified name, (such as Java.) -Other languages qualify names within a Namespace (such as C++) which -result in a different package like structure. Languages which do not -override this function with `tag-full-name' will use -`semantic-tag-name'. Override functions only need to handle -STREAM-OR-BUFFER with a tag stream value, or nil." - (let ((stream (semantic-something-to-tag-table - (or stream-or-buffer tag)))) - (:override-with-args (tag stream)))) - -(make-obsolete-overload 'semantic-nonterminal-full-name - 'semantic-tag-full-name "23.2") - -(defun semantic-tag-full-name-default (tag stream) - "Default method for `semantic-tag-full-name'. -Return the name of TAG found in the toplevel STREAM." - (semantic-tag-name tag)) - (provide 'semantic/tag-ls) ;; Local variables: diff --git a/lisp/cedet/semantic/tag-write.el b/lisp/cedet/semantic/tag-write.el index 757609fac3f..69d26245850 100644 --- a/lisp/cedet/semantic/tag-write.el +++ b/lisp/cedet/semantic/tag-write.el @@ -41,12 +41,12 @@ INDENT is the amount of indentation to use for this tag." (signal 'wrong-type-argument (list tag 'semantic-tag-p))) (when (not indent) (setq indent 0)) ;(princ (make-string indent ? )) - (princ "(\"") + (princ "(") ;; Base parts (let ((name (semantic-tag-name tag)) (class (semantic-tag-class tag))) - (princ name) - (princ "\" ") + (prin1 name) + (princ " ") (princ (symbol-name class)) ) (let ((attr (semantic-tag-attributes tag)) diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index 29e83cd558b..38166871cea 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -51,6 +51,7 @@ (declare-function semantic-analyze-split-name "semantic/analyze/fcn") (declare-function semantic-fetch-tags "semantic") (declare-function semantic-clear-toplevel-cache "semantic") +(declare-function semantic-tag-similar-p "semantic/tag-ls") (defconst semantic-tag-version "2.0" "Version string of semantic tags made with this code.") @@ -362,45 +363,6 @@ of different cons cells." (equal (semantic-tag-bounds tag1) (semantic-tag-bounds tag2)))))) -(defun semantic-tag-similar-p (tag1 tag2 &rest ignorable-attributes) - "Test to see if TAG1 and TAG2 are similar. -Two tags are similar if their name, datatype, and various attributes -are the same. - -Similar tags that have sub-tags such as arg lists or type members, -are similar w/out checking the sub-list of tags. -Optional argument IGNORABLE-ATTRIBUTES are attributes to ignore while comparing similarity." - (let* ((A1 (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2)) - (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)) - (semantic-tag-of-type-p tag1 (semantic-tag-type tag2)))) - (attr1 (semantic-tag-attributes tag1)) - (A2 (= (length attr1) (length (semantic-tag-attributes tag2)))) - (A3 t) - ) - (when (and (not A2) ignorable-attributes) - (setq A2 t)) - (while (and A2 attr1 A3) - (let ((a (car attr1)) - (v (car (cdr attr1)))) - - (cond ((or (eq a :type) ;; already tested above. - (memq a ignorable-attributes)) ;; Ignore them... - nil) - - ;; Don't test sublists of tags - ((and (listp v) (semantic-tag-p (car v))) - nil) - - ;; The attributes are not the same? - ((not (equal v (semantic-tag-get-attribute tag2 a))) - (setq A3 nil)) - (t - nil)) - ) - (setq attr1 (cdr (cdr attr1)))) - - (and A1 A2 A3) - )) (defun semantic-tag-similar-with-subtags-p (tag1 tag2 &rest ignorable-attributes) "Test to see if TAG1 and TAG2 are similar. @@ -408,28 +370,8 @@ Uses `semantic-tag-similar-p' but also recurses through sub-tags, such as argument lists and type members. Optional argument IGNORABLE-ATTRIBUTES is passed down to `semantic-tag-similar-p'." - (let ((C1 (semantic-tag-components tag1)) - (C2 (semantic-tag-components tag2)) - ) - (if (or (/= (length C1) (length C2)) - (not (semantic-tag-similar-p tag1 tag2 ignorable-attributes)) - ) - ;; Basic test fails. - nil - ;; Else, check component lists. - (catch 'component-dissimilar - (while C1 - - (if (not (semantic-tag-similar-with-subtags-p - (car C1) (car C2) ignorable-attributes)) - (throw 'component-dissimilar nil)) - - (setq C1 (cdr C1)) - (setq C2 (cdr C2)) - ) - ;; If we made it this far, we are ok. - t) ))) - + ;; DEPRECATE THIS. + (semantic-tag-similar-p tag1 tag2 ignorable-attributes)) (defun semantic-tag-of-type-p (tag type) "Compare TAG's type against TYPE. Non nil if equivalent. @@ -612,6 +554,51 @@ You can identify a faux tag with `semantic-tag-faux-p'" "Set TAG name to NAME." (setcar tag name)) +;;; TAG Proxies +;; +;; A new kind of tag is a TAG PROXY. These are tags that have some +;; minimal number of features set, such as name and class, but have a +;; marker in them that indicates how to complete them. +;; +;; To make the tags easier to view, the proxy is stored as custom +;; symbol that is not in the global obarray, but has properties set on +;; it. This prevents saving of massive amounts of proxy data. +(defun semantic-create-tag-proxy (function data) + "Create a tag proxy symbol. +FUNCTION will be used to resolve the proxy. It should take 3 +two arguments, DATA and TAG. TAG is a proxy tag that needs +to be resolved, and DATA is the DATA passed into this function. +DATA is data to help resolve the proxy. DATA can be an EIEIO object, +such that FUNCTION is a method. +FUNCTION should return a list of tags, preferably one tag." + (let ((sym (make-symbol ":tag-proxy"))) + (put sym 'proxy-function function) + (put sym 'proxy-data data) + sym)) + +(defun semantic-tag-set-proxy (tag proxy &optional filename) + "Set TAG to be a proxy. The proxy can be resolved with PROXY. +This function will also make TAG be a faux tag with +`semantic-tag-set-faux', and possibly set the tag's +:filename with FILENAME. +To create a proxy, see `semantic-create-tag-proxy'." + (semantic-tag-set-faux tag) + (semantic--tag-put-property tag :proxy proxy) + (when filename + (semantic--tag-put-property tag :filename filename))) + +(defun semantic-tag-resolve-proxy (tag) + "Resolve the proxy in TAG. +The return value is whatever format the proxy was setup as. +It should be a list of complete tags. +If TAG has no proxy, then just return tag." + (let* ((proxy (semantic--tag-get-property tag :proxy)) + (function (get proxy 'proxy-function)) + (data (get proxy 'proxy-data))) + (if proxy + (funcall function data tag) + tag))) + ;;; Copying and cloning tags. ;; (defsubst semantic-tag-clone (tag &optional name) @@ -1350,6 +1337,7 @@ of parent classes. The `cdr' of the list is the list of interfaces, or abstract classes which are parents of TAG." (cons (semantic-tag-get-attribute tag :superclasses) (semantic-tag-type-interfaces tag))) + (make-obsolete 'semantic-token-type-parent "\ use `semantic-tag-type-superclass' \ diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el index 36c14ce7c2a..9380940282f 100644 --- a/lisp/cedet/semantic/texi.el +++ b/lisp/cedet/semantic/texi.el @@ -451,6 +451,7 @@ that start with that symbol." (defvar semantic-imenu-bucketize-file) (defvar semantic-imenu-bucketize-type-members) +;;;###autoload (defun semantic-default-texi-setup () "Set up a buffer for parsing of Texinfo files." ;; This will use our parser. @@ -687,4 +688,9 @@ If TAG is nil, it is derived from the deffn under POINT." (provide 'semantic/texi) +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "semantic/texi" +;; End: + ;;; semantic/texi.el ends here diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index 1cc4d898a34..65201c4fd12 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -298,6 +298,7 @@ If TAG is not specified, use the tag at point." semantic-dump-parse semantic-type-relation-separator-character semantic-command-separation-character + semantic-new-buffer-fcn-was-run ))) (dolist (V vars) (semantic-describe-buffer-var-helper V buff))) diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 30dbafaa6cc..388c8f332a4 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -134,8 +134,11 @@ If optional LEFT is non-nil insert spaces on left." ;;;; ------------------------ (defconst wisent-BITS-PER-WORD - (let ((i 1)) - (while (not (zerop (lsh 1 i))) + (let ((i 1) + (do-shift (if (boundp 'most-positive-fixnum) + (lambda (i) (lsh most-positive-fixnum (- i))) + (lambda (i) (lsh 1 i))))) + (while (not (zerop (funcall do-shift i))) (setq i (1+ i))) i)) @@ -3539,4 +3542,12 @@ See also `wisent-compile-grammar' for more details on AUTOMATON." (provide 'semantic/wisent/comp) +;; Disable messages with regards to lexical scoping, since this will +;; produce a bunch of 'lacks a prefix' warnings with the +;; `wisent-defcontext' trickery above. + +;; Local variables: +;; byte-compile-warnings: (not lexical) +;; End: + ;;; semantic/wisent/comp.el ends here diff --git a/lisp/cedet/semantic/wisent/java-tags.el b/lisp/cedet/semantic/wisent/java-tags.el index 6bdc2736b1b..a85935ad83b 100644 --- a/lisp/cedet/semantic/wisent/java-tags.el +++ b/lisp/cedet/semantic/wisent/java-tags.el @@ -59,6 +59,7 @@ Parse the current context for `field_declaration' nonterminals to collect tags, such as local variables or prototypes. This function override `get-local-variables'." (let ((vars nil) + (ct (semantic-current-tag)) ;; We want nothing to do with funny syntaxing while doing this. (semantic-unmatched-syntax-hook nil)) (while (not (semantic-up-context (point) 'function)) @@ -71,8 +72,31 @@ This function override `get-local-variables'." 'field_declaration 0 t) vars)))) + ;; Add 'this' if in a fcn + (when (semantic-tag-of-class-p ct 'function) + ;; Append a new tag THIS into our space. + (setq vars (cons (semantic-tag-new-variable + "this" (semantic-tag-name (semantic-current-tag-parent)) + nil) + vars))) vars)) +;;; +;;; Analyzer and type cache support +;;; +(define-mode-local-override semantic-analyze-split-name java-mode (name) + "Split up tag names on colon . boundaries." + (let ((ans (split-string name "\\."))) + (if (= (length ans) 1) + name + (delete "" ans)))) + +(define-mode-local-override semantic-analyze-unsplit-name java-mode (namelist) + "Assemble the list of names NAMELIST into a namespace name." + (mapconcat 'identity namelist ".")) + + + ;;;; ;;;; Semantic integration of the Java LALR parser ;;;; @@ -109,6 +133,10 @@ Use the alternate LALR(1) parser." (package . "Package"))) ;; navigation inside 'type children senator-step-at-tag-classes '(function variable) + ;; Remove 'recursive from the default semanticdb find throttle + ;; since java imports never recurse. + semanticdb-find-default-throttle + (remq 'recursive (default-value 'semanticdb-find-default-throttle)) ) ;; Setup javadoc stuff (semantic-java-doc-setup)) diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el index 8ed83e87bce..610df0edc86 100644 --- a/lisp/cedet/semantic/wisent/javascript.el +++ b/lisp/cedet/semantic/wisent/javascript.el @@ -51,8 +51,8 @@ to this variable NAME." start (if elts (car (cddr elt)) (semantic-tag-start tag)) end (if xpand (cdr (cddr elt)) (semantic-tag-end tag)) xpand (cons clone xpand)) - ;; Set the definition of the cloned tag - (semantic-tag-put-attribute clone :default-value value) + ;; Set the definition of the cloned tag + (semantic-tag-put-attribute clone :default-value value) ;; Set the bounds of the cloned tag with those of the name ;; element. (semantic-tag-set-bounds clone start end)) @@ -70,10 +70,56 @@ This function overrides `get-local-variables'." ;; Does javascript have identifiable local variables? nil) +(define-mode-local-override semantic-tag-protection javascript-mode (tag &optional parent) + "Return protection information about TAG with optional PARENT. +This function returns on of the following symbols: + nil - No special protection. Language dependent. + 'public - Anyone can access this TAG. + 'private - Only methods in the local scope can access TAG. + 'protected - Like private for outside scopes, like public for child + classes. +Some languages may choose to provide additional return symbols specific +to themselves. Use of this function should allow for this. + +The default behavior (if not overridden with `tag-protection' +is to return a symbol based on type modifiers." + nil) + +(define-mode-local-override semantic-analyze-scope-calculate-access javascript-mode (type scope) + "Calculate the access class for TYPE as defined by the current SCOPE. +Access is related to the :parents in SCOPE. If type is a member of SCOPE +then access would be 'private. If TYPE is inherited by a member of SCOPE, +the access would be 'protected. Otherwise, access is 'public." + nil) +(define-mode-local-override semantic-ctxt-current-symbol javascript-mode (&optional point) + "Return the current symbol the cursor is on at POINT in a list. +This is a very simple implementation for Javascript symbols. It +will at maximum do one split, so that the first part is seen as +one type. For example: $('#sel').foo.bar will return (\"$('sel').foo\" \"bar\"). +This is currently needed for the mozrepl omniscient database." + (save-excursion + (if point (goto-char point)) + (let* ((case-fold-search semantic-case-fold) + symlist tmp end) + (with-syntax-table semantic-lex-syntax-table + (save-excursion + (when (looking-at "\\w\\|\\s_") + (forward-sexp 1)) + (setq end (point)) + (unless (re-search-backward "\\s-" (point-at-bol) t) + (beginning-of-line)) + (setq tmp (buffer-substring-no-properties (point) end)) + (if (string-match "\\(.+\\)\\." tmp) + (setq symlist (list (match-string 1 tmp) + (substring tmp (1+ (match-end 1)) (length tmp)))) + (setq symlist (list tmp)))))))) + ;;; Setup Function ;; -;; This sets up the javascript parser +;; Since javascript-mode is an alias for js-mode, let it inherit all +;; the overrides. +(define-child-mode js-mode javascript-mode) ;; Since javascript-mode is an alias for js-mode, let it inherit all ;; the overrides. diff --git a/lisp/cedet/semantic/wisent/javat-wy.el b/lisp/cedet/semantic/wisent/javat-wy.el Binary files differindex 1f0a480d554..01f80d3c598 100644 --- a/lisp/cedet/semantic/wisent/javat-wy.el +++ b/lisp/cedet/semantic/wisent/javat-wy.el diff --git a/lisp/cedet/semantic/wisent/js-wy.el b/lisp/cedet/semantic/wisent/js-wy.el index 05346b02c8d..92c5aa6b0d2 100644 --- a/lisp/cedet/semantic/wisent/js-wy.el +++ b/lisp/cedet/semantic/wisent/js-wy.el @@ -60,6 +60,7 @@ ;;; Code: (require 'semantic/lex) +(eval-when-compile (require 'semantic/bovine)) ;;; Prologue ;; @@ -416,6 +417,29 @@ ;;; Analyzers +;; +(define-lex-block-type-analyzer wisent-javascript-jv-wy--<block>-block-analyzer + "block analyzer for <block> tokens." + "\\s(\\|\\s)" + '((("(" OPEN_PARENTHESIS PAREN_BLOCK) + ("{" START_BLOCK BRACE_BLOCK) + ("[" OPEN_SQ_BRACKETS BRACK_BLOCK)) + (")" CLOSE_PARENTHESIS) + ("}" END_BLOCK) + ("]" CLOSE_SQ_BRACKETS)) + ) + +(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<symbol>-regexp-analyzer + "regexp analyzer for <symbol> tokens." + "\\(\\sw\\|\\s_\\)+" + nil + 'VARIABLE) + +(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<number>-regexp-analyzer + "regexp analyzer for <number> tokens." + semantic-lex-number-expression + nil + 'NUMBER) (define-lex-string-type-analyzer wisent-javascript-jv-wy--<punctuation>-string-analyzer "string analyzer for <punctuation> tokens." @@ -462,29 +486,6 @@ (ASSIGN_SYMBOL . "=")) 'punctuation) -(define-lex-block-type-analyzer wisent-javascript-jv-wy--<block>-block-analyzer - "block analyzer for <block> tokens." - "\\s(\\|\\s)" - '((("(" OPEN_PARENTHESIS PAREN_BLOCK) - ("{" START_BLOCK BRACE_BLOCK) - ("[" OPEN_SQ_BRACKETS BRACK_BLOCK)) - (")" CLOSE_PARENTHESIS) - ("}" END_BLOCK) - ("]" CLOSE_SQ_BRACKETS)) - ) - -(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<symbol>-regexp-analyzer - "regexp analyzer for <symbol> tokens." - "\\(\\sw\\|\\s_\\)+" - nil - 'VARIABLE) - -(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<number>-regexp-analyzer - "regexp analyzer for <number> tokens." - semantic-lex-number-expression - nil - 'NUMBER) - (define-lex-sexp-type-analyzer wisent-javascript-jv-wy--<string>-sexp-analyzer "sexp analyzer for <string> tokens." "\\s\"" diff --git a/lisp/cedet/semantic/wisent/python-wy.el b/lisp/cedet/semantic/wisent/python-wy.el index e8229dcd9ea..d215a4b2414 100644 --- a/lisp/cedet/semantic/wisent/python-wy.el +++ b/lisp/cedet/semantic/wisent/python-wy.el @@ -1,6 +1,6 @@ ;;; semantic/wisent/python-wy.el --- Generated parser support file -;; Copyright (C) 2002-2004, 2007, 2010-2012 Free Software Foundation, Inc. +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. ;; Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, ;; 2009, 2010 Python Software Foundation; All Rights Reserved @@ -77,9 +77,12 @@ ;;; Code: (require 'semantic/lex) +(eval-when-compile (require 'semantic/bovine)) ;;; Prologue ;; +(declare-function wisent-python-reconstitute-function-tag "semantic/wisent/python") +(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python") ;;; Declarations ;; @@ -114,8 +117,10 @@ ("return" . RETURN) ("try" . TRY) ("while" . WHILE) + ("with" . WITH) ("yield" . YIELD)) '(("yield" summary "Create a generator function") + ("with" summary "Start statement with an associated context object") ("while" summary "Start a 'while' loop") ("try" summary "Start of statements protected by exception handlers") ("return" summary "Return from a function") @@ -156,6 +161,7 @@ ("string" (STRING_LITERAL)) ("punctuation" + (AT . "@") (BACKQUOTE . "`") (ASSIGN . "=") (COMMA . ",") @@ -226,7 +232,7 @@ (eval-when-compile (require 'semantic/wisent/comp)) (wisent-compile-grammar - '((BACKSLASH NEWLINE INDENT DEDENT INDENT_BLOCK PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK LTLTEQ GTGTEQ EXPEQ DIVDIVEQ DIVDIV LTLT GTGT EXPONENT EQ GE LE PLUSEQ MINUSEQ MULTEQ DIVEQ MODEQ AMPEQ OREQ HATEQ LTGT NE HAT LT GT AMP MULT DIV MOD PLUS MINUS PERIOD TILDE BAR COLON SEMICOLON COMMA ASSIGN BACKQUOTE STRING_LITERAL NUMBER_LITERAL NAME AND AS ASSERT BREAK CLASS CONTINUE DEF DEL ELIF ELSE EXCEPT EXEC FINALLY FOR FROM GLOBAL IF IMPORT IN IS LAMBDA NOT OR PASS PRINT RAISE RETURN TRY WHILE YIELD) + '((BACKSLASH NEWLINE INDENT DEDENT INDENT_BLOCK PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK LTLTEQ GTGTEQ EXPEQ DIVDIVEQ DIVDIV LTLT GTGT EXPONENT EQ GE LE PLUSEQ MINUSEQ MULTEQ DIVEQ MODEQ AMPEQ OREQ HATEQ LTGT NE HAT LT GT AMP MULT DIV MOD PLUS MINUS PERIOD TILDE BAR COLON SEMICOLON COMMA ASSIGN BACKQUOTE AT STRING_LITERAL NUMBER_LITERAL NAME AND AS ASSERT BREAK CLASS CONTINUE DEF DEL ELIF ELSE EXCEPT EXEC FINALLY FOR FROM GLOBAL IF IMPORT IN IS LAMBDA NOT OR PASS PRINT RAISE RETURN TRY WHILE WITH YIELD) nil (goal ((NEWLINE)) @@ -364,8 +370,10 @@ (wisent-raw-tag (semantic-tag-new-include $2 nil)))) (dotted_as_name_list - ((dotted_as_name)) - ((dotted_as_name_list COMMA dotted_as_name))) + ((dotted_as_name_list COMMA dotted_as_name) + (cons $3 $1)) + ((dotted_as_name) + (list $1))) (star_or_import_as_name_list ((MULT) nil) @@ -417,6 +425,7 @@ ((while_stmt)) ((for_stmt)) ((try_stmt)) + ((with_stmt)) ((funcdef)) ((class_declaration))) (if_stmt @@ -476,10 +485,36 @@ (nil) ((test zero_or_one_comma_test) nil)) + (with_stmt + ((WITH test COLON suite) + (wisent-raw-tag + (semantic-tag-new-code $1 nil))) + ((WITH test with_var COLON suite) + (wisent-raw-tag + (semantic-tag-new-code $1 nil)))) + (with_var + ((AS expr) + nil)) + (decorator + ((AT dotted_name varargslist_opt NEWLINE) + (wisent-raw-tag + (semantic-tag-new-function $2 "decorator" $3)))) + (decorators + ((decorator) + (list $1)) + ((decorator decorators) + (cons $1 $2))) (funcdef ((DEF NAME function_parameter_list COLON suite) - (wisent-raw-tag - (semantic-tag-new-function $2 nil $3)))) + (wisent-python-reconstitute-function-tag + (wisent-raw-tag + (semantic-tag-new-function $2 nil $3)) + $5)) + ((decorators DEF NAME function_parameter_list COLON suite) + (wisent-python-reconstitute-function-tag + (wisent-raw-tag + (semantic-tag-new-function $3 nil $4 :decorators $1)) + $6))) (function_parameter_list ((PAREN_BLOCK) (let @@ -505,9 +540,10 @@ (semantic-tag-new-variable $2 nil nil)))) (class_declaration ((CLASS NAME paren_class_list_opt COLON suite) - (wisent-raw-tag - (semantic-tag-new-type $2 $1 $5 - (cons $3 nil))))) + (wisent-python-reconstitute-class-tag + (wisent-raw-tag + (semantic-tag-new-type $2 $1 $5 + (cons $3 nil)))))) (paren_class_list_opt (nil) ((paren_class_list))) @@ -726,7 +762,7 @@ ;;; Analyzers - +;; (define-lex-block-type-analyzer wisent-python-wy--<block>-block-analyzer "block analyzer for <block> tokens." "\\s(\\|\\s)" @@ -738,10 +774,23 @@ ("]" RBRACK)) ) +(define-lex-regex-type-analyzer wisent-python-wy--<symbol>-regexp-analyzer + "regexp analyzer for <symbol> tokens." + "\\(\\sw\\|\\s_\\)+" + nil + 'NAME) + +(define-lex-regex-type-analyzer wisent-python-wy--<number>-regexp-analyzer + "regexp analyzer for <number> tokens." + semantic-lex-number-expression + nil + 'NUMBER_LITERAL) + (define-lex-string-type-analyzer wisent-python-wy--<punctuation>-string-analyzer "string analyzer for <punctuation> tokens." "\\(\\s.\\|\\s$\\|\\s'\\)+" - '((BACKQUOTE . "`") + '((AT . "@") + (BACKQUOTE . "`") (ASSIGN . "=") (COMMA . ",") (SEMICOLON . ";") @@ -781,18 +830,6 @@ (LTLTEQ . "<<=")) 'punctuation) -(define-lex-regex-type-analyzer wisent-python-wy--<symbol>-regexp-analyzer - "regexp analyzer for <symbol> tokens." - "\\(\\sw\\|\\s_\\)+" - nil - 'NAME) - -(define-lex-regex-type-analyzer wisent-python-wy--<number>-regexp-analyzer - "regexp analyzer for <number> tokens." - semantic-lex-number-expression - nil - 'NUMBER_LITERAL) - (define-lex-keyword-type-analyzer wisent-python-wy--<keyword>-keyword-analyzer "keyword analyzer for <keyword> tokens." "\\(\\sw\\|\\s_\\)+") diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el index fef22b16995..ea603f251bb 100644 --- a/lisp/cedet/semantic/wisent/python.el +++ b/lisp/cedet/semantic/wisent/python.el @@ -28,27 +28,90 @@ ;;; Code: +(require 'rx) + +;; Try to load python support, but fail silently since it is only used +;; for optional functionality +(require 'python nil t) + (require 'semantic/wisent) (require 'semantic/wisent/python-wy) +(require 'semantic/find) (require 'semantic/dep) (require 'semantic/ctxt) +(eval-when-compile + (require 'cl)) + +;;; Customization +;; + +(defun semantic-python-get-system-include-path () + "Evaluate some Python code that determines the system include path." + (python-proc) + (if python-buffer + (with-current-buffer python-buffer + (set (make-local-variable 'python-preoutput-result) nil) + (python-send-string + "import sys; print '_emacs_out ' + '\\0'.join(sys.path)") + (accept-process-output (python-proc) 2) + (if python-preoutput-result + (split-string python-preoutput-result "[\0\n]" t) + ;; Try a second, Python3k compatible shot + (python-send-string + "import sys; print('_emacs_out ' + '\\0'.join(sys.path))") + (accept-process-output (python-proc) 2) + (if python-preoutput-result + (split-string python-preoutput-result "[\0\n]" t) + (message "Timeout while querying Python for system include path.") + nil))) + (message "Python seems to be unavailable on this system."))) + +(defcustom-mode-local-semantic-dependency-system-include-path + python-mode semantic-python-dependency-system-include-path + (when (and (featurep 'python) + ;; python-mode and batch somehow often hangs. + (not noninteractive)) + (semantic-python-get-system-include-path)) + "The system include path used by Python language.") ;;; Lexical analysis ;; ;; Python strings are delimited by either single quotes or double -;; quotes, e.g., "I'm a string" and 'I too am s string'. +;; quotes, e.g., "I'm a string" and 'I too am a string'. ;; In addition a string can have either a 'r' and/or 'u' prefix. ;; The 'r' prefix means raw, i.e., normal backslash substitutions are ;; to be suppressed. For example, r"01\n34" is a string with six ;; characters 0, 1, \, n, 3 and 4. The 'u' prefix means the following ;; string is Unicode. -(defconst wisent-python-string-re - (concat (regexp-opt '("r" "u" "ur" "R" "U" "UR" "Ur" "uR") t) - "?['\"]") +(defconst wisent-python-string-start-re "[uU]?[rR]?['\"]" "Regexp matching beginning of a Python string.") +(defconst wisent-python-string-re + (rx + (opt (any "uU")) (opt (any "rR")) + (or + ;; Triple-quoted string using apostrophes + (: "'''" (zero-or-more (or "\\'" + (not (any "'")) + (: (repeat 1 2 "'") (not (any "'"))))) + "'''") + ;; String using apostrophes + (: "'" (zero-or-more (or "\\'" + (not (any "'")))) + "'") + ;; Triple-quoted string using quotation marks. + (: "\"\"\"" (zero-or-more (or "\\\"" + (not (any "\"")) + (: (repeat 1 2 "\"") (not (any "\""))))) + "\"\"\"") + ;; String using quotation marks. + (: "\"" (zero-or-more (or "\\\"" + (not (any "\"")))) + "\""))) + "Regexp matching a complete Python string.") + (defvar wisent-python-EXPANDING-block nil "Non-nil when expanding a paren block for Python lexical analyzer.") @@ -60,16 +123,46 @@ curly braces." (defsubst wisent-python-forward-string () "Move point at the end of the Python string at point." - (when (looking-at wisent-python-string-re) - ;; skip the prefix - (and (match-end 1) (goto-char (match-end 1))) - ;; skip the quoted part - (cond - ((looking-at "\"\"\"[^\"]") - (search-forward "\"\"\"" nil nil 2)) - ((looking-at "'''[^']") - (search-forward "'''" nil nil 2)) - ((forward-sexp 1))))) + (if (looking-at wisent-python-string-re) + (let ((start (match-beginning 0)) + (end (match-end 0))) + ;; Incomplete triple-quoted string gets matched instead as a + ;; complete single quoted string. (This special case would be + ;; unnecessary if Emacs regular expressions had negative + ;; look-ahead assertions.) + (when (and (= (- end start) 2) + (looking-at "\"\\{3\\}\\|'\\{3\\}")) + (error "unterminated syntax")) + (goto-char end)) + (error "unterminated syntax"))) + +(defun wisent-python-forward-balanced-expression () + "Move point to the end of the balanced expression at point. +Here 'balanced expression' means anything matched by Emacs' +open/close parenthesis syntax classes. We can't use forward-sexp +for this because that Emacs built-in can't parse Python's +triple-quoted string syntax." + (let ((end-char (cdr (syntax-after (point))))) + (forward-char 1) + (while (not (or (eobp) (eq (char-after (point)) end-char))) + (cond + ;; Skip over python strings. + ((looking-at wisent-python-string-start-re) + (wisent-python-forward-string)) + ;; At a comment start just goto end of line. + ((looking-at "\\s<") + (end-of-line)) + ;; Skip over balanced expressions. + ((looking-at "\\s(") + (wisent-python-forward-balanced-expression)) + ;; Skip over white space, word, symbol, punctuation, paired + ;; delimiter (backquote) characters, line continuation, and end + ;; of comment characters (AKA newline characters in Python). + ((zerop (skip-syntax-forward "-w_.$\\>")) + (error "can't figure out how to go forward from here")))) + ;; Skip closing character. As a last resort this should raise an + ;; error if we hit EOB before we find our closing character.. + (forward-char 1))) (defun wisent-python-forward-line () "Move point to the beginning of the next logical line. @@ -83,14 +176,14 @@ line ends at the end of the buffer, leave the point there." (progn (cond ;; Skip over python strings. - ((looking-at wisent-python-string-re) + ((looking-at wisent-python-string-start-re) (wisent-python-forward-string)) ;; At a comment start just goto end of line. ((looking-at "\\s<") (end-of-line)) - ;; Skip over generic lists and strings. - ((looking-at "\\(\\s(\\|\\s\"\\)") - (forward-sexp 1)) + ;; Skip over balanced expressions. + ((looking-at "\\s(") + (wisent-python-forward-balanced-expression)) ;; At the explicit line continuation character ;; (backslash) move to next line. ((looking-at "\\s\\") @@ -107,8 +200,8 @@ line ends at the end of the buffer, leave the point there." (defun wisent-python-forward-line-skip-indented () "Move point to the next logical line, skipping indented lines. -That is the next line whose indentation is less than or equal to the -indentation of the current line." +That is the next line whose indentation is less than or equal to +the indentation of the current line." (let ((indent (current-indentation))) (while (progn (wisent-python-forward-line) (and (not (eobp)) @@ -185,17 +278,18 @@ indentation of the current line." ;; Loop lexer to handle tokens in current line. t) ;; Indentation decreased - (t - ;; Pop items from indentation stack - (while (< curr-indent last-indent) - (pop wisent-python-indent-stack) - (setq semantic-lex-current-depth (1- semantic-lex-current-depth) - last-indent (car wisent-python-indent-stack)) - (semantic-lex-push-token - (semantic-lex-token 'DEDENT last-pos (point)))) + ((progn + ;; Pop items from indentation stack + (while (< curr-indent last-indent) + (pop wisent-python-indent-stack) + (setq semantic-lex-current-depth (1- semantic-lex-current-depth) + last-indent (car wisent-python-indent-stack)) + (semantic-lex-push-token + (semantic-lex-token 'DEDENT last-pos (point)))) + (= last-pos (point))) ;; If pos did not change, then we must return nil so that ;; other lexical analyzers can be run. - (/= last-pos (point)))))) + nil)))) ;; All the work was done in the above analyzer matching condition. ) @@ -211,7 +305,7 @@ continuation of current line." (define-lex-regex-analyzer wisent-python-lex-string "Detect and create python string tokens." - wisent-python-string-re + wisent-python-string-start-re (semantic-lex-push-token (semantic-lex-token 'STRING_LITERAL @@ -250,9 +344,113 @@ elsewhere on a line outside a string literal." semantic-lex-ignore-comments ;; Signal error on unhandled syntax. semantic-lex-default-action) + + +;;; Parsing +;; + +(defun wisent-python-reconstitute-function-tag (tag suite) + "Move a docstring from TAG's members into its :documentation attribute. +Set attributes for constructors, special, private and static methods." + ;; Analyze first statement to see whether it is a documentation + ;; string. + (let ((first-statement (car suite))) + (when (semantic-python-docstring-p first-statement) + (semantic-tag-put-attribute + tag :documentation + (semantic-python-extract-docstring first-statement)))) + + ;; TODO HACK: we try to identify methods using the following + ;; heuristic: + ;; + at least one argument + ;; + first argument is self + (when (and (> (length (semantic-tag-function-arguments tag)) 0) + (string= (semantic-tag-name + (first (semantic-tag-function-arguments tag))) + "self")) + (semantic-tag-put-attribute tag :parent "dummy")) + + ;; Identify constructors, special and private functions + (cond + ;; TODO only valid when the function resides inside a class + ((string= (semantic-tag-name tag) "__init__") + (semantic-tag-put-attribute tag :constructor-flag t) + (semantic-tag-put-attribute tag :suite suite)) + + ((semantic-python-special-p tag) + (semantic-tag-put-attribute tag :special-flag t)) + + ((semantic-python-private-p tag) + (semantic-tag-put-attribute tag :protection "private"))) + + ;; If there is a staticmethod decorator, add a static typemodifier + ;; for the function. + (when (semantic-find-tags-by-name + "staticmethod" + (semantic-tag-get-attribute tag :decorators)) + (semantic-tag-put-attribute + tag :typemodifiers + (cons "static" + (semantic-tag-get-attribute tag :typemodifiers)))) + + ;; TODO + ;; + check for decorators classmethod + ;; + check for operators + tag) + +(defun wisent-python-reconstitute-class-tag (tag) + "Move a docstring from TAG's members into its :documentation attribute." + ;; The first member of TAG may be a documentation string. If that is + ;; the case, remove of it from the members list and stick its + ;; content into the :documentation attribute. + (let ((first-member (car (semantic-tag-type-members tag)))) + (when (semantic-python-docstring-p first-member) + (semantic-tag-put-attribute + tag :members + (cdr (semantic-tag-type-members tag))) + (semantic-tag-put-attribute + tag :documentation + (semantic-python-extract-docstring first-member)))) + + ;; Try to find the constructor, determine the name of the instance + ;; parameter, find assignments to instance variables and add + ;; corresponding variable tags to the list of members. + (dolist (member (semantic-tag-type-members tag)) + (when (semantic-tag-function-constructor-p member) + (let ((self (semantic-tag-name + (car (semantic-tag-function-arguments member))))) + (dolist (statement (semantic-tag-get-attribute member :suite)) + (when (semantic-python-instance-variable-p statement self) + (let ((variable (semantic-tag-clone + statement + (substring (semantic-tag-name statement) 5))) + (members (semantic-tag-get-attribute tag :members))) + (when (semantic-python-private-p variable) + (semantic-tag-put-attribute variable :protection "private")) + (setcdr (last members) (list variable)))))))) + + ;; TODO remove the :suite attribute + tag) + +(defun semantic-python-expand-tag (tag) + "Expand compound declarations found in TAG into separate tags. +TAG contains compound declaration if the NAME part of the tag is +a list. In python, this can happen with `import' statements." + (let ((class (semantic-tag-class tag)) + (elts (semantic-tag-name tag)) + (expand nil)) + (cond + ((and (eq class 'include) (listp elts)) + (dolist (E elts) + (setq expand (cons (semantic-tag-clone tag E) expand))) + (setq expand (nreverse expand))) + ))) + + ;;; Overridden Semantic API. ;; + (define-mode-local-override semantic-lex python-mode (start end &optional depth length) "Lexically analyze Python code in current buffer. @@ -274,10 +472,11 @@ what remains in the `wisent-python-indent-stack'." To be implemented for Python! For now just return nil." nil) -(defcustom-mode-local-semantic-dependency-system-include-path - python-mode semantic-python-dependency-system-include-path - nil - "The system include path used by Python language.") +;; Adapted from the semantic Java support by Andrey Torba +(define-mode-local-override semantic-tag-include-filename python-mode (tag) + "Return a suitable path for (some) Python imports." + (let ((name (semantic-tag-name tag))) + (concat (mapconcat 'identity (split-string name "\\.") "/") ".py"))) ;;; Enable Semantic in `python-mode'. ;; @@ -287,13 +486,15 @@ To be implemented for Python! For now just return nil." "Setup buffer for parse." (wisent-python-wy--install-parser) (set (make-local-variable 'parse-sexp-ignore-comments) t) + ;; Give python modes the possibility to overwrite this: + (if (not comment-start-skip) + (set (make-local-variable 'comment-start-skip) "#+\\s-*")) (setq - ;; Character used to separation a parent/child relationship + ;; Character used to separation a parent/child relationship semantic-type-relation-separator-character '(".") semantic-command-separation-character ";" - ;; The following is no more necessary as semantic-lex is overridden - ;; in python-mode. - ;; semantic-lex-analyzer 'wisent-python-lexer + ;; Parsing + semantic-tag-expand-function 'semantic-python-expand-tag ;; Semantic to take over from the one provided by python. ;; The python one, if it uses the senator advice, will hang @@ -320,8 +521,56 @@ To be implemented for Python! For now just return nil." (define-child-mode python-3-mode python-mode "Python 3 mode") +;;; Utility functions +;; + +(defun semantic-python-special-p (tag) + "Return non-nil if the name of TAG is a special identifier of +the form __NAME__. " + (string-match + (rx (seq string-start "__" (1+ (syntax symbol)) "__" string-end)) + (semantic-tag-name tag))) + +(defun semantic-python-private-p (tag) + "Return non-nil if the name of TAG follows the convention _NAME +for private names." + (string-match + (rx (seq string-start "_" (0+ (syntax symbol)) string-end)) + (semantic-tag-name tag))) + +(defun semantic-python-instance-variable-p (tag &optional self) + "Return non-nil if TAG is an instance variable of the instance +SELF or the instance name \"self\" if SELF is nil." + (when (semantic-tag-of-class-p tag 'variable) + (let ((name (semantic-tag-name tag))) + (when (string-match + (rx-to-string + `(seq string-start ,(or self "self") ".")) + name) + (not (string-match "\\." (substring name 5))))))) + +(defun semantic-python-docstring-p (tag) + "Return non-nil, when TAG is a Python documentation string." + ;; TAG is considered to be a documentation string if the first + ;; member is of class 'code and its name looks like a documentation + ;; string. + (let ((class (semantic-tag-class tag)) + (name (semantic-tag-name tag))) + (and (eq class 'code) + (string-match + (rx (seq string-start "\"\"\"" (0+ anything) "\"\"\"" string-end)) + name)))) + +(defun semantic-python-extract-docstring (tag) + "Return the Python documentation string contained in TAG." + ;; Strip leading and trailing """ + (let ((name (semantic-tag-name tag))) + (substring name 3 -3))) + + ;;; Test ;; + (defun wisent-python-lex-buffer () "Run `wisent-python-lexer' on current buffer." (interactive) diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el index f973ee9065e..17121c7547e 100644 --- a/lisp/cedet/srecode.el +++ b/lisp/cedet/srecode.el @@ -4,7 +4,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: codegeneration -;; Version: 1.0pre7 +;; Version: 1.0 ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index d5389a97f03..8a1291f8d72 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el @@ -210,6 +210,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." (buffer-file-name)))) (mode nil) (application nil) + (framework nil) (priority nil) (project nil) (vars nil) @@ -253,6 +254,8 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." ) ((string= name "application") (setq application (read firstvalue))) + ((string= name "framework") + (setq framework (read firstvalue))) ((string= name "priority") (setq priority (read firstvalue))) ((string= name "project") @@ -319,7 +322,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." priority)) ;; Save it up! - (srecode-compile-template-table table mode priority application project vars) + (srecode-compile-template-table table mode priority application framework project vars) ) ) @@ -376,8 +379,8 @@ It is hard if the previous inserter is a newline object." (while (and comp (stringp (car comp))) (setq comp (cdr comp))) (or (not comp) - (require 'srecode/insert) - (srecode-template-inserter-newline-child-p (car comp)))) + (progn (require 'srecode/insert) + (srecode-template-inserter-newline-child-p (car comp))))) (defun srecode-compile-split-code (tag str STATE &optional end-name) @@ -522,12 +525,13 @@ to the inserter constructor." (if (not new) (error "SRECODE: Unknown macro code %S" key)) new))) -(defun srecode-compile-template-table (templates mode priority application project vars) +(defun srecode-compile-template-table (templates mode priority application framework project vars) "Compile a list of TEMPLATES into an semantic recode table. The table being compiled is for MODE, or the string \"default\". PRIORITY is a numerical value that indicates this tables location in an ordered search. APPLICATION is the name of the application these templates belong to. +FRAMEWORK is the name of the framework these templates belong to. PROJECT is a directory name which these templates scope to. A list of defined variables VARS provides a variable table." (let ((namehash (make-hash-table :test 'equal @@ -569,6 +573,7 @@ A list of defined variables VARS provides a variable table." :major-mode mode :priority priority :application application + :framework framework :project project)) (tmpl (oref table templates))) ;; Loop over all the templates, and xref. diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el index 12bfd3af903..d63e1a7a49f 100644 --- a/lisp/cedet/srecode/cpp.el +++ b/lisp/cedet/srecode/cpp.el @@ -47,16 +47,16 @@ buffer contains a using NAMESPACE; statement " :group 'srecode-cpp :type '(repeat string)) -;;; :cpp ARGUMENT HANDLING +;;; :c ARGUMENT HANDLING ;; -;; When a :cpp argument is required, fill the dictionary with -;; information about the current C++ file. +;; When a :c argument is required, fill the dictionary with +;; information about the current C file. ;; -;; Error if not in a C++ mode. +;; Error if not in a C mode. ;;;###autoload -(defun srecode-semantic-handle-:cpp (dict) - "Add macros into the dictionary DICT based on the current c++ file. +(defun srecode-semantic-handle-:c (dict) + "Add macros into the dictionary DICT based on the current c file. Adds the following: FILENAME_SYMBOL - filename converted into a C compat symbol. HEADER - Shown section if in a header file." @@ -76,6 +76,21 @@ HEADER - Shown section if in a header file." ) ) +;;; :cpp ARGUMENT HANDLING +;; +;; When a :cpp argument is required, fill the dictionary with +;; information about the current C++ file. +;; +;; Error if not in a C++ mode. +;;;###autoload +(defun srecode-semantic-handle-:cpp (dict) + "Add macros into the dictionary DICT based on the current c file. +Calls `srecode-semantic-handle-:c. +Also adds the following: + - nothing -" + (srecode-semantic-handle-:c dict) + ) + (defun srecode-semantic-handle-:using-namespaces (dict) "Add macros into the dictionary DICT based on used namespaces. Adds the following: @@ -94,10 +109,15 @@ PREFIX_NAMESPACE - for each NAMESPACE in `srecode-cpp-namespaces'." ) (define-mode-local-override srecode-semantic-apply-tag-to-dict - c++-mode (tag-wrapper dict) - "Apply C++ specific features from TAG-WRAPPER into DICT. + c-mode (tag-wrapper dict) + "Apply C and C++ specific features from TAG-WRAPPER into DICT. Calls `srecode-semantic-apply-tag-to-dict-default' first. Adds -special behavior for tag of classes include, using and function." +special behavior for tag of classes include, using and function. + +This function cannot be split into C and C++ specific variants, as +the way the tags are created from the parser does not distinguish +either. The side effect is that you could get some C++ tag properties +specified in a C file." ;; Use default implementation to fill in the basic properties. (srecode-semantic-apply-tag-to-dict-default tag-wrapper dict) @@ -150,14 +170,20 @@ special behavior for tag of classes include, using and function." (templates (semantic-tag-get-attribute tag :template)) (modifiers (semantic-tag-modifiers tag))) - ;; Add modifiers into the dictionary + ;; Mark constructors and destructors as such. + (when (semantic-tag-function-constructor-p tag) + (srecode-dictionary-show-section dict "CONSTRUCTOR")) + (when (semantic-tag-function-destructor-p tag) + (srecode-dictionary-show-section dict "DESTRUCTOR")) + + ;; Add modifiers into the dictionary. (dolist (modifier modifiers) (let ((modifier-dict (srecode-dictionary-add-section-dictionary dict "MODIFIERS"))) (srecode-dictionary-set-value modifier-dict "NAME" modifier))) ;; Add templates into child dictionaries. - (srecode-cpp-apply-templates dict templates) + (srecode-c-apply-templates dict templates) ;; When the function is a member function, it can have ;; additional modifiers. @@ -171,8 +197,7 @@ special behavior for tag of classes include, using and function." ;; If the member function is pure virtual, add a dictionary ;; entry. (when (semantic-tag-get-attribute tag :pure-virtual-flag) - (srecode-dictionary-show-section dict "PURE")) - ))) + (srecode-dictionary-show-section dict "PURE"))))) ;; ;; CLASS @@ -184,7 +209,7 @@ special behavior for tag of classes include, using and function." ;; Add templates into child dictionaries. (let ((templates (semantic-tag-get-attribute tag :template))) - (srecode-cpp-apply-templates dict templates)))) + (srecode-c-apply-templates dict templates)))) )) ) @@ -192,7 +217,7 @@ special behavior for tag of classes include, using and function." ;;; Helper functions ;; -(defun srecode-cpp-apply-templates (dict templates) +(defun srecode-c-apply-templates (dict templates) "Add section dictionaries for TEMPLATES to DICT." (when templates (let ((templates-dict (srecode-dictionary-add-section-dictionary diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el index 5b65284660f..6262383c397 100644 --- a/lisp/cedet/srecode/dictionary.el +++ b/lisp/cedet/srecode/dictionary.el @@ -117,8 +117,8 @@ Makes sure that :value is compiled." (cons (car fields) newfields)))) (setq fields (cdr (cdr fields)))) - (when (not state) - (error "Cannot create compound variable without :state")) + ;;(when (not state) + ;; (error "Cannot create compound variable outside of sectiondictionary")) (call-next-method this (nreverse newfields)) (when (not (slot-boundp this 'compiled)) @@ -220,7 +220,10 @@ associated with a buffer or parent." "Insert into DICT the variables found in table TPL. TPL is an object representing a compiled template file." (when tpl - (let ((tabs (oref tpl :tables))) + ;; Tables are sorted with highest priority first, useful for looking + ;; up templates, but this means we need to install the variables in + ;; reverse order so higher priority variables override lower ones. + (let ((tabs (reverse (oref tpl :tables)))) (require 'srecode/find) ; For srecode-template-table-in-project-p (while tabs (when (srecode-template-table-in-project-p (car tabs)) @@ -546,40 +549,6 @@ inserted with a new editable field.") ;;; Higher level dictionary functions ;; -(defun srecode-create-section-dictionary (sectiondicts STATE) - "Create a dictionary with section entries for a template. -The format for SECTIONDICTS is what is emitted from the template parsers. -STATE is the current compiler state." - (when sectiondicts - (let ((new (srecode-create-dictionary t))) - ;; Loop over each section. The section is a macro w/in the - ;; template. - (while sectiondicts - (let* ((sect (car (car sectiondicts))) - (entries (cdr (car sectiondicts))) - (subdict (srecode-dictionary-add-section-dictionary new sect)) - ) - ;; Loop over each entry. This is one variable in the - ;; section dictionary. - (while entries - (let ((tname (semantic-tag-name (car entries))) - (val (semantic-tag-variable-default (car entries)))) - (if (eq val t) - (srecode-dictionary-show-section subdict tname) - (cond - ((and (stringp (car val)) - (= (length val) 1)) - (setq val (car val))) - (t - (setq val (srecode-dictionary-compound-variable - tname :value val :state STATE)))) - (srecode-dictionary-set-value - subdict tname val)) - (setq entries (cdr entries)))) - ) - (setq sectiondicts (cdr sectiondicts))) - new))) - (defun srecode-create-dictionaries-from-tags (tags state) "Create a dictionary with entries according to TAGS. diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el index befdb4731c2..f621c5e82d5 100644 --- a/lisp/cedet/srecode/find.el +++ b/lisp/cedet/srecode/find.el @@ -220,32 +220,37 @@ tables that do not belong to an application will be searched." (defvar srecode-read-template-name-history nil "History for completing reads for template names.") -(defun srecode-all-template-hash (&optional mode hash) +(defun srecode-user-template-p (template) + "Non-nil if TEMPLATE is intended for user insertion. +Templates not matching this predicate are used for code +generation or other internal purposes." + t) + +(defun srecode-all-template-hash (&optional mode hash predicate) "Create a hash table of all the currently available templates. Optional argument MODE is the major mode to look for. -Optional argument HASH is the hash table to fill in." - (let* ((mhash (or hash (make-hash-table :test 'equal))) - (mmode (or mode major-mode)) - (mp (get-mode-local-parent mmode)) - ) +Optional argument HASH is the hash table to fill in. +Optional argument PREDICATE can be used to filter the returned +templates." + (let* ((mhash (or hash (make-hash-table :test 'equal))) + (mmode (or mode major-mode)) + (parent-mode (get-mode-local-parent mmode))) ;; Get the parent hash table filled into our current hash. - (when (not (eq mode 'default)) - (if mp - (srecode-all-template-hash mp mhash) - (srecode-all-template-hash 'default mhash))) + (unless (eq mode 'default) + (srecode-all-template-hash (or parent-mode 'default) mhash)) + ;; Load up the hash table for our current mode. - (let* ((mt (srecode-get-mode-table mmode)) - (tabs (when mt (oref mt :tables))) - ) - (while tabs + (let* ((mt (srecode-get-mode-table mmode)) + (tabs (when mt (oref mt :tables)))) + (dolist (tab tabs) ;; Exclude templates for a particular application. - (when (and (not (oref (car tabs) :application)) - (srecode-template-table-in-project-p (car tabs))) + (when (and (not (oref tab :application)) + (srecode-template-table-in-project-p tab)) (maphash (lambda (key temp) - (puthash key temp mhash) - ) - (oref (car tabs) namehash))) - (setq tabs (cdr tabs))) + (when (or (not predicate) + (funcall predicate temp)) + (puthash key temp mhash))) + (oref tab namehash)))) mhash))) (defun srecode-calculate-default-template-string (hash) diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el index 5155044e386..49d913a099a 100644 --- a/lisp/cedet/srecode/getset.el +++ b/lisp/cedet/srecode/getset.el @@ -298,10 +298,10 @@ Base selection on the field related to POINT." (let* ((kids (semantic-find-tags-by-class 'variable (semantic-tag-type-members class))) (sel (completing-read "Use Field: " kids)) - ) - - (or (semantic-find-tags-by-name sel kids) - sel) + (fields (semantic-find-tags-by-name sel kids))) + (if fields + (car fields) + sel) )) (defun srecode-auto-choose-class (point) diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index 7d300614c08..726aa41cffd 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -195,6 +195,32 @@ Buffer based features related to change hooks is handled one level up." ;; area. Return value is not important. )) +(defun srecode-insert-show-error-report (dictionary format &rest args) + "Display an error report based on DICTIONARY, FORMAT and ARGS. +This is intended to diagnose problems with failed template +insertions." + (with-current-buffer (data-debug-new-buffer "*SRECODE INSERTION ERROR*") + (erase-buffer) + ;; Insert the stack of templates that are currently being + ;; inserted. + (insert (propertize "Template Stack" 'face '(:weight bold)) + (propertize " (most recent at bottom)" 'face '(:slant italic)) + ":\n") + (data-debug-insert-stuff-list + (reverse (oref srecode-template active)) "> ") + ;; Show the current dictionary. + (insert (propertize "Dictionary" 'face '(:weight bold)) "\n") + (data-debug-insert-thing dictionary "" "> ") + ;; Show the error message. + (insert (propertize "Error" 'face '(:weight bold)) "\n") + (insert (apply #'format format args)) + (pop-to-buffer (current-buffer)))) + +(defun srecode-insert-report-error (dictionary format &rest args) + ;; TODO only display something when inside an interactive call? + (srecode-insert-show-error-report dictionary format args) + (apply #'error format args)) + ;;; TEMPLATE ARGUMENTS ;; ;; Some templates have arguments. Each argument is associated with @@ -435,8 +461,10 @@ If SECONDNAME is nil, return VALUE." (let ((srecode-inserter-variable-current-dictionary dictionary)) (funcall fcnpart value)) ;; Else, warn. - (error "Variable insertion second arg %s is not a function" - secondname))) + (srecode-insert-report-error + dictionary + "Variable inserter %s: second argument `%s' is not a function" + (object-print sti) secondname))) value)) (defmethod srecode-insert-method ((sti srecode-template-inserter-variable) @@ -467,19 +495,20 @@ If SECONDNAME is nil, return VALUE." ;; If the value returned is nil, then it may be a special ;; field inserter that requires us to set do-princ to nil. (when (not val) - (setq do-princ nil) - ) - ) + (setq do-princ nil))) + ;; Dictionaries... not allowed in this style ((srecode-dictionary-child-p val) - (error "Macro %s cannot insert a dictionary - use section macros instead" - name)) + (srecode-insert-report-error + dictionary + "Macro %s cannot insert a dictionary - use section macros instead" + name)) + ;; Other stuff... convert (t - (error "Macro %s cannot insert arbitrary data" name) - ;;(if (and val (not (stringp val))) - ;; (setq val (format "%S" val)))) - )) + (srecode-insert-report-error + dictionary + "Macro %s cannot insert arbitrary data" name))) ;; Output the dumb thing unless the type of thing specifically ;; did the inserting for us. (when do-princ @@ -559,19 +588,25 @@ Loop over the prompts to see if we have a match." "Derive the default value for an askable inserter STI. DICTIONARY is used to derive some values." (let ((defaultfcn (oref sti :defaultfcn))) - (cond ((stringp defaultfcn) - defaultfcn) - ((functionp defaultfcn) - (funcall defaultfcn)) - ((and (listp defaultfcn) - (eq (car defaultfcn) 'macro)) - (srecode-dictionary-lookup-name - dictionary (cdr defaultfcn))) - ((null defaultfcn) - "") - (t - (error "Unknown default for prompt: %S" - defaultfcn))))) + (cond + ((stringp defaultfcn) + defaultfcn) + + ((functionp defaultfcn) + (funcall defaultfcn)) + + ((and (listp defaultfcn) + (eq (car defaultfcn) 'macro)) + (srecode-dictionary-lookup-name + dictionary (cdr defaultfcn))) + + ((null defaultfcn) + "") + + (t + (srecode-insert-report-error + dictionary + "Unknown default for prompt: %S" defaultfcn))))) (defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask) dictionary) @@ -647,26 +682,33 @@ spaces to the right.") "For VALUE handle WIDTH behaviors for this variable inserter. Return the result as a string. By default, treat as a function name." - (if width - ;; Trim or pad to new length - (let* ((split (split-string width ":")) - (width (string-to-number (nth 0 split))) - (second (nth 1 split)) - (pad (cond ((or (null second) (string= "right" second)) - 'right) - ((string= "left" second) - 'left) - (t - (error "Unknown pad type %s" second))))) - (if (>= (length value) width) - ;; Simple case - too long. - (substring value 0 width) - ;; We need to pad on one side or the other. - (let ((padchars (make-string (- width (length value)) ? ))) - (if (eq pad 'left) - (concat padchars value) - (concat value padchars))))) - (error "Width not specified for variable/width inserter"))) + ;; Cannot work without width. + (unless width + (srecode-insert-report-error + dictionary + "Width not specified for variable/width inserter")) + + ;; Trim or pad to new length + (let* ((split (split-string width ":")) + (width (string-to-number (nth 0 split))) + (second (nth 1 split)) + (pad (cond + ((or (null second) (string= "right" second)) + 'right) + ((string= "left" second) + 'left) + (t + (srecode-insert-report-error + dictionary + "Unknown pad type %s" second))))) + (if (>= (length value) width) + ;; Simple case - too long. + (substring value 0 width) + ;; We need to pad on one side or the other. + (let ((padchars (make-string (- width (length value)) ? ))) + (if (eq pad 'left) + (concat padchars value) + (concat value padchars)))))) (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width) escape-start escape-end) @@ -758,13 +800,15 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." (defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate) dict slot) "Insert a subtemplate for the inserter STI with dictionary DICT." - ;; make sure that only dictionaries are used. - (when (not (srecode-dictionary-child-p dict)) - (error "Only section dictionaries allowed for %s" - (object-name-string sti))) + ;; Make sure that only dictionaries are used. + (unless (srecode-dictionary-child-p dict) + (srecode-insert-report-error + dict + "Only section dictionaries allowed for `%s'" + (object-name-string sti))) + ;; Output the code from the sub-template. - (srecode-insert-method (slot-value sti slot) dict) - ) + (srecode-insert-method (slot-value sti slot) dict)) (defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate) dictionary slot) @@ -774,14 +818,18 @@ The template to insert is stored in SLOT." (let ((dicts (srecode-dictionary-lookup-name dictionary (oref sti :object-name)))) (when (not (listp dicts)) - (error "Cannot insert section %S from non-section variable." - (oref sti :object-name))) + (srecode-insert-report-error + dictionary + "Cannot insert section %S from non-section variable." + (oref sti :object-name))) ;; If there is no section dictionary, then don't output anything ;; from this section. (while dicts (when (not (srecode-dictionary-p (car dicts))) - (error "Cannot insert section %S from non-section variable." - (oref sti :object-name))) + (srecode-insert-report-error + dictionary + "Cannot insert section %S from non-section variable." + (oref sti :object-name))) (srecode-insert-subtemplate sti (car dicts) slot) (setq dicts (cdr dicts))))) @@ -876,11 +924,13 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." "For the template inserter STI, lookup the template to include. Finds the template with this macro function part and stores it in this template instance." - (let* ((templatenamepart (oref sti :secondname)) - ) - ;; If there was no template name, throw an error - (if (not templatenamepart) - (error "Include macro %s needs a template name" (oref sti :object-name))) + (let ((templatenamepart (oref sti :secondname))) + ;; If there was no template name, throw an error. + (unless templatenamepart + (srecode-insert-report-error + dictionary + "Include macro `%s' needs a template name" + (oref sti :object-name))) ;; NOTE: We used to cache the template and not look it up a second time, ;; but changes in the template tables can change which template is @@ -920,11 +970,12 @@ this template instance." ;; Store the found template into this object for later use. (oset sti :includedtemplate tmpl)) - (if (not (oref sti includedtemplate)) - ;; @todo - Call into a debugger to help find the template in question. - (error "No template \"%s\" found for include macro `%s'" - templatenamepart (oref sti :object-name))) - )) + (unless (oref sti includedtemplate) + ;; @todo - Call into a debugger to help find the template in question. + (srecode-insert-report-error + dictionary + "No template \"%s\" found for include macro `%s'" + templatenamepart (oref sti :object-name))))) (defmethod srecode-insert-method ((sti srecode-template-inserter-include) dictionary) diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el index 58d8efc41e2..3635a39d383 100644 --- a/lisp/cedet/srecode/java.el +++ b/lisp/cedet/srecode/java.el @@ -26,6 +26,10 @@ ;;; Code: (require 'srecode/dictionary) +(require 'semantic/tag) + +(eval-when-compile + (require 'semantic/find)) ;;;###autoload (defun srecode-semantic-handle-:java (dict) @@ -33,7 +37,7 @@ Adds the following: FILENAME_AS_PACKAGE - file/dir converted into a java package name. FILENAME_AS_CLASS - file converted to a Java class name." - ;; A symbol representing + ;; Symbols needed by empty files. (let* ((fsym (file-name-nondirectory (buffer-file-name))) (fnox (file-name-sans-extension fsym)) (dir (file-name-directory (buffer-file-name))) @@ -44,12 +48,18 @@ FILENAME_AS_CLASS - file converted to a Java class name." (if (string-match "src/" dir) (setq dir (substring dir (match-end 0))) (setq dir (file-name-nondirectory (directory-file-name dir)))) + (setq dir (directory-file-name dir)) (while (string-match "/" dir) - (setq dir (replace-match "_" t t dir))) - (srecode-dictionary-set-value dict "FILENAME_AS_PACKAGE" - (concat dir "." fpak)) + (setq dir (replace-match "." t t dir))) + (srecode-dictionary-set-value dict "FILENAME_AS_PACKAGE" dir) (srecode-dictionary-set-value dict "FILENAME_AS_CLASS" fnox) - )) + ) + ;; Symbols needed for most other files with stuff in them. + (let ((pkg (semantic-find-tags-by-class 'package (current-buffer)))) + (when pkg + (srecode-dictionary-set-value dict "CURRENT_PACKAGE" (semantic-tag-name (car pkg))) + )) + ) (provide 'srecode/java) diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index 3f891092d7d..d6613ee1b02 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el @@ -297,7 +297,7 @@ if that file is NEW, otherwise assume the mode has not changed." (when (not srecode-current-map) (condition-case nil (setq srecode-current-map - (eieio-persistent-read srecode-map-save-file)) + (eieio-persistent-read srecode-map-save-file srecode-map)) (error ;; There was an error loading the old map. Create a new one. (setq srecode-current-map diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el index e2c07a0863e..805e324a8bd 100644 --- a/lisp/cedet/srecode/mode.el +++ b/lisp/cedet/srecode/mode.el @@ -32,8 +32,11 @@ (require 'srecode/map) (require 'semantic/decorate) (require 'semantic/wisent) +(require 'semantic/senator) +(require 'semantic/wisent) -(eval-when-compile (require 'semantic/find)) +(eval-when-compile + (require 'semantic/find)) ;;; Code: @@ -154,13 +157,22 @@ minor mode is enabled. :keymap srecode-mode-map ;; If we are turning things on, make sure we have templates for ;; this mode first. - (when srecode-minor-mode - (when (not (apply + (if srecode-minor-mode + (if (not (apply 'append (mapcar (lambda (map) (srecode-map-entries-for-mode map major-mode)) (srecode-get-maps)))) - (setq srecode-minor-mode nil)))) + (setq srecode-minor-mode nil) + ;; Else, we have success, do stuff + (add-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items nil t) + ) + (remove-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items t) + ) + ;; Run hooks if we are turning this on. + (when srecode-minor-mode + (run-hooks 'srecode-minor-mode-hook)) + srecode-minor-mode) ;;;###autoload (define-minor-mode global-srecode-minor-mode diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el index 827979f786a..877f6796c76 100644 --- a/lisp/cedet/srecode/semantic.el +++ b/lisp/cedet/srecode/semantic.el @@ -351,6 +351,12 @@ as `function' will leave point where code might be inserted." (setq temp (srecode-semantic-find-template "variable-const" prototype ctxt)) ) + + ((and (semantic-tag-of-class-p tag 'include) + (semantic-tag-get-attribute tag :system-flag)) + (setq temp (srecode-semantic-find-template + "system-include" prototype ctxt)) + ) ) (when (not temp) diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index 48eeab2408f..12fc08b90e4 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -70,13 +70,17 @@ (3 font-lock-builtin-face )) ("^\\(sectiondictionary\\)\\s-+\"" (1 font-lock-keyword-face)) + ("^\\s\s*\\(section\\)\\s-+\"" + (1 font-lock-keyword-face)) + ("^\\s\s*\\(end\\)" + (1 font-lock-keyword-face)) ("^\\(bind\\)\\s-+\"" (1 font-lock-keyword-face)) ;; Variable type setting - ("^\\(set\\)\\s-+\\(\\w+\\)\\s-+" + ("^\\s\s*\\(set\\)\\s-+\\(\\w+\\)\\s-+" (1 font-lock-keyword-face) (2 font-lock-variable-name-face)) - ("^\\(show\\)\\s-+\\(\\w+\\)\\s-*$" + ("^\\s\s*\\(show\\)\\s-+\\(\\w+\\)\\s-*$" (1 font-lock-keyword-face) (2 font-lock-variable-name-face)) ("\\<\\(macro\\)\\s-+\"" diff --git a/lisp/cedet/srecode/srt-wy.el b/lisp/cedet/srecode/srt-wy.el index 8beeb04940d..6f5d73aa312 100644 --- a/lisp/cedet/srecode/srt-wy.el +++ b/lisp/cedet/srecode/srt-wy.el @@ -24,6 +24,7 @@ ;;; Code: (require 'semantic/lex) +(eval-when-compile (require 'semantic/bovine)) ;;; Prologue ;; @@ -38,6 +39,8 @@ ("context" . CONTEXT) ("template" . TEMPLATE) ("sectiondictionary" . SECTIONDICTIONARY) + ("section" . SECTION) + ("end" . END) ("prompt" . PROMPT) ("default" . DEFAULT) ("defaultmacro" . DEFAULTMACRO) @@ -48,6 +51,8 @@ ("defaultmacro" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]") ("default" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]") ("prompt" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]") + ("end" summary "section ... end") + ("section" summary "section <name>\\n <dictionary entries>\\n end") ("sectiondictionary" summary "sectiondictionary <name>\\n <dictionary entries>") ("template" summary "template <name>\\n <template definition>") ("context" summary "context <name>") @@ -73,6 +78,7 @@ '(("number" :declared t) ("string" :declared t) ("symbol" :declared t) + ("property" syntax ":\\(\\w\\|\\s_\\)*") ("property" :declared t) ("newline" :declared t) ("punctuation" syntax "\\s.+") @@ -85,7 +91,7 @@ (eval-when-compile (require 'semantic/wisent/comp)) (wisent-compile-grammar - '((SET SHOW MACRO CONTEXT TEMPLATE SECTIONDICTIONARY PROMPT DEFAULT DEFAULTMACRO READ BIND newline TEMPLATE_BLOCK property symbol string number) + '((SET SHOW MACRO CONTEXT TEMPLATE SECTIONDICTIONARY SECTION END PROMPT DEFAULT DEFAULTMACRO READ BIND newline TEMPLATE_BLOCK property symbol string number) nil (template_file ((newline) @@ -141,7 +147,7 @@ (cons 'macro (read $2)))) (template - ((TEMPLATE templatename opt-dynamic-arguments newline opt-string opt-section-dictionaries TEMPLATE_BLOCK newline opt-bind) + ((TEMPLATE templatename opt-dynamic-arguments newline opt-string section-dictionary-list TEMPLATE_BLOCK newline opt-bind) (wisent-raw-tag (semantic-tag-new-function $2 nil $3 :documentation $5 :code $7 :dictionaries $6 :binding $9)))) (templatename @@ -162,26 +168,40 @@ ((string newline) (read $1)) (nil nil)) - (opt-section-dictionaries - (nil nil) - ((section-dictionary-list))) (section-dictionary-list - ((one-section-dictionary) - (list $1)) - ((section-dictionary-list one-section-dictionary) + (nil nil) + ((section-dictionary-list flat-section-dictionary) + (append $1 + (list $2))) + ((section-dictionary-list section-dictionary) (append $1 (list $2)))) - (one-section-dictionary - ((SECTIONDICTIONARY string newline variable-list) + (flat-section-dictionary + ((SECTIONDICTIONARY string newline flat-dictionary-entry-list) + (cons + (read $2) + $4))) + (flat-dictionary-entry-list + (nil nil) + ((flat-dictionary-entry-list flat-dictionary-entry) + (append $1 $2))) + (flat-dictionary-entry + ((variable) + (wisent-cook-tag $1))) + (section-dictionary + ((SECTION string newline dictionary-entry-list END newline) (cons (read $2) $4))) - (variable-list + (dictionary-entry-list + (nil nil) + ((dictionary-entry-list dictionary-entry) + (append $1 $2))) + (dictionary-entry ((variable) (wisent-cook-tag $1)) - ((variable-list variable) - (append $1 - (wisent-cook-tag $2)))) + ((section-dictionary) + (list $1))) (opt-bind ((BIND string newline) (read $2)) @@ -205,12 +225,12 @@ ;;; Analyzers - -(define-lex-string-type-analyzer srecode-template-wy--<punctuation>-string-analyzer - "string analyzer for <punctuation> tokens." - "\\s.+" +;; +(define-lex-regex-type-analyzer srecode-template-wy--<property>-regexp-analyzer + "regexp analyzer for <property> tokens." + ":\\(\\w\\|\\s_\\)*" nil - 'punctuation) + 'property) (define-lex-regex-type-analyzer srecode-template-wy--<symbol>-regexp-analyzer "regexp analyzer for <symbol> tokens." @@ -224,6 +244,12 @@ nil 'number) +(define-lex-string-type-analyzer srecode-template-wy--<punctuation>-string-analyzer + "string analyzer for <punctuation> tokens." + "\\s.+" + nil + 'punctuation) + (define-lex-sexp-type-analyzer srecode-template-wy--<string>-sexp-analyzer "sexp analyzer for <string> tokens." "\\s\"" diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index fb7ce6bad2f..37403c4fb9e 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el @@ -68,6 +68,15 @@ If this is nil, then this template table belongs to a set of generic templates that can be used with no additional dictionary values. When it is non-nil, it is assumed the template macros need specialized Emacs Lisp code to fill in the dictionary.") + (framework :initarg :framework + :type symbol + :documentation + "Tracks the name of the framework these templates belong to. +If nil, then this template table belongs to any framework, or can be +considered generic for all files of this language. +A framework might be a specific library or build environment for which +special templates are desired. OpenGL might be a framework that +exists for multiple languages.") (priority :initarg :priority :type number :documentation @@ -113,23 +122,39 @@ Tracks various lookup hash tables.") (major-mode :initarg :major-mode :documentation "Table of template tables for this major-mode.") + (modetables :initarg :modetables + :documentation + "All that tables unique to this major mode.") (tables :initarg :tables :documentation - "All the tables that have been defined for this major mode.") + "All the tables that can be used for this major mode.") ) "Track template tables for a particular major mode. Tracks all the template-tables for a specific major mode.") (defun srecode-get-mode-table (mode) "Get the SRecoder mode table for the major mode MODE. -Optional argument SOFT indicates to not make a new one if a table -was not found." - (let ((ans nil)) - (while (and (not ans) mode) - (setq ans (eieio-instance-tracker-find - mode 'major-mode 'srecode-mode-table-list) - mode (get-mode-local-parent mode))) - ans)) +This will find the mode table specific to MODE, and then +calculate all inherited templates from parent modes." + (let ((table nil) + (tmptable nil)) + (while mode + (setq tmptable (eieio-instance-tracker-find + mode 'major-mode 'srecode-mode-table-list) + mode (get-mode-local-parent mode)) + (when tmptable + (if (not table) + (progn + ;; If this is the first, update tables to have + ;; all the mode specific tables in it. + (setq table tmptable) + (oset table tables (oref table modetables))) + ;; If there already is a table, then reset the tables + ;; slot to include all the tables belonging to this new child node. + (oset table tables (append (oref table modetables) + (oref tmptable modetables))))) + ) + table)) (defun srecode-make-mode-table (mode) "Get the SRecoder mode table for the major mode MODE." @@ -140,6 +165,7 @@ was not found." (let* ((ms (if (stringp mode) mode (symbol-name mode))) (new (srecode-mode-table ms :major-mode mode + :modetables nil :tables nil))) ;; Save this new mode table in that mode's variable. (eval `(setq-mode-local ,mode srecode-table ,new)) @@ -149,7 +175,7 @@ was not found." (defmethod srecode-mode-table-find ((mt srecode-mode-table) file) "Look in the mode table MT for a template table from FILE. Return nil if there was none." - (object-assoc file 'file (oref mt tables))) + (object-assoc file 'file (oref mt modetables))) (defun srecode-mode-table-new (mode file &rest init) "Create a new template table for MODE in FILE. @@ -166,16 +192,16 @@ INIT are the initialization parameters for the new template table." init ))) ;; Whack the old table. - (when old (object-remove-from-list mt 'tables old)) + (when old (object-remove-from-list mt 'modetables old)) ;; Add the new table - (object-add-to-list mt 'tables new) + (object-add-to-list mt 'modetables new) ;; Sort the list in reverse order. When other routines ;; go front-to-back, the highest priority items are put ;; into the search table first, allowing lower priority items ;; to be the items found in the search table. - (object-sort-list mt 'tables (lambda (a b) - (> (oref a :priority) - (oref b :priority)))) + (object-sort-list mt 'modetables (lambda (a b) + (> (oref a :priority) + (oref b :priority)))) ;; Return it. new)) @@ -231,6 +257,9 @@ Use PREDICATE is the same as for the `sort' function." (when (oref tab :application) (princ "\nApplication: ") (princ (oref tab :application))) + (when (oref tab :framework) + (princ "\nFramework: ") + (princ (oref tab :framework))) (when (oref tab :project) (require 'srecode/find) ; For srecode-template-table-in-project-p (princ "\nProject Directory: ") diff --git a/lisp/color.el b/lisp/color.el index 94a98615d94..b915beacb0a 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -50,17 +50,17 @@ string (e.g. \"#ff12ec\"). Normally the return value is a list of three floating-point numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive. -Optional arg FRAME specifies the frame where the color is to be +Optional argument FRAME specifies the frame where the color is to be displayed. If FRAME is omitted or nil, use the selected frame. If FRAME cannot display COLOR, return nil." ;; `colors-values' maximum value is either 65535 or 65280 depending on the - ;; display system. So we use a white conversion to get the max value. + ;; display system. So we use a white conversion to get the max value. (let ((valmax (float (car (color-values "#ffffff"))))) (mapcar (lambda (x) (/ x valmax)) (color-values color frame)))) (defun color-rgb-to-hex (red green blue) "Return hexadecimal notation for the color RED GREEN BLUE. -RED GREEN BLUE must be numbers between 0.0 and 1.0 inclusive." +RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive." (format "#%02x%02x%02x" (* red 255) (* green 255) (* blue 255))) @@ -76,7 +76,7 @@ a string specifying a color's RGB components (e.g. \"#ff12ec\")." (defun color-gradient (start stop step-number) "Return a list with STEP-NUMBER colors from START to STOP. The color list builds a color gradient starting at color START to -color STOP. It does not include the START and STOP color in the +color STOP. It does not include the START and STOP color in the resulting list." (let* ((r (nth 0 start)) (g (nth 1 start)) @@ -93,8 +93,8 @@ resulting list." (nreverse result))) (defun color-hue-to-rgb (v1 v2 h) - "Compute hue from V1 and V2 H. Internally used by -`color-hsl-to-rgb'." + "Compute hue from V1 and V2 H. +Used internally by `color-hsl-to-rgb'." (cond ((< h (/ 1.0 6)) (+ v1 (* (- v2 v1) h 6.0))) ((< h 0.5) v2) @@ -102,13 +102,10 @@ resulting list." (t v1))) (defun color-hsl-to-rgb (H S L) - "Convert H S L (HUE, SATURATION, LUMINANCE) , where HUE is in -radians and both SATURATION and LUMINANCE are between 0.0 and -1.0, inclusive to their RGB representation. - -Return a list (RED, GREEN, BLUE) which each be numbers between -0.0 and 1.0, inclusive." - + "Convert hue, saturation and luminance to their RGB representation. +H, S, and L should each be numbers between 0.0 and 1.0, inclusive. +Return a list (RED GREEN BLUE), where each element is between 0.0 and 1.0, +inclusive." (if (= S 0.0) (list L L L) (let* ((m2 (if (<= L 0.5) @@ -116,18 +113,18 @@ Return a list (RED, GREEN, BLUE) which each be numbers between (- (+ L S) (* L S)))) (m1 (- (* 2.0 L) m2))) (list - (color-hue-to-rgb m1 m2 (+ H (/ 1.0 3))) + (color-hue-to-rgb m1 m2 (mod (+ H (/ 1.0 3)) 1)) (color-hue-to-rgb m1 m2 H) - (color-hue-to-rgb m1 m2 (- H (/ 1.0 3))))))) + (color-hue-to-rgb m1 m2 (mod (- H (/ 1.0 3)) 1)))))) (defun color-complement-hex (color) "Return the color that is the complement of COLOR, in hexadecimal format." (apply 'color-rgb-to-hex (color-complement color))) (defun color-rgb-to-hsv (red green blue) - "Convert RED, GREEN, and BLUE color components to HSV. + "Convert RGB color components to HSV. RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0, -inclusive. Return a list (HUE, SATURATION, VALUE), where HUE is +inclusive. Return a list (HUE SATURATION VALUE), where HUE is in radians and both SATURATION and VALUE are between 0.0 and 1.0, inclusive." (let* ((r (float red)) @@ -155,13 +152,10 @@ inclusive." (/ max 255.0))))) (defun color-rgb-to-hsl (red green blue) - "Convert RED GREEN BLUE colors to their HSL representation. + "Convert RGB colors to their HSL representation. RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0, -inclusive. - -Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians -and both SATURATION and LUMINANCE are between 0.0 and 1.0, -inclusive." +inclusive. Return a list (HUE SATURATION LUMINANCE), where +each element is between 0.0 and 1.0, inclusive." (let* ((r red) (g green) (b blue) @@ -187,7 +181,7 @@ inclusive." (defun color-srgb-to-xyz (red green blue) "Convert RED GREEN BLUE colors from the sRGB color space to CIE XYZ. -RED, BLUE and GREEN must be between 0 and 1, inclusive." +RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive." (let ((r (if (<= red 0.04045) (/ red 12.95) (expt (/ (+ red 0.055) 1.055) 2.4))) @@ -225,44 +219,44 @@ RED, BLUE and GREEN must be between 0 and 1, inclusive." (defun color-xyz-to-lab (X Y Z &optional white-point) "Convert CIE XYZ to CIE L*a*b*. WHITE-POINT specifies the (X Y Z) white point for the -conversion. If omitted or nil, use `color-d65-xyz'." +conversion. If omitted or nil, use `color-d65-xyz'." (pcase-let* ((`(,Xr ,Yr ,Zr) (or white-point color-d65-xyz)) (xr (/ X Xr)) - (yr (/ Y Yr)) - (zr (/ Z Zr)) - (fx (if (> xr color-cie-ε) - (expt xr (/ 1 3.0)) - (/ (+ (* color-cie-κ xr) 16) 116.0))) - (fy (if (> yr color-cie-ε) - (expt yr (/ 1 3.0)) - (/ (+ (* color-cie-κ yr) 16) 116.0))) - (fz (if (> zr color-cie-ε) - (expt zr (/ 1 3.0)) - (/ (+ (* color-cie-κ zr) 16) 116.0)))) - (list - (- (* 116 fy) 16) ; L - (* 500 (- fx fy)) ; a + (yr (/ Y Yr)) + (zr (/ Z Zr)) + (fx (if (> xr color-cie-ε) + (expt xr (/ 1 3.0)) + (/ (+ (* color-cie-κ xr) 16) 116.0))) + (fy (if (> yr color-cie-ε) + (expt yr (/ 1 3.0)) + (/ (+ (* color-cie-κ yr) 16) 116.0))) + (fz (if (> zr color-cie-ε) + (expt zr (/ 1 3.0)) + (/ (+ (* color-cie-κ zr) 16) 116.0)))) + (list + (- (* 116 fy) 16) ; L + (* 500 (- fx fy)) ; a (* 200 (- fy fz))))) ; b (defun color-lab-to-xyz (L a b &optional white-point) "Convert CIE L*a*b* to CIE XYZ. WHITE-POINT specifies the (X Y Z) white point for the -conversion. If omitted or nil, use `color-d65-xyz'." +conversion. If omitted or nil, use `color-d65-xyz'." (pcase-let* ((`(,Xr ,Yr ,Zr) (or white-point color-d65-xyz)) (fy (/ (+ L 16) 116.0)) - (fz (- fy (/ b 200.0))) - (fx (+ (/ a 500.0) fy)) - (xr (if (> (expt fx 3.0) color-cie-ε) - (expt fx 3.0) - (/ (- (* fx 116) 16) color-cie-κ))) - (yr (if (> L (* color-cie-κ color-cie-ε)) - (expt (/ (+ L 16) 116.0) 3.0) - (/ L color-cie-κ))) - (zr (if (> (expt fz 3) color-cie-ε) - (expt fz 3.0) - (/ (- (* 116 fz) 16) color-cie-κ)))) - (list (* xr Xr) ; X - (* yr Yr) ; Y + (fz (- fy (/ b 200.0))) + (fx (+ (/ a 500.0) fy)) + (xr (if (> (expt fx 3.0) color-cie-ε) + (expt fx 3.0) + (/ (- (* fx 116) 16) color-cie-κ))) + (yr (if (> L (* color-cie-κ color-cie-ε)) + (expt (/ (+ L 16) 116.0) 3.0) + (/ L color-cie-κ))) + (zr (if (> (expt fz 3) color-cie-ε) + (expt fz 3.0) + (/ (- (* 116 fz) 16) color-cie-κ)))) + (list (* xr Xr) ; X + (* yr Yr) ; Y (* zr Zr)))) ; Z (defun color-srgb-to-lab (red green blue) @@ -349,17 +343,14 @@ returned by `color-srgb-to-lab' or `color-xyz-to-lab'." (min 1.0 (max 0.0 value))) (defun color-saturate-hsl (H S L percent) - "Return a color PERCENT more saturated than the one defined in -H S L color-space. - -Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians -and both SATURATION and LUMINANCE are between 0.0 and 1.0, -inclusive." + "Make a color more saturated by a specified amount. +Given a color defined in terms of hue, saturation, and luminance +\(arguments H, S, and L), return a color that is PERCENT more +saturated. Returns a list (HUE SATURATION LUMINANCE)." (list H (color-clamp (+ S (/ percent 100.0))) L)) (defun color-saturate-name (name percent) - "Short hand to saturate COLOR by PERCENT. - + "Make a color with a specified NAME more saturated by PERCENT. See `color-saturate-hsl'." (apply 'color-rgb-to-hex (apply 'color-hsl-to-rgb @@ -370,32 +361,26 @@ See `color-saturate-hsl'." (list percent)))))) (defun color-desaturate-hsl (H S L percent) - "Return a color PERCENT less saturated than the one defined in -H S L color-space. - -Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians -and both SATURATION and LUMINANCE are between 0.0 and 1.0, -inclusive." + "Make a color less saturated by a specified amount. +Given a color defined in terms of hue, saturation, and luminance +\(arguments H, S, and L), return a color that is PERCENT less +saturated. Returns a list (HUE SATURATION LUMINANCE)." (color-saturate-hsl H S L (- percent))) (defun color-desaturate-name (name percent) - "Short hand to desaturate COLOR by PERCENT. - + "Make a color with a specified NAME less saturated by PERCENT. See `color-desaturate-hsl'." (color-saturate-name name (- percent))) (defun color-lighten-hsl (H S L percent) - "Return a color PERCENT lighter than the one defined in -H S L color-space. - -Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians -and both SATURATION and LUMINANCE are between 0.0 and 1.0, -inclusive." + "Make a color lighter by a specified amount. +Given a color defined in terms of hue, saturation, and luminance +\(arguments H, S, and L), return a color that is PERCENT lighter. +Returns a list (HUE SATURATION LUMINANCE)." (list H S (color-clamp (+ L (/ percent 100.0))))) (defun color-lighten-name (name percent) - "Short hand to saturate COLOR by PERCENT. - + "Make a color with a specified NAME lighter by PERCENT. See `color-lighten-hsl'." (apply 'color-rgb-to-hex (apply 'color-hsl-to-rgb @@ -406,17 +391,14 @@ See `color-lighten-hsl'." (list percent)))))) (defun color-darken-hsl (H S L percent) - "Return a color PERCENT darker than the one defined in -H S L color-space. - -Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians -and both SATURATION and LUMINANCE are between 0.0 and 1.0, -inclusive." + "Make a color darker by a specified amount. +Given a color defined in terms of hue, saturation, and luminance +\(arguments H, S, and L), return a color that is PERCENT darker. +Returns a list (HUE SATURATION LUMINANCE)." (color-lighten-hsl H S L (- percent))) (defun color-darken-name (name percent) - "Short hand to saturate COLOR by PERCENT. - + "Make a color with a specified NAME darker by PERCENT. See `color-darken-hsl'." (color-lighten-name name (- percent))) diff --git a/lisp/dired.el b/lisp/dired.el index 8cb3902161a..a17e1805339 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -248,6 +248,10 @@ This is what the do-commands look for, and what the mark-commands store.") ;; I see no reason ever to make this nil -- rms. ;; (> baud-rate search-slow-speed) "Non-nil means Dired shrinks the display buffer to fit the marked files.") +(make-obsolete-variable 'dired-shrink-to-fit + "use the Customization interface to add a new rule +to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\", +action argument symbol is `window-height' and its value is nil." "24.3") (defvar dired-file-version-alist) @@ -1877,7 +1881,6 @@ for more info): `dired-listing-switches' `dired-trivial-filenames' - `dired-shrink-to-fit' `dired-marker-char' `dired-del-marker' `dired-keep-marker-rename' @@ -2940,6 +2943,7 @@ or \"* [3 files]\"." (defun dired-pop-to-buffer (buf) "Pop up buffer BUF in a way suitable for Dired." + (declare (obsolete dired-mark-pop-up "24.3")) (let ((split-window-preferred-function (lambda (window) (or (and (let ((split-height-threshold 0)) @@ -2981,6 +2985,11 @@ BUFFER-OR-NAME; the default name being \" *Marked Files*\". The window is not shown if there is just one file, `dired-no-confirm' is t, or OP-SYMBOL is a member of the list in `dired-no-confirm'. +By default, Dired shrinks the display buffer to fit the marked files. +To disable this, use the Customization interface to add a new rule +to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\", +action argument symbol is `window-height' and its value is nil. + FILES is the list of marked files. It can also be (t FILENAME) in the case of one marked file, to distinguish that from using just the current file. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d49e56bd2ba..4dd44bb6f22 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1005,13 +1005,20 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (defvar byte-compile-root-dir nil "Directory relative to which file names in error messages are written.") +;; FIXME: We should maybe extend abbreviate-file-name with an optional DIR +;; argument to try and use a relative file-name. +(defun byte-compile-abbreviate-file (file &optional dir) + (let ((f1 (abbreviate-file-name file)) + (f2 (file-relative-name file dir))) + (if (< (length f2) (length f1)) f2 f1))) + ;; This is used as warning-prefix for the compiler. ;; It is always called with the warnings buffer current. (defun byte-compile-warning-prefix (level entry) (let* ((inhibit-read-only t) (dir (or byte-compile-root-dir default-directory)) (file (cond ((stringp byte-compile-current-file) - (format "%s:" (file-relative-name + (format "%s:" (byte-compile-abbreviate-file byte-compile-current-file dir))) ((bufferp byte-compile-current-file) (format "Buffer %s:" @@ -1019,7 +1026,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." ;; We might be simply loading a file that ;; contains explicit calls to byte-compile functions. ((stringp load-file-name) - (format "%s:" (file-relative-name load-file-name dir))) + (format "%s:" (byte-compile-abbreviate-file + load-file-name dir))) (t ""))) (pos (if (and byte-compile-current-file (integerp byte-compile-read-position)) @@ -1746,11 +1754,11 @@ The value is non-nil if there were no errors, nil if errors." (if (with-current-buffer input-buffer no-byte-compile) (progn ;; (message "%s not compiled because of `no-byte-compile: %s'" - ;; (file-relative-name filename) + ;; (byte-compile-abbreviate-file filename) ;; (with-current-buffer input-buffer no-byte-compile)) (when (file-exists-p target-file) (message "%s deleted because of `no-byte-compile: %s'" - (file-relative-name target-file) + (byte-compile-abbreviate-file target-file) (buffer-local-value 'no-byte-compile input-buffer)) (condition-case nil (delete-file target-file) (error nil))) ;; We successfully didn't compile this file. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 6fd52d67b90..6b308119abb 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -273,7 +273,9 @@ first will be printed into the backtrace buffer." (setq debugger-previous-window-height (window-total-size debugger-window)) ;; Unshow debugger-buffer. - (quit-restore-window debugger-window debugger-bury-or-kill)) + (quit-restore-window debugger-window debugger-bury-or-kill) + ;; Restore current buffer (Bug#12502). + (set-buffer debugger-old-buffer)) ;; Restore previous state of debugger-buffer in case we were ;; in a recursive invocation of the debugger, otherwise just ;; erase the buffer and put it into fundamental mode. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index d656dcf9526..18d1661e985 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -383,12 +383,9 @@ Return the result of the last expression in BODY." ;; All windows are dedicated or show `edebug-trace-buffer', split ;; selected one. (t (split-window)))) - (select-window window) (set-window-buffer window buffer) - (set-window-hscroll window 0);; should this be?? - ;; Selecting the window does not set the buffer until command loop. - ;;(set-buffer buffer) - ) + (select-window window) + (set-window-hscroll window 0)) ;; should this be?? (defun edebug-get-displayed-buffer-points () ;; Return a list of buffer point pairs, for all displayed buffers. diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index b5600560cdd..69fe762887f 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -4,7 +4,6 @@ ;;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.2 ;; Keywords: OO, lisp ;; Package: eieio @@ -225,8 +224,16 @@ a file. Optional argument NAME specifies a default file name." )))) (oref this file)) -(defun eieio-persistent-read (filename) - "Read a persistent object from FILENAME, and return it." +(defun eieio-persistent-read (filename &optional class allow-subclass) + "Read a persistent object from FILENAME, and return it. +Signal an error if the object in FILENAME is not a constructor +for CLASS. Optional ALLOW-SUBCLASS says that it is ok for +`eieio-persistent-read' to load in subclasses of class instead of +being pedantic." + (unless class + (message "Unsafe call to `eieio-persistent-read'.")) + (when (and class (not (class-p class))) + (signal 'wrong-type-argument (list 'class-p class))) (let ((ret nil) (buffstr nil)) (unwind-protect @@ -239,13 +246,171 @@ a file. Optional argument NAME specifies a default file name." ;; so that any initialize-instance calls that depend on ;; the current buffer will work. (setq ret (read buffstr)) - (if (not (child-of-class-p (car ret) 'eieio-persistent)) - (error "Corrupt object on disk")) - (setq ret (eval ret)) + (when (not (child-of-class-p (car ret) 'eieio-persistent)) + (error "Corrupt object on disk: Unknown saved object")) + (when (and class + (not (or (eq (car ret) class ) ; same class + (and allow-subclass + (child-of-class-p (car ret) class)) ; subclasses + ))) + (error "Corrupt object on disk: Invalid saved class")) + (setq ret (eieio-persistent-convert-list-to-object ret)) (oset ret file filename)) (kill-buffer " *tmp eieio read*")) ret)) +(defun eieio-persistent-convert-list-to-object (inputlist) + "Convert the INPUTLIST, representing object creation to an object. +While it is possible to just `eval' the INPUTLIST, this code instead +validates the existing list, and explicitly creates objects instead of +calling eval. This avoids the possibility of accidentally running +malicious code. + +Note: This function recurses when a slot of :type of some object is +identified, and needing more object creation." + (let ((objclass (nth 0 inputlist)) + (objname (nth 1 inputlist)) + (slots (nthcdr 2 inputlist)) + (createslots nil)) + + ;; If OBJCLASS is an eieio autoload object, then we need to load it. + (eieio-class-un-autoload objclass) + + (while slots + (let ((name (car slots)) + (value (car (cdr slots)))) + + ;; Make sure that the value proposed for SLOT is valid. + ;; In addition, strip out quotes, list functions, and update + ;; object constructors as needed. + (setq value (eieio-persistent-validate/fix-slot-value + objclass name value)) + + (push name createslots) + (push value createslots) + ) + + (setq slots (cdr (cdr slots)))) + + (apply 'make-instance objclass objname (nreverse createslots)) + + ;;(eval inputlist) + )) + +(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value) + "Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix. +A limited number of functions, such as quote, list, and valid object +constructor functions are considered valid. +Second, any text properties will be stripped from strings." + (cond ((consp proposed-value) + ;; Lists with something in them need special treatment. + (let ((slot-idx (eieio-slot-name-index class nil slot)) + (type nil) + (classtype nil)) + (setq slot-idx (- slot-idx 3)) + (setq type (aref (aref (class-v class) class-public-type) + slot-idx)) + + (setq classtype (eieio-persistent-slot-type-is-class-p + type)) + + (cond ((eq (car proposed-value) 'quote) + (car (cdr proposed-value))) + + ;; An empty list sometimes shows up as (list), which is dumb, but + ;; we need to support it for backward compat. + ((and (eq (car proposed-value) 'list) + (= (length proposed-value) 1)) + nil) + + ;; We have a slot with a single object that can be + ;; saved here. Recurse and evaluate that + ;; sub-object. + ((and classtype (class-p classtype) + (child-of-class-p (car proposed-value) classtype)) + (eieio-persistent-convert-list-to-object + proposed-value)) + + ;; List of object constructors. + ((and (eq (car proposed-value) 'list) + ;; 2nd item is a list. + (consp (car (cdr proposed-value))) + ;; 1st elt of 2nd item is a class name. + (class-p (car (car (cdr proposed-value)))) + ) + + ;; Check the value against the input class type. + ;; If something goes wrong, issue a smart warning + ;; about how a :type is needed for this to work. + (unless (and + ;; Do we have a type? + (consp classtype) (class-p (car classtype))) + (error "In save file, list of object constructors found, but no :type specified for slot %S" + slot)) + + ;; We have a predicate, but it doesn't satisfy the predicate? + (dolist (PV (cdr proposed-value)) + (unless (child-of-class-p (car PV) (car classtype)) + (error "Corrupt object on disk"))) + + ;; We have a list of objects here. Lets load them + ;; in. + (let ((objlist nil)) + (dolist (subobj (cdr proposed-value)) + (push (eieio-persistent-convert-list-to-object subobj) + objlist)) + ;; return the list of objects ... reversed. + (nreverse objlist))) + (t + proposed-value)))) + + ((stringp proposed-value) + ;; Else, check for strings, remove properties. + (substring-no-properties proposed-value)) + + (t + ;; Else, just return whatever the constant was. + proposed-value)) + ) + +(defun eieio-persistent-slot-type-is-class-p (type) + "Return the class refered to in TYPE. +If no class is referenced there, then return nil." + (cond ((class-p type) + ;; If the type is a class, then return it. + type) + + ((and (symbolp type) (string-match "-child$" (symbol-name type)) + (class-p (intern-soft (substring (symbol-name type) 0 + (match-beginning 0))))) + ;; If it is the predicate ending with -child, then return + ;; that class. Unfortunately, in EIEIO, typep of just the + ;; class is the same as if we used -child, so no further work needed. + (intern-soft (substring (symbol-name type) 0 + (match-beginning 0)))) + + ((and (symbolp type) (string-match "-list$" (symbol-name type)) + (class-p (intern-soft (substring (symbol-name type) 0 + (match-beginning 0))))) + ;; If it is the predicate ending with -list, then return + ;; that class and the predicate to use. + (cons (intern-soft (substring (symbol-name type) 0 + (match-beginning 0))) + type)) + + ((and (consp type) (eq (car type) 'or)) + ;; If type is a list, and is an or, it is possibly something + ;; like (or null myclass), so check for that. + (let ((ans nil)) + (dolist (subtype (cdr type)) + (setq ans (eieio-persistent-slot-type-is-class-p + subtype))) + ans)) + + (t + ;; No match, not a class. + nil))) + (defmethod object-write ((this eieio-persistent) &optional comment) "Write persistent object THIS out to the current stream. Optional argument COMMENT is a header line comment." diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 59aeb161d8e..cab9caad108 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -332,6 +332,16 @@ Argument OBJ is the object that has been customized." Optional argument GROUP is the sub-group of slots to display." (eieio-customize-object obj group)) +(defvar eieio-custom-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map widget-keymap) + map) + "Keymap for EIEIO Custom mode") + +(define-derived-mode eieio-custom-mode fundamental-mode "EIEIO Custom" + "Major mode for customizing EIEIO objects. +\\{eieio-custom-mode-map}") + (defmethod eieio-customize-object ((obj eieio-default-superclass) &optional group) "Customize OBJ in a specialized custom buffer. @@ -347,6 +357,7 @@ These groups are specified with the `:group' slot flag." (symbol-name g) "*"))) (setq buffer-read-only nil) (kill-all-local-variables) + (eieio-custom-mode) (erase-buffer) (let ((all (overlay-lists))) ;; Delete all the overlays. @@ -363,7 +374,6 @@ These groups are specified with the `:group' slot flag." (widget-insert "\n") (eieio-custom-object-apply-reset obj) ;; Now initialize the buffer - (use-local-map widget-keymap) (widget-setup) ;;(widget-minor-mode) (goto-char (point-min)) @@ -461,8 +471,4 @@ Return the symbol for the group, or nil" (provide 'eieio-custom) -;; Local variables: -;; generated-autoload-file: "eieio.el" -;; End: - ;;; eieio-custom.el ends here diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index b7f0deb0ee2..ec470d21bf3 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -92,12 +92,11 @@ PREBUTTONTEXT is some text between PREFIX and the object button." "Class: ") ;; Loop over all the public slots (let ((publa (aref cv class-public-a)) - (publd (aref cv class-public-d)) ) (while publa (if (slot-boundp obj (car publa)) - (let ((i (class-slot-initarg cl (car publa))) - (v (eieio-oref obj (car publa)))) + (let* ((i (class-slot-initarg cl (car publa))) + (v (eieio-oref obj (car publa)))) (data-debug-insert-thing v prefix (concat (if i (symbol-name i) @@ -112,7 +111,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." " ") 'font-lock-keyword-face)) ) - (setq publa (cdr publa) publd (cdr publd)))))) + (setq publa (cdr publa)))))) ;;; Augment the Data debug thing display list. (data-debug-add-specialized-thing (lambda (thing) (object-p thing)) diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index a899839f68a..64b240b9d5d 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -4,7 +4,6 @@ ;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.2 ;; Keywords: OO, lisp ;; Package: eieio @@ -30,6 +29,9 @@ ;; (require 'eieio) +(require 'button) +(require 'help-mode) +(require 'find-func) ;;; Code: ;;;###autoload @@ -85,11 +87,16 @@ Optional HEADERFCN should be called to insert a few bits of info first." (called-interactively-p 'interactive)) (when headerfcn (funcall headerfcn)) - - (if (class-option class :abstract) - (princ "Abstract ")) - (princ "Class ") (prin1 class) + (princ " is a") + (if (class-option class :abstract) + (princ "n abstract")) + (princ " class") + ;; Print file location + (when (get class 'class-location) + (princ " in `") + (princ (file-name-nondirectory (get class 'class-location))) + (princ "'")) (terpri) ;; Inheritance tree information (let ((pl (class-parents class))) @@ -251,8 +258,13 @@ Uses `eieio-describe-class' to describe the class being constructed." (eieio-describe-class fcn (lambda () ;; Describe the constructor part. - (princ "Object Constructor Function: ") (prin1 fcn) + (princ " is an object constructor function") + ;; Print file location + (when (get fcn 'class-location) + (princ " in `") + (princ (file-name-nondirectory (get fcn 'class-location))) + (princ "'")) (terpri) (princ "Creates an object of class ") (prin1 fcn) @@ -262,6 +274,16 @@ Uses `eieio-describe-class' to describe the class being constructed." )) ) +(defun eieio-build-class-list (class) + "Return a list of all classes that inherit from CLASS." + (if (class-p class) + (apply #'append + (mapcar + (lambda (c) + (append (list c) (eieio-build-class-list c))) + (class-children-fast class))) + (list class))) + (defun eieio-build-class-alist (&optional class instantiable-only buildlist) "Return an alist of all currently active classes for completion purposes. Optional argument CLASS is the class to start with. @@ -270,8 +292,9 @@ are not abstract, otherwise allow all classes. Optional argument BUILDLIST is more list to attach and is used internally." (let* ((cc (or class eieio-default-superclass)) (sublst (aref (class-v cc) class-children))) - (if (or (not instantiable-only) (not (class-abstract-p cc))) - (setq buildlist (cons (cons (symbol-name cc) 1) buildlist))) + (unless (assoc (symbol-name cc) buildlist) + (when (or (not instantiable-only) (not (class-abstract-p cc))) + (setq buildlist (cons (cons (symbol-name cc) 1) buildlist)))) (while sublst (setq buildlist (eieio-build-class-alist (car sublst) instantiable-only buildlist)) @@ -342,10 +365,10 @@ Also extracts information about all methods specific to this generic." (princ "Implementations:") (terpri) (terpri) - (let ((i 3) + (let ((i 4) (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] )) ;; Loop over fanciful generics - (while (< i 6) + (while (< i 7) (let ((gm (aref (get generic 'eieio-method-tree) i))) (when gm (princ "Generic ") @@ -357,8 +380,9 @@ Also extracts information about all methods specific to this generic." (setq i (1+ i))) (setq i 0) ;; Loop over defined class-specific methods - (while (< i 3) - (let ((gm (reverse (aref (get generic 'eieio-method-tree) i)))) + (while (< i 4) + (let ((gm (reverse (aref (get generic 'eieio-method-tree) i))) + location) (while gm (princ "`") (prin1 (car (car gm))) @@ -375,6 +399,13 @@ Also extracts information about all methods specific to this generic." ;; 3 because of cdr (princ (or (documentation (cdr (car gm))) "Undocumented")) + ;; Print file location if available + (when (and (setq location (get generic 'method-locations)) + (setq location (assoc (caar gm) location))) + (setq location (cadr location)) + (princ "\n\nDefined in `") + (princ (file-name-nondirectory location)) + (princ "'\n")) (setq gm (cdr gm)) (terpri) (terpri))) @@ -554,7 +585,65 @@ Optional argument HISTORYVAR is the variable to use as history." ;;; HELP AUGMENTATION ;; -;;;###autoload +(define-button-type 'eieio-method-def + :supertype 'help-xref + 'help-function (lambda (class method file) + (eieio-help-find-method-definition class method file)) + 'help-echo (purecopy "mouse-2, RET: find method's definition")) + +(define-button-type 'eieio-class-def + :supertype 'help-xref + 'help-function (lambda (class file) + (eieio-help-find-class-definition class file)) + 'help-echo (purecopy "mouse-2, RET: find class definition")) + +(defun eieio-help-find-method-definition (class method file) + (let ((filename (find-library-name file)) + location buf) + (when (null filename) + (error "Cannot find library %s" file)) + (setq buf (find-file-noselect filename)) + (with-current-buffer buf + (goto-char (point-min)) + (when + (re-search-forward + ;; Regexp for searching methods. + (concat "(defmethod[ \t\r\n]+" method + "\\([ \t\r\n]+:[a-zA-Z]+\\)?" + "[ \t\r\n]+(\\s-*(\\(\\sw\\|\\s_\\)+\\s-+" + class + "\\s-*)") + nil t) + (setq location (match-beginning 0)))) + (if (null location) + (message "Unable to find location in file") + (pop-to-buffer buf) + (goto-char location) + (recenter) + (beginning-of-line)))) + +(defun eieio-help-find-class-definition (class file) + (let ((filename (find-library-name file)) + location buf) + (when (null filename) + (error "Cannot find library %s" file)) + (setq buf (find-file-noselect filename)) + (with-current-buffer buf + (goto-char (point-min)) + (when + (re-search-forward + ;; Regexp for searching a class. + (concat "(defclass[ \t\r\n]+" class "[ \t\r\n]+") + nil t) + (setq location (match-beginning 0)))) + (if (null location) + (message "Unable to find location in file") + (pop-to-buffer buf) + (goto-char location) + (recenter) + (beginning-of-line)))) + + (defun eieio-help-mode-augmentation-maybee (&rest unused) "For buffers thrown into help mode, augment for EIEIO. Arguments UNUSED are not used." @@ -597,6 +686,26 @@ Arguments UNUSED are not used." (goto-char (point-min)) (while (re-search-forward "^\\(Private \\)?Slot:" nil t) (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) + (goto-char (point-min)) + (cond + ((looking-at "\\(.+\\) is a generic function") + (let ((mname (match-string 1)) + cname) + (while (re-search-forward "^`\\(.+\\)'[^\0]+?Defined in `\\(.+\\)'" nil t) + (setq cname (match-string-no-properties 1)) + (help-xref-button 2 'eieio-method-def cname + mname + (cadr (assoc (intern cname) + (get (intern mname) + 'method-locations))))))) + ((looking-at "\\(.+\\) is an object constructor function in `\\(.+\\)'") + (let ((cname (match-string-no-properties 1))) + (help-xref-button 2 'eieio-class-def cname + (get (intern cname) 'class-location)))) + ((looking-at "\\(.+\\) is a\\(n abstract\\)? class in `\\(.+\\)'") + (let ((cname (match-string-no-properties 1))) + (help-xref-button 3 'eieio-class-def cname + (get (intern cname) 'class-location))))) )))) ;;; SPEEDBAR SUPPORT @@ -698,8 +807,4 @@ INDENT is the current indentation level." (provide 'eieio-opt) -;; Local variables: -;; generated-autoload-file: "eieio.el" -;; End: - ;;; eieio-opt.el ends here diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el index f169e3f0cd2..327e5ced0e3 100644 --- a/lisp/emacs-lisp/eieio-speedbar.el +++ b/lisp/emacs-lisp/eieio-speedbar.el @@ -3,7 +3,6 @@ ;; Copyright (C) 1999-2002, 2005, 2007-2012 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.2 ;; Keywords: OO, tools ;; Package: eieio @@ -191,23 +190,24 @@ that path." ;;; DEFAULT SUPERCLASS baseline methods ;; -;; First, define methods onto the superclass so all classes -;; will have some minor support. +;; First, define methods with no class defined. These will work as if +;; on the default superclass. Specifying no class will allow these to be used +;; when no other methods are found, allowing multiple inheritance to work +;; reliably with eieio-speedbar. -(defmethod eieio-speedbar-description ((object eieio-default-superclass)) +(defmethod eieio-speedbar-description (object) "Return a string describing OBJECT." (object-name-string object)) -(defmethod eieio-speedbar-derive-line-path ((object eieio-default-superclass)) +(defmethod eieio-speedbar-derive-line-path (object) "Return the path which OBJECT has something to do with." nil) -(defmethod eieio-speedbar-object-buttonname ((object eieio-default-superclass)) +(defmethod eieio-speedbar-object-buttonname (object) "Return a string to use as a speedbar button for OBJECT." (object-name-string object)) -(defmethod eieio-speedbar-make-tag-line ((object eieio-default-superclass) - depth) +(defmethod eieio-speedbar-make-tag-line (object depth) "Insert a tag line into speedbar at point for OBJECT. By default, all objects appear as simple TAGS with no need to inherit from the special `eieio-speedbar' classes. Child classes should redefine this @@ -220,7 +220,7 @@ Argument DEPTH is the depth at which the tag line is inserted." 'speedbar-tag-face depth)) -(defmethod eieio-speedbar-handle-click ((object eieio-default-superclass)) +(defmethod eieio-speedbar-handle-click (object) "Handle a click action on OBJECT in speedbar. Any object can be represented as a tag in SPEEDBAR without special attributes. These default objects will be pulled up in a custom diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 9304f0e3918..7e64b42d9e4 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -94,21 +94,6 @@ default setting for optimization purposes.") (defvar eieio-optimize-primary-methods-flag t "Non-nil means to optimize the method dispatch on primary methods.") -;; State Variables -;; FIXME: These two constants below should have an `eieio-' prefix added!! -(defvar this nil - "Inside a method, this variable is the object in question. -DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots. - -Note: Embedded methods are no longer supported. The variable THIS is -still set for CLOS methods for the sake of routines like -`call-next-method'.") - -(defvar scoped-class nil - "This is set to a class when a method is running. -This is so we know we are allowed to check private parts or how to -execute a `call-next-method'. DO NOT SET THIS YOURSELF!") - (defvar eieio-initializing-object nil "Set to non-nil while initializing an object.") @@ -410,6 +395,7 @@ It creates an autoload function for CNAME's constructor." (autoload cname filename doc nil nil) (autoload (intern (concat (symbol-name cname) "-p")) filename "" nil nil) (autoload (intern (concat (symbol-name cname) "-child-p")) filename "" nil nil) + (autoload (intern (concat (symbol-name cname) "-list-p")) filename "" nil nil) )))) @@ -539,6 +525,23 @@ See `defclass' for more information." (and (eieio-object-p obj) (object-of-class-p obj ,cname)))) + ;; Create a handy list of the class test too + (let ((csym (intern (concat (symbol-name cname) "-list-p")))) + (fset csym + `(lambda (obj) + ,(format + "Test OBJ to see if it a list of objects which are a child of type %s" + cname) + (when (listp obj) + (let ((ans t)) ;; nil is valid + ;; Loop over all the elements of the input list, test + ;; each to make sure it is a child of the desired object class. + (while (and obj ans) + (setq ans (and (eieio-object-p (car obj)) + (object-of-class-p (car obj) ,cname))) + (setq obj (cdr obj))) + ans))))) + ;; When using typep, (typep OBJ 'myclass) returns t for objects which ;; are subclasses of myclass. For our predicates, however, it is ;; important for EIEIO to be backwards compatible, where @@ -781,6 +784,16 @@ See `defclass' for more information." (put cname 'variable-documentation (class-option-assoc options :documentation)) + ;; Save the file location where this class is defined. + (let ((fname (if load-in-progress + load-file-name + buffer-file-name)) + loc) + (when fname + (when (string-match "\\.elc$" fname) + (setq fname (substring fname 0 (1- (length fname))))) + (put cname 'class-location fname))) + ;; We have a list of custom groups. Store them into the options. (let ((g (class-option-assoc options :custom-groups))) (mapc (lambda (cg) (add-to-list 'g cg)) groups) @@ -1254,8 +1267,10 @@ IMPL is the symbol holding the method implementation." (eieio-generic-call-methodname ',method) (eieio-generic-call-arglst local-args) ) - (apply #',impl local-args) - ;;(,impl local-args) + ,(if (< emacs-major-version 24) + `(apply ,(list 'quote impl) local-args) + `(apply #',impl local-args)) + ;(,impl local-args) ))))))) (defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method) @@ -2008,13 +2023,13 @@ reverse-lookup that name, and recurse with the associated slot value." ((not (get fsym 'protection)) (+ 3 fsi)) ((and (eq (get fsym 'protection) 'protected) - scoped-class + (bound-and-true-p scoped-class) (or (child-of-class-p class scoped-class) (and (eieio-object-p obj) (child-of-class-p class (object-class obj))))) (+ 3 fsi)) ((and (eq (get fsym 'protection) 'private) - (or (and scoped-class + (or (and (bound-and-true-p scoped-class) (eieio-slot-originating-class-p scoped-class slot)) eieio-initializing-object)) (+ 3 fsi)) @@ -2319,7 +2334,7 @@ If REPLACEMENT-ARGS is non-nil, then use them instead of arguments passed in at the top level. Use `next-method-p' to find out if there is a next method to call." - (if (not scoped-class) + (if (not (bound-and-true-p scoped-class)) (error "`call-next-method' not called within a class specific method")) (if (and (/= eieio-generic-call-key method-primary) (/= eieio-generic-call-key method-static)) @@ -2403,6 +2418,18 @@ CLASS is the class this method is associated with." (if (< key method-num-lists) (let ((nsym (intern (symbol-name class) (aref emto key)))) (fset nsym method))) + ;; Save the defmethod file location in a symbol property. + (let ((fname (if load-in-progress + load-file-name + buffer-file-name)) + loc) + (when fname + (when (string-match "\\.elc$" fname) + (setq fname (substring fname 0 (1- (length fname))))) + (setq loc (get method-name 'method-locations)) + (add-to-list 'loc + (list class fname)) + (put method-name 'method-locations loc))) ;; Now optimize the entire obarray (if (< key method-num-lists) (let ((eieiomt-optimizing-obarray (aref emto key))) @@ -2807,9 +2834,9 @@ this object." (princ (make-string (* eieio-print-depth 2) ? )) (princ "(") (princ (symbol-name (class-constructor (object-class this)))) - (princ " \"") - (princ (object-name-string this)) - (princ "\"\n") + (princ " ") + (prin1 (object-name-string this)) + (princ "\n") ;; Loop over all the public slots (let ((publa (aref cv class-public-a)) (publd (aref cv class-public-d)) @@ -2876,7 +2903,6 @@ of `eq'." ) - ;;; Obsolete backward compatibility functions. ;; Needed to run byte-code compiled with the EIEIO of Emacs-23. diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 494d8a87e0e..284c591fc61 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -204,7 +204,7 @@ timers). If nil, allocate a new cell." "Insert TIMER into `timer-idle-list'. This arranges to activate TIMER whenever Emacs is next idle. If optional argument DONT-WAIT is non-nil, set TIMER to activate -immediately \(see beloe\), or at the right time, if Emacs is +immediately \(see below\), or at the right time, if Emacs is already idle. REUSE-CELL, if non-nil, is a cons cell to reuse when inserting @@ -450,7 +450,7 @@ be detected. (with-timeout-timers (cons -with-timeout-timer- with-timeout-timers))) (unwind-protect - ,@body + (progn ,@body) (cancel-timer -with-timeout-timer-)))))) ;; It is tempting to avoid the `if' altogether and instead run ;; timeout-forms in the timer, just before throwing `timeout'. diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 348765036ea..3558a8a90b5 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,8 @@ +2012-10-04 Julien Danjou <julien@danjou.info> + + * erc-desktop-notifications.el: Rename from erc-notifications to + avoid clash with 8+3 filename format and erc-notify.el. + 2012-09-25 Chong Yidong <cyd@gnu.org> * erc.el (erc-send-command): Use define-obsolete-function-alias. diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el index ab429a12589..fd9ac69aa3a 100644 --- a/lisp/erc/erc-autoaway.el +++ b/lisp/erc/erc-autoaway.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Jorgen Schaefer <forcer@forcix.cx> +;; Maintainer: FSF ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcAutoAway ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 5da3009c854..75f0047bf06 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -4,6 +4,7 @@ ;; Filename: erc-backend.el ;; Author: Lawrence Mitchell <wence@gmx.li> +;; Maintainer: FSF ;; Created: 2004-05-7 ;; Keywords: IRC chat client internet diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index a0593dcb743..687d11d144e 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1996-2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> +;; Maintainer: FSF ;; Keywords: irc, button, url, regexp ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcButton diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index c7103d6dc61..08b9c67f6c0 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -2,6 +2,10 @@ ;; Copyright (C) 2006-2012 Free Software Foundation, Inc. +;; Maintainer: FSF + +; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 1fb3930091e..1e299407fe9 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002-2003, 2005-2012 Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex@gnu.org> +;; Maintainer: FSF ;; URL: http://www.emacswiki.org/cgi-bin/wiki/ERC ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 4d0534d3d5e..ed8440315eb 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -6,7 +6,7 @@ ;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu> ;; Noah Friedman <friedman@prep.ai.mit.edu> ;; Per Persson <pp@sno.pp.se> -;; Maintainer: mlang@delysid.org +;; Maintainer: FSF ;; Keywords: comm, processes ;; Created: 1994-01-23 diff --git a/lisp/erc/erc-notifications.el b/lisp/erc/erc-desktop-notifications.el index 4faffc913c5..57b93f43219 100644 --- a/lisp/erc/erc-notifications.el +++ b/lisp/erc/erc-desktop-notifications.el @@ -1,4 +1,4 @@ -;; erc-notifications.el -- Send notification on PRIVMSG or mentions +;; erc-desktop-notifications.el -- Send notification on PRIVMSG or mentions ;; Copyright (C) 2012 Free Software Foundation, Inc. @@ -75,7 +75,7 @@ This will replace the last notification sent with this function." (member nick erc-track-exclude))) (erc-notifications-notify nick msg))))) -;;;###autoload(autoload 'erc-notifications-mode "erc-notifications" "" t) +;;;###autoload(autoload 'erc-notifications-mode "erc-desktop-notifications" "" t) (define-erc-module notifications nil "Send notifications on private message reception and mentions." ;; Enable @@ -85,6 +85,6 @@ This will replace the last notification sent with this function." ((remove-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG) (remove-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match))) -(provide 'erc-notifications) +(provide 'erc-desktop-notifications) -;;; erc-notifications.el ends here +;;; erc-desktop-notifications.el ends here diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el index f40eaa8c549..5e5d6c2c188 100644 --- a/lisp/erc/erc-ezbounce.el +++ b/lisp/erc/erc-ezbounce.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002, 2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Andreas Fuchs <asf@void.at> +;; Maintainer: FSF ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 2422ca10d0a..35e14eb0e29 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -4,6 +4,7 @@ ;; Author: Andreas Fuchs <asf@void.at> ;; Mario Lang <mlang@delysid.org> +;; Maintainer: FSF ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcFilling ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 49820b78ff6..892f82e2eba 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2001-2012 Free Software Foundation, Inc. ;; Author: Jorgen Schaefer <forcer@forcix.cx> +;; Maintainer: FSF ;; Most code is taken verbatim from erc.el, see there for the original ;; authors. diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el index 1a713009c85..d1e74fd4c54 100644 --- a/lisp/erc/erc-ibuffer.el +++ b/lisp/erc/erc-ibuffer.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002, 2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> +;; Maintainer: FSF ;; Keywords: comm ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcIbuffer diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el index aee808c0921..9586dd698a0 100644 --- a/lisp/erc/erc-identd.el +++ b/lisp/erc/erc-identd.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2003, 2006-2012 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> +;; Maintainer: FSF ;; Keywords: comm, processes ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index 53dc9e7abf2..7346fca1b8a 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2001-2002, 2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> +;; Maintainer: FSF ;; Keywords: comm ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcImenu diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index ae7f90003a6..ac6b311a0c4 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex@gnu.org> +;; Maintainer: FSF ;; Keywords: irc ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcAutoJoin diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el index 11384a25885..2d7f555971e 100644 --- a/lisp/erc/erc-lang.el +++ b/lisp/erc/erc-lang.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002, 2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex@gnu.org> -;; Maintainer: Alex Schroeder <alex@gnu.org> +;; Maintainer: FSF ;; Version: 1.0.0 ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcLang ;; Keywords: comm languages processes diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el index f7d33ffbc28..19afe2e79ee 100644 --- a/lisp/erc/erc-list.el +++ b/lisp/erc/erc-list.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2008-2012 Free Software Foundation, Inc. ;; Author: Tom Tromey <tromey@redhat.com> +;; Maintainer: FSF ;; Version: 0.1 ;; Keywords: comm diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index eefe51ae706..9e6c587bd12 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2003-2012 Free Software Foundation, Inc. ;; Author: Lawrence Mitchell <wence@gmx.li> +;; Maintainer: FSF ;; Keywords: IRC, chat, client, Internet, logging ;; Created 2003-04-26 diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index de7f2137197..8dcdcb9e2e6 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002-2012 Free Software Foundation, Inc. ;; Author: Andreas Fuchs <asf@void.at> +;; Maintainer: FSF ;; Keywords: comm, faces ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcMatch diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el index 5d96fc4d487..1aec2ad417f 100644 --- a/lisp/erc/erc-menu.el +++ b/lisp/erc/erc-menu.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2001-2002, 2004-2012 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> +;; Maintainer: FSF ;; Keywords: comm, processes, menu ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el index 355b345492c..fc4aeb10c84 100644 --- a/lisp/erc/erc-netsplit.el +++ b/lisp/erc/erc-netsplit.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> +;; Maintainer: FSF ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 9a3c562f0a6..89372555ccc 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002, 2004-2012 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@lexx.delysid.org> +;; Maintainer: FSF ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 3bf82c13f19..0b5e99180d6 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@lexx.delysid.org> +;; Maintainer: FSF ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el index 51ddc33e1c0..8eae6c83d15 100644 --- a/lisp/erc/erc-page.el +++ b/lisp/erc/erc-page.el @@ -2,6 +2,8 @@ ;; Copyright (C) 2002, 2004, 2006-2012 Free Software Foundation, Inc. +;; Maintainer: FSF + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index d3cbe8a5804..bb30fd90066 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Sacha Chua <sacha@free.net.ph> +;; Maintainer: FSF ;; Keywords: comm, convenience ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el index 6c5804c62a4..3d4a5d311b1 100644 --- a/lisp/erc/erc-replace.el +++ b/lisp/erc/erc-replace.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001-2002, 2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Andreas Fuchs <asf@void.at> -;; Maintainer: Mario Lang (mlang@delysid.org) +;; Maintainer: FSF ;; Keywords: IRC, client, Internet ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index 94af8a09200..6b3f3e3c3aa 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2001-2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex@gnu.org> +;; Maintainer: FSF ;; Keywords: comm ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcHistory diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index 5986d81efed..b3b80a5f851 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -2,6 +2,8 @@ ;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc. +;; Maintainer: FSF + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el index 8b44cb5146c..55336a68cfe 100644 --- a/lisp/erc/erc-sound.el +++ b/lisp/erc/erc-sound.el @@ -2,6 +2,8 @@ ;; Copyright (C) 2002-2003, 2006-2012 Free Software Foundation, Inc. +;; Maintainer: FSF + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 1e028e22642..4b98cf173be 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -4,6 +4,7 @@ ;; Author: Mario Lang <mlang@delysid.org> ;; Contributor: Eric M. Ludlam <eric@siege-engine.com> +;; Maintainer: FSF ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el index 441e3536e19..5f40cc39e89 100644 --- a/lisp/erc/erc-spelling.el +++ b/lisp/erc/erc-spelling.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2005-2012 Free Software Foundation, Inc. ;; Author: Jorgen Schaefer <forcer@forcix.cx> +;; Maintainer: FSF ;; Keywords: irc ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcSpelling diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 4ce2f18e041..1613d03912c 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> +;; Maintainer: FSF ;; Keywords: comm, processes, timestamp ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcStamp diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 88a3285730d..a204584b400 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2002-2012 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> +;; Maintainer: FSF ;; Keywords: comm, faces ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcChannelTracking diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index dd47c601ea8..8a219500ecb 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2003-2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Andreas Fuchs <asf@void.at> +;; Maintainer: FSF ;; Keywords: IRC, chat, client, Internet, logging ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el index 0328c407aa0..85356b39033 100644 --- a/lisp/erc/erc-xdcc.el +++ b/lisp/erc/erc-xdcc.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2003-2004, 2006-2012 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> +;; Maintainer: FSF ;; Keywords: comm, processes ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7feadc50aca..687e60da28a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -9,7 +9,7 @@ ;; Andreas Fuchs (afs@void.at) ;; Gergely Nagy (algernon@midgard.debian.net) ;; David Edmondson (dme@dme.org) -;; Maintainer: Michael Olson (mwolson@gnu.org) +;; Maintainer: FSF ;; Keywords: IRC, chat, client, Internet ;; Version: 5.3 diff --git a/lisp/facemenu.el b/lisp/facemenu.el index bcef25eb893..88b9ddc7f54 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -464,7 +464,8 @@ These special properties include `invisible', `intangible' and `read-only'." `(rgb-dist . COLOR)' sorts by the RGB distance to the specified color. `hsv' sorts by hue, saturation, value. `(hsv-dist . COLOR)' sorts by the HSV distance to the specified color -and excludes grayscale colors." +and excludes grayscale colors. +`luminance' sorts by relative luminance in the CIE XYZ color space." :type '(choice (const :tag "Unsorted" nil) (const :tag "Color Name" name) (const :tag "Red-Green-Blue" rgb) @@ -474,7 +475,8 @@ and excludes grayscale colors." (const :tag "Hue-Saturation-Value" hsv) (cons :tag "Distance on HSV cylinder" (const :tag "Distance from Color" hsv-dist) - (color :tag "Source Color Name"))) + (color :tag "Source Color Name")) + (const :tag "Luminance" luminance)) :group 'facemenu :version "24.1") @@ -504,7 +506,12 @@ filter out the color from the output." (+ (expt (- 180 (abs (- 180 (abs (- (nth 0 c-hsv) ; wrap hue (nth 0 o-hsv)))))) 2) (expt (- (nth 1 c-hsv) (nth 1 o-hsv)) 2) - (expt (- (nth 2 c-hsv) (nth 2 o-hsv)) 2))))))) + (expt (- (nth 2 c-hsv) (nth 2 o-hsv)) 2))))) + ((eq list-colors-sort 'luminance) + (let ((c-rgb (color-name-to-rgb color))) + (+ (* (nth 0 c-rgb) 0.21266729) + (* (nth 1 c-rgb) 0.7151522) + (* (nth 2 c-rgb) 0.0721750)))))) (defun list-colors-display (&optional list buffer-name callback) "Display names of defined colors, and show what they look like. diff --git a/lisp/faces.el b/lisp/faces.el index 3ee859305a5..803b7e68fc4 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2272,8 +2272,6 @@ terminal type to a different value." :version "21.1" :group 'mode-line-faces :group 'basic-faces) -;; No need to define aliases of this form for new faces. -(define-obsolete-face-alias 'modeline 'mode-line "21.1") (defface mode-line-inactive '((default diff --git a/lisp/files.el b/lisp/files.el index 76a13f6cefd..c3f9e1ef1a0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -22,7 +22,7 @@ ;;; Commentary: -;; Defines most of Emacs'ss file- and directory-handling functions, +;; Defines most of Emacs's file- and directory-handling functions, ;; including basic file visiting, backup generation, link handling, ;; ITS-id version control, load- and write-hook handling, and the like. diff --git a/lisp/help-macro.el b/lisp/help-macro.el index 0600484b6df..63ae02eb90d 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -69,6 +69,11 @@ (require 'backquote) +;; This needs to be autoloaded because it is used in the +;; make-help-screen macro. Using (bound-and-true-p three-step-help) +;; is not an acceptable alternative, because nothing loads help-macro +;; in a normal session, so any user customization would never be applied. +;;;###autoload (defcustom three-step-help nil "Non-nil means give more info about Help command in three steps. The three steps are simple prompt, prompt with all options, and diff --git a/lisp/ido.el b/lisp/ido.el index 94818fe57b0..4ab183b3207 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -496,7 +496,7 @@ as first char even if `ido-enable-prefix' is nil." ;; See http://debbugs.gnu.org/2042 for more info. (defcustom ido-buffer-disable-smart-matches t "Non-nil means not to re-order matches for buffer switching. -By default, ido aranges matches in the following order: +By default, ido arranges matches in the following order: full-matches > suffix matches > prefix matches > remaining matches @@ -1720,7 +1720,7 @@ This function also adds a hook to the minibuffer." (ido-final-slash dir) (not (ido-is-unc-host dir)) (file-directory-p dir) - (> (nth 7 (file-attributes dir)) ido-max-directory-size)))) + (> (nth 7 (file-attributes (file-truename dir))) ido-max-directory-size)))) (defun ido-set-current-directory (dir &optional subdir no-merge) ;; Set ido's current directory to DIR or DIR/SUBDIR diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 7b515a69a1c..a16d69c6cc2 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -68,7 +68,7 @@ should return a grid vector array that is the new solution. ;;;*** ;;;### (autoloads (ada-mode ada-add-extensions) "ada-mode" "progmodes/ada-mode.el" -;;;;;; (20427 14766 970343 0)) +;;;;;; (20576 42138 697312 0)) ;;; Generated autoloads from progmodes/ada-mode.el (autoload 'ada-add-extensions "ada-mode" "\ @@ -253,7 +253,7 @@ old-style time formats for entries are supported. ;;;### (autoloads (defadvice ad-activate ad-add-advice ad-disable-advice ;;;;;; ad-enable-advice ad-default-compilation-action ad-redefinition-action) -;;;;;; "advice" "emacs-lisp/advice.el" (20497 6436 957082 0)) +;;;;;; "advice" "emacs-lisp/advice.el" (20563 51044 242568 0)) ;;; Generated autoloads from emacs-lisp/advice.el (defvar ad-redefinition-action 'warn "\ @@ -398,7 +398,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) ;;;### (autoloads (align-newline-and-indent align-unhighlight-rule ;;;;;; align-highlight-rule align-current align-entire align-regexp -;;;;;; align) "align" "align.el" (20515 36389 544939 0)) +;;;;;; align) "align" "align.el" (20566 63671 243798 0)) ;;; Generated autoloads from align.el (autoload 'align "align" "\ @@ -489,7 +489,7 @@ A replacement function for `newline-and-indent', aligning as it goes. ;;;### (autoloads (outlineify-sticky allout-mode allout-mode-p allout-auto-activation ;;;;;; allout-setup allout-auto-activation-helper) "allout" "allout.el" -;;;;;; (20523 62082 997685 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from allout.el (autoload 'allout-auto-activation-helper "allout" "\ @@ -910,7 +910,7 @@ outline hot-spot navigation (see `allout-mode'). ;;;*** ;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp" -;;;;;; "net/ange-ftp.el" (20501 3499 284800 0)) +;;;;;; "net/ange-ftp.el" (20566 63671 243798 0)) ;;; Generated autoloads from net/ange-ftp.el (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir) @@ -965,7 +965,7 @@ the buffer *Birthday-Present-for-Name*. ;;;*** ;;;### (autoloads (ansi-color-process-output ansi-color-for-comint-mode-on) -;;;;;; "ansi-color" "ansi-color.el" (20523 30501 603360 0)) +;;;;;; "ansi-color" "ansi-color.el" (20577 33959 40183 0)) ;;; Generated autoloads from ansi-color.el (autoload 'ansi-color-for-comint-mode-on "ansi-color" "\ @@ -991,7 +991,7 @@ This is a good function to put in `comint-output-filter-functions'. ;;;*** ;;;### (autoloads (antlr-set-tabs antlr-mode antlr-show-makefile-rules) -;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20427 14766 970343 +;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20566 63671 243798 ;;;;;; 0)) ;;; Generated autoloads from progmodes/antlr-mode.el @@ -1160,8 +1160,8 @@ Returns list of symbols and documentation found. ;;;*** -;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20387 -;;;;;; 44199 24128 0)) +;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20585 +;;;;;; 28088 480237 0)) ;;; Generated autoloads from arc-mode.el (autoload 'archive-mode "arc-mode" "\ @@ -1573,7 +1573,7 @@ Major mode for editing Autoconf configure.ac files. ;;;*** ;;;### (autoloads (auto-insert-mode define-auto-insert auto-insert) -;;;;;; "autoinsert" "autoinsert.el" (20458 56750 651721 0)) +;;;;;; "autoinsert" "autoinsert.el" (20566 63671 243798 0)) ;;; Generated autoloads from autoinsert.el (autoload 'auto-insert "autoinsert" "\ @@ -1830,7 +1830,7 @@ seconds. ;;;*** ;;;### (autoloads (benchmark benchmark-run-compiled benchmark-run) -;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20355 10021 546955 +;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20557 48712 315579 ;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/benchmark.el @@ -1845,6 +1845,8 @@ See also `benchmark-run-compiled'. \(fn &optional REPETITIONS &rest FORMS)" nil t) +(put 'benchmark-run 'lisp-indent-function '1) + (autoload 'benchmark-run-compiled "benchmark" "\ Time execution of compiled version of FORMS. This is like `benchmark-run', but what is timed is a funcall of the @@ -1853,6 +1855,8 @@ result. The overhead of the `lambda's is accounted for. \(fn &optional REPETITIONS &rest FORMS)" nil t) +(put 'benchmark-run-compiled 'lisp-indent-function '1) + (autoload 'benchmark "benchmark" "\ Print the time taken for REPETITIONS executions of FORM. Interactively, REPETITIONS is taken from the prefix arg. @@ -1864,7 +1868,7 @@ For non-interactive use see also `benchmark-run' and ;;;*** ;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize) -;;;;;; "bibtex" "textmodes/bibtex.el" (20439 5925 915283 0)) +;;;;;; "bibtex" "textmodes/bibtex.el" (20576 13095 881042 0)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1989,8 +1993,8 @@ Binhex decode region between START and END. ;;;*** -;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (20545 -;;;;;; 57511 257469 0)) +;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (20551 +;;;;;; 9899 283417 0)) ;;; Generated autoloads from play/blackbox.el (autoload 'blackbox "blackbox" "\ @@ -2113,7 +2117,7 @@ a reflection. ;;;;;; bookmark-save bookmark-write bookmark-delete bookmark-insert ;;;;;; bookmark-rename bookmark-insert-location bookmark-relocate ;;;;;; bookmark-jump-other-window bookmark-jump bookmark-set) "bookmark" -;;;;;; "bookmark.el" (20514 15527 107017 0)) +;;;;;; "bookmark.el" (20585 28088 480237 0)) ;;; Generated autoloads from bookmark.el (define-key ctl-x-r-map "b" 'bookmark-jump) (define-key ctl-x-r-map "m" 'bookmark-set) @@ -2314,7 +2318,7 @@ Incremental search of bookmarks, hiding the non-matches as we go. ;;;;;; browse-url-xdg-open browse-url-at-mouse browse-url-at-point ;;;;;; browse-url browse-url-of-region browse-url-of-dired-file ;;;;;; browse-url-of-buffer browse-url-of-file browse-url-browser-function) -;;;;;; "browse-url" "net/browse-url.el" (20478 3673 653810 0)) +;;;;;; "browse-url" "net/browse-url.el" (20566 63671 243798 0)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function 'browse-url-default-browser "\ @@ -2630,7 +2634,7 @@ from `browse-url-elinks-wrapper'. ;;;*** ;;;### (autoloads (bs-show bs-customize bs-cycle-previous bs-cycle-next) -;;;;;; "bs" "bs.el" (20520 54308 826101 0)) +;;;;;; "bs" "bs.el" (20576 13095 881042 0)) ;;; Generated autoloads from bs.el (autoload 'bs-cycle-next "bs" "\ @@ -2670,8 +2674,8 @@ name of buffer configuration. ;;;*** -;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20478 3673 -;;;;;; 653810 0)) +;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from play/bubbles.el (autoload 'bubbles "bubbles" "\ @@ -2717,7 +2721,7 @@ Like `bug-reference-mode', but only buttonize in comments and strings. ;;;;;; batch-byte-compile-if-not-done display-call-tree byte-compile ;;;;;; compile-defun byte-compile-file byte-recompile-directory ;;;;;; byte-force-recompile byte-compile-enable-warning byte-compile-disable-warning) -;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20522 38631 876994 556000)) +;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20585 28088 480237 0)) ;;; Generated autoloads from emacs-lisp/bytecomp.el (put 'byte-compile-dynamic 'safe-local-variable 'booleanp) (put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp) @@ -2876,8 +2880,8 @@ from the cursor position. ;;;### (autoloads (defmath calc-embedded-activate calc-embedded calc-grab-rectangle ;;;;;; calc-grab-region full-calc-keypad calc-keypad calc-eval quick-calc -;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20504 -;;;;;; 23200 130482 0)) +;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20572 +;;;;;; 16038 402143 0)) ;;; Generated autoloads from calc/calc.el (define-key ctl-x-map "*" 'calc-dispatch) @@ -2984,8 +2988,8 @@ See the documentation for `calculator-mode' for more information. ;;;*** -;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20457 -;;;;;; 35879 688143 0)) +;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20577 +;;;;;; 33959 40183 0)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -3022,7 +3026,7 @@ Runs the following hooks: generating a calendar, if today's date is visible or not, respectively `calendar-initial-window-hook' - after first creating a calendar -This function is suitable for execution in a .emacs file. +This function is suitable for execution in an init file. \(fn &optional ARG)" t nil) @@ -3094,7 +3098,7 @@ Obsoletes `c-forward-into-nomenclature'. ;;;*** ;;;### (autoloads (c-guess-basic-syntax) "cc-engine" "progmodes/cc-engine.el" -;;;;;; (20486 36135 22104 0)) +;;;;;; (20557 48712 315579 0)) ;;; Generated autoloads from progmodes/cc-engine.el (autoload 'c-guess-basic-syntax "cc-engine" "\ @@ -3384,7 +3388,7 @@ Key bindings: ;;;*** ;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles" -;;;;;; "progmodes/cc-styles.el" (20355 10021 546955 0)) +;;;;;; "progmodes/cc-styles.el" (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/cc-styles.el (autoload 'c-set-style "cc-styles" "\ @@ -3401,8 +3405,8 @@ might get set too. If DONT-OVERRIDE is neither nil nor t, style variables whose default values have been set (more precisely, whose default values are not the symbol `set-from-style') will not be changed. This avoids overriding global settings -done in ~/.emacs. It is useful to call c-set-style from a mode hook in this -way. +done in your init file. It is useful to call c-set-style from a mode hook +in this way. If DONT-OVERRIDE is t, style variables that already have values (i.e., whose values are not the symbol `set-from-style') will not be overridden. CC Mode @@ -4129,8 +4133,8 @@ For example, the function `case' has an indent property ;;;*** -;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (20541 60450 -;;;;;; 834170 0)) +;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (20582 12953 +;;;;;; 724727 481000)) ;;; Generated autoloads from emacs-lisp/cl-lib.el (define-obsolete-variable-alias 'custom-print-functions 'cl-custom-print-functions "24.3") @@ -4158,7 +4162,7 @@ a future Emacs interpreter will be able to use it.") ;;;*** ;;;### (autoloads (c-macro-expand) "cmacexp" "progmodes/cmacexp.el" -;;;;;; (20495 51111 757560 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/cmacexp.el (autoload 'c-macro-expand "cmacexp" "\ @@ -4222,7 +4226,7 @@ If FRAME cannot display COLOR, return nil. ;;;### (autoloads (comint-redirect-results-list-from-process comint-redirect-results-list ;;;;;; comint-redirect-send-command-to-process comint-redirect-send-command ;;;;;; comint-run make-comint make-comint-in-buffer) "comint" "comint.el" -;;;;;; (20523 62082 997685 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from comint.el (defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\ @@ -4359,8 +4363,8 @@ on third call it again advances points to the next difference and so on. ;;;;;; compilation-shell-minor-mode compilation-mode compilation-start ;;;;;; compile compilation-disable-input compile-command compilation-search-path ;;;;;; compilation-ask-about-save compilation-window-height compilation-start-hook -;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20543 -;;;;;; 15782 195452 0)) +;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20576 +;;;;;; 42138 697312 0)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -5147,7 +5151,7 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. ;;;;;; customize-mode customize customize-push-and-save customize-save-variable ;;;;;; customize-set-variable customize-set-value custom-menu-sort-alphabetically ;;;;;; custom-buffer-sort-alphabetically custom-browse-sort-alphabetically) -;;;;;; "cus-edit" "cus-edit.el" (20523 62082 997685 0)) +;;;;;; "cus-edit" "cus-edit.el" (20577 33959 40183 0)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5504,8 +5508,8 @@ Mode used for cvs status output. ;;;*** -;;;### (autoloads (global-cwarn-mode turn-on-cwarn-mode cwarn-mode) -;;;;;; "cwarn" "progmodes/cwarn.el" (20478 3673 653810 0)) +;;;### (autoloads (global-cwarn-mode cwarn-mode) "cwarn" "progmodes/cwarn.el" +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from progmodes/cwarn.el (autoload 'cwarn-mode "cwarn" "\ @@ -5523,13 +5527,7 @@ if ARG is omitted or nil. \(fn &optional ARG)" t nil) -(autoload 'turn-on-cwarn-mode "cwarn" "\ -Turn on CWarn mode. - -This function is designed to be added to hooks, for example: - (add-hook 'c-mode-hook 'turn-on-cwarn-mode) - -\(fn)" nil nil) +(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1") (defvar global-cwarn-mode nil "\ Non-nil if Global-Cwarn mode is enabled. @@ -5784,7 +5782,7 @@ There is some minimal font-lock support (see vars ;;;*** ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" -;;;;;; "emacs-lisp/debug.el" (20497 6436 957082 0)) +;;;;;; "emacs-lisp/debug.el" (20572 16038 402143 0)) ;;; Generated autoloads from emacs-lisp/debug.el (setq debugger 'debug) @@ -5828,7 +5826,7 @@ To specify a nil argument interactively, exit with an empty minibuffer. ;;;*** ;;;### (autoloads (decipher-mode decipher) "decipher" "play/decipher.el" -;;;;;; (20478 3673 653810 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from play/decipher.el (autoload 'decipher "decipher" "\ @@ -5965,7 +5963,7 @@ any selection. ;;;*** ;;;### (autoloads (derived-mode-init-mode-variables define-derived-mode) -;;;;;; "derived" "emacs-lisp/derived.el" (20437 50597 545250 0)) +;;;;;; "derived" "emacs-lisp/derived.el" (20577 33959 40183 0)) ;;; Generated autoloads from emacs-lisp/derived.el (autoload 'define-derived-mode "derived" "\ @@ -6069,7 +6067,7 @@ relevant to POS. ;;;### (autoloads (desktop-revert desktop-save-in-desktop-dir desktop-change-dir ;;;;;; desktop-load-default desktop-read desktop-remove desktop-save ;;;;;; desktop-clear desktop-locals-to-save desktop-save-mode) "desktop" -;;;;;; "desktop.el" (20497 6436 957082 0)) +;;;;;; "desktop.el" (20577 33959 40183 0)) ;;; Generated autoloads from desktop.el (defvar desktop-save-mode nil "\ @@ -6234,6 +6232,8 @@ Also inhibit further loading of it. \(fn)" nil nil) +(make-obsolete 'desktop-load-default 'desktop-save-mode "22.1") + (autoload 'desktop-change-dir "desktop" "\ Change to desktop saved in DIRNAME. Kill the desktop as specified by variables `desktop-save-mode' and @@ -6289,14 +6289,14 @@ Deuglify broken Outlook (Express) articles and redisplay. ;;;*** ;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib" -;;;;;; "calendar/diary-lib.el" (20530 32124 97707 678000)) +;;;;;; "calendar/diary-lib.el" (20576 42138 697312 0)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ Generate the diary window for ARG days starting with the current date. If no argument is provided, the number of days of diary entries is governed by the variable `diary-number-of-entries'. A value of ARG less than 1 -does nothing. This function is suitable for execution in a `.emacs' file. +does nothing. This function is suitable for execution in an init file. \(fn &optional ARG)" t nil) @@ -6307,8 +6307,8 @@ Mail is sent to the address specified by `diary-mail-addr'. Here is an example of a script to call `diary-mail-entries', suitable for regular scheduling using cron (or at). Note that -since `emacs -script' does not load your `.emacs' file, you -should ensure that all relevant variables are set. +since `emacs -script' does not load your init file, you should +ensure that all relevant variables are set. #!/usr/bin/emacs -script ;; diary-rem.el - run the Emacs diary-reminder @@ -6331,8 +6331,9 @@ Major mode for editing the diary file. ;;;*** -;;;### (autoloads (diff-buffer-with-file diff-backup diff diff-command -;;;;;; diff-switches) "diff" "vc/diff.el" (20476 31768 298871 0)) +;;;### (autoloads (diff-buffer-with-file diff-latest-backup-file +;;;;;; diff-backup diff diff-command diff-switches) "diff" "vc/diff.el" +;;;;;; (20570 60708 993668 0)) ;;; Generated autoloads from vc/diff.el (defvar diff-switches (purecopy "-c") "\ @@ -6367,6 +6368,11 @@ With prefix arg, prompt for diff switches. \(fn FILE &optional SWITCHES)" t nil) +(autoload 'diff-latest-backup-file "diff" "\ +Return the latest existing backup of FILE, or nil. + +\(fn FN)" nil nil) + (autoload 'diff-buffer-with-file "diff" "\ View the differences between BUFFER and its associated file. This requires the external program `diff' to be in your `exec-path'. @@ -6376,7 +6382,7 @@ This requires the external program `diff' to be in your `exec-path'. ;;;*** ;;;### (autoloads (diff-minor-mode diff-mode) "diff-mode" "vc/diff-mode.el" -;;;;;; (20523 62082 997685 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from vc/diff-mode.el (autoload 'diff-mode "diff-mode" "\ @@ -6420,8 +6426,8 @@ Optional arguments are passed to `dig-invoke'. ;;;*** ;;;### (autoloads (dired-mode dired-noselect dired-other-frame dired-other-window -;;;;;; dired dired-listing-switches) "dired" "dired.el" (20539 18737 -;;;;;; 159373 0)) +;;;;;; dired dired-listing-switches) "dired" "dired.el" (20584 7212 +;;;;;; 455152 0)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6777,8 +6783,8 @@ Locate SOA record and increment the serial field. ;;;*** ;;;### (autoloads (doc-view-bookmark-jump doc-view-minor-mode doc-view-mode-maybe -;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20476 -;;;;;; 31768 298871 0)) +;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20581 +;;;;;; 31014 234484 0)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -6865,7 +6871,7 @@ Switch to *dungeon* buffer and start game. ;;;### (autoloads (easy-mmode-defsyntax easy-mmode-defmap easy-mmode-define-keymap ;;;;;; define-globalized-minor-mode define-minor-mode) "easy-mmode" -;;;;;; "emacs-lisp/easy-mmode.el" (20459 40320 865360 0)) +;;;;;; "emacs-lisp/easy-mmode.el" (20574 57775 217760 0)) ;;; Generated autoloads from emacs-lisp/easy-mmode.el (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) @@ -6877,12 +6883,17 @@ MODE (you can override this with the :variable keyword, see below). DOC is the documentation for the mode toggle command. The defined mode command takes one optional (prefix) argument. -Interactively with no prefix argument it toggles the mode. -With a prefix argument, it enables the mode if the argument is -positive and otherwise disables it. When called from Lisp, it -enables the mode if the argument is omitted or nil, and toggles -the mode if the argument is `toggle'. If DOC is nil this -function adds a basic doc-string stating these facts. +Interactively with no prefix argument, it toggles the mode. +A prefix argument enables the mode if the argument is positive, +and disables it otherwise. + +When called from Lisp, the mode command toggles the mode if the +argument is `toggle', disables the mode if the argument is a +non-positive integer, and enables the mode otherwise (including +if the argument is omitted or nil or a positive integer). + +If DOC is nil, give the mode command a basic doc-string +documenting what its argument does. Optional INIT-VALUE is the initial value of the mode's variable. Optional LIGHTER is displayed in the mode line when the mode is on. @@ -6995,8 +7006,8 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). ;;;*** ;;;### (autoloads (easy-menu-change easy-menu-create-menu easy-menu-do-define -;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20437 -;;;;;; 50597 545250 0)) +;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20563 +;;;;;; 1062 543283 0)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload 'easy-menu-define "easymenu" "\ @@ -7150,7 +7161,7 @@ To implement dynamic menus, either call this from ;;;;;; ebnf-eps-file ebnf-eps-directory ebnf-spool-region ebnf-spool-buffer ;;;;;; ebnf-spool-file ebnf-spool-directory ebnf-print-region ebnf-print-buffer ;;;;;; ebnf-print-file ebnf-print-directory ebnf-customize) "ebnf2ps" -;;;;;; "progmodes/ebnf2ps.el" (20495 51111 757560 0)) +;;;;;; "progmodes/ebnf2ps.el" (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/ebnf2ps.el (autoload 'ebnf-customize "ebnf2ps" "\ @@ -7424,8 +7435,8 @@ See `ebnf-style-database' documentation. ;;;;;; ebrowse-tags-find-declaration-other-window ebrowse-tags-find-definition ;;;;;; ebrowse-tags-view-definition ebrowse-tags-find-declaration ;;;;;; ebrowse-tags-view-declaration ebrowse-member-mode ebrowse-electric-choose-tree -;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20478 -;;;;;; 3673 653810 0)) +;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20561 +;;;;;; 18280 338092 0)) ;;; Generated autoloads from progmodes/ebrowse.el (autoload 'ebrowse-tree-mode "ebrowse" "\ @@ -7657,7 +7668,7 @@ an EDE controlled project. ;;;### (autoloads (edebug-all-forms edebug-all-defs edebug-eval-top-level-form ;;;;;; edebug-basic-spec edebug-all-forms edebug-all-defs) "edebug" -;;;;;; "emacs-lisp/edebug.el" (20523 62082 997685 0)) +;;;;;; "emacs-lisp/edebug.el" (20563 1062 543283 0)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -7987,7 +7998,7 @@ Display Ediff's registry. ;;;*** ;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe) -;;;;;; "ediff-util" "vc/ediff-util.el" (20355 10021 546955 0)) +;;;;;; "ediff-util" "vc/ediff-util.el" (20584 7212 455152 0)) ;;; Generated autoloads from vc/ediff-util.el (autoload 'ediff-toggle-multiframe "ediff-util" "\ @@ -8057,7 +8068,7 @@ or nil, use a compact 80-column format. ;;;*** ;;;### (autoloads (edt-emulation-on edt-set-scroll-margins) "edt" -;;;;;; "emulation/edt.el" (20448 20900 17488 0)) +;;;;;; "emulation/edt.el" (20566 63671 243798 0)) ;;; Generated autoloads from emulation/edt.el (autoload 'edt-set-scroll-margins "edt" "\ @@ -8075,7 +8086,7 @@ Turn on EDT Emulation. ;;;*** ;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20561 18280 338092 0)) ;;; Generated autoloads from ehelp.el (autoload 'with-electric-help "ehelp" "\ @@ -8319,7 +8330,7 @@ displayed. ;;;*** ;;;### (autoloads (emacs-lock-mode) "emacs-lock" "emacs-lock.el" -;;;;;; (20523 62082 997685 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from emacs-lock.el (autoload 'emacs-lock-mode "emacs-lock" "\ @@ -8347,7 +8358,7 @@ Other values are interpreted as usual. ;;;*** ;;;### (autoloads (report-emacs-bug-query-existing-bugs report-emacs-bug) -;;;;;; "emacsbug" "mail/emacsbug.el" (20523 62082 997685 0)) +;;;;;; "emacsbug" "mail/emacsbug.el" (20576 13095 881042 0)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -8368,7 +8379,7 @@ The result is an alist with items of the form (URL SUBJECT NO). ;;;;;; emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote ;;;;;; emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor ;;;;;; emerge-buffers emerge-files-with-ancestor emerge-files) "emerge" -;;;;;; "vc/emerge.el" (20355 10021 546955 0)) +;;;;;; "vc/emerge.el" (20576 42138 697312 0)) ;;; Generated autoloads from vc/emerge.el (autoload 'emerge-files "emerge" "\ @@ -8469,8 +8480,8 @@ Commands: ;;;;;; epa-sign-region epa-verify-cleartext-in-region epa-verify-region ;;;;;; epa-decrypt-armor-in-region epa-decrypt-region epa-encrypt-file ;;;;;; epa-sign-file epa-verify-file epa-decrypt-file epa-select-keys -;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20434 -;;;;;; 17809 692608 0)) +;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20577 +;;;;;; 33959 40183 0)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8697,7 +8708,7 @@ Encrypt marked files. ;;;### (autoloads (epa-global-mail-mode epa-mail-import-keys epa-mail-encrypt ;;;;;; epa-mail-sign epa-mail-verify epa-mail-decrypt epa-mail-mode) -;;;;;; "epa-mail" "epa-mail.el" (20355 10021 546955 0)) +;;;;;; "epa-mail" "epa-mail.el" (20566 63671 243798 0)) ;;; Generated autoloads from epa-mail.el (autoload 'epa-mail-mode "epa-mail" "\ @@ -8767,8 +8778,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads (epg-make-context) "epg" "epg.el" (20355 10021 -;;;;;; 546955 0)) +;;;### (autoloads (epg-make-context) "epg" "epg.el" (20577 33959 +;;;;;; 40183 0)) ;;; Generated autoloads from epg.el (autoload 'epg-make-context "epg" "\ @@ -8800,7 +8811,7 @@ Look at CONFIG and try to expand GROUP. ;;;*** ;;;### (autoloads (erc-handle-irc-url erc-tls erc erc-select-read-args) -;;;;;; "erc" "erc/erc.el" (20530 32114 546307 0)) +;;;;;; "erc" "erc/erc.el" (20577 33959 40183 0)) ;;; Generated autoloads from erc/erc.el (autoload 'erc-select-read-args "erc" "\ @@ -8855,15 +8866,15 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** -;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20434 17809 -;;;;;; 692608 0)) +;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from erc/erc-button.el (autoload 'erc-button-mode "erc-button" nil t) ;;;*** -;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20355 10021 -;;;;;; 546955 0)) +;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from erc/erc-capab.el (autoload 'erc-capab-identify-mode "erc-capab" nil t) @@ -9065,7 +9076,7 @@ You can save every individual message by putting this function on ;;;### (autoloads (erc-delete-dangerous-host erc-add-dangerous-host ;;;;;; erc-delete-keyword erc-add-keyword erc-delete-fool erc-add-fool ;;;;;; erc-delete-pal erc-add-pal) "erc-match" "erc/erc-match.el" -;;;;;; (20531 24613 995935 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from erc/erc-match.el (autoload 'erc-match-mode "erc-match") @@ -9119,7 +9130,7 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'. ;;;*** ;;;### (autoloads (erc-cmd-WHOLEFT) "erc-netsplit" "erc/erc-netsplit.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from erc/erc-netsplit.el (autoload 'erc-netsplit-mode "erc-netsplit") @@ -9174,7 +9185,7 @@ with args, toggle notify status of people. ;;;*** -;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20355 10021 546955 +;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20566 63671 243798 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-page.el (autoload 'erc-page-mode "erc-page") @@ -9188,8 +9199,8 @@ with args, toggle notify status of people. ;;;*** -;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20355 10021 -;;;;;; 546955 0)) +;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from erc/erc-replace.el (autoload 'erc-replace-mode "erc-replace") @@ -9247,15 +9258,15 @@ This will add a speedbar major display mode. ;;;*** -;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20434 17809 -;;;;;; 692608 0)) +;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from erc/erc-stamp.el (autoload 'erc-timestamp-mode "erc-stamp" nil t) ;;;*** ;;;### (autoloads (erc-track-minor-mode) "erc-track" "erc/erc-track.el" -;;;;;; (20427 14766 970343 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from erc/erc-track.el (defvar erc-track-minor-mode nil "\ @@ -9315,7 +9326,7 @@ Add a file to `erc-xdcc-files'. ;;;### (autoloads (ert-describe-test ert-run-tests-interactively ;;;;;; ert-run-tests-batch-and-exit ert-run-tests-batch ert-deftest) -;;;;;; "ert" "emacs-lisp/ert.el" (20355 10021 546955 0)) +;;;;;; "ert" "emacs-lisp/ert.el" (20576 42138 697312 0)) ;;; Generated autoloads from emacs-lisp/ert.el (autoload 'ert-deftest "ert" "\ @@ -9381,7 +9392,7 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). ;;;*** ;;;### (autoloads (ert-kill-all-test-buffers) "ert-x" "emacs-lisp/ert-x.el" -;;;;;; (20364 28960 773408 688000)) +;;;;;; (20576 42138 697312 0)) ;;; Generated autoloads from emacs-lisp/ert-x.el (put 'ert-with-test-buffer 'lisp-indent-function 1) @@ -9407,7 +9418,7 @@ Emacs shell interactive mode. ;;;*** ;;;### (autoloads (eshell-command-result eshell-command eshell) "eshell" -;;;;;; "eshell/eshell.el" (20523 62082 997685 0)) +;;;;;; "eshell/eshell.el" (20577 33959 40183 0)) ;;; Generated autoloads from eshell/eshell.el (autoload 'eshell "eshell" "\ @@ -10177,8 +10188,8 @@ This is used only in conjunction with `expand-add-abbrevs'. ;;;*** -;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20461 32935 -;;;;;; 300400 0)) +;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -10408,8 +10419,8 @@ Besides the choice of face, it is the same as `buffer-face-mode'. ;;;### (autoloads (feedmail-queue-reminder feedmail-run-the-queue ;;;;;; feedmail-run-the-queue-global-prompt feedmail-run-the-queue-no-prompts -;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20501 3499 -;;;;;; 284800 0)) +;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from mail/feedmail.el (autoload 'feedmail-send-it "feedmail" "\ @@ -10464,7 +10475,7 @@ you can set `feedmail-queue-reminder-alist' to nil. ;;;### (autoloads (ffap-bindings ffap-guess-file-name-at-point dired-at-point ;;;;;; ffap-at-mouse ffap-menu find-file-at-point ffap-next) "ffap" -;;;;;; "ffap.el" (20542 46798 773957 0)) +;;;;;; "ffap.el" (20566 63671 243798 0)) ;;; Generated autoloads from ffap.el (autoload 'ffap-next "ffap" "\ @@ -10656,8 +10667,8 @@ Copy directory-local variables to the -*- line. ;;;*** -;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20476 -;;;;;; 31768 298871 0)) +;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from filesets.el (autoload 'filesets-init "filesets" "\ @@ -11028,7 +11039,7 @@ Find packages matching a given keyword. ;;;*** ;;;### (autoloads (enable-flow-control-on enable-flow-control) "flow-ctrl" -;;;;;; "flow-ctrl.el" (20355 10021 546955 0)) +;;;;;; "flow-ctrl.el" (20566 63671 243798 0)) ;;; Generated autoloads from flow-ctrl.el (autoload 'enable-flow-control "flow-ctrl" "\ @@ -11066,8 +11077,8 @@ to get the effect of a C-q. ;;;*** ;;;### (autoloads (flymake-find-file-hook flymake-mode-off flymake-mode-on -;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20482 39076 -;;;;;; 289170 0)) +;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20551 9899 +;;;;;; 283417 0)) ;;; Generated autoloads from progmodes/flymake.el (autoload 'flymake-mode "flymake" "\ @@ -11097,7 +11108,7 @@ Turn flymake mode off. ;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off ;;;;;; turn-off-flyspell turn-on-flyspell flyspell-mode flyspell-prog-mode) -;;;;;; "flyspell" "textmodes/flyspell.el" (20434 17809 692608 0)) +;;;;;; "flyspell" "textmodes/flyspell.el" (20566 63671 243798 0)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -11133,7 +11144,7 @@ invoking `ispell-change-dictionary'. Consider using the `ispell-parser' to check your text. For instance consider adding: \(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex)))) -in your .emacs file. +in your init file. \\[flyspell-region] checks all words inside a region. \\[flyspell-buffer] checks the whole buffer. @@ -11651,8 +11662,8 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. ;;;*** ;;;### (autoloads (gnus gnus-other-frame gnus-slave gnus-no-server -;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20503 45225 -;;;;;; 529939 0)) +;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20552 30761 +;;;;;; 207103 0)) ;;; Generated autoloads from gnus/gnus.el (when (fboundp 'custom-autoload) (custom-autoload 'gnus-select-method "gnus")) @@ -11796,7 +11807,7 @@ If CLEAN, obsolete (ignore). ;;;*** ;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el" -;;;;;; (20522 9637 465791 0)) +;;;;;; (20578 54821 719276 0)) ;;; Generated autoloads from gnus/gnus-art.el (autoload 'gnus-article-prepare-display "gnus-art" "\ @@ -11951,8 +11962,8 @@ Reminder user if there are unsent drafts. ;;;### (autoloads (gnus-convert-png-to-face gnus-convert-face-to-png ;;;;;; gnus-face-from-file gnus-x-face-from-file gnus-insert-random-x-face-header -;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (20495 -;;;;;; 51111 757560 0)) +;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (20549 +;;;;;; 54573 979353 0)) ;;; Generated autoloads from gnus/gnus-fun.el (autoload 'gnus-random-x-face "gnus-fun" "\ @@ -12016,7 +12027,7 @@ If gravatars are already displayed, remove them. ;;;*** ;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group) -;;;;;; "gnus-group" "gnus/gnus-group.el" (20495 51111 757560 0)) +;;;;;; "gnus-group" "gnus/gnus-group.el" (20553 51627 169867 0)) ;;; Generated autoloads from gnus/gnus-group.el (autoload 'gnus-fetch-group "gnus-group" "\ @@ -12218,7 +12229,7 @@ Like `message-reply'. ;;;*** ;;;### (autoloads (gnus-notifications) "gnus-notifications" "gnus/gnus-notifications.el" -;;;;;; (20544 36659 880486 0)) +;;;;;; (20559 4008 701730 0)) ;;; Generated autoloads from gnus/gnus-notifications.el (autoload 'gnus-notifications "gnus-notifications" "\ @@ -12482,8 +12493,8 @@ Use \\[describe-mode] for more info. ;;;*** ;;;### (autoloads (goto-address-prog-mode goto-address-mode goto-address -;;;;;; goto-address-at-point) "goto-addr" "net/goto-addr.el" (20355 -;;;;;; 10021 546955 0)) +;;;;;; goto-address-at-point) "goto-addr" "net/goto-addr.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from net/goto-addr.el (define-obsolete-function-alias 'goto-address-at-mouse 'goto-address-at-point "22.1") @@ -12543,8 +12554,8 @@ Retrieve MAIL-ADDRESS gravatar and returns it. ;;;### (autoloads (zrgrep rgrep lgrep grep-find grep grep-mode grep-compute-defaults ;;;;;; grep-process-setup grep-setup-hook grep-find-command grep-command -;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20369 14251 -;;;;;; 85829 0)) +;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20572 16038 +;;;;;; 402143 0)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -12813,7 +12824,7 @@ it if ARG is omitted or nil. ;;;### (autoloads (setf gv-define-simple-setter gv-define-setter ;;;;;; gv--defun-declaration gv-define-expander gv-letplace gv-get) -;;;;;; "gv" "emacs-lisp/gv.el" (20542 46798 773957 0)) +;;;;;; "gv" "emacs-lisp/gv.el" (20580 10161 446444 0)) ;;; Generated autoloads from emacs-lisp/gv.el (autoload 'gv-get "gv" "\ @@ -12902,8 +12913,8 @@ The return value is the last VAL in the list. ;;;*** -;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20355 -;;;;;; 10021 546955 0)) +;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from play/handwrite.el (autoload 'handwrite "handwrite" "\ @@ -13126,7 +13137,7 @@ different regions. With numeric argument ARG, behaves like ;;;### (autoloads (doc-file-to-info doc-file-to-man describe-categories ;;;;;; describe-syntax describe-variable variable-at-point describe-function-1 ;;;;;; find-lisp-object-file-name help-C-file-name describe-function) -;;;;;; "help-fns" "help-fns.el" (20532 45476 981297 0)) +;;;;;; "help-fns" "help-fns.el" (20584 7212 455152 0)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ @@ -13205,21 +13216,6 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file. ;;;*** -;;;### (autoloads (three-step-help) "help-macro" "help-macro.el" -;;;;;; (20355 10021 546955 0)) -;;; Generated autoloads from help-macro.el - -(defvar three-step-help nil "\ -Non-nil means give more info about Help command in three steps. -The three steps are simple prompt, prompt with all options, and -window listing and describing the options. -A value of nil means skip the middle step, so that \\[help-command] \\[help-command] -gives the window that lists the options.") - -(custom-autoload 'three-step-help "help-macro" t) - -;;;*** - ;;;### (autoloads (help-bookmark-jump help-xref-on-pp help-insert-xref-button ;;;;;; help-xref-button help-make-xrefs help-buffer help-setup-xref ;;;;;; help-mode-finish help-mode-setup help-mode) "help-mode" "help-mode.el" @@ -13436,7 +13432,7 @@ This discards the buffer's undo information. ;;;### (autoloads (hi-lock-write-interactive-patterns hi-lock-unface-buffer ;;;;;; hi-lock-face-phrase-buffer hi-lock-face-buffer hi-lock-line-face-buffer ;;;;;; global-hi-lock-mode hi-lock-mode) "hi-lock" "hi-lock.el" -;;;;;; (20522 9637 465791 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ @@ -13628,7 +13624,7 @@ Several variables affect how the hiding is done: ;;;*** ;;;### (autoloads (turn-off-hideshow hs-minor-mode) "hideshow" "progmodes/hideshow.el" -;;;;;; (20541 6907 775259 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/hideshow.el (defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil))) "\ @@ -13826,61 +13822,10 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode. ;;;*** -;;;### (autoloads (make-hippie-expand-function hippie-expand hippie-expand-only-buffers -;;;;;; hippie-expand-ignore-buffers hippie-expand-max-buffers hippie-expand-no-restriction -;;;;;; hippie-expand-dabbrev-as-symbol hippie-expand-dabbrev-skip-space -;;;;;; hippie-expand-verbose hippie-expand-try-functions-list) "hippie-exp" -;;;;;; "hippie-exp.el" (20495 51111 757560 0)) +;;;### (autoloads (make-hippie-expand-function hippie-expand) "hippie-exp" +;;;;;; "hippie-exp.el" (20584 7212 455152 0)) ;;; Generated autoloads from hippie-exp.el -(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\ -The list of expansion functions tried in order by `hippie-expand'. -To change the behavior of `hippie-expand', remove, change the order of, -or insert functions in this list.") - -(custom-autoload 'hippie-expand-try-functions-list "hippie-exp" t) - -(defvar hippie-expand-verbose t "\ -Non-nil makes `hippie-expand' output which function it is trying.") - -(custom-autoload 'hippie-expand-verbose "hippie-exp" t) - -(defvar hippie-expand-dabbrev-skip-space nil "\ -Non-nil means tolerate trailing spaces in the abbreviation to expand.") - -(custom-autoload 'hippie-expand-dabbrev-skip-space "hippie-exp" t) - -(defvar hippie-expand-dabbrev-as-symbol t "\ -Non-nil means expand as symbols, i.e. syntax `_' is considered a letter.") - -(custom-autoload 'hippie-expand-dabbrev-as-symbol "hippie-exp" t) - -(defvar hippie-expand-no-restriction t "\ -Non-nil means that narrowed buffers are widened during search.") - -(custom-autoload 'hippie-expand-no-restriction "hippie-exp" t) - -(defvar hippie-expand-max-buffers nil "\ -The maximum number of buffers (apart from the current) searched. -If nil, all buffers are searched.") - -(custom-autoload 'hippie-expand-max-buffers "hippie-exp" t) - -(defvar hippie-expand-ignore-buffers (list (purecopy "^ \\*.*\\*$") 'dired-mode) "\ -A list specifying which buffers not to search (if not current). -Can contain both regexps matching buffer names (as strings) and major modes -\(as atoms)") - -(custom-autoload 'hippie-expand-ignore-buffers "hippie-exp" t) - -(defvar hippie-expand-only-buffers nil "\ -A list specifying the only buffers to search (in addition to current). -Can contain both regexps matching buffer names (as strings) and major modes -\(as atoms). If non-nil, this variable overrides the variable -`hippie-expand-ignore-buffers'.") - -(custom-autoload 'hippie-expand-only-buffers "hippie-exp" t) - (autoload 'hippie-expand "hippie-exp" "\ Try to expand text before point, using multiple methods. The expansion functions in `hippie-expand-try-functions-list' are @@ -13956,7 +13901,7 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and ;;;;;; holiday-bahai-holidays holiday-islamic-holidays holiday-christian-holidays ;;;;;; holiday-hebrew-holidays holiday-other-holidays holiday-local-holidays ;;;;;; holiday-oriental-holidays holiday-general-holidays) "holidays" -;;;;;; "calendar/holidays.el" (20530 32124 107724 973000)) +;;;;;; "calendar/holidays.el" (20566 63671 243798 0)) ;;; Generated autoloads from calendar/holidays.el (define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1") @@ -14031,7 +13976,7 @@ See the documentation for `calendar-holidays' for details.") (define-obsolete-variable-alias 'christian-holidays 'holiday-christian-holidays "23.1") -(defvar holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") (holiday-julian 12 25 "Eastern Orthodox Christmas") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) "\ +(defvar holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") (holiday-julian 12 25 "Christmas (Julian calendar)") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) "\ Christian holidays. See the documentation for `calendar-holidays' for details.") @@ -14074,7 +14019,7 @@ See the documentation for `calendar-holidays' for details.") (autoload 'holidays "holidays" "\ Display the holidays for last month, this month, and next month. If called with an optional prefix argument ARG, prompts for month and year. -This function is suitable for execution in a .emacs file. +This function is suitable for execution in a init file. \(fn &optional ARG)" t nil) @@ -14116,7 +14061,7 @@ Convert HTML to plain text in the current buffer. ;;;*** ;;;### (autoloads (htmlfontify-copy-and-link-dir htmlfontify-buffer) -;;;;;; "htmlfontify" "htmlfontify.el" (20355 10021 546955 0)) +;;;;;; "htmlfontify" "htmlfontify.el" (20577 33959 40183 0)) ;;; Generated autoloads from htmlfontify.el (autoload 'htmlfontify-buffer "htmlfontify" "\ @@ -14239,7 +14184,7 @@ bound to the current value of the filter. ;;;*** ;;;### (autoloads (ibuffer ibuffer-other-window ibuffer-list-buffers) -;;;;;; "ibuffer" "ibuffer.el" (20542 46798 773957 0)) +;;;;;; "ibuffer" "ibuffer.el" (20576 13312 649004 817000)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -14280,7 +14225,7 @@ FORMATS is the value to use for `ibuffer-formats'. ;;;### (autoloads (icalendar-import-buffer icalendar-import-file ;;;;;; icalendar-export-region icalendar-export-file) "icalendar" -;;;;;; "calendar/icalendar.el" (20434 17809 692608 0)) +;;;;;; "calendar/icalendar.el" (20577 33959 40183 0)) ;;; Generated autoloads from calendar/icalendar.el (autoload 'icalendar-export-file "icalendar" "\ @@ -14397,7 +14342,7 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads (idlwave-shell) "idlw-shell" "progmodes/idlw-shell.el" -;;;;;; (20427 14766 970343 0)) +;;;;;; (20572 16038 402143 0)) ;;; Generated autoloads from progmodes/idlw-shell.el (autoload 'idlwave-shell "idlw-shell" "\ @@ -14423,7 +14368,7 @@ See also the variable `idlwave-shell-prompt-pattern'. ;;;*** ;;;### (autoloads (idlwave-mode) "idlwave" "progmodes/idlwave.el" -;;;;;; (20458 56750 651721 0)) +;;;;;; (20576 42138 697312 0)) ;;; Generated autoloads from progmodes/idlwave.el (autoload 'idlwave-mode "idlwave" "\ @@ -14557,8 +14502,8 @@ The main features of this mode are ;;;;;; ido-find-alternate-file ido-find-file-other-window ido-find-file ;;;;;; ido-find-file-in-dir ido-switch-buffer-other-frame ido-insert-buffer ;;;;;; ido-kill-buffer ido-display-buffer ido-switch-buffer-other-window -;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20495 -;;;;;; 51111 757560 0)) +;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20585 +;;;;;; 28088 480237 0)) ;;; Generated autoloads from ido.el (defvar ido-mode nil "\ @@ -14817,7 +14762,7 @@ DEF, if non-nil, is the default value. ;;;*** -;;;### (autoloads (ielm) "ielm" "ielm.el" (20355 10021 546955 0)) +;;;### (autoloads (ielm) "ielm" "ielm.el" (20566 63671 243798 0)) ;;; Generated autoloads from ielm.el (autoload 'ielm "ielm" "\ @@ -14850,7 +14795,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;;;;;; create-image image-type-auto-detected-p image-type-available-p ;;;;;; image-type image-type-from-file-name image-type-from-file-header ;;;;;; image-type-from-buffer image-type-from-data) "image" "image.el" -;;;;;; (20523 62082 997685 0)) +;;;;;; (20574 57775 217760 0)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -15251,7 +15196,7 @@ An image file is one whose name has an extension in ;;;*** ;;;### (autoloads (image-bookmark-jump image-mode-as-text image-minor-mode -;;;;;; image-mode) "image-mode" "image-mode.el" (20476 31768 298871 +;;;;;; image-mode) "image-mode" "image-mode.el" (20580 10161 446444 ;;;;;; 0)) ;;; Generated autoloads from image-mode.el @@ -15297,7 +15242,7 @@ on these modes. ;;;*** ;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar -;;;;;; imenu-sort-function) "imenu" "imenu.el" (20511 39332 974340 +;;;;;; imenu-sort-function) "imenu" "imenu.el" (20577 33959 40183 ;;;;;; 0)) ;;; Generated autoloads from imenu.el @@ -15468,56 +15413,10 @@ Convert old Emacs Devanagari characters to UCS. ;;;*** -;;;### (autoloads (inferior-lisp inferior-lisp-prompt inferior-lisp-load-command -;;;;;; inferior-lisp-program inferior-lisp-filter-regexp) "inf-lisp" -;;;;;; "progmodes/inf-lisp.el" (20355 10021 546955 0)) +;;;### (autoloads (inferior-lisp) "inf-lisp" "progmodes/inf-lisp.el" +;;;;;; (20584 7212 455152 0)) ;;; Generated autoloads from progmodes/inf-lisp.el -(defvar inferior-lisp-filter-regexp (purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'") "\ -What not to save on inferior Lisp's input history. -Input matching this regexp is not saved on the input history in Inferior Lisp -mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword -\(as in :a, :c, etc.)") - -(custom-autoload 'inferior-lisp-filter-regexp "inf-lisp" t) - -(defvar inferior-lisp-program (purecopy "lisp") "\ -Program name for invoking an inferior Lisp in Inferior Lisp mode.") - -(custom-autoload 'inferior-lisp-program "inf-lisp" t) - -(defvar inferior-lisp-load-command (purecopy "(load \"%s\")\n") "\ -Format-string for building a Lisp expression to load a file. -This format string should use `%s' to substitute a file name -and should result in a Lisp expression that will command the inferior Lisp -to load that file. The default works acceptably on most Lisps. -The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\" -produces cosmetically superior output for this application, -but it works only in Common Lisp.") - -(custom-autoload 'inferior-lisp-load-command "inf-lisp" t) - -(defvar inferior-lisp-prompt (purecopy "^[^> \n]*>+:? *") "\ -Regexp to recognize prompts in the Inferior Lisp mode. -Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl, -and franz. This variable is used to initialize `comint-prompt-regexp' in the -Inferior Lisp buffer. - -This variable is only used if the variable -`comint-use-prompt-regexp' is non-nil. - -More precise choices: -Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\" -franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\" -kcl: \"^>+ *\" - -This is a fine thing to set in your .emacs file or through Custom.") - -(custom-autoload 'inferior-lisp-prompt "inf-lisp" t) - -(defvar inferior-lisp-mode-hook 'nil "\ -Hook for customizing Inferior Lisp mode.") - (autoload 'inferior-lisp "inf-lisp" "\ Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'. If there is a process already running in `*inferior-lisp*', just switch @@ -15537,7 +15436,7 @@ of `inferior-lisp-program'). Runs the hooks from ;;;;;; Info-goto-emacs-key-command-node Info-goto-emacs-command-node ;;;;;; Info-mode info-finder info-apropos Info-index Info-directory ;;;;;; Info-on-current-buffer info-standalone info-emacs-bug info-emacs-manual -;;;;;; info info-other-window) "info" "info.el" (20540 39589 424586 +;;;;;; info info-other-window) "info" "info.el" (20561 18280 338092 ;;;;;; 0)) ;;; Generated autoloads from info.el @@ -16067,7 +15966,7 @@ Add submenus to the File menu, to convert to and from various formats. ;;;;;; ispell-complete-word ispell-continue ispell-buffer ispell-comments-and-strings ;;;;;; ispell-region ispell-change-dictionary ispell-kill-ispell ;;;;;; ispell-help ispell-pdict-save ispell-word ispell-personal-dictionary) -;;;;;; "ispell" "textmodes/ispell.el" (20458 56750 651721 0)) +;;;;;; "ispell" "textmodes/ispell.el" (20566 63671 243798 0)) ;;; Generated autoloads from textmodes/ispell.el (put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) @@ -16280,7 +16179,7 @@ use the `x' command. (Any subsequent regions will be checked.) The `X' command aborts sending the message so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines -in your .emacs file: +in your init file: (add-hook 'message-send-hook 'ispell-message) ;; GNUS 5 (add-hook 'news-inews-hook 'ispell-message) ;; GNUS 4 (add-hook 'mail-send-hook 'ispell-message) @@ -16294,8 +16193,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to ;;;*** -;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20495 -;;;;;; 51111 757560 0)) +;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20577 +;;;;;; 33959 40183 0)) ;;; Generated autoloads from iswitchb.el (defvar iswitchb-mode nil "\ @@ -16773,8 +16672,8 @@ coding system names is determined from `latex-inputenc-coding-alist'. ;;;*** ;;;### (autoloads (latin1-display-ucs-per-lynx latin1-display latin1-display) -;;;;;; "latin1-disp" "international/latin1-disp.el" (20355 10021 -;;;;;; 546955 0)) +;;;;;; "latin1-disp" "international/latin1-disp.el" (20577 33959 +;;;;;; 40183 0)) ;;; Generated autoloads from international/latin1-disp.el (defvar latin1-display nil "\ @@ -16840,19 +16739,10 @@ generations (this defaults to 1). ;;;*** -;;;### (autoloads (global-linum-mode linum-mode linum-format) "linum" -;;;;;; "linum.el" (20355 10021 546955 0)) +;;;### (autoloads (global-linum-mode linum-mode) "linum" "linum.el" +;;;;;; (20580 10161 446444 0)) ;;; Generated autoloads from linum.el -(defvar linum-format 'dynamic "\ -Format used to display line numbers. -Either a format string like \"%7d\", `dynamic' to adapt the width -as needed, or a function that is called with a line number as its -argument and should evaluate to a string to be shown on that line. -See also `linum-before-numbering-hook'.") - -(custom-autoload 'linum-format "linum" t) - (autoload 'linum-mode "linum" "\ Toggle display of line numbers in the left margin (Linum mode). With a prefix argument ARG, enable Linum mode if ARG is positive, @@ -16919,7 +16809,7 @@ something strange, such as redefining an Emacs function. ;;;*** ;;;### (autoloads (locate-with-filter locate locate-ls-subdir-switches) -;;;;;; "locate" "locate.el" (20355 10021 546955 0)) +;;;;;; "locate" "locate.el" (20566 63671 243798 0)) ;;; Generated autoloads from locate.el (defvar locate-ls-subdir-switches (purecopy "-al") "\ @@ -16971,8 +16861,8 @@ except that FILTER is not optional. ;;;*** -;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20477 21160 -;;;;;; 227853 0)) +;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20584 7212 +;;;;;; 455152 0)) ;;; Generated autoloads from vc/log-edit.el (autoload 'log-edit "log-edit" "\ @@ -17149,14 +17039,14 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).") ;;;*** -;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (20355 -;;;;;; 10021 546955 0)) +;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from calendar/lunar.el (autoload 'lunar-phases "lunar" "\ Display the quarters of the moon for last month, this month, and next month. If called with an optional prefix argument ARG, prompts for month and year. -This function is suitable for execution in a .emacs file. +This function is suitable for execution in an init file. \(fn &optional ARG)" t nil) @@ -17175,20 +17065,6 @@ A major mode to edit m4 macro files. ;;;*** -;;;### (autoloads (macroexpand-all) "macroexp" "emacs-lisp/macroexp.el" -;;;;;; (20497 6436 957082 0)) -;;; Generated autoloads from emacs-lisp/macroexp.el - -(autoload 'macroexpand-all "macroexp" "\ -Return result of expanding macros at all levels in FORM. -If no macros are expanded, FORM is returned unchanged. -The second optional arg ENVIRONMENT specifies an environment of macro -definitions to shadow the loaded ones for use in file byte-compilation. - -\(fn FORM &optional ENVIRONMENT)" nil nil) - -;;;*** - ;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro ;;;;;; name-last-kbd-macro) "macros" "macros.el" (20355 10021 546955 ;;;;;; 0)) @@ -17312,7 +17188,7 @@ Convert mail domain DOMAIN to the country it corresponds to. ;;;### (autoloads (mail-hist-put-headers-into-history mail-hist-keep-history ;;;;;; mail-hist-enable mail-hist-define-keys) "mail-hist" "mail/mail-hist.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from mail/mail-hist.el (autoload 'mail-hist-define-keys "mail-hist" "\ @@ -17419,8 +17295,8 @@ matches may be returned from the message body. ;;;*** ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup -;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20387 -;;;;;; 44199 24128 0)) +;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ @@ -17471,7 +17347,7 @@ double-quotes. ;;;### (autoloads (mail-complete mail-completion-at-point-function ;;;;;; define-mail-alias expand-mail-aliases mail-complete-style) -;;;;;; "mailalias" "mail/mailalias.el" (20355 10021 546955 0)) +;;;;;; "mailalias" "mail/mailalias.el" (20577 33959 40183 0)) ;;; Generated autoloads from mail/mailalias.el (defvar mail-complete-style 'angles "\ @@ -17520,6 +17396,8 @@ current header, calls `mail-complete-function' and passes prefix ARG if any. \(fn ARG)" t nil) +(make-obsolete 'mail-complete 'mail-completion-at-point-function "24.1") + ;;;*** ;;;### (autoloads (mailclient-send-it) "mailclient" "mail/mailclient.el" @@ -17779,7 +17657,7 @@ recursion depth in the minibuffer prompt. This is only useful if ;;;;;; message-forward-make-body message-forward message-recover ;;;;;; message-supersede message-cancel-news message-followup message-wide-reply ;;;;;; message-reply message-news message-mail message-mode) "message" -;;;;;; "gnus/message.el" (20545 57511 257469 0)) +;;;;;; "gnus/message.el" (20567 23165 75548 0)) ;;; Generated autoloads from gnus/message.el (define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook) @@ -18224,7 +18102,7 @@ to its second argument TM. ;;;*** ;;;### (autoloads (minibuffer-electric-default-mode) "minibuf-eldef" -;;;;;; "minibuf-eldef.el" (20355 10021 546955 0)) +;;;;;; "minibuf-eldef.el" (20580 10161 446444 0)) ;;; Generated autoloads from minibuf-eldef.el (defvar minibuffer-electric-default-mode nil "\ @@ -18366,7 +18244,7 @@ whose file names match the specified wildcard. ;;;*** ;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/mixal-mode.el (autoload 'mixal-mode "mixal-mode" "\ @@ -18458,7 +18336,7 @@ Assume text has been decoded if DECODED is non-nil. ;;;*** ;;;### (autoloads (mml-attach-file mml-to-mime) "mml" "gnus/mml.el" -;;;;;; (20458 56750 651721 0)) +;;;;;; (20567 23165 75548 0)) ;;; Generated autoloads from gnus/mml.el (autoload 'mml-to-mime "mml" "\ @@ -18469,7 +18347,8 @@ Translate the current buffer from MML to MIME. (autoload 'mml-attach-file "mml" "\ Attach a file to the outgoing MIME message. The file is not inserted or encoded until you send the message with -`\\[message-send-and-exit]' or `\\[message-send]'. +`\\[message-send-and-exit]' or `\\[message-send]' in Message mode, +or `\\[mail-send-and-exit]' or `\\[mail-send]' in Mail mode. FILE is the name of the file to attach. TYPE is its content-type, a string of the form \"type/subtype\". DESCRIPTION @@ -18609,7 +18488,7 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text. ;;;*** ;;;### (autoloads (mouse-drag-drag mouse-drag-throw) "mouse-drag" -;;;;;; "mouse-drag.el" (20355 10021 546955 0)) +;;;;;; "mouse-drag.el" (20566 63671 243798 0)) ;;; Generated autoloads from mouse-drag.el (autoload 'mouse-drag-throw "mouse-drag" "\ @@ -18707,7 +18586,7 @@ different buffer menu using the function `msb'. ;;;;;; describe-current-coding-system describe-current-coding-system-briefly ;;;;;; describe-coding-system describe-character-set list-charset-chars ;;;;;; read-charset list-character-sets) "mule-diag" "international/mule-diag.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from international/mule-diag.el (autoload 'list-character-sets "mule-diag" "\ @@ -18843,19 +18722,10 @@ The default is 20. If LIMIT is negative, do not limit the listing. ;;;;;; detect-coding-with-priority with-coding-priority coding-system-translation-table-for-encode ;;;;;; coding-system-translation-table-for-decode coding-system-pre-write-conversion ;;;;;; coding-system-post-read-conversion lookup-nested-alist set-nested-alist -;;;;;; truncate-string-to-width store-substring string-to-sequence) -;;;;;; "mule-util" "international/mule-util.el" (20355 10021 546955 -;;;;;; 0)) +;;;;;; truncate-string-to-width store-substring) "mule-util" "international/mule-util.el" +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from international/mule-util.el -(autoload 'string-to-sequence "mule-util" "\ -Convert STRING to a sequence of TYPE which contains characters in STRING. -TYPE should be `list' or `vector'. - -\(fn STRING TYPE)" nil nil) - -(make-obsolete 'string-to-sequence "use `string-to-list' or `string-to-vector'." "22.1") - (defsubst string-to-list (string) "\ Return a list of characters in STRING." (append string nil)) @@ -18964,6 +18834,8 @@ coding systems ordered by priority. \(fn FROM TO PRIORITY-LIST)" nil t) +(make-obsolete 'detect-coding-with-priority 'with-coding-priority "23.1") + (autoload 'detect-coding-with-language-environment "mule-util" "\ Detect a coding system for the text between FROM and TO with LANG-ENV. The detection takes into account the coding system priorities for the @@ -19185,7 +19057,7 @@ STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality. ;;;*** ;;;### (autoloads (newsticker-start newsticker-running-p) "newst-backend" -;;;;;; "net/newst-backend.el" (20355 10021 546955 0)) +;;;;;; "net/newst-backend.el" (20577 33959 40183 0)) ;;; Generated autoloads from net/newst-backend.el (autoload 'newsticker-running-p "newst-backend" "\ @@ -19251,7 +19123,7 @@ running already. ;;;*** ;;;### (autoloads (newsticker-treeview) "newst-treeview" "net/newst-treeview.el" -;;;;;; (20434 17809 692608 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from net/newst-treeview.el (autoload 'newsticker-treeview "newst-treeview" "\ @@ -19311,7 +19183,7 @@ Generate NOV databases in all nnml directories. ;;;*** ;;;### (autoloads (disable-command enable-command disabled-command-function) -;;;;;; "novice" "novice.el" (20478 3673 653810 0)) +;;;;;; "novice" "novice.el" (20566 63671 243798 0)) ;;; Generated autoloads from novice.el (define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1") @@ -19336,8 +19208,8 @@ to future sessions. (autoload 'disable-command "novice" "\ Require special confirmation to execute COMMAND from now on. COMMAND must be a symbol. -This command alters the user's .emacs file so that this will apply -to future sessions. +This command alters your init file so that this choice applies to +future sessions. \(fn COMMAND)" t nil) @@ -19458,7 +19330,7 @@ the variable `nxml-enabled-unicode-blocks'. ;;;;;; org-babel-pop-to-session-maybe org-babel-load-in-session-maybe ;;;;;; org-babel-expand-src-block-maybe org-babel-view-src-block-info ;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob" -;;;;;; "org/ob.el" (20417 65331 139825 0)) +;;;;;; "org/ob.el" (20585 28088 480237 0)) ;;; Generated autoloads from org/ob.el (autoload 'org-babel-execute-safely-maybe "ob" "\ @@ -19546,13 +19418,13 @@ session. Initiate session for current code block. If called with a prefix argument then resolve any variable references in the header arguments and assign these variables in -the session. Copy the body of the code block to the kill ring. +the session. Copy the body of the code block to the kill ring. \(fn &optional ARG INFO)" t nil) (autoload 'org-babel-switch-to-session "ob" "\ Switch to the session of the current code block. -Uses `org-babel-initiate-session' to start the session. If called +Uses `org-babel-initiate-session' to start the session. If called with a prefix argument then this is passed on to `org-babel-initiate-session'. @@ -19674,7 +19546,7 @@ With optional prefix argument ARG, jump backward ARG many source blocks. \(fn &optional ARG)" t nil) (autoload 'org-babel-mark-block "ob" "\ -Mark current src block +Mark current src block. \(fn)" t nil) @@ -19692,8 +19564,8 @@ Describe all keybindings behind `org-babel-key-prefix'. ;;;*** ;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe -;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (20355 10021 -;;;;;; 546955 0)) +;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (20585 28088 +;;;;;; 480237 0)) ;;; Generated autoloads from org/ob-lob.el (autoload 'org-babel-lob-ingest "ob-lob" "\ @@ -19718,7 +19590,7 @@ Return a Library of Babel function call as a string. ;;;### (autoloads (org-babel-tangle org-babel-tangle-file org-babel-load-file ;;;;;; org-babel-tangle-lang-exts) "ob-tangle" "org/ob-tangle.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/ob-tangle.el (defvar org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "\ @@ -19783,7 +19655,7 @@ startup file, `~/.emacs-octave'. ;;;*** ;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el" -;;;;;; (20388 65061 302484 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/octave-mod.el (autoload 'octave-mode "octave-mod" "\ @@ -19844,12 +19716,12 @@ Variables you can use to customize Octave mode Turning on Octave mode runs the hook `octave-mode-hook'. To begin using this mode for all `.m' files that you edit, add the -following lines to your `.emacs' file: +following lines to your init file: (add-to-list 'auto-mode-alist '(\"\\\\.m\\\\'\" . octave-mode)) To automatically turn on the abbrev and auto-fill features, -add the following lines to your `.emacs' file as well: +add the following lines to your init file as well: (add-hook 'octave-mode-hook (lambda () @@ -19865,13 +19737,16 @@ including a reproducible test case and send the message. ;;;*** -;;;### (autoloads (org-customize org-reload org-require-autoloaded-modules -;;;;;; org-submit-bug-report org-cycle-agenda-files org-switchb -;;;;;; org-map-entries org-open-link-from-string org-open-at-point-global -;;;;;; org-insert-link-global org-store-link org-run-like-in-org-mode -;;;;;; turn-on-orgstruct++ turn-on-orgstruct orgstruct-mode org-global-cycle -;;;;;; org-mode org-version org-babel-do-load-languages) "org" "org/org.el" -;;;;;; (20420 41510 996439 0)) +;;;### (autoloads (org-unindent-buffer org-transpose-element org-narrow-to-element +;;;;;; org-mark-element org-drag-element-forward org-drag-element-backward +;;;;;; org-up-element org-backward-element org-forward-element org-customize +;;;;;; org-reload org-require-autoloaded-modules org-submit-bug-report +;;;;;; org-cycle-agenda-files org-switchb org-map-entries org-update-all-dblocks +;;;;;; org-open-link-from-string org-open-at-point-global org-insert-link-global +;;;;;; org-store-link org-run-like-in-org-mode turn-on-orgstruct++ +;;;;;; turn-on-orgstruct orgstruct-mode org-global-cycle org-mode +;;;;;; org-version org-babel-do-load-languages) "org" "org/org.el" +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -19881,9 +19756,11 @@ Load the languages defined in `org-babel-load-languages'. (autoload 'org-version "org" "\ Show the org-mode version in the echo area. -With prefix arg HERE, insert it at point. +With prefix argument HERE, insert it at point. +When FULL is non-nil, use a verbose version string. +When MESSAGE is non-nil, display a message with the version. -\(fn &optional HERE)" t nil) +\(fn &optional HERE FULL MESSAGE)" t nil) (autoload 'org-mode "org" "\ Outline-based notes management and organizer, alias @@ -19987,6 +19864,12 @@ Open a link in the string S, as if it was in Org-mode. \(fn S &optional ARG REFERENCE-BUFFER)" t nil) +(autoload 'org-update-all-dblocks "org" "\ +Update all dynamic blocks in the buffer. +This function can be used in a hook. + +\(fn)" t nil) + (autoload 'org-map-entries "org" "\ Call FUNC at each headline selected by MATCH in SCOPE. @@ -20098,16 +19981,77 @@ Call the customize function with org as argument. \(fn)" t nil) +(autoload 'org-forward-element "org" "\ +Move forward by one element. +Move to the next element at the same level, when possible. + +\(fn)" t nil) + +(autoload 'org-backward-element "org" "\ +Move backward by one element. +Move to the previous element at the same level, when possible. + +\(fn)" t nil) + +(autoload 'org-up-element "org" "\ +Move to upper element. + +\(fn)" t nil) + +(defvar org-element-greater-elements) + +(autoload 'org-drag-element-backward "org" "\ +Move backward element at point. + +\(fn)" t nil) + +(autoload 'org-drag-element-forward "org" "\ +Move forward element at point. + +\(fn)" t nil) + +(autoload 'org-mark-element "org" "\ +Put point at beginning of this element, mark at end. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next element after the +ones already marked. + +\(fn)" t nil) + +(autoload 'org-narrow-to-element "org" "\ +Narrow buffer to current element. + +\(fn)" t nil) + +(autoload 'org-transpose-element "org" "\ +Transpose current and previous elements, keeping blank lines between. +Point is moved after both elements. + +\(fn)" t nil) + +(autoload 'org-unindent-buffer "org" "\ +Un-indent the visible part of the buffer. +Relative indentation (between items, inside blocks, etc.) isn't +modified. + +\(fn)" t nil) + ;;;*** ;;;### (autoloads (org-agenda-to-appt org-calendar-goto-agenda org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item ;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list ;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views ;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda -;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (20420 41510 -;;;;;; 996439 0)) +;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org/org-agenda.el" +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-agenda.el +(autoload 'org-toggle-sticky-agenda "org-agenda" "\ +Toggle `org-agenda-sticky'. + +\(fn &optional ARG)" t nil) + (autoload 'org-agenda "org-agenda" "\ Dispatch agenda commands to collect entries to the agenda buffer. Prompts for a command to execute. Any prefix arg will be passed @@ -20123,6 +20067,7 @@ M Like `m', but select only TODO entries, no ordinary headlines. L Create a timeline for the current buffer. e Export views to associated files. s Search entries for keywords. +S Search entries for keywords, only with TODO keywords. / Multi occur across all agenda files and also files listed in `org-agenda-text-search-extra-files'. < Restrict agenda commands to buffer, subtree, or region. @@ -20142,7 +20087,7 @@ first press `<' once to indicate that the agenda should be temporarily Pressing `<' twice means to restrict to the current subtree or region \(if active). -\(fn &optional ARG KEYS RESTRICTION)" t nil) +\(fn &optional ARG ORG-KEYS RESTRICTION)" t nil) (autoload 'org-batch-agenda "org-agenda" "\ Run an agenda command in batch mode and send the result to STDOUT. @@ -20268,7 +20213,7 @@ the list to these. When using \\[universal-argument], you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'. -\(fn ARG)" t nil) +\(fn &optional ARG)" t nil) (autoload 'org-tags-view "org-agenda" "\ Show all headlines for all `org-agenda-files' matching a TAGS criterion. @@ -20285,7 +20230,7 @@ of what a project is and how to check if it stuck, customize the variable \(fn &rest IGNORE)" t nil) (autoload 'org-diary "org-agenda" "\ -Return diary information from org-files. +Return diary information from org files. This function can be used in a \"sexp\" diary entry in the Emacs calendar. It accesses org files and extracts information from those files to be listed in the diary. The function accepts arguments specifying what @@ -20353,13 +20298,16 @@ By default `org-agenda-to-appt' will use :deadline, :scheduled and :timestamp entries. See the docstring of `org-diary' for details and examples. +If an entry as a APPT_WARNTIME property, its value will be used +to override `appt-message-warning-time'. + \(fn &optional REFRESH FILTER &rest ARGS)" t nil) ;;;*** ;;;### (autoloads (org-archive-subtree-default-with-confirmation ;;;;;; org-archive-subtree-default) "org-archive" "org/org-archive.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-archive.el (autoload 'org-archive-subtree-default "org-archive" "\ @@ -20379,8 +20327,8 @@ This command is set with the variable `org-archive-default-command'. ;;;### (autoloads (org-export-as-ascii org-export-region-as-ascii ;;;;;; org-replace-region-by-ascii org-export-as-ascii-to-buffer ;;;;;; org-export-as-utf8-to-buffer org-export-as-utf8 org-export-as-latin1-to-buffer -;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (20355 -;;;;;; 10021 546955 0)) +;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (20585 +;;;;;; 28088 480237 0)) ;;; Generated autoloads from org/org-ascii.el (autoload 'org-export-as-latin1 "org-ascii" "\ @@ -20453,8 +20401,8 @@ publishing directory. ;;;*** -;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (20355 -;;;;;; 10021 546955 0)) +;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (20585 +;;;;;; 28088 480237 0)) ;;; Generated autoloads from org/org-attach.el (autoload 'org-attach "org-attach" "\ @@ -20466,7 +20414,7 @@ Shows a list of commands and prompts for another key to execute a command. ;;;*** ;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org/org-bbdb.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-bbdb.el (autoload 'org-bbdb-anniversaries "org-bbdb" "\ @@ -20477,10 +20425,12 @@ Extract anniversaries from BBDB for display in the agenda. ;;;*** ;;;### (autoloads (org-capture-import-remember-templates org-capture-insert-template-here -;;;;;; org-capture) "org-capture" "org/org-capture.el" (20355 10021 -;;;;;; 546955 0)) +;;;;;; org-capture) "org-capture" "org/org-capture.el" (20585 28088 +;;;;;; 480237 0)) ;;; Generated autoloads from org/org-capture.el +(defvar org-capture-initial nil) + (autoload 'org-capture "org-capture" "\ Capture something. \\<org-capture-mode-map> @@ -20497,9 +20447,12 @@ stored. When called with a `C-0' (zero) prefix, insert a template at point. -Lisp programs can set KEYS to a string associated with a template in -`org-capture-templates'. In this case, interactive selection will be -bypassed. +Lisp programs can set KEYS to a string associated with a template +in `org-capture-templates'. In this case, interactive selection +will be bypassed. + +If `org-capture-use-agenda-date' is non-nil, capturing from the +agenda will use the date at point as the default date. \(fn &optional GOTO KEYS)" t nil) @@ -20515,10 +20468,24 @@ Set org-capture-templates to be similar to `org-remember-templates'. ;;;*** -;;;### (autoloads (org-clock-persistence-insinuate org-get-clocktable) -;;;;;; "org-clock" "org/org-clock.el" (20427 14766 970343 0)) +;;;### (autoloads (org-clock-persistence-insinuate org-get-clocktable +;;;;;; org-clock-in-last) "org-clock" "org/org-clock.el" (20585 +;;;;;; 28088 480237 0)) ;;; Generated autoloads from org/org-clock.el +(autoload 'org-clock-in-last "org-clock" "\ +Clock in the last closed clocked item. +When already clocking in, send an warning. +With a universal prefix argument, select the task you want to +clock in from the last clocked in tasks. +With two universal prefix arguments, start clocking using the +last clock-out time, if any. +With three universal prefix arguments, interactively prompt +for a todo state to switch to, overriding the existing value +`org-clock-in-switch-to-state'. + +\(fn &optional ARG)" t nil) + (autoload 'org-get-clocktable "org-clock" "\ Get a formatted clocktable with parameters according to PROPS. The table is created in a temporary buffer, fully formatted and @@ -20533,8 +20500,19 @@ Set up hooks for clock persistence. ;;;*** +;;;### (autoloads (org-check-version) "org-compat" "org/org-compat.el" +;;;;;; (20585 28088 480237 0)) +;;; Generated autoloads from org/org-compat.el + +(autoload 'org-check-version "org-compat" "\ +Try very hard to provide sensible version strings. + +\(fn)" nil t) + +;;;*** + ;;;### (autoloads (org-datetree-find-date-create) "org-datetree" -;;;;;; "org/org-datetree.el" (20355 10021 546955 0)) +;;;;;; "org/org-datetree.el" (20585 28088 480237 0)) ;;; Generated autoloads from org/org-datetree.el (autoload 'org-datetree-find-date-create "org-datetree" "\ @@ -20550,7 +20528,7 @@ tree can be found. ;;;### (autoloads (org-export-as-docbook org-export-as-docbook-pdf-and-open ;;;;;; org-export-as-docbook-pdf org-export-region-as-docbook org-replace-region-by-docbook ;;;;;; org-export-as-docbook-to-buffer org-export-as-docbook-batch) -;;;;;; "org-docbook" "org/org-docbook.el" (20355 10021 546955 0)) +;;;;;; "org-docbook" "org/org-docbook.el" (20585 28088 480237 0)) ;;; Generated autoloads from org/org-docbook.el (autoload 'org-export-as-docbook-batch "org-docbook" "\ @@ -20625,9 +20603,67 @@ publishing directory. ;;;*** +;;;### (autoloads (org-element-context org-element-at-point org-element-interpret-data) +;;;;;; "org-element" "org/org-element.el" (20585 28088 480237 0)) +;;; Generated autoloads from org/org-element.el + +(autoload 'org-element-interpret-data "org-element" "\ +Interpret DATA as Org syntax. + +DATA is a parse tree, an element, an object or a secondary string +to interpret. + +Optional argument PARENT is used for recursive calls. It contains +the element or object containing data, or nil. + +Return Org syntax as a string. + +\(fn DATA &optional PARENT)" nil nil) + +(autoload 'org-element-at-point "org-element" "\ +Determine closest element around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. + +Possible types are defined in `org-element-all-elements'. +Properties depend on element or object type, but always +include :begin, :end, :parent and :post-blank properties. + +As a special case, if point is at the very beginning of a list or +sub-list, returned element will be that list instead of the first +item. In the same way, if point is at the beginning of the first +row of a table, returned element will be the table instead of the +first row. + +If optional argument KEEP-TRAIL is non-nil, the function returns +a list of of elements leading to element at point. The list's +CAR is always the element at point. Following positions contain +element's siblings, then parents, siblings of parents, until the +first element of current section. + +\(fn &optional KEEP-TRAIL)" nil nil) + +(autoload 'org-element-context "org-element" "\ +Return closest element or object around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element or object and PROPS a plist of properties +associated to it. + +Possible types are defined in `org-element-all-elements' and +`org-element-all-objects'. Properties depend on element or +object type, but always include :begin, :end, :parent +and :post-blank properties. + +\(fn)" nil nil) + +;;;*** + ;;;### (autoloads (org-insert-export-options-template org-export-as-org ;;;;;; org-export-visible org-export) "org-exp" "org/org-exp.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-exp.el (autoload 'org-export "org-exp" "\ @@ -20688,8 +20724,8 @@ Insert into the buffer a template with information for exporting. ;;;*** ;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update -;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (20355 -;;;;;; 10021 546955 0)) +;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (20585 +;;;;;; 28088 480237 0)) ;;; Generated autoloads from org/org-feed.el (autoload 'org-feed-update-all "org-feed" "\ @@ -20717,7 +20753,7 @@ Show the raw feed buffer of a feed. ;;;*** ;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote" -;;;;;; "org/org-footnote.el" (20378 29222 722320 0)) +;;;;;; "org/org-footnote.el" (20585 28088 480237 0)) ;;; Generated autoloads from org/org-footnote.el (autoload 'org-footnote-action "org-footnote" "\ @@ -20768,7 +20804,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;;;### (autoloads (org-freemind-to-org-mode org-freemind-from-org-sparse-tree ;;;;;; org-freemind-from-org-mode org-freemind-from-org-mode-node ;;;;;; org-freemind-show org-export-as-freemind) "org-freemind" -;;;;;; "org/org-freemind.el" (20355 10021 546955 0)) +;;;;;; "org/org-freemind.el" (20585 28088 480237 0)) ;;; Generated autoloads from org/org-freemind.el (autoload 'org-export-as-freemind "org-freemind" "\ @@ -20829,7 +20865,7 @@ Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE. ;;;### (autoloads (org-export-htmlize-generate-css org-export-as-html ;;;;;; org-export-region-as-html org-replace-region-by-html org-export-as-html-to-buffer ;;;;;; org-export-as-html-batch org-export-as-html-and-open) "org-html" -;;;;;; "org/org-html.el" (20355 10021 546955 0)) +;;;;;; "org/org-html.el" (20585 28088 480237 0)) ;;; Generated autoloads from org/org-html.el (put 'org-export-html-style-include-default 'safe-local-variable 'booleanp) @@ -20923,7 +20959,7 @@ that uses these same face definitions. ;;;### (autoloads (org-export-icalendar-combine-agenda-files org-export-icalendar-all-agenda-files ;;;;;; org-export-icalendar-this-file) "org-icalendar" "org/org-icalendar.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-icalendar.el (autoload 'org-export-icalendar-this-file "org-icalendar" "\ @@ -20951,7 +20987,7 @@ The file is stored under the name `org-combined-agenda-icalendar-file'. ;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-find ;;;;;; org-id-goto org-id-get-with-outline-drilling org-id-get-with-outline-path-completion ;;;;;; org-id-get org-id-copy org-id-get-create) "org-id" "org/org-id.el" -;;;;;; (20545 57511 257469 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-id.el (autoload 'org-id-get-create "org-id" "\ @@ -21020,7 +21056,7 @@ Store a link to the current entry, using its ID. ;;;*** ;;;### (autoloads (org-indent-mode) "org-indent" "org/org-indent.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-indent.el (autoload 'org-indent-mode "org-indent" "\ @@ -21038,7 +21074,7 @@ during idle time. ;;;*** ;;;### (autoloads (org-irc-store-link) "org-irc" "org/org-irc.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-irc.el (autoload 'org-irc-store-link "org-irc" "\ @@ -21051,7 +21087,7 @@ Dispatch to the appropriate function to store a link to an IRC session. ;;;### (autoloads (org-export-as-pdf-and-open org-export-as-pdf org-export-as-latex ;;;;;; org-export-region-as-latex org-replace-region-by-latex org-export-as-latex-to-buffer ;;;;;; org-export-as-latex-batch) "org-latex" "org/org-latex.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-latex.el (autoload 'org-export-as-latex-batch "org-latex" "\ @@ -21132,7 +21168,7 @@ Export as LaTeX, then process through to PDF, and open. ;;;### (autoloads (org-lparse-region org-replace-region-by org-lparse-to-buffer ;;;;;; org-lparse-batch org-lparse-and-open) "org-lparse" "org/org-lparse.el" -;;;;;; (20417 65331 139825 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-lparse.el (autoload 'org-lparse-and-open "org-lparse" "\ @@ -21189,8 +21225,8 @@ in a window. A non-interactive call will only return the buffer. ;;;*** ;;;### (autoloads (org-mobile-create-sumo-agenda org-mobile-pull -;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (20355 -;;;;;; 10021 546955 0)) +;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (20585 +;;;;;; 28088 480237 0)) ;;; Generated autoloads from org/org-mobile.el (autoload 'org-mobile-push "org-mobile" "\ @@ -21216,9 +21252,11 @@ Create a file that contains all custom agenda views. ;;;### (autoloads (org-export-as-odf-and-open org-export-as-odf org-export-odt-convert ;;;;;; org-export-as-odt org-export-as-odt-batch org-export-as-odt-and-open) -;;;;;; "org-odt" "org/org-odt.el" (20417 65331 139825 0)) +;;;;;; "org-odt" "org/org-odt.el" (20585 28088 480237 0)) ;;; Generated autoloads from org/org-odt.el +(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp) + (autoload 'org-export-as-odt-and-open "org-odt" "\ Export the outline as ODT and immediately open it with a browser. If there is an active region, export only the region. @@ -21286,7 +21324,7 @@ formula file. ;;;*** ;;;### (autoloads (org-plot/gnuplot) "org-plot" "org/org-plot.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-plot.el (autoload 'org-plot/gnuplot "org-plot" "\ @@ -21300,7 +21338,7 @@ line directly before or after the table. ;;;### (autoloads (org-publish-current-project org-publish-current-file ;;;;;; org-publish-all org-publish) "org-publish" "org/org-publish.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-publish.el (defalias 'org-publish-project 'org-publish) @@ -21334,7 +21372,7 @@ the project. ;;;### (autoloads (org-remember-handler org-remember org-remember-apply-template ;;;;;; org-remember-annotation org-remember-insinuate) "org-remember" -;;;;;; "org/org-remember.el" (20420 41510 996439 0)) +;;;;;; "org/org-remember.el" (20585 28088 480237 0)) ;;; Generated autoloads from org/org-remember.el (autoload 'org-remember-insinuate "org-remember" "\ @@ -21409,10 +21447,21 @@ See also the variable `org-reverse-note-order'. ;;;*** -;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl) -;;;;;; "org-table" "org/org-table.el" (20417 65331 139825 0)) +;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl org-table-iterate-buffer-tables +;;;;;; org-table-recalculate-buffer-tables) "org-table" "org/org-table.el" +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-table.el +(autoload 'org-table-recalculate-buffer-tables "org-table" "\ +Recalculate all tables in the current buffer. + +\(fn)" t nil) + +(autoload 'org-table-iterate-buffer-tables "org-table" "\ +Iterate all tables in the buffer, to converge inter-table dependencies. + +\(fn)" t nil) + (autoload 'turn-on-orgtbl "org-table" "\ Unconditionally turn on `orgtbl-mode'. @@ -21434,7 +21483,7 @@ The table is taken from the parameter TXT, or from the buffer at point. ;;;*** ;;;### (autoloads (org-export-as-taskjuggler-and-open org-export-as-taskjuggler) -;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (20355 10021 546955 +;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (20585 28088 480237 ;;;;;; 0)) ;;; Generated autoloads from org/org-taskjuggler.el @@ -21442,12 +21491,12 @@ The table is taken from the parameter TXT, or from the buffer at point. Export parts of the current buffer as a TaskJuggler file. The exporter looks for a tree with tag, property or todo that matches `org-export-taskjuggler-project-tag' and takes this as -the tasks for this project. The first node of this tree defines +the tasks for this project. The first node of this tree defines the project properties such as project name and project period. If there is a tree with tag, property or todo that matches `org-export-taskjuggler-resource-tag' this three is taken as -resources for the project. If no resources are specified, a -default resource is created and allocated to the project. Also +resources for the project. If no resources are specified, a +default resource is created and allocated to the project. Also the taskjuggler project will be created with default reports as defined in `org-export-taskjuggler-default-reports'. @@ -21462,8 +21511,8 @@ with the TaskJuggler GUI. ;;;*** ;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region -;;;;;; org-timer org-timer-start) "org-timer" "org/org-timer.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; org-timer org-timer-stop org-timer-pause-or-continue org-timer-start) +;;;;;; "org-timer" "org/org-timer.el" (20585 28088 480237 0)) ;;; Generated autoloads from org/org-timer.el (autoload 'org-timer-start "org-timer" "\ @@ -21479,6 +21528,17 @@ the region 0:00:00. \(fn &optional OFFSET)" t nil) +(autoload 'org-timer-pause-or-continue "org-timer" "\ +Pause or continue the relative timer. +With prefix arg STOP, stop it entirely. + +\(fn &optional STOP)" t nil) + +(autoload 'org-timer-stop "org-timer" "\ +Stop the relative timer. + +\(fn)" t nil) + (autoload 'org-timer "org-timer" "\ Insert a H:MM:SS string from the timer into the buffer. The first time this command is used, the timer is started. When used with @@ -21523,8 +21583,29 @@ replace any running timer. ;;;*** +;;;### (autoloads (org-git-version org-release) "org-version" "org/org-version.el" +;;;;;; (20585 28088 480237 0)) +;;; Generated autoloads from org/org-version.el + +(autoload 'org-release "org-version" "\ +The release version of org-mode. + Inserted by installing org-mode or when a release is made. + +\(fn)" nil nil) + +(autoload 'org-git-version "org-version" "\ +The Git version of org-mode. + Inserted by installing org-mode or when a release is made. + +\(fn)" nil nil) + +(defconst org-odt-data-dir "/usr/share/emacs/etc/org" "\ +The location of ODT styles.") + +;;;*** + ;;;### (autoloads (org-export-as-xoxo) "org-xoxo" "org/org-xoxo.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from org/org-xoxo.el (autoload 'org-export-as-xoxo "org-xoxo" "\ @@ -21600,7 +21681,7 @@ See the command `outline-mode' for more information on this mode. ;;;### (autoloads (list-packages describe-package package-initialize ;;;;;; package-refresh-contents package-install-file package-install-from-buffer ;;;;;; package-install package-enable-at-startup) "package" "emacs-lisp/package.el" -;;;;;; (20440 26788 208175 0)) +;;;;;; (20576 42138 697312 0)) ;;; Generated autoloads from emacs-lisp/package.el (defvar package-enable-at-startup t "\ @@ -21765,8 +21846,7 @@ no args, if that value is non-nil. ;;;*** ;;;### (autoloads (password-in-cache-p password-cache-expiry password-cache) -;;;;;; "password-cache" "password-cache.el" (20355 10021 546955 -;;;;;; 0)) +;;;;;; "password-cache" "password-cache.el" (20577 33959 40183 0)) ;;; Generated autoloads from password-cache.el (defvar password-cache t "\ @@ -21788,7 +21868,7 @@ Check if KEY is in the cache. ;;;*** ;;;### (autoloads (pcase-let pcase-let* pcase) "pcase" "emacs-lisp/pcase.el" -;;;;;; (20497 6436 957082 0)) +;;;;;; (20582 12914 894781 0)) ;;; Generated autoloads from emacs-lisp/pcase.el (autoload 'pcase "pcase" "\ @@ -21861,7 +21941,7 @@ Completion rules for the `cvs' command. ;;;*** ;;;### (autoloads (pcomplete/tar pcomplete/make pcomplete/bzip2 pcomplete/gzip) -;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20355 10021 546955 0)) +;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20572 16038 402143 0)) ;;; Generated autoloads from pcmpl-gnu.el (autoload 'pcomplete/gzip "pcmpl-gnu" "\ @@ -21980,8 +22060,8 @@ Includes files as well as host names followed by a colon. ;;;### (autoloads (pcomplete-shell-setup pcomplete-comint-setup pcomplete-list ;;;;;; pcomplete-help pcomplete-expand pcomplete-continue pcomplete-expand-and-complete -;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (20523 -;;;;;; 62082 997685 0)) +;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (20582 +;;;;;; 12914 894781 0)) ;;; Generated autoloads from pcomplete.el (autoload 'pcomplete "pcomplete" "\ @@ -22040,7 +22120,7 @@ Setup `shell-mode' to use pcomplete. ;;;### (autoloads (cvs-dired-use-hook cvs-dired-action cvs-status ;;;;;; cvs-update cvs-examine cvs-quickdir cvs-checkout) "pcvs" -;;;;;; "vc/pcvs.el" (20476 31768 298871 0)) +;;;;;; "vc/pcvs.el" (20584 7212 455152 0)) ;;; Generated autoloads from vc/pcvs.el (autoload 'cvs-checkout "pcvs" "\ @@ -22115,8 +22195,8 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d ;;;*** -;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20476 31768 -;;;;;; 298871 0)) +;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20576 42138 +;;;;;; 697312 0)) ;;; Generated autoloads from vc/pcvs-defs.el (defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m)) "\ @@ -22125,7 +22205,7 @@ Global menu used by PCL-CVS.") ;;;*** ;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el" -;;;;;; (20523 62082 997685 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/perl-mode.el (put 'perl-indent-level 'safe-local-variable 'integerp) (put 'perl-continued-statement-offset 'safe-local-variable 'integerp) @@ -22187,7 +22267,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'. ;;;*** ;;;### (autoloads (picture-mode) "picture" "textmodes/picture.el" -;;;;;; (20373 11301 906925 0)) +;;;;;; (20551 9899 283417 0)) ;;; Generated autoloads from textmodes/picture.el (autoload 'picture-mode "picture" "\ @@ -22394,7 +22474,7 @@ Ignores leading comment characters. ;;;;;; pr-ps-buffer-print pr-ps-buffer-using-ghostscript pr-ps-buffer-preview ;;;;;; pr-ps-directory-ps-print pr-ps-directory-print pr-ps-directory-using-ghostscript ;;;;;; pr-ps-directory-preview pr-interface) "printing" "printing.el" -;;;;;; (20501 3499 284800 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from printing.el (autoload 'pr-interface "printing" "\ @@ -22981,7 +23061,7 @@ are both set to t. ;;;*** -;;;### (autoloads (proced) "proced" "proced.el" (20511 39332 974340 +;;;### (autoloads (proced) "proced" "proced.el" (20576 13095 881042 ;;;;;; 0)) ;;; Generated autoloads from proced.el @@ -23000,8 +23080,38 @@ Proced buffers. ;;;*** +;;;### (autoloads (profiler-find-profile-other-frame profiler-find-profile-other-window +;;;;;; profiler-find-profile profiler-start) "profiler" "profiler.el" +;;;;;; (20585 28088 480237 0)) +;;; Generated autoloads from profiler.el + +(autoload 'profiler-start "profiler" "\ +Start/restart profilers. +MODE can be one of `cpu', `mem', or `cpu+mem'. +If MODE is `cpu' or `cpu+mem', time-based profiler will be started. +Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started. + +\(fn MODE)" t nil) + +(autoload 'profiler-find-profile "profiler" "\ +Open profile FILENAME. + +\(fn FILENAME)" t nil) + +(autoload 'profiler-find-profile-other-window "profiler" "\ +Open profile FILENAME. + +\(fn FILENAME)" t nil) + +(autoload 'profiler-find-profile-other-frame "profiler" "\ +Open profile FILENAME. + +\(fn FILENAME)" t nil) + +;;;*** + ;;;### (autoloads (run-prolog mercury-mode prolog-mode) "prolog" -;;;;;; "progmodes/prolog.el" (20397 45851 446679 0)) +;;;;;; "progmodes/prolog.el" (20576 42138 697312 0)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ @@ -23048,8 +23158,8 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").") ;;;*** -;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (20355 -;;;;;; 10021 546955 0)) +;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (20576 +;;;;;; 42138 697312 0)) ;;; Generated autoloads from progmodes/ps-mode.el (autoload 'ps-mode "ps-mode" "\ @@ -23100,8 +23210,8 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ;;;;;; ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ;;;;;; ps-print-buffer ps-print-customize ps-print-color-p ps-paper-type -;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (20355 -;;;;;; 10021 546955 0)) +;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from ps-print.el (defvar ps-page-dimensions-database (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") (list 'legal (* 72 8.5) (* 72 14.0) "Legal") (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall") (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid") (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger") (list 'statement (* 72 5.5) (* 72 8.5) "Statement") (list 'executive (* 72 7.5) (* 72 10.0) "Executive") (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small") (list 'b4 (* 72 10.125) (* 72 14.33) "B4") (list 'b5 (* 72 7.16) (* 72 10.125) "B5") '(addresslarge 236.0 99.0 "AddressLarge") '(addresssmall 236.0 68.0 "AddressSmall") '(cuthanging13 90.0 222.0 "CutHanging13") '(cuthanging15 90.0 114.0 "CutHanging15") '(diskette 181.0 136.0 "Diskette") '(eurofilefolder 139.0 112.0 "EuropeanFilefolder") '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow") '(eurofolderwide 526.0 136.0 "EuroFolderWide") '(euronamebadge 189.0 108.0 "EuroNameBadge") '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge") '(filefolder 230.0 37.0 "FileFolder") '(jewelry 76.0 136.0 "Jewelry") '(mediabadge 180.0 136.0 "MediaBadge") '(multipurpose 126.0 68.0 "MultiPurpose") '(retaillabel 90.0 104.0 "RetailLabel") '(shipping 271.0 136.0 "Shipping") '(slide35mm 26.0 104.0 "Slide35mm") '(spine8mm 187.0 26.0 "Spine8mm") '(topcoated 425.19685 136.0 "TopCoatedPaper") '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") '(zipdisk 156.0 136.0 "ZipDisk"))) "\ @@ -23298,7 +23408,7 @@ If EXTENSION is any other symbol, it is ignored. ;;;*** ;;;### (autoloads (python-mode run-python) "python" "progmodes/python.el" -;;;;;; (20523 62082 997685 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from progmodes/python.el (add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode)) @@ -23334,7 +23444,7 @@ if that value is non-nil. ;;;*** ;;;### (autoloads (quoted-printable-decode-region) "qp" "gnus/qp.el" -;;;;;; (20544 36659 880486 0)) +;;;;;; (20557 48712 315579 0)) ;;; Generated autoloads from gnus/qp.el (autoload 'quoted-printable-decode-region "qp" "\ @@ -23588,8 +23698,8 @@ of each directory. ;;;### (autoloads (quickurl-list quickurl-list-mode quickurl-edit-urls ;;;;;; quickurl-browse-url-ask quickurl-browse-url quickurl-add-url -;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20478 -;;;;;; 3673 653810 0)) +;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from net/quickurl.el (defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\ @@ -23601,7 +23711,7 @@ To make use of this do something like: (setq quickurl-postfix quickurl-reread-hook-postfix) -in your ~/.emacs (after loading/requiring quickurl).") +in your init file (after loading/requiring quickurl).") (autoload 'quickurl "quickurl" "\ Insert a URL based on LOOKUP. @@ -23917,8 +24027,8 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead. ;;;*** ;;;### (autoloads (reftex-reset-scanning-information reftex-mode -;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20507 42276 -;;;;;; 222255 0)) +;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20585 28088 +;;;;;; 480237 0)) ;;; Generated autoloads from textmodes/reftex.el (autoload 'turn-on-reftex "reftex" "\ @@ -23927,13 +24037,7 @@ Turn on RefTeX mode. \(fn)" nil nil) (autoload 'reftex-mode "reftex" "\ -Toggle RefTeX mode. -With a prefix argument ARG, enable RefTeX mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. - -RefTeX mode is a buffer-local minor mode with distinct support -for \\label, \\ref and \\cite in LaTeX. +Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX. \\<reftex-mode-map>A Table of Contents of the entire (multifile) document with browsing capabilities is available with `\\[reftex-toc]'. @@ -23974,7 +24078,7 @@ This enforces rescanning the buffer on next use. ;;;*** ;;;### (autoloads (reftex-citation) "reftex-cite" "textmodes/reftex-cite.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from textmodes/reftex-cite.el (autoload 'reftex-citation "reftex-cite" "\ @@ -24004,7 +24108,7 @@ While entering the regexp, completion on knows citation keys is possible. ;;;*** ;;;### (autoloads (reftex-isearch-minor-mode) "reftex-global" "textmodes/reftex-global.el" -;;;;;; (20427 14766 970343 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from textmodes/reftex-global.el (autoload 'reftex-isearch-minor-mode "reftex-global" "\ @@ -24021,7 +24125,7 @@ With no argument, this command toggles ;;;*** ;;;### (autoloads (reftex-index-phrases-mode) "reftex-index" "textmodes/reftex-index.el" -;;;;;; (20399 35365 4050 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from textmodes/reftex-index.el (autoload 'reftex-index-phrases-mode "reftex-index" "\ @@ -24054,7 +24158,7 @@ Here are all local bindings. ;;;*** ;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from textmodes/reftex-parse.el (autoload 'reftex-all-document-files "reftex-parse" "\ @@ -24066,8 +24170,8 @@ of master file. ;;;*** -;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20507 -;;;;;; 42276 222255 0)) +;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20585 +;;;;;; 28088 480237 0)) ;;; Generated autoloads from textmodes/reftex-vars.el (put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) (put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) @@ -24139,15 +24243,15 @@ Extract diary entries from the region. ;;;*** -;;;### (autoloads (repeat) "repeat" "repeat.el" (20388 65061 302484 +;;;### (autoloads (repeat) "repeat" "repeat.el" (20574 57775 217760 ;;;;;; 0)) ;;; Generated autoloads from repeat.el (autoload 'repeat "repeat" "\ Repeat most recently executed command. -With prefix arg, apply new prefix arg to that command; otherwise, -use the prefix arg that was used before (if any). -This command is like the `.' command in the vi editor. +If REPEAT-ARG is non-nil (interactively, with a prefix argument), +supply a prefix argument to that command. Otherwise, give the +command the same prefix argument it was given before, if any. If this command is invoked by a multi-character key sequence, it can then be repeated by repeating the final character of that @@ -24323,8 +24427,8 @@ variable. ;;;;;; rmail-secondary-file-directory rmail-primary-inbox-list rmail-highlighted-headers ;;;;;; rmail-retry-ignored-headers rmail-displayed-headers rmail-ignored-headers ;;;;;; rmail-user-mail-address-regexp rmail-movemail-variant-p rmail-spool-directory -;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20526 43809 637014 -;;;;;; 858000)) +;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20568 19013 9762 +;;;;;; 342000)) ;;; Generated autoloads from mail/rmail.el (defvar rmail-file-name (purecopy "~/RMAIL") "\ @@ -24744,7 +24848,7 @@ Toggle the use of ROT13 encoding for the current window. ;;;*** ;;;### (autoloads (rst-minor-mode rst-mode) "rst" "textmodes/rst.el" -;;;;;; (20523 62082 997685 0)) +;;;;;; (20576 13095 881042 0)) ;;; Generated autoloads from textmodes/rst.el (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) @@ -24775,7 +24879,7 @@ for modes derived from Text mode, like Mail mode. ;;;*** ;;;### (autoloads (ruby-mode) "ruby-mode" "progmodes/ruby-mode.el" -;;;;;; (20522 38650 757441 0)) +;;;;;; (20576 42138 697312 0)) ;;; Generated autoloads from progmodes/ruby-mode.el (autoload 'ruby-mode "ruby-mode" "\ @@ -25126,8 +25230,8 @@ enclosed in `(and ...)'. ;;;*** -;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20523 -;;;;;; 62082 997685 0)) +;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20577 +;;;;;; 33959 40183 0)) ;;; Generated autoloads from savehist.el (defvar savehist-mode nil "\ @@ -25320,7 +25424,7 @@ Semantic mode. ;;;;;; mail-personal-alias-file mail-default-reply-to mail-archive-file-name ;;;;;; mail-header-separator send-mail-function mail-interactive ;;;;;; mail-self-blind mail-specify-envelope-from mail-from-style) -;;;;;; "sendmail" "mail/sendmail.el" (20501 3499 284800 0)) +;;;;;; "sendmail" "mail/sendmail.el" (20577 33959 40183 0)) ;;; Generated autoloads from mail/sendmail.el (defvar mail-from-style 'default "\ @@ -25602,8 +25706,8 @@ Like `mail' command, but display mail buffer in another frame. ;;;*** ;;;### (autoloads (server-save-buffers-kill-terminal server-mode -;;;;;; server-force-delete server-start) "server" "server.el" (20545 -;;;;;; 57511 257469 0)) +;;;;;; server-force-delete server-start) "server" "server.el" (20584 +;;;;;; 7212 455152 0)) ;;; Generated autoloads from server.el (put 'server-host 'risky-local-variable t) @@ -25670,7 +25774,7 @@ only these files will be asked to be saved. ;;;*** -;;;### (autoloads (ses-mode) "ses" "ses.el" (20493 9382 687578 0)) +;;;### (autoloads (ses-mode) "ses" "ses.el" (20553 51627 169867 0)) ;;; Generated autoloads from ses.el (autoload 'ses-mode "ses" "\ @@ -25689,7 +25793,7 @@ These are active only in the minibuffer, when entering or editing a formula: ;;;*** ;;;### (autoloads (html-mode sgml-mode) "sgml-mode" "textmodes/sgml-mode.el" -;;;;;; (20478 3673 653810 0)) +;;;;;; (20580 10161 446444 0)) ;;; Generated autoloads from textmodes/sgml-mode.el (autoload 'sgml-mode "sgml-mode" "\ @@ -25703,7 +25807,7 @@ the next N words. In Transient Mark mode, when the mark is active, N defaults to -1, which means to wrap it around the current region. If you like upcased tags, put (setq sgml-transformation-function 'upcase) -in your `.emacs' file. +in your init file. Use \\[sgml-validate] to validate your document with an SGML parser. @@ -25755,7 +25859,7 @@ To work around that, do: ;;;*** ;;;### (autoloads (sh-mode) "sh-script" "progmodes/sh-script.el" -;;;;;; (20541 6907 775259 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from progmodes/sh-script.el (put 'sh-shell 'safe-local-variable 'symbolp) @@ -25819,7 +25923,7 @@ with your script for an edit-interpret-debug cycle. ;;;*** ;;;### (autoloads (list-load-path-shadows) "shadow" "emacs-lisp/shadow.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20572 16038 402143 0)) ;;; Generated autoloads from emacs-lisp/shadow.el (autoload 'list-load-path-shadows "shadow" "\ @@ -25909,7 +26013,7 @@ Set up file shadowing. ;;;*** ;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el" -;;;;;; (20478 3673 653810 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -26176,7 +26280,7 @@ symmetrical ones, and the same character twice for the others. ;;;*** ;;;### (autoloads (smerge-start-session smerge-mode smerge-ediff) -;;;;;; "smerge-mode" "vc/smerge-mode.el" (20523 62082 997685 0)) +;;;;;; "smerge-mode" "vc/smerge-mode.el" (20585 28088 480237 0)) ;;; Generated autoloads from vc/smerge-mode.el (autoload 'smerge-ediff "smerge-mode" "\ @@ -26222,7 +26326,7 @@ interactively. If there's no argument, do it at the current buffer. ;;;*** ;;;### (autoloads (smtpmail-send-queued-mail smtpmail-send-it) "smtpmail" -;;;;;; "mail/smtpmail.el" (20402 11562 85788 0)) +;;;;;; "mail/smtpmail.el" (20551 9899 283417 0)) ;;; Generated autoloads from mail/smtpmail.el (autoload 'smtpmail-send-it "smtpmail" "\ @@ -26262,7 +26366,7 @@ Snake mode keybindings: ;;;*** ;;;### (autoloads (snmpv2-mode snmp-mode) "snmp-mode" "net/snmp-mode.el" -;;;;;; (20478 3673 653810 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from net/snmp-mode.el (autoload 'snmp-mode "snmp-mode" "\ @@ -26291,8 +26395,8 @@ then `snmpv2-mode-hook'. ;;;*** -;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (20355 -;;;;;; 10021 546955 0)) +;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from calendar/solar.el (autoload 'sunrise-sunset "solar" "\ @@ -26301,7 +26405,7 @@ If called with an optional prefix argument ARG, prompt for date. If called with an optional double prefix argument, prompt for longitude, latitude, time zone, and date, and always use standard time. -This function is suitable for execution in a .emacs file. +This function is suitable for execution in an init file. \(fn &optional ARG)" t nil) @@ -26595,7 +26699,7 @@ Spam reports will be queued with the method used when ;;;*** ;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar" -;;;;;; "speedbar.el" (20497 6436 957082 0)) +;;;;;; "speedbar.el" (20566 63671 243798 0)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -26639,7 +26743,7 @@ Return a vector containing the lines from `spook-phrases-file'. ;;;;;; sql-ms sql-ingres sql-solid sql-mysql sql-sqlite sql-informix ;;;;;; sql-sybase sql-oracle sql-product-interactive sql-connect ;;;;;; sql-mode sql-help sql-add-product-keywords) "sql" "progmodes/sql.el" -;;;;;; (20480 38535 248706 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/sql.el (autoload 'sql-add-product-keywords "sql" "\ @@ -26719,8 +26823,8 @@ For information on how to create multiple SQLi buffers, see `sql-interactive-mode'. Note that SQL doesn't have an escape character unless you specify -one. If you specify backslash as escape character in SQL, -you must tell Emacs. Here's how to do that in your `~/.emacs' file: +one. If you specify backslash as escape character in SQL, you +must tell Emacs. Here's how to do that in your init file: \(add-hook 'sql-mode-hook (lambda () @@ -27175,8 +27279,8 @@ GnuTLS requires a port number. ;;;;;; strokes-mode strokes-list-strokes strokes-load-user-strokes ;;;;;; strokes-help strokes-describe-stroke strokes-do-complex-stroke ;;;;;; strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke -;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20523 -;;;;;; 62082 997685 0)) +;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from strokes.el (autoload 'strokes-global-set-stroke "strokes" "\ @@ -27367,7 +27471,7 @@ See `subword-mode' for more information on Subword mode. ;;;*** ;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20576 42138 697312 0)) ;;; Generated autoloads from mail/supercite.el (autoload 'sc-cite-original "supercite" "\ @@ -27464,7 +27568,7 @@ The variable `tab-width' controls the spacing of tab stops. ;;;;;; table-recognize table-insert-row-column table-insert-column ;;;;;; table-insert-row table-insert table-point-left-cell-hook ;;;;;; table-point-entered-cell-hook table-load-hook table-cell-map-hook) -;;;;;; "table" "textmodes/table.el" (20434 17809 692608 0)) +;;;;;; "table" "textmodes/table.el" (20566 63671 243798 0)) ;;; Generated autoloads from textmodes/table.el (defvar table-cell-map-hook nil "\ @@ -28068,8 +28172,8 @@ Connect to the Emacs talk group from the current X display or tty frame. ;;;*** -;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20522 9637 -;;;;;; 465791 0)) +;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20585 28088 +;;;;;; 480237 0)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -28093,7 +28197,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;;;*** ;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl" -;;;;;; "progmodes/tcl.el" (20355 10021 546955 0)) +;;;;;; "progmodes/tcl.el" (20580 10161 446444 0)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -28168,7 +28272,7 @@ Normally input is edited in Emacs and sent a line at a time. ;;;*** ;;;### (autoloads (serial-term ansi-term term make-term) "term" "term.el" -;;;;;; (20478 3673 653810 0)) +;;;;;; (20580 10161 446444 0)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -28248,7 +28352,7 @@ subprocess started. ;;;*** ;;;### (autoloads (testcover-this-defun) "testcover" "emacs-lisp/testcover.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20580 10161 446444 0)) ;;; Generated autoloads from emacs-lisp/testcover.el (autoload 'testcover-this-defun "testcover" "\ @@ -28290,7 +28394,7 @@ tetris-mode keybindings: ;;;;;; tex-start-commands tex-start-options slitex-run-command latex-run-command ;;;;;; tex-run-command tex-offer-save tex-main-file tex-first-line-header-regexp ;;;;;; tex-directory tex-shell-file-name) "tex-mode" "textmodes/tex-mode.el" -;;;;;; (20523 62082 997685 0)) +;;;;;; (20584 7212 455152 0)) ;;; Generated autoloads from textmodes/tex-mode.el (defvar tex-shell-file-name nil "\ @@ -28948,7 +29052,7 @@ This function performs no refilling of the changed text. ;;;### (autoloads (emacs-init-time emacs-uptime display-time-world ;;;;;; display-time-mode display-time display-time-day-and-date) -;;;;;; "time" "time.el" (20387 44199 24128 0)) +;;;;;; "time" "time.el" (20561 45732 920134 0)) ;;; Generated autoloads from time.el (defvar display-time-day-and-date nil "\ @@ -29128,7 +29232,7 @@ This function does not work for SECONDS greater than `most-positive-fixnum'. ;;;*** ;;;### (autoloads (time-stamp-toggle-active time-stamp) "time-stamp" -;;;;;; "time-stamp.el" (20355 10021 546955 0)) +;;;;;; "time-stamp.el" (20566 63671 243798 0)) ;;; Generated autoloads from time-stamp.el (put 'time-stamp-format 'safe-local-variable 'stringp) (put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p) @@ -29142,7 +29246,7 @@ This function does not work for SECONDS greater than `most-positive-fixnum'. (autoload 'time-stamp "time-stamp" "\ Update the time stamp string(s) in the buffer. A template in a file can be automatically updated with a new time stamp -every time you save the file. Add this line to your .emacs file: +every time you save the file. Add this line to your init file: (add-hook 'before-save-hook 'time-stamp) or customize `before-save-hook' through Custom. Normally the template must appear in the first 8 lines of a file and @@ -29172,7 +29276,7 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out ;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in ;;;;;; timeclock-mode-line-display) "timeclock" "calendar/timeclock.el" -;;;;;; (20523 62082 997685 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from calendar/timeclock.el (autoload 'timeclock-mode-line-display "timeclock" "\ @@ -29466,7 +29570,7 @@ holds a keymap. ;;;*** ;;;### (autoloads (tpu-edt-on tpu-edt-mode) "tpu-edt" "emulation/tpu-edt.el" -;;;;;; (20399 35365 4050 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from emulation/tpu-edt.el (defvar tpu-edt-mode nil "\ @@ -29496,7 +29600,7 @@ Turn on TPU/edt emulation. ;;;*** ;;;### (autoloads (tpu-mapper) "tpu-mapper" "emulation/tpu-mapper.el" -;;;;;; (20355 10021 546955 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from emulation/tpu-mapper.el (autoload 'tpu-mapper "tpu-mapper" "\ @@ -29512,7 +29616,7 @@ Finally, you will be prompted for the name of the file to store the key definitions. If you chose the default, TPU-edt will find it and load it automatically. If you specify a different file name, you will need to set the variable ``tpu-xkeys-file'' before starting TPU-edt. Here's how -you might go about doing that in your .emacs file. +you might go about doing that in your init file. (setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\")) (tpu-edt) @@ -29582,7 +29686,7 @@ BUFFER defaults to `trace-buffer'. ;;;### (autoloads (tramp-unload-tramp tramp-completion-handle-file-name-completion ;;;;;; tramp-completion-handle-file-name-all-completions tramp-unload-file-name-handlers ;;;;;; tramp-file-name-handler tramp-syntax tramp-mode) "tramp" -;;;;;; "net/tramp.el" (20530 32114 546307 0)) +;;;;;; "net/tramp.el" (20561 18280 338092 0)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -29725,8 +29829,8 @@ Discard Tramp from loading remote files. ;;;*** -;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20518 -;;;;;; 12580 46478 0)) +;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20584 +;;;;;; 7212 455152 0)) ;;; Generated autoloads from tutorial.el (autoload 'help-with-tutorial "tutorial" "\ @@ -29762,7 +29866,7 @@ resumed later. ;;;*** ;;;### (autoloads (2C-split 2C-associate-buffer 2C-two-columns) "two-column" -;;;;;; "textmodes/two-column.el" (20364 31990 752722 691000)) +;;;;;; "textmodes/two-column.el" (20566 63671 243798 0)) ;;; Generated autoloads from textmodes/two-column.el (autoload '2C-command "two-column" () t 'keymap) (global-set-key "\C-x6" '2C-command) @@ -29810,71 +29914,19 @@ First column's text sSs Second column's text ;;;*** ;;;### (autoloads (type-break-guesstimate-keystroke-threshold type-break-statistics -;;;;;; type-break type-break-mode type-break-keystroke-threshold -;;;;;; type-break-good-break-interval type-break-good-rest-interval -;;;;;; type-break-interval type-break-mode) "type-break" "type-break.el" -;;;;;; (20545 57511 257469 0)) +;;;;;; type-break type-break-mode) "type-break" "type-break.el" +;;;;;; (20582 12914 894781 0)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ -Toggle typing break mode. -See the docstring for the `type-break-mode' command for more information. +Non-nil if Type-Break mode is enabled. +See the command `type-break-mode' for a description of this minor mode. Setting this variable directly does not take effect; -use either \\[customize] or the function `type-break-mode'.") +either customize it (see the info node `Easy Customization') +or call the function `type-break-mode'.") (custom-autoload 'type-break-mode "type-break" nil) -(defvar type-break-interval (* 60 60) "\ -Number of seconds between scheduled typing breaks.") - -(custom-autoload 'type-break-interval "type-break" t) - -(defvar type-break-good-rest-interval (/ type-break-interval 6) "\ -Number of seconds of idle time considered to be an adequate typing rest. - -When this variable is non-nil, Emacs checks the idle time between -keystrokes. If this idle time is long enough to be considered a \"good\" -rest from typing, then the next typing break is simply rescheduled for later. - -If a break is interrupted before this much time elapses, the user will be -asked whether or not really to interrupt the break.") - -(custom-autoload 'type-break-good-rest-interval "type-break" t) - -(defvar type-break-good-break-interval nil "\ -Number of seconds considered to be an adequate explicit typing rest. - -When this variable is non-nil, its value is considered to be a \"good\" -length (in seconds) for a break initiated by the command `type-break', -overriding `type-break-good-rest-interval'. This provides querying of -break interruptions when `type-break-good-rest-interval' is nil.") - -(custom-autoload 'type-break-good-break-interval "type-break" t) - -(defvar type-break-keystroke-threshold (let* ((wpm 35) (avg-word-length 5) (upper (* wpm avg-word-length (/ type-break-interval 60))) (lower (/ upper 5))) (cons lower upper)) "\ -Upper and lower bound on number of keystrokes for considering typing break. -This structure is a pair of numbers (MIN . MAX). - -The first number is the minimum number of keystrokes that must have been -entered since the last typing break before considering another one, even if -the scheduled time has elapsed; the break is simply rescheduled until later -if the minimum threshold hasn't been reached. If this first value is nil, -then there is no minimum threshold; as soon as the scheduled time has -elapsed, the user will always be queried. - -The second number is the maximum number of keystrokes that can be entered -before a typing break is requested immediately, pre-empting the originally -scheduled break. If this second value is nil, then no pre-emptive breaks -will occur; only scheduled ones will. - -Keys with bucky bits (shift, control, meta, etc) are counted as only one -keystroke even though they really require multiple keys to generate them. - -The command `type-break-guesstimate-keystroke-threshold' can be used to -guess a reasonably good pair of values for this variable.") - -(custom-autoload 'type-break-keystroke-threshold "type-break" t) - (autoload 'type-break-mode "type-break" "\ Enable or disable typing-break mode. This is a minor mode, but it is global to all buffers by default. @@ -29949,7 +30001,7 @@ across Emacs sessions. This provides recovery of the break status between sessions and after a crash. Manual changes to the file may result in problems. -\(fn &optional PREFIX)" t nil) +\(fn &optional ARG)" t nil) (autoload 'type-break "type-break" "\ Take a typing break. @@ -29995,8 +30047,8 @@ FRAC should be the inverse of the fractional value; for example, a value of ;;;*** -;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (20355 10021 -;;;;;; 546955 0)) +;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from mail/uce.el (autoload 'uce-reply-to-uce "uce" "\ @@ -30323,7 +30375,7 @@ Might do a non-blocking connection; use `process-status' to check. ;;;### (autoloads (url-insert-file-contents url-file-local-copy url-copy-file ;;;;;; url-file-handler url-handler-mode) "url-handlers" "url/url-handlers.el" -;;;;;; (20440 54677 388705 0)) +;;;;;; (20584 7212 455152 0)) ;;; Generated autoloads from url/url-handlers.el (defvar url-handler-mode nil "\ @@ -30581,7 +30633,7 @@ Fetch a data URL (RFC 2397). ;;;*** ;;;### (autoloads (url-generic-parse-url url-recreate-url) "url-parse" -;;;;;; "url/url-parse.el" (20523 62082 997685 0)) +;;;;;; "url/url-parse.el" (20577 33959 40183 0)) ;;; Generated autoloads from url/url-parse.el (autoload 'url-recreate-url "url-parse" "\ @@ -30664,8 +30716,8 @@ The variable `url-queue-timeout' sets a timeout. ;;;;;; url-percentage url-display-percentage url-pretty-length url-strip-leading-spaces ;;;;;; url-eat-trailing-space url-get-normalized-date url-lazy-message ;;;;;; url-normalize-url url-insert-entities-in-string url-parse-args -;;;;;; url-debug url-debug) "url-util" "url/url-util.el" (20520 -;;;;;; 54308 826101 0)) +;;;;;; url-debug url-debug) "url-util" "url/url-util.el" (20584 +;;;;;; 7212 455152 0)) ;;; Generated autoloads from url/url-util.el (defvar url-debug nil "\ @@ -30691,8 +30743,8 @@ If a list, it is a list of the types of messages to be logged.") (autoload 'url-insert-entities-in-string "url-util" "\ Convert HTML markup-start characters to entity references in STRING. Also replaces the \" character, so that the result may be safely used as - an attribute value in a tag. Returns a new string with the result of the - conversion. Replaces these characters as follows: +an attribute value in a tag. Returns a new string with the result of the +conversion. Replaces these characters as follows: & ==> & < ==> < > ==> > @@ -30767,7 +30819,19 @@ Given a QUERY in the form: (key2 val2) (key3 val1 val2) (key4) - (key5 + (key5 \"\")) + +\(This is the same format as produced by `url-parse-query-string') + +This will return a string +\"key1=val1&key2=val2&key3=val1&key3=val2&key4&key5\". Keys may +be strings or symbols; if they are symbols, the symbol name will +be used. + +When SEMICOLONS is given, the separator will be \";\". + +When KEEP-EMPTY is given, empty values will show as \"key=\" +instead of just \"key\" as in the example above. \(fn QUERY &optional SEMICOLONS KEEP-EMPTY)" nil nil) @@ -30827,7 +30891,7 @@ This uses `url-current-object', set locally to the buffer. ;;;*** ;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock) -;;;;;; "userlock" "userlock.el" (20490 33188 850375 0)) +;;;;;; "userlock" "userlock.el" (20555 6946 859539 0)) ;;; Generated autoloads from userlock.el (autoload 'ask-user-about-lock "userlock" "\ @@ -30925,8 +30989,8 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. ;;;;;; vc-print-log vc-retrieve-tag vc-create-tag vc-merge vc-insert-headers ;;;;;; vc-revision-other-window vc-root-diff vc-ediff vc-version-ediff ;;;;;; vc-diff vc-version-diff vc-register vc-next-action vc-before-checkin-hook -;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20542 -;;;;;; 46798 773957 0)) +;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20580 +;;;;;; 10161 446444 0)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -31252,7 +31316,7 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20489 12324 656827 +;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20584 7212 455152 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-bzr.el @@ -31330,7 +31394,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20495 51111 757560 +;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20566 63671 243798 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-git.el (defun vc-git-registered (file) @@ -31370,7 +31434,7 @@ Name of the monotone directory's format file.") ;;;*** ;;;### (autoloads (vc-rcs-master-templates) "vc-rcs" "vc/vc-rcs.el" -;;;;;; (20478 3673 653810 0)) +;;;;;; (20584 7212 455152 0)) ;;; Generated autoloads from vc/vc-rcs.el (defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\ @@ -31384,7 +31448,7 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** ;;;### (autoloads (vc-sccs-master-templates) "vc-sccs" "vc/vc-sccs.el" -;;;;;; (20430 41939 815258 390000)) +;;;;;; (20584 7212 455152 0)) ;;; Generated autoloads from vc/vc-sccs.el (defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\ @@ -31392,7 +31456,8 @@ Where to look for SCCS master files. For a description of possible values, see `vc-check-master-templates'.") (custom-autoload 'vc-sccs-master-templates "vc-sccs" t) - (defun vc-sccs-registered(f) (vc-default-registered 'SCCS f)) + +(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f)) (defun vc-sccs-search-project-dir (dirname basename) "\ Return the name of a master file in the SCCS project directory. @@ -31416,7 +31481,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** ;;;### (autoloads (vera-mode) "vera-mode" "progmodes/vera-mode.el" -;;;;;; (20434 17809 692608 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from progmodes/vera-mode.el (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) @@ -31474,7 +31539,7 @@ Key bindings: ;;;*** ;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (20420 41510 996439 0)) +;;;;;; (20581 31014 234484 0)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -31613,7 +31678,7 @@ Key bindings specific to `verilog-mode-map' are: ;;;*** ;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el" -;;;;;; (20495 51111 757560 0)) +;;;;;; (20584 7212 455152 0)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -32167,7 +32232,7 @@ Key bindings: ;;;*** -;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20355 10021 546955 +;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20566 63671 243798 ;;;;;; 0)) ;;; Generated autoloads from emulation/vi.el @@ -32271,7 +32336,7 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics. ;;;;;; view-mode view-buffer-other-frame view-buffer-other-window ;;;;;; view-buffer view-file-other-frame view-file-other-window ;;;;;; view-file kill-buffer-if-not-modified view-remove-frame-by-deleting) -;;;;;; "view" "view.el" (20355 10021 546955 0)) +;;;;;; "view" "view.el" (20577 33959 40183 0)) ;;; Generated autoloads from view.el (defvar view-remove-frame-by-deleting t "\ @@ -32501,6 +32566,8 @@ entry for the selected window, purge that entry from \(fn BUFFER &optional ITEM)" nil nil) +(make-obsolete 'view-return-to-alist-update '"this function has no effect." "24.1") + (autoload 'view-mode-enter "view" "\ Enter View mode and set up exit from view mode depending on optional arguments. Optional argument QUIT-RESTORE if non-nil must specify a valid @@ -32542,7 +32609,7 @@ Turn on VIP emulation of VI. ;;;*** ;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "emulation/viper.el" -;;;;;; (20501 3499 284800 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from emulation/viper.el (autoload 'toggle-viper-mode "viper" "\ @@ -32666,8 +32733,8 @@ See `wdired-mode'. ;;;*** -;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20355 10021 -;;;;;; 546955 0)) +;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from net/webjump.el (autoload 'webjump "webjump" "\ @@ -32683,16 +32750,13 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke ;;;*** -;;;### (autoloads (which-function-mode which-func-mode) "which-func" -;;;;;; "progmodes/which-func.el" (20523 62082 997685 0)) +;;;### (autoloads (which-function-mode) "which-func" "progmodes/which-func.el" +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from progmodes/which-func.el (put 'which-func-format 'risky-local-variable t) (put 'which-func-current 'risky-local-variable t) -(autoload 'which-func-mode "which-func" "\ - - -\(fn &optional ARG)" nil nil) +(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1") (defvar which-function-mode nil "\ Non-nil if Which-Function mode is enabled. @@ -33194,8 +33258,8 @@ Setup current buffer so editing string widgets works. ;;;*** ;;;### (autoloads (windmove-default-keybindings windmove-down windmove-right -;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20495 -;;;;;; 51111 757560 0)) +;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from windmove.el (autoload 'windmove-left "windmove" "\ @@ -33247,20 +33311,25 @@ Default MODIFIER is 'shift. ;;;*** -;;;### (autoloads (winner-mode winner-mode) "winner" "winner.el" -;;;;;; (20478 3673 653810 0)) +;;;### (autoloads (winner-mode) "winner" "winner.el" (20584 7212 +;;;;;; 455152 0)) ;;; Generated autoloads from winner.el (defvar winner-mode nil "\ -Toggle Winner mode. +Non-nil if Winner mode is enabled. +See the command `winner-mode' for a description of this minor mode. Setting this variable directly does not take effect; -use either \\[customize] or the function `winner-mode'.") +either customize it (see the info node `Easy Customization') +or call the function `winner-mode'.") (custom-autoload 'winner-mode "winner" nil) (autoload 'winner-mode "winner" "\ -Toggle Winner mode. -With arg, turn Winner mode on if and only if arg is positive. +Toggle Winner mode on or off. +With a prefix argument ARG, enable Winner mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. +\\{winner-mode-map} \(fn &optional ARG)" t nil) @@ -33729,25 +33798,26 @@ Zone out, completely. ;;;;;; "gnus/nntp.el" "gnus/nnvirtual.el" "gnus/nnweb.el" "gnus/registry.el" ;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2104.el" ;;;;;; "gnus/rfc2231.el" "gnus/rtree.el" "gnus/shr-color.el" "gnus/sieve-manage.el" -;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "hex-util.el" -;;;;;; "hfy-cmap.el" "ibuf-ext.el" "international/cp51932.el" "international/eucjp-ms.el" -;;;;;; "international/fontset.el" "international/iso-ascii.el" "international/ja-dic-cnv.el" -;;;;;; "international/ja-dic-utl.el" "international/ogonek.el" "international/uni-bidi.el" -;;;;;; "international/uni-category.el" "international/uni-combining.el" -;;;;;; "international/uni-comment.el" "international/uni-decimal.el" -;;;;;; "international/uni-decomposition.el" "international/uni-digit.el" -;;;;;; "international/uni-lowercase.el" "international/uni-mirrored.el" -;;;;;; "international/uni-name.el" "international/uni-numeric.el" -;;;;;; "international/uni-old-name.el" "international/uni-titlecase.el" -;;;;;; "international/uni-uppercase.el" "json.el" "kermit.el" "language/hanja-util.el" -;;;;;; "language/thai-word.el" "ldefs-boot.el" "loadup.el" "mail/blessmail.el" -;;;;;; "mail/mailheader.el" "mail/mspools.el" "mail/rfc2368.el" -;;;;;; "mail/rfc822.el" "mail/rmail-spam-filter.el" "mail/rmailedit.el" -;;;;;; "mail/rmailkwd.el" "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el" -;;;;;; "mail/rmailsum.el" "mail/undigest.el" "md4.el" "mh-e/mh-acros.el" -;;;;;; "mh-e/mh-alias.el" "mh-e/mh-buffers.el" "mh-e/mh-compat.el" -;;;;;; "mh-e/mh-funcs.el" "mh-e/mh-gnus.el" "mh-e/mh-identity.el" -;;;;;; "mh-e/mh-inc.el" "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.el" +;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "help-macro.el" +;;;;;; "hex-util.el" "hfy-cmap.el" "ibuf-ext.el" "international/cp51932.el" +;;;;;; "international/eucjp-ms.el" "international/fontset.el" "international/iso-ascii.el" +;;;;;; "international/ja-dic-cnv.el" "international/ja-dic-utl.el" +;;;;;; "international/ogonek.el" "international/uni-bidi.el" "international/uni-category.el" +;;;;;; "international/uni-combining.el" "international/uni-comment.el" +;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el" +;;;;;; "international/uni-digit.el" "international/uni-lowercase.el" +;;;;;; "international/uni-mirrored.el" "international/uni-name.el" +;;;;;; "international/uni-numeric.el" "international/uni-old-name.el" +;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el" +;;;;;; "json.el" "kermit.el" "language/hanja-util.el" "language/thai-word.el" +;;;;;; "ldefs-boot.el" "loadup.el" "mail/blessmail.el" "mail/mailheader.el" +;;;;;; "mail/mspools.el" "mail/rfc2368.el" "mail/rfc822.el" "mail/rmail-spam-filter.el" +;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el" +;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el" +;;;;;; "mail/undigest.el" "md4.el" "mh-e/mh-acros.el" "mh-e/mh-alias.el" +;;;;;; "mh-e/mh-buffers.el" "mh-e/mh-compat.el" "mh-e/mh-funcs.el" +;;;;;; "mh-e/mh-gnus.el" "mh-e/mh-identity.el" "mh-e/mh-inc.el" +;;;;;; "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.el" ;;;;;; "mh-e/mh-loaddefs.el" "mh-e/mh-mime.el" "mh-e/mh-print.el" ;;;;;; "mh-e/mh-scan.el" "mh-e/mh-search.el" "mh-e/mh-seq.el" "mh-e/mh-show.el" ;;;;;; "mh-e/mh-speed.el" "mh-e/mh-thread.el" "mh-e/mh-tool-bar.el" @@ -33770,47 +33840,47 @@ Zone out, completely. ;;;;;; "org/ob-awk.el" "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el" ;;;;;; "org/ob-css.el" "org/ob-ditaa.el" "org/ob-dot.el" "org/ob-emacs-lisp.el" ;;;;;; "org/ob-eval.el" "org/ob-exp.el" "org/ob-fortran.el" "org/ob-gnuplot.el" -;;;;;; "org/ob-haskell.el" "org/ob-java.el" "org/ob-js.el" "org/ob-latex.el" -;;;;;; "org/ob-ledger.el" "org/ob-lilypond.el" "org/ob-lisp.el" -;;;;;; "org/ob-matlab.el" "org/ob-maxima.el" "org/ob-mscgen.el" +;;;;;; "org/ob-haskell.el" "org/ob-io.el" "org/ob-java.el" "org/ob-js.el" +;;;;;; "org/ob-latex.el" "org/ob-ledger.el" "org/ob-lilypond.el" +;;;;;; "org/ob-lisp.el" "org/ob-matlab.el" "org/ob-maxima.el" "org/ob-mscgen.el" ;;;;;; "org/ob-ocaml.el" "org/ob-octave.el" "org/ob-org.el" "org/ob-perl.el" ;;;;;; "org/ob-picolisp.el" "org/ob-plantuml.el" "org/ob-python.el" -;;;;;; "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el" "org/ob-scheme.el" -;;;;;; "org/ob-screen.el" "org/ob-sh.el" "org/ob-shen.el" "org/ob-sql.el" -;;;;;; "org/ob-sqlite.el" "org/ob-table.el" "org/org-beamer.el" -;;;;;; "org/org-bibtex.el" "org/org-colview.el" "org/org-compat.el" -;;;;;; "org/org-crypt.el" "org/org-ctags.el" "org/org-docview.el" -;;;;;; "org/org-entities.el" "org/org-eshell.el" "org/org-exp-blocks.el" -;;;;;; "org/org-faces.el" "org/org-gnus.el" "org/org-habit.el" "org/org-info.el" -;;;;;; "org/org-inlinetask.el" "org/org-install.el" "org/org-jsinfo.el" -;;;;;; "org/org-list.el" "org/org-mac-message.el" "org/org-macs.el" -;;;;;; "org/org-mew.el" "org/org-mhe.el" "org/org-mks.el" "org/org-mouse.el" -;;;;;; "org/org-pcomplete.el" "org/org-protocol.el" "org/org-rmail.el" -;;;;;; "org/org-special-blocks.el" "org/org-src.el" "org/org-vm.el" -;;;;;; "org/org-w3m.el" "org/org-wl.el" "play/gamegrid.el" "play/gametree.el" -;;;;;; "play/meese.el" "progmodes/ada-prj.el" "progmodes/cc-align.el" -;;;;;; "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el" "progmodes/cc-cmds.el" -;;;;;; "progmodes/cc-defs.el" "progmodes/cc-fonts.el" "progmodes/cc-langs.el" -;;;;;; "progmodes/cc-menus.el" "progmodes/ebnf-abn.el" "progmodes/ebnf-bnf.el" -;;;;;; "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el" "progmodes/ebnf-iso.el" -;;;;;; "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" "progmodes/idlw-complete-structtag.el" -;;;;;; "progmodes/idlw-help.el" "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" -;;;;;; "progmodes/xscheme.el" "ps-def.el" "ps-mule.el" "ps-samp.el" -;;;;;; "saveplace.el" "sb-image.el" "scroll-bar.el" "select.el" -;;;;;; "soundex.el" "subdirs.el" "tempo.el" "textmodes/bib-mode.el" -;;;;;; "textmodes/makeinfo.el" "textmodes/page-ext.el" "textmodes/refbib.el" -;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el" -;;;;;; "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" -;;;;;; "textmodes/texnfo-upd.el" "timezone.el" "tooltip.el" "tree-widget.el" -;;;;;; "uniquify.el" "url/url-about.el" "url/url-cookie.el" "url/url-dired.el" -;;;;;; "url/url-domsuf.el" "url/url-expand.el" "url/url-ftp.el" -;;;;;; "url/url-future.el" "url/url-history.el" "url/url-imap.el" -;;;;;; "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el" -;;;;;; "url/url-vars.el" "vc/ediff-diff.el" "vc/ediff-init.el" "vc/ediff-merg.el" -;;;;;; "vc/ediff-ptch.el" "vc/ediff-vers.el" "vc/ediff-wind.el" -;;;;;; "vc/pcvs-info.el" "vc/pcvs-parse.el" "vc/pcvs-util.el" "vc/vc-dav.el" -;;;;;; "vcursor.el" "vt-control.el" "vt100-led.el" "w32-fns.el" -;;;;;; "w32-vars.el" "x-dnd.el") (20545 57718 475744 538000)) +;;;;;; "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el" "org/ob-scala.el" +;;;;;; "org/ob-scheme.el" "org/ob-screen.el" "org/ob-sh.el" "org/ob-shen.el" +;;;;;; "org/ob-sql.el" "org/ob-sqlite.el" "org/ob-table.el" "org/org-beamer.el" +;;;;;; "org/org-bibtex.el" "org/org-colview.el" "org/org-crypt.el" +;;;;;; "org/org-ctags.el" "org/org-docview.el" "org/org-entities.el" +;;;;;; "org/org-eshell.el" "org/org-exp-blocks.el" "org/org-faces.el" +;;;;;; "org/org-gnus.el" "org/org-habit.el" "org/org-info.el" "org/org-inlinetask.el" +;;;;;; "org/org-install.el" "org/org-jsinfo.el" "org/org-list.el" +;;;;;; "org/org-mac-message.el" "org/org-macs.el" "org/org-mew.el" +;;;;;; "org/org-mhe.el" "org/org-mks.el" "org/org-mouse.el" "org/org-pcomplete.el" +;;;;;; "org/org-protocol.el" "org/org-rmail.el" "org/org-special-blocks.el" +;;;;;; "org/org-src.el" "org/org-vm.el" "org/org-w3m.el" "org/org-wl.el" +;;;;;; "play/gamegrid.el" "play/gametree.el" "play/meese.el" "progmodes/ada-prj.el" +;;;;;; "progmodes/cc-align.el" "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el" +;;;;;; "progmodes/cc-cmds.el" "progmodes/cc-defs.el" "progmodes/cc-fonts.el" +;;;;;; "progmodes/cc-langs.el" "progmodes/cc-menus.el" "progmodes/ebnf-abn.el" +;;;;;; "progmodes/ebnf-bnf.el" "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el" +;;;;;; "progmodes/ebnf-iso.el" "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" +;;;;;; "progmodes/idlw-complete-structtag.el" "progmodes/idlw-help.el" +;;;;;; "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" "progmodes/xscheme.el" +;;;;;; "ps-def.el" "ps-mule.el" "ps-samp.el" "saveplace.el" "sb-image.el" +;;;;;; "scroll-bar.el" "select.el" "soundex.el" "subdirs.el" "tempo.el" +;;;;;; "textmodes/bib-mode.el" "textmodes/makeinfo.el" "textmodes/page-ext.el" +;;;;;; "textmodes/refbib.el" "textmodes/refer.el" "textmodes/reftex-auc.el" +;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" +;;;;;; "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el" "timezone.el" +;;;;;; "tooltip.el" "tree-widget.el" "uniquify.el" "url/url-about.el" +;;;;;; "url/url-cookie.el" "url/url-dired.el" "url/url-domsuf.el" +;;;;;; "url/url-expand.el" "url/url-ftp.el" "url/url-future.el" +;;;;;; "url/url-history.el" "url/url-imap.el" "url/url-methods.el" +;;;;;; "url/url-nfs.el" "url/url-proxy.el" "url/url-vars.el" "vc/ediff-diff.el" +;;;;;; "vc/ediff-init.el" "vc/ediff-merg.el" "vc/ediff-ptch.el" +;;;;;; "vc/ediff-vers.el" "vc/ediff-wind.el" "vc/pcvs-info.el" "vc/pcvs-parse.el" +;;;;;; "vc/pcvs-util.el" "vc/vc-dav.el" "vcursor.el" "vt-control.el" +;;;;;; "vt100-led.el" "w32-fns.el" "w32-vars.el" "x-dnd.el") (20585 +;;;;;; 28294 985050 730000)) ;;;*** diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 010b4edfb05..88e59eff86b 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1812,9 +1812,14 @@ for the definition of the menu frame." When called in the minibuffer, get out of the minibuffer using `abort-recursive-edit'." (interactive) - (if (menu-bar-non-minibuffer-window-p) - (kill-buffer (current-buffer)) - (abort-recursive-edit))) + (cond + ;; Don't do anything when `menu-frame' is not alive or visible + ;; (Bug#8184). + ((not (menu-bar-menu-frame-live-and-visible-p))) + ((menu-bar-non-minibuffer-window-p) + (kill-buffer (current-buffer))) + (t + (abort-recursive-edit)))) (defun kill-this-buffer-enabled-p () "Return non-nil if the `kill-this-buffer' menu item should be enabled." diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el index 9d160fe319d..42b618815f5 100644 --- a/lisp/net/eudcb-bbdb.el +++ b/lisp/net/eudcb-bbdb.el @@ -166,18 +166,18 @@ The record is filtered according to `eudc-bbdb-current-return-attributes'" (symbol-name attr))) 'record)))) (t - (setq val "Unknown BBDB attribute"))) - (if val - (cond - ((memq attr '(phones addresses)) - (setq eudc-rec (append val eudc-rec))) - ((and (listp val) - (= 1 (length val))) - (setq eudc-rec (cons (cons attr (car val)) eudc-rec))) - ((> (length val) 0) - (setq eudc-rec (cons (cons attr val) eudc-rec))) - (t - (error "Unexpected attribute value"))))) + (error "Unknown BBDB attribute"))) + (cond + ((or (not val) (equal val ""))) ; do nothing + ((memq attr '(phones addresses)) + (setq eudc-rec (append val eudc-rec))) + ((and (listp val) + (= 1 (length val))) + (setq eudc-rec (cons (cons attr (car val)) eudc-rec))) + ((> (length val) 0) + (setq eudc-rec (cons (cons attr val) eudc-rec))) + (t + (error "Unexpected attribute value")))) (nreverse eudc-rec))) diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index fc356a303e2..0bc7d6ad6ea 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -1722,7 +1722,7 @@ return a nested list." (defun newsticker-group-move-feed (name group-name &optional no-update) "Move feed NAME to group GROUP-NAME. -Update teeview afterwards unless NO-UPDATE is non-nil." +Update treeview afterwards unless NO-UPDATE is non-nil." (interactive (let ((completion-ignore-case t)) (list (completing-read "Feed Name: " diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 152af5f43ed..ef40c9316cf 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,3021 @@ +2012-09-30 Abdó Roig-Maranges <abdo.roig@gmail.com> + + * org-html.el (org-export-html-preprocess) + (org-export-html-format-image): Use + `org-latex-preview-ltxpng-directory'. + + * org-odt.el (org-export-odt-do-preprocess-latex-fragments): + Ditto. + + * org.el (org-latex-preview-ltxpng-directory): New option. + (org-preview-latex-fragment): Store LaTeX preview images in + `org-latex-preview-ltxpng-directory'. + +2012-09-30 Achim Gratz <Stromeko@Stromeko.DE> + + * ob-R.el (org-babel-R-initiate-session): Protect against use of + unbound variable `ess-ask-for-ess-directory´. The default for this + variable is true, so act accordingly if it is found unbound. + + * ob-R.el: Remove initialization with `nil´ from + `ess-ask-for-ess-directory´ and `ess-local-process-name´. Remove + second declaration for `ess-local-process-name´. + + * org-gnus.el: Add a missing require for gnus-util. + + * org-compat.el: Rename utils to make throughout. + + * org.el: Move check for outline-mode-keymap after (require + 'outline). + + * org-element.el: New file. Do not (require 'org). + + * org-agenda.el: Remove duplicate requires. + + * org.el (org-mode-map): Add keybindings to + `org-element-transpose' and `org-narrow-to-element'. + (org-metaup): Fall back on `org-element-drag-backward'. + (org-metadown): Fall back on `org-element-drag-forward'. Also + move chunks of declarations and require statements to get rid of + compiler warnings. + + * org-exp-blocks.el (org): Don't require org. Add declarations. + + * org-clock.el (org): Don't require org. + + * ob-exp.el (org-list-forbidden-blocks): Add declarations. + + * ob.el (org-babel-exeext): New defconst to hold extension for + executables or nil if none. Should be ".exe" for both Windows and + Cygwin. + + * ob-C.el (org-babel-C-execute): Use org-babel-exeext when + constructing the target file name for the compiled executable. + + * ob-fortran.el (org-babel-execute:fortran): Add org-babel-exeext + when constructing the target file name for the compiled + executable. + + * org-version.el: New file. + + * org-compat.el (org-check-version): New macro. Check if + org-version.el exists and provide autoloads to that. Otherwise + check if org-fixup.el exists and use it to provide definitions. + Finally if nothing worked, complain about a botched installation + and provide fallback definitions. + + * org.el: Use org-check-version. + + * org.el: Fix a subtle error resulting in version functions + sometimes not being defined and byte-compiling failing. Always + compile in fallback definitions into org.elc -- org-fixup either + provides re-definitions at compile-time or checks org-version.el + and then the git work tree when run uncompiled. So the fallback + definitions will only come into effect when org-fixup is not + available. + + * org.el (org-version): Make org-version more robust, e.g. when + byte-compiling single files with 'make compile-dirty'. + + * org.el (org-reload): Revert an undesirable change in org-reload. + Do not prepend org-dir to babel-files, which prevents the files + from being found in load-path. + + * org.el (org-version): Add optional parameters 'full and 'message + to optionally return the full version string and echo to message + area in non-interactive calls. + + * org.el (org-submit-bug-report): Add optional parameter 'full to + call of (org-version) so that the bug report has all version + information. + + * org.el (org-reload): Simplify file-re (orgtbl-*.el files do not + exist anymore). Keep org-*.el at the end of the files list. + Explicitely load org-version.el (since it doesn't provide feature + 'org-version) at the very end, but ignore errors when it doesn't + exist. Add parameters 'full and 'message to the call of + (org-version) so that after reload the full version information is + displayed in the message area again. + + * org-agenda.el: Replace with-no-warnings with org-no-warnings + (defined in org-macs.el). + + * org-bbdb.el: Replace with-no-warnings with org-no-warnings + (defined in org-macs.el). + + * org-clock.el: Replace with-no-warnings with org-no-warnings + (defined in org-macs.el). + + * org.el: Replace with-no-warnings with org-no-warnings (defined + in org-macs.el). + + * org.el: Add with-not-warnings around call of (org-fixup). + + * org-compat.el (org-find-library-dir): Rename + org-find-library-name (misleading) and implement with a function + that exists identically in Emacs/XEmacs. + + * org-exp-blocks.el: Change calls to org-find-library-dir. + + * org.el: change calls to org-find-library-dir. Make require for + noutline fail silently because it is missing from XEmacs. + + * org.el (org-version): Use functions instead of global variables + to get the version strings and remove the defvaralias to + org-version. Warn when encountering a mixed installation (org and + org-install.el should be found in the same directory). + + * org.el: Add with-no-warning to defvar for two unprefixed global + variables from calendar.el (there's nothing else we can do inside + org until it is fixed in calendar.el). + + * org.el: Require find-func and remove declare-function for + find-library-name, otherwise autoloaded org-version doesn't show + all info correctly. + + * org.el (org-version): Show the full path to org-install.el in + the version string to avoid confusion if multiple installations + exist or a previously loaded org-install.el has already defined a + version string that is now out of date. + + * org.el (org-version): Remove determination of version + information, show "N/A" if the information is not provided via + org-install.el. + + * org.el (org-git-version): Placeholder for recording the Git + version of org during install + + * org.el (org-version): Initialize local git-version with + placeholder and fall through using it when org is not installed in + a Git repository + +2012-09-30 Adam Spiers <orgmode@adamspiers.org> (tiny change) + + * org-html.el: Add hyperlink to http://orgmode.org/ from export + footer. + + * org-clock.el (org-clock-modify-effort-estimate): Display a + message when no clock is currently active. + +2012-09-30 Andrew Hyatt <ahyatt@gmail.com> (tiny change) + + * org-archive.el (org-archive-subtree): Allow archiving to a + datetree. + + * org.el (org-archive-location): Ditto. + +2012-09-30 Bastien Guerry <bzg@gnu.org> + + * ob-io.el: New file. + + * ob-scala.el: New file. + + * org.el (org-url-hexify-p, org-doi-server-url) + (org-latex-preview-ltxpng-directory, org-custom-properties) + (org-sparse-tree-default-date-type): Add :version "24.3". + + * org-agenda.el (org-agenda-sticky) + (org-agenda-custom-commands-contexts): Ditto. + + * org-capture.el (org-capture-bookmark) + (org-capture-templates-contexts) (org-capture-use-agenda-date): + Ditto. + + * org-latex.el (org-export-latex-hyperref-options-format) + (org-export-latex-link-with-unknown-path-format): Ditto. + + * org-id.el (org-id-link-to-org-use-id): Ditto. + + * org-datetree.el (org-datetree-add-timestamp): Ditto. + + * org.el (org-make-link-description-function): Enhance docstring. + (org-insert-link): Fall back on interactive prompt when + `org-make-link-description-function' fails. + + * org-agenda.el (org-todo-list): Fix redoing of todo agenda when + `org-agenda-sticky' is non-nil. + + * org-agenda.el (org-agenda-quit): Delete last indirect buffer. + (org-agenda-pre-follow-window-conf): New variable. + (org-agenda-tree-to-indirect-buffer): Fix bug: don't split agenda + window when there an indirect buffer is already displayed. + + * org-agenda.el (org-agenda-manipulate-query) + (org-agenda-goto-date, org-agenda-goto-today) + (org-agenda-find-same-or-today-or-agenda, ) + (org-agenda-later, org-agenda-change-time-span) + (org-agenda-change-all-lines) + (org-agenda-execute-calendar-command) + (org-agenda-goto-calendar, org-agenda-convert-date): Make sure to + get a property from (1- (point-max)), not (point-max)). + + * ob-dot.el (org-babel-execute:dot): Throw an error when there is + no :file parameter. + + * org-table.el (org-table-eval-formula): Convert time-stamps to + inactive time-stamp so that Calc can handle them correctly. + + * org-table.el (org-table-fix-formulas): Warn with a message when + formulas have been updated. + + * org-publish.el (org-publish-cache-ctime-of-src): Delete the + base-dir argument and use (file-name-directory file) to get the + file's directory. + (org-publish-update-timestamp) + (org-publish-cache-file-needs-publishing): Call + `org-publish-cache-ctime-of-src' with only one argument. + + * org.el (org-follow-timestamp-link): Fix bug when using sticky + agenda. Add a docstring. + + * org-agenda.el (org-agenda-sticky): Don't use a function to set. + Add a :version string. + + * org.el (org-priority): Use a new argument to show priority + instead of setting it. + (org-show-priority): New function to show priority both in normal + Org buffers and in Org Agenda buffers. + (org-speed-commands-default): Use "," as a speed command for + setting priority. + + * org-agenda.el (org-agenda-mode-map): Bind `org-agenda-priority' + to `C-c ,' as it was before. + (org-agenda-show-priority): Delete. + (org-agenda-priority): Use a new argument to show priority instead + of setting it. + + * org.el (org-font-lock-hook, org-set-font-lock-defaults): Add a + docstring. + (org-display-inline-remove-overlay): Rename from + `org-display-inline-modification-hook'. + (org-speed-command-activate): Rename from + `org-speed-command-default-hook'. + (org-babel-speed-command-hook): Rename from + `org-babel-speed-command-activate'. + + * org-agenda.el (org-agenda-update-agenda-type): Rename from + `org-agenda-post-command-hook'. + (org-agenda-mode): Use the new name. + (org-agenda-post-command-hook): Define as obsolete function. + + * org-lparse.el (org-lparse): Temporarily activate the hooks + needed for the ODT conversion. + (org-lparse-preprocess-after-blockquote): Rename from + `org-lparse-preprocess-after-blockquote-hook'. + (org-lparse-strip-experimental-blocks-maybe): Rename from + `org-lparse-strip-experimental-blocks-maybe'. + (org-lparse-preprocess-after-blockquote-hook) + (org-lparse-strip-experimental-blocks-maybe-hook): Define as + obsolete functions. + + * ob.el (org-babel-insert-result): Comma-escape results inserted + with ":results org". + + * org-src.el (org-edit-src-code, org-edit-src-exit): Fix bug about + saving the source editing window with the default value for + `org-src-window-setup' (i.e. 'reorganize-frame). + + * org-src.el (org-src-font-lock-fontify-block): Fix bug: don't + fontify the last character. + + * org.el (org-open-at-point): Don't follow timestamp within + bracket links. + + * org-capture.el (org-capture-templates): Fix typo in docstring. + + * org-agenda.el (org-agenda-skip): Skip information retrieved from + a source block. + + * ob.el (org-babel-common-header-args-w-values) + (org-babel-insert-result): Reintroduce ":results org" but using + "#+BEGIN_SRC org", not "#+BEGIN_ORG". + + * ob.el (org-babel-common-header-args-w-values): Remove "org" the + list of predefined values for the ":results" parameter. + + * ob.el (org-babel-insert-result): Remove support for ":results + org". + + * ob.el (org-babel-common-header-args-w-values) + (org-babel-insert-result): Deprecate ":results wrap" in favor of + ":results drawer". + + * org-crypt.el (org-at-encrypted-entry-p): Fix bug when the check + happens before the first headline. + + * org-capture.el (org-at-encrypted-entry-p) + (org-encrypt-entry, org-decrypt-entry): Declare. + (org-capture-set-target-location): Check whether `org-crypt' has + been loaded. + + * org-agenda.el (org-agenda-todo-custom-ignore-p): Fix typo in + docstring. + + * org-capture.el (org-capture-finalize): Maybe re-encrypt the + target headline if it was decrypted. + (org-capture-set-target-location): Maybe decrypt the target + headline. + + * org-crypt.el (org-at-encrypted-entry-p): New function. + + * org.el (org-options-keywords): Add "STYLE:". + + * org-agenda.el (org-agenda-ndays): Don't make an alias, as + `org-agenda-span' is defined separately. + + * org.el (org-in-subtree-not-table-p): New utility function for + building the menu. + (org-org-menu): Add an item for refiling. Check more contexts + when activating items. + (org-tree-to-indirect-buffer): Use `org-up-heading-safe'. + + * org-agenda.el (org-agenda-tree-to-indirect-buffer) + (org-agenda-do-tree-to-indirect-buffer): Use argument `arg'. + + * org-capture.el (org-capture-set-target-location): Set a correct + time value when storing a note in a datetree and prompting the + user for a date. + + * org-capture.el (org-capture-mode): Fix bug: don't run the mode's + hook twice. + + * org-agenda.el (org-agenda-menu-two-column) + (org-finalize-agenda-hook, org-agenda-ndays): Use + `define-obsolete-variable-alias' instead of + `make-obsolete-variable'. + + * org.el (org-link-to-org-use-id): Move to org-id.el. + + * org-id.el (org-id-link-to-org-use-id): Rename from + `org-link-to-org-use-id'. Use `nil' as the default value. + (org-link-to-org-use-id): Alias and define as obsolete. + + * org-agenda.el (org-search-view, org-agenda-get-todos) + (org-agenda-get-timestamps, org-agenda-get-blocks): Use the dotime + parameter of `org-agenda-format-item' so that 'time-up and + 'time-down agenda sorting strategies are handled correctly. + + * org-capture.el (org-capture-fill-template): Fix checking of + protected template entries. + + * org.el (org-cycle-global-at-bob): Fix typo in docstring. + + * org.el (org-insert-drawer): Deactivate the mark before trying to + indent the :END: of the drawer. + + * org-agenda.el (org-agenda-export-html-style): Default to nil as + any string value will replace the htmlize style. + + * org.el (org-cycle-hook): Fix tiny typo in docstring. + + * org.el (org-time-string-to-time) + (org-time-string-to-seconds, org-end-of-subtree): Add a dosctring. + + * org-freemind.el (org-freemind-write-node): Enhance links + conversion in nodes. + + * org-freemind.el (org-freemind-write-node): Convert links in + nodes. + + * org.el (org-link-to-org-use-id, org-directory) + (org-default-notes-file, org-reverse-note-order) + (org-extend-today-until, org-finish-function) + (org-store-link-functions): Use "capture" instead of "remember" in + docstrings. Also use the `org-capture' group when it makes sense. + + * org-agenda.el (org-agenda-tree-to-indirect-buffer): Find the + correct agenda buffer. Don't split the agenda window when the + indirect buffer is displayed in another frame. + + * org.el (org-mode): Try to set the org-hide face correctly. + + * org-exp.el (org-export): Set the mark correctly when exporting a + subtree. + + * org-agenda.el (org-agenda-get-restriction-and-command): Fix the + display of the number of commands for block agendas. + + * org-agenda.el (org-agenda-before-write-hook) + (org-agenda-add-entry-text-maxlines): Enhance phrasing. + (org-agenda-finalize-hook, org-agenda-mode-hook): Tell that the + buffer is writable when the hook is called. + (org-agenda-finalize): Allow org-agenda-finalize-hook to modify + the buffer. + + * org-agenda.el (org-habit-show-all-today): Only use defvar to + silent the byte-compiler. + (org-agenda-get-scheduled): Check whether some org-habit.el + options have been defined. + + * org-capture.el (org-capture-entry): New variable. + (org-capture-string, org-capture): Use it to possibly skip the + interactive prompt for a capture template. + + * org.el (org-activate-plain-links): Don't try to check if we are + in a bracket link already. + + * org.el (org-read-date-analyze): Fix bug introduced in commit + cc5f9f: adding a time should not prevent relative answers to be + parsed correctly. + + * org-agenda.el (org-agenda-bulk-action): Always read the date + through `org-read-date'. When possible, use the date at point as + the default date. + + * org-agenda.el (org-agenda-bulk-action): Fix bug when + bulk-shifting timestamps. + + * org.el (org-version): New constant. + + * org-compat.el (org-random): New compatibility function. + + * org-id.el (org-id-uuid): Use it. + + * org-capture.el (org-capture-use-agenda-date): New option. + (org-capture): Use it. + + * org-agenda.el (org-agenda-capture): New command. + (org-agenda-mode-map): Bind it to `k'. + (org-agenda-menu): Add it to the menu. + + * org-capture.el (org-capture): Update docstring. + + * org-capture.el (org-capture): When called from an agenda buffer, + use the cursor date at the default date. + + * org-agenda.el (org-agenda-bulk-action): Use the let-bound + `entries' instead the variable. + + * org-agenda.el (org-agenda-bulk-action): Fix bug: don't remove + persistent marks too early. + + * org-agenda.el (org-agenda-bulk-action): Possibly use the day at + point to reset the scheduled or deadline cookie. On date headers, + use it without prompting the user. On an item, use the item's + date as the default prompt for `org-read-date'. + + * org.el (org-read-date): Docstring fix. + + * org-agenda.el (org-agenda-bulk-action): Reorder possible actions + in the message. + + * org-agenda.el (org-agenda-action, org-agenda-do-action): Delete. + (org-agenda-mode-map): Delete related keys. + + * org-agenda.el (org-agenda-menu): Fix a keybinding. + + * org-colview.el (org-columns-goto-top-level): Correctly move the + marker `org-columns-top-level-marker'. + (org-agenda-columns): Don't set + `org-agenda-overriding-columns-format' as a buffer variable, as we + only need it dynamically. + (org-agenda-colview-summarize): Fix a bug in returning the match + string. + + * org-agenda.el (org-agenda-span-to-ndays): Make the second + argument `starting-day' optional. + (org-agenda-goto-date): Keep parameters of custom agendas. + + * org-agenda.el (org-agenda-list): Allow setting the agenda buffer + name through a temporary variable. + (org-agenda-buffer-tmp-name): New variable to temporary store the + agenda buffer name. + + * org-agenda.el (org-agenda-goto-date): Fix behavior when using + sticky agendas. + + * org-agenda.el (org-diary): Don't check whether there is an + agenda buffer when trying to compile the prefix format. + (org-compile-prefix-format): Check if there is an agenda buffer. + If not, use the current buffer. + + * org-agenda.el (org-agenda-get-day-entries): Set the agenda + buffer inconditionnally. + + * ob.el (org-babel-named-src-block-regexp-for-name): Generate a + more general regexp. + + * ob.el (org-babel-where-is-src-block-head): Find a src block head + correctly when #+header(s) is before #+name. + + * org-agenda.el (org-agenda-finalize-hook) + (org-agenda-finalize, org-agenda-finalize-entries): Rename from + org-finalize-agenda-*. + (org-agenda-run-series, org-agenda-finalize, org-timeline) + (org-agenda-list, org-search-view, org-todo-list) + (org-tags-view, org-diary, org-agenda-finalize-entries) + (org-agenda-change-all-lines): Use the new names. + + * org-agenda.el (org-agenda-local-vars): Remove + Ì€org-agenda-last-arguments' from the list of local variables. + (org-agenda-mode-map): `g' does the same than `r' in buffers with + only one agenda view, but its behavior differs when there are + several views. In manually appended agendas (with `A'), `g' + displays only the agenda under the point. With multiple agenda + blocks, `g' reinitializes the view by discarding any temporary + changes (e.g. with Ì€f' or `w'), while Ì€r' keeps those temporary + changes for the agenda view under the point. + (org-agenda-run-series, org-agenda-redo): Implement the above + changes. + (org-agenda-mark-header-line): Don't set useless properties. + (org-agenda-list, org-todo-only, org-search-view) + (org-todo-list, org-tags-view, org-agenda-list-stuck-projects) + (org-agenda-manipulate-query, org-agenda-goto-today) + (org-agenda-later, org-agenda-change-time-span): Use text + properties for storing the last command and the last arguments for + each agenda block. + (org-unhighlight-once): Delete. + + * org-agenda.el (org-agenda-append-agenda): Fit agenda window to + buffer. + + * org-agenda.el (org-agenda-append-agenda): Bugfix: correctly + check whether we are in org-agenda-mode. + + * org-agenda.el (org-agenda-pre-window-conf): Rename from + `org-pre-agenda-window-conf'. + (org-agenda-local-vars, org-agenda-prepare-window) + (org-agenda-Quit, org-agenda-quit): Use the new name. + + * org-agenda.el (org-keys, org-match): New variable, dynamically + scoped in `org-agenda'. + (org-agenda, org-agenda-list, org-search-view, org-todo-list) + (org-tags-view): Use the new variables. + (org-batch-store-agenda-views): Let-bind `match'. + + * org-agenda.el (org-search-view, org-todo-list) + (org-tags-view): Do not let `org-agenda-sticky' prevent the use of + these functions programmatically. Also use the sticky agenda + function correctly. + + * org-agenda.el (org-agenda): Set `org-agenda-buffer-name' + correctly with sticky agendas and non-custom commands. + + * org-agenda.el (org-agenda-fit-window-to-buffer): Rename from + `org-fit-agenda-window'. + (org-agenda-run-series, org-agenda-prepare, org-agenda-list) + (org-search-view, org-todo-list, org-tags-view): Use the new name. + + * org-agenda.el (org-agenda-prepare): Let `throw' display an + error. + + * org-agenda.el (org-agenda-list): Fix bug: don't throw an error + when called from programs as (org-agenda-list). + + * org-agenda.el (org-todo-list): Make arg optional. + + * org.el (org-agenda-prepare-buffers): Rename from + `org-prepare-agenda-buffers'. + (org-match-sparse-tree, org-map-entries): Use the new names. + + * org-agenda.el (org-agenda-prepare-window): Rename from + `org-prepare-agenda-window'. + (org-agenda-prepare): Rename from `org-prepare-agenda'. + (org-agenda-run-series, org-agenda-prepare, org-timeline) + (org-agenda-list, org-search-view, org-todo-list) + (org-tags-view, org-agenda-list-stuck-projects, org-diary) + (org-agenda-to-appt): Use the new names. + + * org-mobile.el (org-mobile-create-index-file): Ditto. + + * org-icalendar.el (org-export-icalendar): Ditto. + + * org-clock.el (org-dblock-write:clocktable) + (org-dblock-write:clocktable): Ditto. + + * org2rem.el (org2rem): Ditto. + + * org-agenda.el (org-agenda): In sticky agendas, use the current + command's match to set the buffer name. This gives more + information to the user and allows to distinguish various agendas + triggered by the same key. + (org-batch-store-agenda-views): Handle the new sticky agenda + buffer name. + + * org-agenda.el (org-agenda) + (org-agenda-get-restriction-and-command): Use `S' as a key for + searching words in TODO-only entries. + + * org-agenda.el (org-prepare-agenda): Fit agenda window when + displaying a sticky agenda. + + * org-table.el (org-table-number-regexp): Allow the user to set it + to a new regexp, which allows commas as decimal mark. The default + is to not use this setting, but the one before commit 7ff8c1, + which has ben reverted. + + * org-agenda.el (org-agenda-overriding-cmd) + (org-agenda-multi-current-cmd) + (org-agenda-multi-overriding-arguments): New variables. + (org-agenda-run-series): `org-agenda-overriding-arguments' + defaults to the last agenda block arguments, so don't use it + globally. + (org-agenda-mark-header-line): Add properties needed so that + `org-agenda-overriding-arguments', `org-agenda-current-span' and + `org-agenda-last-arguments' can be set to their correct contextual + value. + (org-agenda-multi-back-to-pos): New variable. + (org-agenda-later): Retrieve `org-agenda-current-span' and + `org-agenda-overriding-arguments' from text properties. Also + handle numeric span. + (org-agenda-later, org-agenda-change-time-span): Set + `org-agenda-overriding-cmd' so that we to take overriding + arguments into account for this command only. + + * org-agenda.el (org-agenda-kill, org-agenda-archive-with): Fix + bug when called with a non-nil value of `org-agenda-stick'. + + * org-agenda.el (org-agenda-refile): Fix bug when refiling an + entry from a sticky agenda. + + * org-agenda.el (org-prepare-agenda-window): Use + `org-pre-agenda-window-conf' if already set. + (org-agenda-Quit): Set `org-pre-agenda-window-conf' to nil when + quitting. + (org-agenda-quit): Ditto. + + * org-capture.el (org-capture-fill-template): Protect the text + used for replacement from being further replaced. + + * org.el (org-contextualize-validate-key): Fix the check against a + function. + + * org.el (org-contextualize-keys): Rename from + `org-contextualize-agenda-or-capture'. Fix normalization to + handle empty key replacement string. + (org-contextualize-validate-key): Rename from + `org-contexts-validate'. Allow checking against a custom + function. + + * org-agenda.el (org-agenda-custom-commands-contexts): Update. + (org-agenda): Use `org-contextualize-keys'. + + * org-capture.el (org-capture-templates-contexts): Ditto. + + * org.el (org-contextualize-agenda-or-capture): Normalize + contexts. + + * org.el (org-contextualize-agenda-or-capture): Handle key + replacement depending on the contexts. + + * org-capture.el (org-capture-templates-contexts): Allow to use + the context as a way to replace one capture template by another + one. + + * org-agenda.el (org-agenda-custom-commands-contexts): Allow to + use the context as a way to replace one agenda custom command by + another one. + + * org.el (org-contextualize-agenda-or-capture) + (org-rule-validate): New functions, implement context filtering + for agenda commands and capture templates. + + * org-agenda.el (org-agenda-custom-commands-contexts): New option. + (org-agenda): Use it. + + * org-capture.el (org-capture-templates-contexts): New option. + (org-capture-select-template): Use it. + + * org.el (org-beginning-of-defun, org-end-of-defun): Delete. + (org-mode): Set `beginning-of-defun-function' and + `end-of-defun-function' directly. + + * org.el (org-insert-link): Fix bug: include links abbreviations + when completing. + + * org-icalendar.el (org-icalendar-print-entries): Fix bug: when + `org-icalendar-use-plain-timestamp' is nil, scheduled and deadline + items should not be ignored. + + * org.el (org-ds-keyword-length, org-make-tags-matcher): Docstring + clean-up. + + * org-freemind.el (org-freemind-convert-links-from-org): Replace + literally to prevent errors when replacing with string containing + backslashes. + + * org-pcomplete.el (org-thing-at-point): Allow to match (and then + complete) a "thing" containing dashes. + + * org-table.el (org-table-toggle-coordinate-overlays): Better + message when interactively toggling. + + * org-table.el (org-table-number-regexp): Update the docstring to + show an example of a decimal number using the comma as a + separation mark. + + * org-agenda.el (org-prepare-agenda): Minor code clean-up. + (org-agenda-filter-by-category): Filtering must be turned off only + when a category filter has been set and this filter is not empty. + + * org-agenda.el (org-search-view, org-agenda-get-todos) + (org-agenda-get-timestamps, org-agenda-get-sexps) + (org-agenda-get-progress, org-agenda-get-deadlines) + (org-agenda-get-scheduled, org-agenda-get-blocks): Use + `category-pos' instead of `org-category-pos'. + + * ob-fortran.el (org-babel-fortran-transform-list): Rename from + `ob-fortran-transform-list'. + (org-babel-fortran-var-to-fortran): Use the new function's name. + + * ob-calc.el (org-babel-calc-maybe-resolve-var): Rename from + `ob-calc-maybe-resolve-var'. + (org-babel-execute:calc): Use the new function's name. + + * org-jsinfo.el (org-infojs-template): Add a license. + (org-infojs-handle-options): Replace all template elements. + + * org-html.el (org-export-html-scripts): Add a license. + (org-export-html-mathjax-config): Replace all template elements. + (org-export-html-mathjax-template): Add a license. + (org-export-as-html): Minor code clean-up. + + * org.el (org-options-keywords): Add "#+MATHJAX" and + "#+INFOJS_OPT" to the list of keywords for completion. + + * org.el (org-src-prevent-auto-filling): Remove unused and useless + option. + + * org.el (org-element-at-point): Autoload. + (org-element-up): Remove useless declaration. + (org-fill-context-prefix, org-fill-paragraph) + (org-mark-element, org-narrow-to-element) + (org-transpose-element, org-unindent-buffer): Do not require + org-element. + + * org.el (org-fill-paragraph): Require org-element. + + * org-agenda.el (org-agenda-persistent-marks): Minor docstring + enhancement. + + * org.el (org-create-math-formula): Use the compatibility function + `org-region-active-p'. + + * org-odt.el (org-export-as-odf): Ditto. + + * ob.el (org-babel-demarcate-block): Ditto. + + * org.el (org-mark-subtree): Maybe call `org-mark-element' + interactively. + (org-mark-element): Only mark further elements when called + interactively. + + * org.el (org-mark-element, org-narrow-to-element) + (org-transpose-element): Require org-element. + + * org-agenda.el (org-agenda-get-timestamps) + (org-agenda-get-sexps, org-agenda-get-deadlines) + (org-agenda-get-scheduled): Add the 'warntime as a text property, + getting its value from the APPT_WARNTIME property. + (org-agenda-to-appt): Use the 'warntime text property. + + * org-capture.el (org-capture-place-table-line): Fix bug. + + * org.el (org-activate-plain-links): Don't activate a plain link + when it is part of a bracketed link, unless bracketed links are + not enlisted in `org-activate-links'. + (org-open-at-point): Don't consider the text immediately after a + bracketed link is part of a plain link. + + * org.el (org-compute-latex-and-specials-regexp) + (org-paste-subtree, org-sort-entries, org-store-link) + (org-open-at-point, org-file-remote-p, org-add-log-setup) + (org-set-tags-to, org-fast-tag-selection) + (org-diary-sexp-entry): Ditto. + + * org-agenda.el (org-agenda-get-blocks, org-cmp-priority) + (org-cmp-effort, org-cmp-todo-state, org-cmp-alpha) + (org-cmp-tag, org-cmp-time): Remove useless (t nil) sexps at the + end of (cond ...) constructs. + + * org-mobile.el (org-mobile-create-index-file): Ditto. + + * org-lparse.el (org-lparse-format-table-row): Ditto. + + * org-list.el (org-sort-list): Ditto. + + * org-id.el (org-id-get): Ditto. + + * org-html.el (org-export-html-preprocess): Ditto. + + * org-exp.el (org-default-export-plist) + (org-table-clean-before-export): Ditto. + + * org.el (org-options-keywords): Add "TODO". + (org-make-options-regexp): Make the hashtag mandatory for options + and don't allow whitespaces between the hashtag and the plus sign. + + * org.el (org-refresh-category-properties) + (org-find-dblock, org-dblock-start-re, org-dblock-end-re): Allow + lowercase "#+category" and "#+begin:" dynamic blocks. + + * org.el (org-context): Use case-folding when trying to match + clocktables and source blocks contexts. + + * org-clock.el (org-clock-put-overlay): Put the overlay on the + whole headline, not only on the last character. This fixes a bug + with overlays on headlines ending with a bracketed link. + + * org-html.el (org-export-as-html): Make sure we always process a + string. + + * org-exp.el (org-export-cleanup-toc-line): Always return a + string. + + * org.el (org-fontify-meta-lines-and-blocks-1): Correctly handle + metalines with #+results[...]:. + + * org-exp.el (org-export-handle-metalines): Rename from + `org-export-handle-table-metalines'. Now also handle source block + metalines. + (org-export-res/src-name-cleanup): Delete. + (org-export-preprocess-string): Use `org-export-handle-metalines'. + Don't use `org-export-res/src-name-cleanup' anymore. + + * org-html.el (org-format-org-table-html): Don't include the + caption tag for empty captions in HTML export. Keep it in the + DocBook export so that it produces valid DocBook XML. + + * org.el (org-read-date-analyze): Allow both "8am Wed" and "Wed + 8am" to be parsed correctly with respect to possible values of + `org-read-date-prefer-future'. + (org-read-date-prefer-future): Update docstring to remove the + restriction about inserting only the time. The user can now + insert the time and the day. + + * org-icalendar.el (org-icalendar-print-entries): Rename from + `org-print-icalendar-entries'. + (org-icalendar-start-file): Rename from + `org-start-icalendar-file'. + (org-icalendar-finish-file): Rename from + `org-finish-icalendar-file'. + (org-icalendar-ts-to-string): Rename from `org-ical-ts-to-string'. + (org-export-icalendar): Use the correct functions. + + * ob-ref.el (org-babel-ref-index-list): Fix bug introduced by + commit e85479. + + * org.el (org-fill-context-prefix): Require org-element. + (org-timestamp-change): Fix bug by saving excursion when adjusting + another clock. + + * org.el (org-read-date-prefer-future): Fix docstring formatting. + (org-read-date-analyze): Fix the interpretation of + `org-read-date-prefer-future'. + + * org-agenda.el (org-agenda-menu-two-column): Rename to + `org-agenda-menu-two-columns'. + + * ob.el (org-babel-sha1-hash, org-babel-noweb-p): Replace + `org-labels' by `let*'. + + * org-bibtex.el (org-bibtex-headline): Ditto. + + * org-compat.el: Delete `org-labels'. + + * ob.el (org-babel-get-src-block-info) + (org-babel-check-src-block, org-babel-current-result-hash) + (org-babel-parse-src-block-match, org-babel-read-link) + (org-babel-insert-result, org-babel-clean-text-properties): Use + Ì€org-no-properties' instead of `org-babel-clean-text-properties'. + (org-babel-clean-text-properties): Delete redundant function + `org-babel-clean-text-properties'. + + * ob-tangle.el (org-babel-tangle-collect-blocks) + (org-babel-tangle-comment-links): Ditto. + + * ob-table.el (sbe): Ditto. + + * ob-lob.el (org-babel-lob-get-info) + (org-babel-lob-execute): Ditto. + + * ob-exp.el (org-babel-exp-non-block-elements): Ditto. + + * org-macs.el (org-no-properties): Allow a new parameter + `restricted' to restrict the properties removal to those in + `org-rm-props'. The default is now to remove all properties. + + * org-compat.el (org-substring-no-properties): Remove unused + defun. + + * org-remember.el (org-remember-apply-template): Remove redundant + removal of text properties. + (org-remember-apply-template): Use `org-no-properties'. + + * org-capture.el (org-capture-fill-template): Remove redundant + removal of text properties. + (org-capture-fill-template): Use `org-no-properties'. + + * org-gnus.el (org-gnus-open, org-gnus-follow-link): Use + `org-no-properties'. + + * org-colview.el (org-columns-display-here): Ditto. + + * org-table.el (org-table-eval-formula): Ditto. + + * org.el (org-entry-properties): Ditto. + + * org-icalendar.el (org-print-icalendar-entries): Fix bug about + handling `alarm-time'. + + * ob-R.el (org-babel-edit-prep:R): Don't set the session. + + * org.el (org-store-log-note): Only skip comments starting with "# + " when storing a note. + + * org.el (org-custom-properties): New option. + (org-custom-properties-overlays): New variable. + (org-toggle-custom-properties-visibility): New command to toggle + the visibility of custom properties. + (org-check-before-invisible-edit): Also prevent errors when trying + to edit invisible properties. + + * org-datetree.el (org-datetree-add-timestamp): New option. + (org-datetree-insert-line): Use it. + + * org.el (org-fill-template): Fix bug when filling template for a + key associated to the nil value. + + * org-agenda.el (org-diary): Fix tiny typo. + + * org.el (message-in-body-p): Move declaration up to fix compiler + warning. + + * org.el (org-fill-context-prefix): Fix auto-filling in + `message-mode'. + + * org.el (org-fill-paragraph): Correctly fill paragraph in + message-mode. + (org-indent-line): Correctly indent according to mode when + `orgstruct++-mode' is on. + (orgstruct++-mode): Add `fill-prefix' to the variable temporarily + stored in `org-fb-vars'. + + * org.el (org-fill-paragraph): Make a command. Fix bug about + filling message headers and citations. + + * org.el (org-redisplay-inline-images): New command. + (org-mode-map): Bind it to C-c C-x C-M-v. + + * org-colview.el (org-columns-get-format-and-top-level): Fix bug. + (org-columns-get-format): Fix compiler warning. + + * org-feed.el: Add declarations. + + * org-agenda.el (org-agenda-get-sexps): Use `org-get-tags-at' to + allow tag inheritance. + + * org-capture.el (org-capture): Fix bug introduced by commit + 1737d3. + + * org-publish.el (org-publish-needed-p) + (org-publish-update-timestamp, org-publish-file) + (org-publish-cache-file-needs-publishing): New argument + `base-dir'. + (org-publish-cache-ctime-of-src): Use the new argument to make + sure we find the file according to :base-directory. + + * org-capture.el (org-capture-string): New command to prompt for + the interactive text interactively. This can also be used in + Elisp programs to use Ì€org-capture' with some initial text. + (org-capture-initial): New variable to store the initial text. + (org-capture): Use `org-capture-initial'. + + * org.el (org-emph-re): Tiny docstring formatting fix. + + * org-compat.el (org-labels): Remove. + + * org-bibtex.el (org-bibtex-headline): Don't use `org-labels'. + + * ob.el (org-babel-sha1-hash, org-babel-noweb-p): Ditto. + + * org.el (org-emph-re): Tiny formatting fix. + + * org.el (orgstruct-setup): Require `org-element'. + + * org.el (org-store-link, org-open-at-point): New link type + "help". + + * org-compat.el (org-flet): Remove alias. + + * ob.el (org-babel-edit-distance, org-babel-sha1-hash) + (org-babel-get-rownames, org-babel-insert-result) + (org-babel-merge-params) + (org-babel-expand-noweb-references): Don't use `org-flet'. Also + indent some functions correctly. + + * ob.el (org-babel-execute-src-block) + (org-babel-join-splits-near-ch, org-babel-format-result) + (org-babel-examplize-region): Don't use `org-flet'. + (org-babel-tramp-handle-call-process-region): Fix typo. + + * ob-awk.el (org-babel-awk-var-to-awk): Don't use `org-flet'. + + * ob-sh.el (org-babel-sh-var-to-string): Ditto. + + * ob-tangle.el (org-babel-tangle, org-babel-spec-to-string): Don't + use `org-flet'. + + * org-pcomplete.el (org-compat): Require. + + * ob-tangle.el (org-babel-load-file): Don't use `org-flet'. + + * org-bibtex.el (org-bibtex-write): Use let*. + + * org-plot.el (org-plot/gnuplot-script): Don't use `org-flet'. + + * org-bibtex.el (org-bibtex-headline, org-bibtex-fleshout) + (org-bibtex-read, org-bibtex-write): Don't use `org-flet'. + + * org-clock.el (org-clock-cancel): Use `org-looking-back'. + + * org-pcomplete.el (org-thing-at-point): Ditto. + + * org.el (org-timestamp-change): Ditto. + + * org-mouse.el (org-mouse-timestamp-today) + (org-mouse-set-priority, org-mouse-popup-global-menu) + (org-mouse-context-menu): Don't use Ì€org-flet'. + + * org.el (org-priority): Fix docstring. + + * org-publish.el (org-publish-write-cache-file) + (org-publish-initialize-cache) + (org-publish-cache-file-needs-publishing) + (org-publish-cache-get): Small code clean-up. + + * org-publish.el (org-publish-cache-ctime-of-src): Simplify. + + * org-agenda.el (org-agenda-get-sexps): Add a 'tags property for + agenda entries created from sexps. + + * org-capture.el (org-capture-templates): Docstring clean up. + (org-capture-place-entry, org-capture-place-item) + (org-capture-place-plain-text, org-capture-place-table-line): + Ensure to always position the point according to %?. + + * org-table.el (org-table-convert-refs-to-rc): Fix bug when + converting remote table references. + + * org-agenda.el (org-agenda-switch-to): Run hooks in + Ì€org-agenda-after-show-hook'. + + * ob-ref.el (org-babel-ref-index-list): Use let* and rename the + variable `length' to `lgth'. + + * org-plot.el (org-plot/gnuplot-to-grid-data): Don't use + Ì€org-flet'. + + * org-exp.el (org-export-format-source-code-or-example): Ditto. + + * org-exp-blocks.el (org-export-blocks-preprocess): Ditto. + + * ob.el (org-babel-view-src-block-info) + (org-babel-execute-src-block, org-babel-edit-distance) + (org-babel-switch-to-session-with-code) + (org-babel-balanced-split, org-babel-insert-result): Ditto. + + * ob-ref.el (org-babel-ref-index-list): Ditto. + + * ob-python.el (org-babel-python-evaluate-session): Ditto. + + * ob-lob.el (org-babel-lob-get-info): Ditto. + + * ob-gnuplot.el (org-babel-expand-body:gnuplot): Ditto. + + * ob-exp.el (org-babel-exp-do-export): Ditto. + + * org-table.el (orgtbl-to-generic): Fix docstring. + + * org-clock.el (org-clock-in): Call `org-clock-out' with the new + argument `switch-to-state' set to nil. Fix docstring. + (org-clock-in-last): Prompt for a todo state to switch to when + called with three universal prefix arguments. Don't display a + message when the clock is already running. Update docstring. + (org-clock-out): New argument `switch-to-state'. When this + argument is non-nil, prompt for a state to switch the clocked out + task to, overriding `org-clock-out-switch-to-state'. + + * org.el (org-entry-get): Don't use `org-flet'. + + * org.el (org-forward-heading-same-level): Rename from + `org-forward-same-level'. + (org-backward-heading-same-level): Rename from + `org-backward-same-level'. + + * org.el (org-forward-element): Rename from `org-element-forward'. + (org-backward-element): Rename from `org-element-backward'. + (org-up-element): Rename from `org-element-up'. + (org-down-element): Rename from `org-element-down'. + (org-drag-element-backward): Rename from + `org-element-drag-backward'. + (org-drag-element-forward): Rename from + `org-element-drag-forward'. + (org-mark-element): Rename from `org-element-mark-element'. + (org-transpose-element): Rename from `org-element-transpose'. + (org-unindent-buffer): Rename from `org-element-unindent-buffer'. + (org-mode-map): Update the names of a commands. Remove useless + declarations. + + * org-element.el (org-element-forward, org-element-backward) + (org-element-up, org-element-down) + (org-element-drag-backward, org-element-drag-forward) + (org-element-mark-element, org-narrow-to-element) + (org-element-transpose, org-element-unindent-buffer): Move to + org.el. + + * org.el (org-forward-same-level): Fix typo in docstring. + + * org-agenda.el (org-agenda-mode-map): Bind + `org-agenda-show-priority' to `C-c,' instead of `P'. + (org-agenda-next-item, org-agenda-previous-item): New commands to + move by one item down/up in the agenda. + (org-agenda-mode-map): Bind `org-agenda-next-item' and + `org-agenda-previous-item' to `N' and `P' respectively. + + * org-rmail.el (org-rmail-store-link, org-rmail-follow-link): + Toggle headers when necessary. + + * org-element.el (org-narrow-to-element): Autoload. + + * org.el (org-mode-map): Use `M-h' for `org-element-mark-element'. + (org-mark-subtree): Allow a numeric prefix argument to move up + into the hierarchy of headlines. + + * org-element.el (org-element-up, org-element-down): Autoload. + + * org.el: Declare functions and don't require org-element. + + * org-element.el (org-element-at-point, org-element-forward) + (org-element-backward, org-element-drag-backward) + (org-element-drag-forward, org-element-mark-element) + (org-element-transpose, org-element-unindent-buffer): Autoload. + Require 'org and remove all declarations. + + * org.el (org-outline-regexp-bol, org-heading-regexp): Use + variables instead of constants. + + * org-archive.el (org-datetree-find-date-create): Declare. + + * org.el (org-open-at-point): Only set + `clean-buffer-list-kill-buffer-names' when the feature 'midnight + has been loaded. + + * org-icalendar.el (org-print-icalendar-entries): Let + APPT_WARNTIME take precedence over Ì€org-icalendar-alarm-time'. + + * org.el (org-special-properties): New special property + CLOCKSUM_T. + (org-entry-properties): Handle the new special property. + + * org-colview.el (org-columns): Handle a new special property + CLOCKSUM_T. + (org-agenda-colview-summarize, org-agenda-colview-compute): Ditto. + + * org-clock.el (org-clock-sum-today): New function. + (org-clock-sum): New argument PROPNAME to set a custom text + property instead of :org-clock-minutes. + + * org-agenda.el (org-agenda-check-type): Throw a more appropriate + error message when no agenda is currently being displayed. + + * org.el (org-get-property-block): Find blocks before the first + headline. + (org-entry-properties): Minor code cleanup. + (org-entry-get, org-entry-get-with-inheritance): Get property + before the first headline. + + * org-mobile.el (org-mobile-create-index-file): Use `files-alist'. + + * org.el (org-make-link): Delete. + (org-store-link, org-insert-link) + (org-file-complete-link): Don't use `org-make-link'. + + * org-wl.el (org-wl-store-link-folder) + (org-wl-store-link-message): Ditto. + + * org-vm.el (org-vm-store-link): Ditto. + + * org-rmail.el (org-rmail-store-link): Ditto. + + * org-mhe.el (org-mhe-store-link): Ditto. + + * org-mew.el (org-mew-store-link): Ditto. + + * org-irc.el (org-irc-erc-store-link): Ditto. + + * org-info.el (org-info-store-link): Ditto. + + * org-id.el (org-id-store-link): Ditto. + + * org-gnus.el (org-gnus-group-link, org-gnus-article-link): Ditto. + + * org-eshell.el (org-eshell-store-link): Ditto. + + * org-bbdb.el (org-bbdb-store-link): Ditto. + + * org.el (org-url-hexify-p): New option. When non-nil (the + default), hexify URLs when creating a link. + + * org.el (org-insert-link): Make sure point is at the beginning of + the buffer. + + * org.el (clean-buffer-list-kill-buffer-names): Declare. + (org-open-at-point): Allow opening multiple shell links by + creating a new output buffer for each shell process. The new + buffer is added to `clean-buffer-list-kill-buffer-names'. + + * org-mobile.el (org-mobile-create-index-file): Use + `org-global-tags-completion-table' instead of + `org-tag-alist-for-agenda' to get the tags for the index file. + + * org.el (org-global-tags-completion-table): Fix typo in + docstring. + + * org.el (org-link-to-org-use-id): Use `org-capture' instead of + `org-remember' in the docstring. + (org-link-fontify-links-to-this-file): New function to fontify + links to the current buffer in `org-stored-links'. + (org-store-link): Small code simplification. + (org-link-prettify): Enclose literal links into <...> instead of + [[...]]. + (org-insert-link): Use `org-link-fontify-links-to-this-file'. + Also allow completion over links' descriptions, as well as links + destinations. When the user uses the description for completion, + don't prompt again for a description. + + * org-capture.el (org-capture-templates): Fix docstring by adding + Gnus to the list of mail clients. + + * org.el (org-log-repeat): Enhance docstring. + + * org.el (org-mode-map): Don't bind C-<up> and C-<down> to + `org-element-backward/forward' as these functions stops when there + is no element of the same type before/after point. It is useful + to navigate with `forward/backward-paragraph' with no stop in most + cases. + + * org-capture.el (org-capture-templates): New template %l to + insert the literal link pointing at the current buffer. + + * org.el (org-todo-keywords): Ditto. + + * org.el (org-fill-paragraph): Falls back on + `message-fill-paragraph' if required in `message-mode'. + + * org-pcomplete.el (pcomplete/org-mode/file-option/x): New macro. + (pcomplete/org-mode/file-option/options) + (pcomplete/org-mode/file-option/title) + (pcomplete/org-mode/file-option/author) + (pcomplete/org-mode/file-option/email) + (pcomplete/org-mode/file-option/date): Use the new macro to offer + completion over default values for #+OPTIONS, #+TITLE, #+AUTHOR, + #+EMAIL and #+DATE. + + * org-agenda.el (org-agenda-write): Fix bug when writing agenda to + an external file while `org-agenda-sticky' is non-nil. + + * org.el (org-speed-commands-default): New speedy command to + quickly add the :APPT_WARNTIME: property. + + * org-agenda.el (org-agenda-to-appt): Use the :APPT_WARNTIME: + property to override `appt-message-warning-time' when adding an + appointment from an entry. + + * org.el (org-version): Improve docstring. + (org-self-insert-cluster-for-undo): The default value should be + nil for Emacs >=24.1. See bug#11774. + + * org.el (org-fontify-meta-lines-and-blocks-1): Fix previous + commit. + + * org.el (org-options-keywords): New constant. + (org-additional-option-like-keywords): Remove duplicates with + keywords in the new constant. + (org-additional-option-like-keywords-for-flyspell): Use the new + constant. + (org-mode-flyspell-verify): Exclude keywords from the new + constant. + + * org-pcomplete.el (pcomplete/org-mode/file-option): Use + `org-options-keywords'. + + * org.el (org-toggle-heading): Bugfix: use + `org-element-mark-element' instead of `org-mark-list'. + + * org-list.el (org-mark-list): Delete. + + * org.el: Update a few keybindings. + + * org-element.el (org-element-down): Throw an error when the + element has no content. + + * org-table.el (orgtbl-radio-table-templates): Add a template for + org-mode. + (orgtbl-to-orgtbl): Complete and align the table created with + orgtbl-to-orgtbl, in case the user use the function for radio + tables. + (orgtbl-to-table.el): New function to export a table to another + one using the table.el format. + (orgtbl-to-unicode): New function to export a table using unicode + characters. + + * org-exp.el (org-export-language-setup): Use "Sommaire" for the + french translation of "Table of contents", to avoid a possible bug + when exporting to ODT. + + * org.el (org-additional-option-like-keywords): Add keywords. + (org-additional-option-like-keywords-for-flyspell): New constant + to use with flyspell. + (org-mode-flyspell-verify): Use the dedicated constant and don't + check `org-startup-options'. + + * org-agenda.el (org-batch-store-agenda-views): Use the sticky + agenda buffer name, if required. + (org-agenda-write): New parameter `agenda-bufname' to allow + setting the agenda buffer name. + + * org.el (org-mode-map): Add keybindings for + `org-element-forward', `org-element-backward', `org-element-up' + and `org-element-down'. + + * org.el (org-auto-fill-function): Don't call `do-auto-fill' + within (org-let org-fb-vars ...) as `do-auto-fill' should do the + right thing whether orgstruct++-mode is turned on or off. + + * org.el (org-sparse-tree-default-date-type): New option. + (org-ts-type): New variable. + (org-sparse-tree): New argument `type'. Use the new option + `org-sparse-tree-default-date-type' as the default value for + `type'. Fix docstring. + (org-re-timestamp): New function. + (org-check-before-date, org-check-after-date) + (org-check-dates-range): Use `org-ts-type' and `org-re-timestamp' + to tell compute the date regexp. + + * org.el (orgstruct++-mode, org-get-local-variables): Also set + `normal-auto-fill-function' when turning on/off orgstruct++-mode. + + * org-agenda.el (org-agenda-start-with-log-mode): Add relevant + customization types. + + * org-faces.el (org-document-title): Use the normal height. + + * org-clock.el (org-x11idle-exists-p): New variable. + (org-user-idle-seconds): Use it. + + * org.el (org-mode-map): Rebind `org-insert-all-links' to `C-c + C-M-l'. + + * org.el (org-insert-all-links): New command. + (org-insert-link): `org-keep-stored-link-after-insertion' is now + checked when the link to insert has been defined, regardless on + how it has been defined. Also don't read the description + interactively when the `default-description' parameter was given. + (org-mode-map): Bind `org-insert-all-links' to `C-c C-L'. + + * org.el (org-inc-effort): New command to increment the effort + property. + (org-set-effort): Use it. + (org-mode-map): Bind it to `C-c C-x E'. + (org-speed-commands-default): Use `E' as a speed command for it. + + * org.el (org-re-property-keyword): New function. + (org-entry-put): Use it to fix a bug with respect to setting the + value of a property when a property line with no value already + exists. + + * org.el (org-timestamp-change): Adjust clock in other org files + correctly. + + * org-clock.el (org-user-idle-seconds): Simplify. + + * org.el (org-mode-map): Bind `org-resolve-clocks' to `C-c C-x + C-z'. + + * org.el (org-mode-map): Add keybindings to + `org-element-transpose' and `org-narrow-to-element'. + (org-metaup): Fall back on `org-element-drag-backward'. + (org-metadown): Fall back on `org-element-drag-forward'. Also + move chunks of declarations and require statements to get rid of + compiler warnings. + + * org-exp-blocks.el (org): Don't require org. Add declarations. + + * org-clock.el (org): Don't require org. + + * ob-exp.el (org-list-forbidden-blocks): Add declarations. + + * org.el (org-timestamp-change): Don't use the `position'. + + * org.el (org-clock-history, org-clock-adjust-closest): New + variables. + (org-timestamp-change): Maybe adjust the next or previous clock in + `org-clock-history'. + (org-shiftmetaup, org-shiftmetadown): On clock logs, update the + timestamp at point and adjust the next or previous clock in + `org-clock-history', when possible. + + * org-clock.el (org-clock-in): Set the marker for + `org-clock-history' at a safer position. + + * org-timer.el (org-timer-pause-or-continue, org-timer-stop): + Autoload. + + * org-mobile.el (org-mobile-post-pull-hook): Fix docstring. + + * org.el (org-indent-line): Fix indentation of a property line + starting at the beginning of a line. + + * org-odt.el (org-odt-cleanup-xml-buffers): Use the new alias. + + * org-compat.el: Alias `org-condition-case-unless-debug' to + `condition-case-unless-debug' or `condition-case-no-debug'. + + * org.el (org-todo-keywords): Ditto. + + * org.el (org-use-fast-todo-selection): Reformat docstring. + + * org.el (org-flag-drawer): Add a docstring. + (org-mode-map): Bind Ì€org-clock-cancel' to "C-cC-xC-q" and + `org-clock-in-last' to "C-cC-xC-x". This fixes a bug in the + previous keybinding for `org-clock-in-last', which would override + the one for `org-clock-in'. + + * org-clock.el (org-clock-in-last): Prevent errors when there is + no clocking history. + (org-clock-cancel): Fix bug when checking against a clock log in a + folded drawer. + + * org.el (org-link-expand-abbrev): Implement "%(my-function)" as a + new specifier. Update the docstring. + + * org.el (org-startup-options): Fix docstring formatting. + + * org.el (org-use-sub-superscripts): Fix typo in docstring. + + * org.el (org-refile): Fix bug: prevent looping when calling + `org-set-tags' internally. + + * org.el (org-mode-map): Add `C-c C-x C-I' as a keybinding for + `org-clock-in-last'. + + * org-clock.el (org-clock-continuously): New option. + (org-clock-in): Three universal prefix arguments set + `org-clock-continuously' to `t' temporarily. + (org-clock-in-last): Fix call to `org-clock-select-task' and + support continuous clocking. + (org-clock-out-time): New variable. + (org-clock-out): Set `org-clock-out-time' when clocking out. + Small docstring rewriting. + (org-clock-remove-empty-clock-drawer): Fix "invalid search bound" + bug when trying to delete empty logbook drawer. + (org-clock-cancel): If the clock log is gone, send a warning + instead of deleting the region that is supposed to contain it. + + * org.el (org-move-line-down, org-move-line-up): Remove. + (org-metaup, org-metadown): When the region is active, move it + up/down by one line, with no regard to the context. + + * org-odt.el (org-odt-cleanup-xml-buffers): Use the new alias. + + * org-compat.el: Alias `org-condition-case-unless-debug' to + `condition-case-unless-debug' or `condition-case-no-debug'. + + * org-pcomplete.el (org-thing-at-point): Ignore trailing + whitespaces while looking-back at properties. + + * org.el (org-mode): Set `indent-region-function'. + (org-indent-region): New function. + (org-fill-paragraph): When in a src block, use `indent-region' to + indent the whole source code instead of falling back on + `fill-paragraph', as this function messes up the code. + + * org-src.el (org-edit-src-code): Fix docstring formatting. + + * ob.el (org-babel-do-key-sequence-in-edit-buffer): Ditto. + + * org.el (org-mode, org-add-log-setup) + (org-get-property-block, org-entry-put) + (org-property-next-allowed-value, org-return) + (org-indent-line): Rename `org-indent-line-function' to + `org-indent-line'. + + * org-timer.el (org-timer-item): Ditto. + + * org-table.el (org-table-store-formulas): Ditto. + + * org-clock.el (org-clock-in, org-clock-find-position): Ditto. + + * org-src.el (org-src-font-lock-fontify-block) + (org-src-strip-leading-and-trailing-blank-lines) + (org-src-ask-before-returning-to-edit-buffer) + (org-edit-src-code, org-edit-src-continue) + (org-edit-fixed-width-region) + (org-src-do-key-sequence-at-code-block) + (org-src-font-lock-fontify-block, org-src-fontify-buffer): Fix + typos in docstrings. + + * org-docbook.el (org-export-docbook-emphasis-alist): Fix typo: + use "format string" instead of "formatting string". + + * org-latex.el (org-export-latex-emphasis-alist) + (org-export-latex-title-command, org-export-latex-tables): Ditto. + + * org-html.el (org-export-html-postamble): Ditto. + + * org-latex.el (org-export-latex-hyperref-options-format): New + option. + (org-export-latex-make-header): Use it. + + * ob.el (org-babel-confirm-evaluate): Prevent errors when + `org-current-export-file' is void. + + * org-table.el (org-table-export): Use the file name extension to + suggest the right conversion format. Also amend the docstring. + + * org.el (org-speed-commands-default): Two new speed commands. + Use `:' for `org-columns' and Ì€#' for `org-toggle-comment'. + + * org.el (org-time-stamp): With two universal arguments, insert an + active timestamp with the current time without prompting the user. + + * org-clock.el (org-clock-in-last): New command. + + * org-clock.el (org-clock-in): Fix typo in docstring. + + * org-mobile.el (org-mobile-edit): Fix reference to a free + variable. + + * org.el (org-doi-server-url): Update :group. + + * ob-lob.el (org-babel-lob-execute): Fix reference to non-existent + variable. + + * org.el (org-doi-server-url): New option. + (org-open-at-point): Use it. + + * org.el (org-at-comment-p): New function. + (org-toggle-heading): Use `org-at-comment-p' to skip comments. + + * org-html.el (org-export-as-html): Add links to the Org mode and + GNU Emacs websites When :html-postamble is set to 't. + + * org-export.el (org-export-creator-string): Add links to the Org + mode and GNU Emacs websites. + + * org-special-blocks.el + (org-special-blocks-convert-html-special-cookies): Prevent errors + by first checking `org-line' is not nil. + + * org-clock.el (org-clock-string-limit) + (org-clock-modeline-total, org-clock-task-overrun-text) + (org-clock-mode-line-entry): Doc fix, "modeline" -> "mode line". + + * org.el (org-at-timestamp-p): Set Ì€org-ts-what' to 'after when the + point is right after the timestamp. `org-at-timestamp-p' still + returns `t' in this case, as this is more practical. + (org-return): Check against Ì€org-ts-what' to verify that point is + really within the timestamp (if any). + + * org.el (org-return): Follow time-stamp links when point is an a + time-stamp. + + * org-capture.el (org-capture-bookmark): New option. + (org-capture-finalize): Use it. + + * org-publish.el (org-publish-cache-file-needs-publishing): Make + the column mandatory after #+include:. + + * org-exp.el (org-export-handle-include-files): Ditto. + + * org-bibtex.el (org-bibtex-entries): Rename from + (org-bibtex-read, org-bibtex-write): Use the new name. + + * org-exp.el (org-export-handle-include-files): Allow to use + #+include with no column. + + * org-publish.el (org-publish-cache-file-needs-publishing): Make + quotes mandatory around the file name and allow spaces in it. + + * org-html.el (org-export-as-html): Add link to Org's and Emacs's + websites. + + * org-latex.el + (org-export-latex-link-with-unknown-path-format): New option. + (org-export-latex-links): Use it. + + * org-agenda.el (org-agenda-get-timestamps): Remove any active + timestamp from the headline text, not only those for the current + date. + + * org.el (org-set-tags): Allow setting tags for headlines in the + region when `org-loop-over-headlines-in-active-region' is non-nil. + + * org.el (org-allow-promoting-top-level-subtree): New option to + allow promoting a top-level subtree. + (org-called-with-limited-levels): New variable, dynamically bound + within the `org-with-limited-levels' macro. + (org-promote): Use the new option to allow promoting a top-level + subtree. + + * org-macs.el (org-with-limited-levels): Let-bind + `org-called-interactively-p' to t. + + * org.el (org-create-formula-image-with-dvipng) + (org-create-formula-image-with-imagemagick): Make sure a file + exists before trying to delete it. + + * org.el (org-scan-tags): Correctly match TODO keywords. + + * org-agenda.el (org-agenda-bulk-action): Fix bug: use + `org-agenda-bulk-unmark-all'. + + * org.el (orgstruct++-mode): Fix docstring. + (org-fill-paragraph): Use the 'justify parameter when falling back + on `fill-paragraph'. + + * org.el (org-indent-line-function): Use `org-let' instead of + `orgstruct++-ignore-org-filling'. + (org-fill-paragraph, org-auto-fill-function): Ditto. + + * org-macs.el (orgstruct++-ignore-org-filling): Delete. + + * org-table.el (org-table-time-string-to-seconds): Return the + empty string if provided. + (org-table-eval-formula): When assigning a duration string, handle + it correctly -- i.e. don't make any computation on it, except the + one to insert it using the correct duration format. + + * org.el (org-indent-line-function): Fix bug. + + * org-clock.el (org-frame-title-format-backup): New variable to + store the value of `frame-title-format' before `org-clock' might + replace it by `org-clock-frame-title-format'. + (org-clock-frame-title-format): New option. + (org-frame-title-string): Delete. + (org-clock-update-mode-line): Minor code reformatting. + (org-clock-in, org-clock-out, org-clock-cancel): Use + `org-clock-frame-title-format'. + + * org-clock.el (org-clock-get-clock-string): Add a space. + + * org-list.el (org-mark-list): Return an error when there is no + list at point. + + * org.el (org-toggle-heading): Allow `C-u C-c *' to mark the list + at point before converting items to headings. With a simple + universal-argument, set `current-prefix-arg' to 1, otherwise keep + the numeric value. + + * org-agenda.el (org-agenda-view-mode-dispatch): Make the message + more readable. + + * org-agenda.el (org-agenda-mode-map): New keybinding Ì€*' to mark + all entries for bulk action. + (org-agenda-menu): New menu item for marking all entries. + (org-agenda-bulk-mark-all): New function to mark all entries. + (org-agenda-bulk-mark-regexp): Minor docstring fix. + (org-agenda-bulk-unmark): With a prefix argument, unmark all. + Also send a better message. + (org-agenda-bulk-remove-all-marks): Rename to + `org-agenda-bulk-unmark-all'. Check against + `org-agenda-bulk-marked-entries' before trying to unmark entries. + Minor docstring fix. + (org-agenda-bulk-unmark-all): Renamed from + Ì€org-agenda-bulk-remove-all-marks'. + + * org-agenda.el (org-agenda-bulk-mark-char): New option. + (org-agenda-bulk-mark): Use the new option. + + * org.el (org-src-prevent-auto-filling): New option to prevent + auto-filling in src blocks. This defaults to nil to avoid people + being surprised that no auto-fill occurs in Org buffers where they + use `auto-fill-mode'. + (org-auto-fill-function): Use the new option. + + * org.el (org-properties-postprocess-alist): Better customization + type. + (org-set-property): Fix the check against + `org-properties-postprocess-alist'. + + * org-macs.el (orgstruct++-ignore-org-filling): Set + `def-edebug-spec' correctly. + + * org-colview.el (org-columns-string-to-number): When computing + the values for the colview, match durations and convert them to + HH:MM values. + + * org.el (org-duration-string-to-minutes): Match non-round + numbers. Add a new optional parameter to allow returning the + output as a string. + + * org.el (org-auto-fill-fallback-function) + (org-indent-line-fallback-function) + (org-fill-paragraph-fallback-function) + (org-auto-fill-fallback-function) + (org-indent-line-fallback-function) + (org-fill-paragraph-fallback-function): Remove. + (org-fb-vars): New buffer-local variable. + (orgstruct++-mode): Use the fallback variable `org-fb-vars' to + store, use and restore variables if needed. + (org-fill-paragraph): Ignore `orgstruct++-mode' filling variables + when needed. + (org-auto-fill-function, org-indent-line-function): Ditto. + + * org-macs.el (orgstruct++-ignore-org-filling): New macro. + + * org-exp-block.el: Use `org-find-library-name' instead of + `find-library-name'. + + * org-compat.el (org-find-library-name): Convert into a macro to + avoid compilation of a function from XEmacs in Emacs and vice + versa. + + * org-table.el (org-table-store-formulas): Fix typo. + (org-table-maybe-eval-formula): Fix the regexp to only match + formulas, which never end with the `=' character. If the field + only contain this character, don't eval either. + + * org.el (org-set-property): Perform the correct check against + `org-properties-postprocess-alist'. + + * org-bbdb.el (org-bbdb-anniversary-format-alist): Update the + customization type. + (name): Suppress (defvar 'name) as name is not eval'ed when + setting `org-bbdb-anniversary-format-alist'. + + * org.el (org-version): When called non-interactively, insert the + short version string, otherwise send a message with the complete + version string. + + * org-odt.el (org-odt-update-meta-file): Use (org-version) and + delegate checking whether `org-version' is known as a variable + there. + + * org-html.el (org-export-as-html): Use (org-version). + + * org-docbook.el (org-export-as-docbook): Ditto. + + * org-latex.el (org-export-latex-make-header): Ditto. + + * org-clock.el (org-clocktable-write-default): Temporarily disable + `delete-active-region' so that we don't accidently delete an + active region when exporting a subtree/region. + + * org-clock.el (org-program-exists): Remove. + (org-show-notification, org-clock-play-sound): Use + `executable-find' instead of `org-program-exists'. + + * org-agenda.el (org-diary): Prevent failure from + `org-compile-prefix-format' when there is no agenda buffer. + + * org-agenda.el (org-agenda-mode): Replace obsolete variable + `buffer-substring-filters'. + + * org-indent.el (org-indent-mode): Ditto. + + * org-compat.el (org-find-library-name): Silent the byte-compiler + about a warning related to XEmacs support. + + * org-special-blocks.el + (org-special-blocks-convert-html-special-cookies): Use `org-line' + instead of `line'. + + * org-html.el (org-html-handle-links, org-export-as-html) + (org-format-org-table-html, org-format-table-table-html) + (org-html-export-list-line): Use `org-line' instead of `line' as + the free variable name. + + * org-latex.el (org-export-latex-tables): Let-bind `hfmt'. + + * org-faces.el (org-list-dt): New face. + + * org.el (org-set-font-lock-defaults): Use `org-list-dt' as the + face for definition terms in definition lists. + + * org.el (org-fill-paragraph): Pass the `justify' argument to + `org-fill-paragraph-fallback-function'. + + * org.el (org-eval-in-calendar): Fix docstring to mention the + KEEPDATE parameter. + + * org.el (org-refresh-category-properties): Let-bind + `inhibit-read-only' to t. + + * org.el (org-auto-fill-fallback-function) + (org-indent-line-fallback-function) + (org-fill-paragraph-fallback-function): New variables to store + some fall-back functions when turning `orgstruct++-mode' on. + (orgstruct++-mode): Set the new variables. + (org-indent-line-function, org-fill-paragraph) + (org-auto-fill-function): Use them. + + * org.el (org-read-date): Bugfix: call `org-eval-in-calendar' with + the 'keepdate parameter set to t when setting the cursor type. + + * org-agenda.el (org-agenda-persistent-marks): New option to keep + marks after a bulk action. The option defaults to nil. + (org-agenda-bulk-action): Use the new option. + + * org-capture.el (org-capture-fill-template): Use %\n instead of + %n as a template element to be replaced with the nth prompted + string. + (org-capture-templates): Update docstring. + + * org.el (org-goto): Fix docstring and document what C-u does. + + * org-publish.el (org-publish-cache-file-needs-publishing): Use + (case-fold-search t) when looking for #+INCLUDE:. + + * org.el: Use (case-fold-search t). + (org-edit-special, org-ctrl-c-ctrl-c): Ditto. + + * org-table.el: + (org-table-store-formulas, org-table-get-stored-formulas) + (org-table-fix-formulas, org-table-edit-formulas) + (org-old-auto-fill-inhibit-regexp, orgtbl-ctrl-c-ctrl-c) + (orgtbl-toggle-comment, org-table-get-remote-range): Ditto. + + * org-footnote.el: + (org-footnote-goto-local-insertion-point): Ditto. + + * org-exp.el: Ditto. + + * org-colview.el: + (org-dblock-write:columnview, org-dblock-write:columnview): Ditto. + + * org-clock.el (org-clocktable-write-default): Ditto. + + * org-capture.el (org-capture-place-table-line): Ditto. + + * ob.el (org-babel-data-names, org-babel-goto-named-src-block) + (org-babel-src-block-names) + (org-babel-where-is-src-block-result, org-babel-result-end) + (org-babel-where-is-src-block-head) + (org-babel-find-named-result, org-babel-result-names): Ditto. + + * org-table.el (orgtbl-send-table): Escape special characters. + Introduce a new parameter :no-escape to prevent escaping. + + * org-agenda.el (org-toggle-sticky-agenda): Only shout a message + when called interactively. + (org-agenda-get-restriction-and-command): Call + `org-toggle-sticky-agenda' interactively. + + * org-agenda.el (org-agenda-top-category-filter): New variable for + storing the current top-category filter. + (org-agenda-redo): Apply a top-category filter, if any. + (org-agenda-filter-by-top-category) + (org-agenda-filter-top-category-apply): Set + `org-agenda-top-category-filter' to the right value. + + * org-clock.el (org-clock-out, org-clock-cancel) + (org-clock-in): Don't modify `frame-title-format' if it is a + string. + + * org-latex.el (org-export-latex-special-chars): Fix bug when + escaping special characters in a table. + + * org.el (org-read-date): Set cursor-type to nil in the calendar. + + * org-faces.el (org-date-selected): Use inverse video. Don't + explicitely set bold to nil as it causes `customize-face' to show + the weight property and thus encourage the user to change it. + Warn in the docstring that using bold might cause problems when + displaying the calendar. + + * org-id.el (org-id-update-id-locations): New parameter to silent + `org-id-find'. + (org-id-find): Use the new parameter. + + * org.el (org-show-hierarchy-above, org-cycle) + (org-global-cycle, org-files-list, org-store-link) + (org-link-search, org-open-file, org-display-outline-path) + (org-refile-get-location, org-update-all-dblocks) + (org-change-tag-in-region, org-entry-properties) + (org-save-all-org-buffers, org-revert-all-org-buffers) + (org-buffer-list, org-cdlatex-mode) + (org-install-agenda-files-menu, org-end-of-subtree) + (org-speedbar-set-agenda-restriction): Use (derived-mode-p + 'org-mode) instead of (eq major-mode 'org-mode). + + * org-timer.el (org-timer-set-timer): Ditto. + + * org-table.el (orgtbl-mode, org-table-align, orgtbl-mode): Ditto. + + * org-src.el (org-edit-src-exit, org-edit-src-code) + (org-edit-fixed-width-region, org-edit-src-exit): Ditto. + + * org-remember.el (org-remember-handler): Ditto. + + * org-mouse.el (dnd-open-file, org-mouse-insert-item): Ditto. + + * org-macs.el (org-get-limited-outline-regexp): Ditto. + + * org-lparse.el (org-replace-region-by): Ditto. + + * org-latex.el (org-latex-to-pdf-process) + (org-replace-region-by-latex): Ditto. + + * org-indent.el (org-indent-indent-buffer): Ditto. + + * org-id.el (org-id-store-link, org-id-update-id-locations) + (org-id-store-link): Ditto. + + * org-html.el (org-export-html-preprocess) + (org-replace-region-by-html): Ditto. + + * org-footnote.el (org-footnote-normalize) + (org-footnote-goto-definition) + (org-footnote-create-definition, org-footnote-normalize): Ditto. + + * org-docbook.el (org-replace-region-by-docbook): Ditto. + + * org-ctags.el (find-tag): Ditto. + + * org-colview.el (org-columns-redo) + (org-columns-display-here, org-columns-edit-value) + (org-columns-redo): Ditto. + + * org-capture.el (org-capture-insert-template-here) + (org-capture, org-capture-finalize) + (org-capture-set-target-location) + (org-capture-insert-template-here): Ditto. + + * org-ascii.el (org-replace-region-by-ascii): Ditto. + + * org-archive.el (org-archive-subtree): Ditto. + + * org-agenda.el (org-agenda) + (org-agenda-get-restriction-and-command) + (org-agenda-get-some-entry-text, org-search-view) + (org-tags-view, org-agenda-get-day-entries) + (org-agenda-format-item, org-agenda-goto, org-agenda-kill) + (org-agenda-archive-with, org-agenda-switch-to): Ditto. + + * org.el (org-repeat-re) + (org-clone-subtree-with-time-shift, org-auto-repeat-maybe) + (org-deadline, org-schedule, org-matcher-time) + (org-time-stamp, org-read-date, org-read-date-get-relative) + (org-display-custom-time, org-get-wdays) + (org-time-string-to-absolute, org-closest-date) + (org-timestamp-change): Allow to set hourly repeat cookie. Send + an error when an hourly repeat cookie is set and no hour is + specified in the timestamp. + + * org-icalendar.el (org-print-icalendar-entries): Handle hourly + repeat cookies. + + * org-clock.el (org-program-exists): Fix docstring. + + * org-clock.el (org-clock-file-time-cell-format): New option. + (org-clocktable-write-default): Use it. + + * org-faces.el (org-date-selected): New face. + + * org.el (org-date-ovl): Use `org-date-selected'. + + * org.el (org-mode): Don't use `buffer-face-mode' by default. + + * org-agenda.el (org-agenda-mode-map): Bind `^' to + `org-agenda-filter-by-top-category'. + + * org-ascii.el (org-export-ascii-underline): Change the default + underlining characters for headlines of level 1 and 2. Also + introduce \. as the underline character for headlines of level 5. + + * org-table.el (org-table-recalculate-buffer-tables) + (org-table-iterate-buffer-tables): Add autoload cookie. + + * org.el (org-table-map-tables): Exclude tables in src and example + blocks. + + * org.el (org-fill-paragraph): Leave scheduled/deadline lines + untouched when filling an adjacent paragraph. + + * org-html.el (org-export-html-preamble-format) + (org-export-html-postamble-format): Improve the docstring. + + * org.el (org-todo): Fix regression: rename `state' to + `org-state'. + + * org-clock.el (org-show-notification): Use `fboundp' instead of + `featurep' and the additional `require'. + + * org-clock.el (org-clock-in-prepare-hook): New option to format + the total time cells. + (org-clocktable-write-default): Use the new option. + + * org.el (org-open-at-point): Allow to open the agenda from an + active or inactive timestamp in a headline. + + * org-html.el (org-export-html-date-format-string): Make a + defcustom. + + * org-latex.el (org-export-as-latex): Fix TeX-master declaration. + +2012-09-30 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-expand-lhs-ranges): Allow hline + references to be expanded correctly in LHS of formulas. + + * org-beamer.el (org-beamer-inherited-properties): New option. + (org-beamer-after-initial-vars): Use new option to look for + inherited properties. + + * org.el (org-ts-regexp0): Allow time stamps without name of day. + + * org-agenda.el (org-toggle-sticky-agenda): + (org-agenda-sticky): Improve :set property. + + * org-agenda.el (org-agenda-local-vars): Clean up the variable + list. + (org-agenda-get-restriction-and-command): Add a key for toggling + sticky agenda views. + + * org-agenda.el (org-agenda-local-vars): Final decisions about + global/local + + * org-agenda.el (org-agenda-force-single-file): Variable removed. + (org-prepare-agenda-window): Store pre-agenda window config + locally. + (org-timeline): Introduce a scoped version of + `org-agenda-show-log'. + (org-agenda-list): Introduce a scoped version of + `org-agenda-show-log'. + (org-agenda-get-progress): Use the scoped version of + `org-agenda-show-log'. + (org-agenda-local-vars): Write the analysis result as a comment - + to be cleaned up in the next iteration. + + * org-agenda.el (org-toggle-sticky-agenda): Kill all agenda + buffers when toggling sticky-agendas. + (org-agenda-get-restriction-and-command): Add `C-c a C-k' as a key + to explicitly kill all agenda buffers. + (org-agenda-run-series): Remove any old agenda markers in the + buffer that is going to take the new block agenda. + (org-prepare-agenda): Reset markers before erasing the buffer anc + running `org-agenda-mode', because after that hte local variable + `org-agenda-markers' will have gone away. + (org-agenda-Quit): + (org-finalize-agenda): Install the marker resetter into the + `kill-buffer-hook'. + (org-agenda-save-markers-for-cut-and-paste): Look for markers in + all agenda buffers. + (org-agenda-kill-all-agenda-buffers): New function. + +2012-09-30 Chris Gray <chrismgray@gmail.com> + + * org-html.el (org-export-as-html): Remove the check for body-only + in the code for generating tables of contents. + +2012-09-30 Christoph Dittmann <github@christoph-d.de> (tiny change) + + * org-beamer.el (org-beamer-auto-fragile-frames): Make + [fragile] work with overlay specifications. + +2012-09-30 Christophe Junke <christophe.junke@inria.fr> (tiny change) + + * org-agenda.el (org-agenda-list): Ensures that the list returned + by `org-agenda-add-time-grid-maybe' is appended to Ì€rtnall' before + checking if the latter is empty. + +2012-09-30 Christophe Rhodes <csr21@cantab.net> (tiny change) + + * org-latex.el (org-export-latex-tables): Support setting the + :hfmt parameter from #+ATTR_LaTeX. + +2012-09-30 Daniel Dehennin <daniel.dehennin@baby-gnu.org> (tiny change) + + * org-exp.el (org-export-handle-include-files) + (org-get-file-contents): Handle new parameter :addlevel. + +2012-09-30 Dave Abrahams <dave@boostpro.com> (tiny change) + + * org.el (org-link-prettify): New function to prettify links while + displaying them with `org-insert-link'. + (org-insert-link): Use the new function. + +2012-09-30 David Maus <dmaus@ictsoc.de> + + * org-exp.el (org-export-language-setup): Use numeric character + entities for proper rendering of non-UTF8 documents. + + * org-exp.el (org-export-language-setup): Add japanese + translation. + +2012-09-30 Eric Schulte <eric.schulte@gmx.com> + + * ob-sh.el (org-babel-sh-evaluate): Don't could 0-length shebangs. + + * ob.el (org-babel-insert-result): Replace key sequence with + function call. Use a more informative flag to the local function. + (org-add-protective-commas): Declare a new external function. + + * org-src.el (org-add-protective-commas): This should be its own + function. + (org-edit-src-exit): Use the new function. + + * org-compat.el (org-labels): Remove. + + * org-bibtex.el (org-bibtex-headline): Don't use `org-labels'. + + * ob.el (org-babel-sha1-hash, org-babel-noweb-p): Ditto. + + * ob.el (org-babel-string-read): Don't automatically evaluate code + block results which look like elisp. + (org-babel-import-elisp-from-file): Raise a warning message when + the process of reading code block results raises an error. + + * ob-tangle.el (org-babel-with-temp-filebuffer): Don't execute + macro argument multiple times. + + * org.el (org-compat): Require org-compat before we first use one + of its functions (a macro actually). + + * ob-comint.el (org-babel-comint-with-output): Don't name the + filter function, but rather pass through the anonymous lambda + directly. + + * org.el (org-babel-load-languages): Common lisp should be + mentioned as a supported babel language. + + * org-clock.el (org-clock-special-range): "concat 'string" -> + "concat" + (org-clocktable-shift): "concat 'string" -> "concat" + + * org-bibtex.el (org-bibtex-headline): Replacing org-flet with + org-labels. + + * ob-calc.el (org-babel-execute:calc): Strip single quotes from + calc internal representations. + + * org-clock.el (org-clock-special-range): Replacing cl concatenate + with concat. + (org-clocktable-shift): Replacing cl concatenate with concat. + + * ob.el (org-babel-edit-distance): Remove use of map at runtime. + + * org-compat.el (org-flet): Compatibility function now that flet + has been removed from cl-macs. + (org-labels): Compatibility function now that labels has been + removed from cl-macs. + + * ob-R.el (org-compat): Require org-compat. + + * ob-comint.el: Require org-compat. + + * ob-exp.el (org-babel-exp-do-export): Switch to compatibility + function. + + * ob-gnuplot.el (org-babel-expand-body:gnuplot): Switch to + compatibility function. + + * ob-lob.el (org-babel-lob-get-info): Switch to compatibility + function. + (org-babel-lob-execute): Switch to compatibility function. + + * ob-python.el (org-babel-python-evaluate-session): Switch to + compatibility function. + + * ob-ref.el (org-babel-ref-index-list): Switch to compatibility + function. + + * ob-sh.el (org-babel-sh-var-to-string): Switch to compatibility + function. + + * ob-tangle.el (org-babel-load-file): Switch to compatibility + function. + (org-babel-tangle): Switch to compatibility function. + (org-babel-spec-to-string): Switch to compatibility function. + + * ob.el (org-babel-view-src-block-info): Switch to compatibility + function. + (org-babel-execute-src-block): Switch to compatibility function. + (org-babel-edit-distance): Switch to compatibility function. + (org-babel-switch-to-session-with-code): Switch to compatibility + function. + (org-babel-sha1-hash): Switch to compatibility function. + (org-babel-balanced-split): Switch to compatibility function. + (org-babel-join-splits-near-ch): Switch to compatibility function. + (org-babel-get-rownames): Switch to compatibility function. + (org-babel-format-result): Switch to compatibility function. + (org-babel-insert-result): Switch to compatibility function. + (org-babel-examplize-region): Switch to compatibility function. + (org-babel-merge-params): Switch to compatibility function. + (org-babel-noweb-p): Switch to compatibility function. + (org-babel-expand-noweb-references): Switch to compatibility + function. + + * org-bibtex.el (org-bibtex-headline): Switch to compatibility + function. + (org-bibtex-fleshout): Switch to compatibility function. + (org-bibtex-read): Switch to compatibility function. + (org-bibtex-write): Switch to compatibility function. + + * org-exp-blocks.el (org-export-blocks-preprocess): Switch to + compatibility function. + + * org-exp.el (org-export-format-source-code-or-example): Switch to + compatibility function. + + * org-macs.el (org-called-interactively-p): Indentation fix. + + * org-mouse.el (org-mouse-timestamp-today): Switch to + compatibility function. + (org-mouse-set-priority): Switch to compatibility function. + (org-mouse-popup-global-menu): Switch to compatibility function. + (org-mouse-context-menu): Switch to compatibility function. + + * org-plot.el (org-plot/gnuplot-to-grid-data): Switch to + compatibility function. + (org-plot/gnuplot-script): Switch to compatibility function. + + * org.el (org-entry-get): Switch to compatibility function. + (org-fill-paragraph): Switch to compatibility function. + (org-auto-fill-function): Switch to compatibility function. + + * ob-lob.el (org-babel-lob-execute): Only try to insert extant + hashes. + + * ob-R.el (org-babel-R-command): From a defvar to a defcustom. + + * ob.el (org-babel-set-current-result-hash): Change the hash of + the results for the current code block. + (org-babel-current-result-hash): Fix documentation. + + * ob-lob.el (org-babel-lob-execute): Don't re-execute the called + function if the current call line hash matches that in its + results. + + * ob-R.el (org-babel-R-assign-elisp): Can't assume every entry in + a table is a sequence. + + * ob-R.el (org-babel-R-assign-elisp): Clean up the code + implementing reads of irregular data into R. + + * ob.el (org-babel-header-arg-expand): In new buffers + (char-before) may return nil so use equal rather than =. + + * ob-R.el (org-babel-header-args:R): Adding values. + + * ob-clojure.el (org-babel-header-args:clojure): Adding values. + + * ob-lisp.el (org-babel-header-args:lisp): Adding values. + + * ob-sql.el (org-babel-header-args:sql): Adding values. + + * ob-sqlite.el (org-babel-header-args:sqlite): Adding values. + + * ob.el (org-babel-combine-header-arg-lists): Combine lists of + arguments and values. + (org-babel-insert-header-arg): Use new combined header argument + lists. + (org-babel-header-arg-expand): Add support for completing-read + insertion of header arguments after ":" + (org-babel-enter-header-arg-w-completion): Completing read + insertion of header arguments + (org-tab-first-hook): Adding header argument completion. + (org-babel-params-from-properties): Combining header argument + lists. + + * ob-exp.el (org-babel-exp-results): Ensure noweb expanded body is + used on export. + + * ob.el (org-babel-result-to-file): New optional description + argument. + (org-babel-insert-result): Moved description logic to another + function. + + * ob.el (org-babel-insert-result): Change name of filelinkdescr to + file-desc. + (org-babel-common-header-args-w-values): Change name of + filelinkdescr to file-desc. + + * ob-C.el (org-babel-C-execute): Add .exe to the end of compiled C + files on windows. + + * ob-exp.el (org-babel-exp-code): Escape all lines when exporting + Org-mode blocks. + + * ob.el (org-babel-parse-src-block-match): Make use of the new + language argument to org-babel-strip-protective-commas. + (org-babel-parse-inline-src-block-match): Make use of the new + language argument to org-babel-strip-protective-commas. + (org-babel-strip-protective-commas): Now accepts a language + argument. + +2012-09-30 Fabrice Niessen <fniessen-TA4HMoP+1wHrZ44/DZwexQ@public.gmane.org> (tiny change) + + * org-agenda.el (org-agenda-write-buffer-name): Remove the test + for the presence of <style> tag. + +2012-09-30 Feng Shu <tumashu@gmail.com> + + * org.el (org-create-formula-image-with-imagemagick): Use + 'call-process to launch latex so that no shell output buffer will + be shown when previewing formulas. + + * org.el (org-create-formula-image-with-imagemagick): Fix typo. + + * org.el (org-latex-create-formula-image-program): New option to + use either dvipng or imagemagick to convert and preview LaTeX + fragments. + (org-preview-latex-fragment, org-format-latex): Handle the new + option. + (org-create-formula-image-with-dvipng): Rename from + `org-create-formula-image'. + (org-create-formula-image-with-imagemagick): New defun to handle + LaTeX preview with imagemagick. + (org-latex-color, org-latex-color-format): New defuns to handle + color conversions. + + * org-latex.el (org-latex-to-pdf-process, org-export-as-pdf): + Allow to use imagemagick to convert LaTeX fragments. + + * org-html.el (org-export-html-preprocess): Ditto. + + * org-exp.el (org-export-with-LaTeX-fragments): Ditto. + +2012-09-30 George Kettleborough <g.kettleborough@member.fsf.org> + + * org-clock.el: New option `org-clock-clocked-in-display' to + control whether the current clock is displayed in the mode line + and/or frame title. + + * org-timer.el: New option `org-timer-display' to control whether + the current timer is displayed in the mode line and/or frame + title. + +2012-09-30 Hans-Peter Deifel <hpdeifel@gmx.de> (tiny change) + + * ob.el (org-babel-execute-src-block): Allow the :dir header + argument to take relative file names. + +2012-09-30 Harri Kiiskinen <harri@pp-kaitue.(none)> (tiny change) + + * org-protocol.el: New option. + (org-protocol-store-link, org-protocol-do-capture): Use it. + +2012-09-30 Henning Weiss <hdweiss@gmail.com> + + * org-mobile.el (org-mobile-edit): Added handling of addheading, + refile, archive, archive-sibling and delete edit nodes. + (org-mobile-locate-entry): Olp links containing only a file are + now be located correctly. + (org-mobile-apply): Instead of finding the location of all target + headings for edit nodes in a separate loop, they will be found + immediately before applying edits. + + * org-mobile.el (org-mobile-sumo-agenda-command): Use a shorter + title. + +2012-09-30 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change) + + * org.el (org-parse-time-string): Allow strings supported by + tags/properties matcher (eg <now>, <yesterday>, <-7d>) if the time + starts with < and ends with >. This means that e.g. in the + clocktable parameters you can specify :tstart "<-1w>" :tend + "<now>". + +2012-09-30 Ippei FURUHASHI <top.tuna+orgmode@gmail.com> (tiny change) + + * org-colview.el (org-columns): New argument `columns-fmt-string'. + + * org-colview.el (org-columns-get-format-end-top-level): Split + into `org-columns-get-format' and `org-columns-goto-top-level'. + + * org-colview.el (org-dblock-write:columnview): Add a new + parameter :format which specifies the column view format for the + output of the columnview dynamic block. + +2012-09-30 Jambunathan K <kjambunathan@gmail.com> + + * org-lparse.el (org-lparse-and-open) + (org-lparse-do-convert): Open exported files with system-specific + application. + + * org-odt.el: Don't meddle with `org-file-apps'. + + * org-compat.el (org-condition-case-unless-debug): Alias to + `condition-case' when both `condition-case-no-debug' and + `condition-case-unless-debug' is unavailable. + + * org-odt.el (org-odt-do-image-size): Replace `flet' with + equivalent construct. + + * org-odt.el (org-odt-cleanup-xml-buffers): Use + `condition-case-no-debug' instead of + `condition-case-unless-debug'. This ensures backward + compatibility with Emacs versions < 24.1. + + * org-odt.el (org-odt-zip-dir) + (org-odt-cleanup-xml-buffers): New. + (org-export-as-odt-and-open, org-export-as-odt) + (org-odt-init-outfile, org-odt-save-as-outfile) + (org-export-as-odf, org-export-as-odf-and-open): Use + `org-odt-cleanup-xml-buffers'. + + * org-odt.el (org-export-odt-default-org-styles-alist): Add + default character style. + + * org-odt.el (org-export-odt-default-org-styles-alist): Add + default character style. + + * org-lparse.el (org-do-lparse): Remove stray call to + `org-export-html-after-blockquotes-hook'. + + * org-bbdb.el (org-bbdb-export): Add support for ODT format. + + * org-odt.el (org-odt-update-meta-file): Check for `org-version' + is bound before accessing it. + + * org-odt.el (org-odt-schema-dir-list): OD Schema files have been + moved away from $(git-root)/contrib/odt/etc/schema/ to + $(git-root)/etc/schema/. + + * org-odt.el (org-odt-format-org-link): Pay no heed to whether the + internal links destined for headlines provide a description or + not. In fact, the `org-store-link' and `org-insert-link' create + internal links which do have a description. + + * org-lparse.el (org-lparse-insert-org-table): Consider short + caption as plain text and not as org text. + + * org-odt.el (org-export-odt-format-formula) + (org-export-odt-format-image): Ditto. + + * org-odt.el (org-odt-begin-table) + (org-export-odt-format-formula, org-export-odt-format-image) + (org-odt-format-entity): Handle short caption. + + * org-lparse.el (org-lparse-insert-org-table) + (org-lparse-insert-list-table, org-lparse-insert-table-table): + Ditto. + +2012-09-30 Jay McCarthy <jay.mccarthy@gmail.com> (tiny change) + + * org-colview.el (org-columns-new-overlay): Make sure to add a + face to a string that has no face. + +2012-09-30 Jérémie Courrèges-Anglas <jca@wxcvbn.org> (tiny change) + + * org-latex.el: Ensure a final newline is appended to the export + buffer. + +2012-09-30 Levin Du <zslevin@gmail.com> (tiny change) + + * org-clock.el (org-clock-in): Fix bug in setting the clock + heading. + +2012-09-30 Madan Ramakrishnan <madanr79@gmail.com> (tiny change) + + * org-agenda.el (org-agenda-bulk-mark): Truly make arg optional as + advertised by the function. + +2012-09-30 Mark E. Shoulson <mark@kli.org> (tiny change) + + * org.el (org-fontify-entities): Hide {} when prettifying + entities. + +2012-09-30 Mark Shoulson <mark@kli.org> (tiny change) + + * org-entities.el (org-entities): Add new entities for characters + which could cause formatting changes if typed directly. + + * org-entities.el (org-entities): Added \asciicirc entity for ^; + also fixed \circ expansion in latex. + + * org.el (org-fontify-entities): Fix bug: The entities \sup[123] + and \there4 were not "prettified" when org-pretty-entities was + enabled. + +2012-09-30 Mats Lidell <matsl@xemacs.org> (tiny change) + + * org-element.el (org-element-paragraph-separate): Remove + redundant and misplaced t clause in case. + +2012-09-30 Matt Lundin <mdl@imapmail.org> + + * org-datetree.el: Fix regexp to allow datetree to find headings + with trailing whitespace. This fixes a bug in which an existing + datetree heading (e.g., "* 2012 ") would not be found by + org-datetree-find-year-create if it had trailing whitespace. This + can cause problems, for instance, if one is using column view on + the date tree, since editing subheadings with column view adds + whitespace at the end of the top heading. + + * org-footnote.el (org-footnote-new): Don't call + org-footnote-unique-label if org-footnote-auto-label is set to + random. + + * org-gnus.el: (org-gnus-follow-link): Fix argument to + gnus-group-read-group so that following a link does not result in + unread article being selected. + + * org-bbdb.el (org-bbdb-anniv-extract-date) + (org-bbdb-make-anniv-hash): Fix org-bbdb anniversary functionality + to accommodate BBDB 3.x. There are two major changes in BBDB 3.x + that need to be taken into account. The first is that + `bbdb-split' reverses the order of its parameters in 3.x. The + second is that `bbdb-record-getprop' is replaced by + bbdb-record-note in 3.x. + +2012-09-30 Max Mikhanosha <max@openchat.com> + + * org-agenda.el (org-agenda-change-all-lines): Speedup refresh of + a single line of agenda by narrowing the agenda buffer to just + that line before calling `org-agenda-finalize'. + + * org.el (org-mode): Don't set org-hide's foreground to + "invisible-bg". + (org-find-invisible-foreground): New function. + + * org-agenda.el (defvar org-habit-show-all-today): New variable + (org-agenda-get-scheduled): Show all habits if user wants it + + * org-habit.el (defcustom org-habit-show-all-today): New variable + + * org-agenda.el (org-agenda-quit): Copy the code for optionally + restoring window configuration after burying the sticky agenda + buffer. + + * org-agenda.el (org-agenda-new-marker): Check for NIL + org-agenda-buffer + (org-agenda-to-appt): Bind org-agenda-buffer to NIL + + * org-agenda.el (org-agenda-change-all-lines): Move accessing of + 'extra text property outside of with-current-buffer for original + buffer + + * org-agenda.el (defvar org-habit-show-habits-only-for-today): + initialize to nil + +2012-09-30 Michael Brand <michael.ch.brand@gmail.com> + + * org-id.el (org-id-link-to-org-use-id): Align the doc string to + the changed default. + + * ob-tangle.el (org-babel-tangle-collect-blocks): Use dummy string + when heading has no text. + + * org-capture.el (org-capture-inside-embedded-elisp-p): Improve + parsing. + + * org-feed.el (org-feed-format-entry): Require `org-capture'. + Expand Elisp %(...) templates. + (org-feed-default-template): Update docstring. + + * org-capture.el (org-capture-expand-embedded-elisp): New + function. + (org-capture-fill-template): Use it. + (org-capture-inside-embedded-elisp-p): New function to tell if we + are within an Elisp %(...) template. + + * org-list.el (org-at-item-description-p) + (org-list-item-body-column): Make the inline regexp more + consistent with `org-list-full-item-re', the inline regexp + "Description list items" from `org-set-font-lock-defaults and + others'. + +2012-09-30 Mike Sperber <sperber@deinprogramm.de> + + * org.el (org-fill-paragraph): Pass optional argument to + `fill-paragraph' to fix compatibility with XEmacs. + + * org.el (org-self-insert-cluster-for-undo): Default + `org-self-insert-cluster-for-undo' also on XEmacs. + + * org.el (org-kill-line): Access `visual-line-mode' only if it's + bound. + +2012-09-30 Muchenxuan Tong <demon386@gmail.com> (tiny change) + + * org-timer.el (org-timer-set-mode-line): Check + `org-timer-display' when value is 'off. + +2012-09-30 Nicolas Calderon Asselin <nicolas.calderon.asselin@gmail.com> (tiny change) + + * org-clock.el (org-clock-idle-time): Org-mode assumed that + x11idle was an available command, and returned an idle time of 0 + if it was not + (never idle). Added checks so that org-idle-time will come from + emacs' own current-idle-time if x11idle cannot be found or if it + cannot retrieve the idle time from X11 + +2012-09-30 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-element.el: Properly remove COMMENT and QUOTE keywords from + title in parser. + + * org-element.el (org-element-headline-parser): Fix parsing for + headlines with a single COMMENT or QUOTE keyword. + + * ob-org.el (org-babel-default-header-args:org): By default, + export code from Org src blocks. + + * org-element.el (org-element-inline-src-block-successor): Fix + inline-src-block parsing at the beginning of an item. + + * org-element.el (org-element--collect-affiliated-keywords): Fix + caption parsing. + + * org-element.el (org-element--current-element): At the very + beginning of a footnote definition or an item, next element is + always a paragraph. + + * org-element.el (org-element-headline-parser): Handle nil titles. + (org-element-inlinetask-parser): Add :raw-value property. Also + handle nil titles. + + * org.el (org-set-regexps-and-options): Don't consider tags as a + replacement for a missing title in an headline. + + * org.el (org-setup-filling): Remove duplicate code. + + * org.el (org-adaptive-fill-function): Make sure fill prefix is + computed from beginning of line. + + * org-element.el (org-element-section-parser): Make sure section + cannot contain an headline. + (org-element--current-element): Fix bug requiring to parse a quote + section even when point is at an headline. + + * org.el (org-adaptive-fill-function): Remove occasional spurious + space character when auto-filling. + + * org.el (org-mode): Call external initalizers. Now both filling + code and comments code have their own independant part in org.el. + (org-setup-filling): Renamed from `org-set-autofill-regexps'. + (org-setup-comments-handling): New function. + + * org.el (org-fill-paragraph): Refine filling in comments and in + paragraphs. Allow commented blank lines. Take into consideration + the indentation of the second line of the paragraph being filled. + (org-comment-or-uncomment-region): Rewrite function. Now comment + region at a fixed column: the minimal indentation of the region. + (org-fill-context-prefix): Rename function into + `org-adaptive-fill-function'. Also, In a paragraph, choose the + same prefix as the current line. + + * org-exp.el (org-export-handle-comments): Also remove comments at + column 0. + + * org-exp.el (org-export-handle-comments): Handle inline comments + with new syntax. + + * org.el (org-structure-template-alist): Add missing colon to + #+INCLUDE. + + * org.el (org-backward-element): When called at the beginning of + first element in section, the function shouldn't return an error + but move point to headline or point-min instead. + + * org-element.el (org-element-paragraph-parser): Tiny refactoring. + + * org-element.el (org-element-paragraph-parser): Remove trailing + code comments. + + * org.el (org-fill-context-prefix): Fix incorrect output when + called at the beginning of a plain list with an affiliated + keyword. + (org-fill-paragraph): Remove useless variable. + + * org-element.el (org-element-paragraph-parser): Fix parsing of + paragraph at the beginning of an item. + + * org.el (org-mode): Set back comment-start-skip so comment-dwim + can tell a keyword from a comment. + + * org.el (org-set-autofill-regexps): Install new comment line + break function. + (org-comment-line-break-function): New function. + (org-mode): Remove unnecessary line. + + * org.el (org-fill-context-prefix, org-fill-paragraph): Do not + fill verse blocks contents. Verse blocks can be used to format + free-form poetry, so filling has to be done manually. + + * org.el (org-fill-paragraph-separate-nobreak-p): New function. + (org-set-autofill-regexps): Introduce new predicate. + (org-fill-item-nobreak-p): Remove function. + + * org-element.el (org-element-paragraph-separate): Since this + variable is meant to be searched forward, \end{...} shouldn't + trigger the end of a paragraph before checking if it is the end of + a complete environment. + (org-element-latex-environment-parser): Slight change to the + regexp matching the beginning of a latex environment. + (org-element-paragraph-parser): Paragraphs don't end at incomplete + latex environments. + (org-element-latex-or-entity-successor): Remove paragraph + environments from latex fragment search. + + * org-table.el (org-table-number-regexp): By default, accept comma + as a decimal mark to represent numbers. + + * org-element.el (org-element-map): Fix comment typo. + + * org.el (org-fill-paragraph): Add a `save-excursion' to avoid + returning funny results. + + * org.el (org-fill-paragraph): Try not to include message header + and citation lines in a paragraph when filling it. + + * org.el (org-fill-paragraph): Fix filling in a narrowed buffer. + (org-fill-context-prefix): Fill prefix doesn't depend on current + narrowing. + + * org.el (org-mode): Line with a single hash sign on it is a + comment. + + * org.el (org-set-font-lock-defaults): Fix comment fontification. + + * org-element.el (org-element-item-parser): Do not remove tag from + body if list isn't descriptive. + + * org-list.el (org-insert-item): Only ask about a term for + descriptive lists. + (org-list-struct, org-list-insert-item): Do not recognize a tag in + an ordered list. + + * org-element.el (org-element-set-element): Rewrite function. + (org-element-adopt-elements): New function. + (org-element-adopt-element): Removed function. + (org-element--parse-elements, org-element--parse-objects): Use new + function. + + * org-list.el (org-list-automatic-rules): Remove `bullet' rule, + which is now hard-coded. + (org-cycle-list-bullet): Hard code `bullet' rule. + (org-list-get-list-type): Make sure a list with numbered bullets + cannot have `descriptive' type. + + * org-element.el (org-element-paragraph-parser): Fix previous + patch. + + * org.el (org-fill-paragraph): No need to use + `org-element-paragraph-separate' in a verse block since blank + lines only can end a "paragraph". + + * org-element.el (org-element-paragraph-separate): Apply changes + to comments. + (org-element-paragraph-parser): Correctly find end of paragraphs. + (org-element--current-element): Require colons for Babel calls. + (org-element-center-block-parser) + (org-element-dynamic-block-parser, org-element-quote-block-parser) + (org-element-special-block-parser) + (org-element-comment-block-parser) + (org-element-example-block-parser) + (org-element-export-block-parser, org-element-src-block-parser) + (org-element-verse-block-parser): Fall-back to paragraph parsing + when incomplete or ill-formed. + + * org-element.el (org-element-swap-A-B): Small refactoring. + + * org-element.el (org-element-text-markup-successor): Fix typo in + docstring. + + * org-element.el (org-element-at-point): Return consistent value + when function is called on a blank line within a plain list. + + * org-element.el (org-element-paragraph-separate): Fix comments in + paragraph separator regexp. Optimize it. + + * org-element.el: Update code commets. + + * org.el (org-mark-subtree): Fix bug when marking subtree with + point on an inlinetask. Refactor code. + + * org.el (org-mark-subtree): Do not make a special case for + inlinetasks when marking a subtree. These are handled by + `org-element-mark-element'. + + * org-element.el (org-element-comment-parser): Consider first "+" + as a comment when parsing an ill-defined keyword. + + * org-element.el (org-element-item-interpreter): Simplify bullet + creation. + (org-element-plain-list-interpreter): Fix wrong bullets, if + needed. + + * org-element.el (org-element-comment-parser): Fix parsing when a + keyword follows the commented line. + + * org.el (org-fill-context-prefix): Auto-fill first paragraph in + footnote definitions. + + * org.el (org-mode): Define new comment syntax. + (org-fontify-meta-lines-and-blocks-1, org-strip-protective-commas) + (org-fill-context-prefix, org-insert-comment) + (org-comment-or-uncomment-region): Use new comment syntax. + + * org-element.el (org-element-comment-parser) + (org-element-comment-interpreter, org-element--current-element): + Use new comment syntax. + + * org.el (org-fill-paragraph): When at an item or a footnote + definition, fill first paragraph instead. + + * org.el (org-fill-paragraph): Fix filling when point is at the + very end of a paragraph. + + * org.el (org-mode): Set comments related variables. + (org-insert-comment, org-comment-or-uncomment-region): New + functions. + + * org.el (org-fill-context-prefix): Small refactoring. + (org-fill-paragraph): Add code comments. + + * org-element.el (org-element-at-point): Add :parent property to + output. + (org-element-context): Add :parent property to output. Also + return a single element or object instead of a list of parents. + (org-element-forward, org-element-up): Apply changes. + + * org.el (org-fill-context-prefix): New function. + (org-fill-paragraph, org-auto-fill-function): Use new function. + Also handle comments. + (org-adaptive-fill-function): Remove function. + (org-get-local-variables, orgstruct++-mode): Don't store now + unused adaptive-fill* functions. + + * org-element.el (org-element-at-point): Fix function when buffer + starts with an inlinetask. Also fix it when called on the last + element in a greater element or the buffer. + + * org-element.el (org-element-center-block-parser) + (org-element-dynamic-block-parser) + (org-element-footnote-definition-parser) + (org-element-headline-parser, org-element-inlinetask-parser) + (org-element-quote-block-parser, org-element-special-block-parser) + (org-element-plain-list-parser): Refactor code. + (org-element-drawer-parser): Fall-back to paragraph parser when + drawer is incomplete. + + * org-macs.el (org-with-limited-levels): Fix typo. + + * org-element.el (org-element-paragraph-separate): Refactor. + (org-element-paragraph-parser): Fix paragraph parsing. + + * org.el (org-fill-paragraph): Rewrite function using + `org-element-at-point'. + + * org-element.el (org-element-fill-paragraph): Remove function. + + * org.el (org-planning-or-clock-line-re): Make it a defconst. + It's no use to make it a buffer-local variable since variables on + which it depends are not buffer-local anyway. + + * org.el (org-drawer-regexp): Provide default value for + `org-drawer-regexp' in non-Org buffers. + + * org-entities.el (org-entities-create-table): Function chokes + when CAR of `org-entities' is a string. + + * org-list.el (org-list-automatic-rules): Allow check-boxes in + description lists. + (org-list-struct-apply-struct, org-insert-item): Remove rule + check. + + * org-footnote.el (org-footnote-normalize): Fix positionning in + HTML export without a footnote section. + + * org-list.el (org-list-struct-indent): Follow + `org-list-demote-modify-bullet' specifications for ordered + bullets. + (org-list-indent-item-generic, org-indent-item-tree) + (org-outdent-item-tree): Fix bug when operating on a region. + (org-outdent-item, org-indent-item): Allow to operate on a region. + + * org.el (org-shiftmetaleft, org-shiftmetaright): Allow to operate + on a region. + + * org-footnote.el (org-footnote-delete-definitions): Remove blank + lines before the footnote definition instead of removing those + after it. + + * org-footnote.el (org-footnote-at-definition-p): Don't grab + trailing blank lines in a footnote definition. + (org-footnote-delete-definitions): Remove both footnote definition + and trailing blank lines. + +2012-09-30 Rick Frankel <rick@rickster.com> + + * ob-sql.el: Add dbi engine type and pre/post processing. + +2012-09-30 Sean O'Halpin <sean.ohalpin@gmail.com> (tiny change) + + * ob.el (org-babel-expand-noweb-references): Capture current noweb + start and end patterns then use to set buffer locals in + (with-temp-buffer) form. + +2012-09-30 Sebastien Vauban <sva@mygooglest.com> (tiny change) + + * org.el (org-update-all-dblocks): Autoload function. + +2012-09-30 Simon Thum <simon.thum@gmx.de> (tiny change) + + * ob-maxima.el (org-babel-execute:maxima): Let cmdline always + return a string. + +2012-09-30 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk> (tiny change) + + * org-icalendar.el (org-icalendar-timezone): Fix typo and clarify + meaning. + +2012-09-30 Stuart Hickinbottom <stuart@hickinbottom.com> (tiny change) + + * org-clock.el (org-x11idle-exists-p): Only shell out when running + on X. + +2012-09-30 Suhail Shergill <suhailshergill@gmail.com> (tiny change) + + * org-html.el (org-export-as-html): If possible, use the + :CUSTOM_ID: property to assign unique ids to footnotes. + +2012-09-30 T.F. Torrey <tftorrey@tftorrey.com> (tiny change) + + * org-exp.el (org-export-remember-html-container-classes): Allow + exporting a single subtree with HTML_CONTAINER_CLASS property. + + * org-rmail.el (org-rmail-follow-link): Use `rmail-widen' instead + of `widen' and don't toggle header as `rmail-widen' already takes + care of this. + +2012-09-30 Tim Howe <vsync@quadium.net> (tiny change) + + * org-clock.el (org-clocktable-defaults): Revert extra layer of + quoting. + +2012-09-30 Toby S. Cubitt <tsc25@cantab.net> + + * org-capture.el (org-capture-fill-template): Expand %<num> escape + sequences into text entered for <num>'th %^{PROMPT} escape. + + * org-capture.el (org-capture-fill-template): Fixed regexp for + %<n> expandos to match any positive integer. + (org-capture-templates): Updated docstring accordingly. + + * org-agenda.el (org-agenda-skip-timestamp-if-deadline-is-shown): + Skip timestamp items in agenda view if item is already shown as a + deadline item. + (org-agenda-skip-dealine-if-done): Pass deadline results to + org-agenda-get-timestamps. + (org-agenda-get-timestamps): Optionally take list of deadline + results, so that timestamp results can be skipped if already + included in deadline results. + + * org-agenda.el (org-agenda-diary-sexp-prefix): Regexp matching + deadline/scheduling information to be displayed in diary sexp + agenda items. + (org-agenda-get-sexps): Extract deadline/scheduling information + from diary sexp entries. + + * org-capture.el (org-capture-place-entry): Place captured entry + immediately after last subheading of target, instead of just + before next heading at same level as target. + + * org-capture.el (org-capture-templates): Document new capture + template properties. + + * org-capture.el (org-capture-place-entry) + (org-capture-empty-lines-before): Make new :empty-lines-before + property override :empty-lines when inserting empty lines before + captured captured entry. + + * org-capture.el (org-capture-finalize) + (org-capture-empty-lines-after): Make new :empty-lines-after + property override :empty-lines when inserting empty lines after + captured captured entry. + + * org-agenda.el (org-agenda-skip-if, org-agenda-skip-if-todo): Add + new todo-unblocked and nottodo-unblocked skip conditions. These + match as for todo and nottodo, but only for unblocked todo items. + +2012-09-30 Zachary Kanfer <zkanfer@gmail.com> (tiny change) + + * org.el (org-read-date-display): Fix bug when displaying the + overlay. + +2012-09-30 Niels Giesen <niels.giesen@gmail.com> + + * org-table.el (orgtbl-to-generic): Add check for :skipheadrule. + When present, the :hline following the head will be skipped. This + is necessary to avoid doubling of horizontal rules in LaTeX + longtable environments and consequent width problems. + + * org-latex.el (org-export-latex-tables-tstart) + (org-export-latex-tables-hline) + (org-export-latex-tables-tend): New options. + (org-export-latex-tables): Use the new options. + +2012-09-30 tumashu <tumashu@gmail.com> (tiny change) + + * org-exp.el (org-export-language-setup): Add simplified chinese + translation. + 2012-09-01 Paul Eggert <eggert@cs.ucla.edu> Better seed support for (random). diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index 583510ac618..ba50722e325 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -61,7 +61,7 @@ is currently being evaluated.") (org-babel-execute:C++ body params)) (defun org-babel-execute:C++ (body params) - "Execute a block of C++ code with org-babel. This function is + "Execute a block of C++ code with org-babel. This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) @@ -88,9 +88,7 @@ or `org-babel-execute:C++'." (cond ((equal org-babel-c-variant 'c) ".c") ((equal org-babel-c-variant 'cpp) ".cpp")))) - (tmp-bin-file (org-babel-temp-file - "C-bin-" - (if (equal system-type 'windows-nt) ".exe" ""))) + (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext)) (cmdline (cdr (assoc :cmdline params))) (flags (cdr (assoc :flags params))) (full-body (org-babel-C-expand body params)) @@ -118,8 +116,8 @@ or `org-babel-execute:C++'." (org-babel-pick-name (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) (defun org-babel-C-expand (body params) "Expand a block of C or C++ code with org-babel according to @@ -131,22 +129,22 @@ it's header arguments." (defines (org-babel-read (or (cdr (assoc :defines params)) (org-babel-read (org-entry-get nil "defines" t)))))) - (mapconcat 'identity - (list - ;; includes - (mapconcat - (lambda (inc) (format "#include %s" inc)) - (if (listp includes) includes (list includes)) "\n") - ;; defines - (mapconcat - (lambda (inc) (format "#define %s" inc)) - (if (listp defines) defines (list defines)) "\n") - ;; variables - (mapconcat 'org-babel-C-var-to-C vars "\n") - ;; body - (if main-p - (org-babel-C-ensure-main-wrap body) - body) "\n") "\n"))) + (mapconcat 'identity + (list + ;; includes + (mapconcat + (lambda (inc) (format "#include %s" inc)) + (if (listp includes) includes (list includes)) "\n") + ;; defines + (mapconcat + (lambda (inc) (format "#define %s" inc)) + (if (listp defines) defines (list defines)) "\n") + ;; variables + (mapconcat 'org-babel-C-var-to-C vars "\n") + ;; body + (if main-p + (org-babel-C-ensure-main-wrap body) + body) "\n") "\n"))) (defun org-babel-C-ensure-main-wrap (body) "Wrap body in a \"main\" function call if none exists." diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index 49a8a85cf6d..3dedb393654 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -39,24 +39,48 @@ (declare-function ess-make-buffer-current "ext:ess-inf" ()) (declare-function ess-eval-buffer "ext:ess-inf" (vis)) (declare-function org-number-sequence "org-compat" (from &optional to inc)) - -(defconst org-babel-header-arg-names:R - '(width height bg units pointsize antialias quality compression - res type family title fonts version paper encoding - pagecentre colormodel useDingbats horizontal) +(declare-function org-remove-if-not "org" (predicate seq)) + +(defconst org-babel-header-args:R + '((width . :any) + (height . :any) + (bg . :any) + (units . :any) + (pointsize . :any) + (antialias . :any) + (quality . :any) + (compression . :any) + (res . :any) + (type . :any) + (family . :any) + (title . :any) + (fonts . :any) + (version . :any) + (paper . :any) + (encoding . :any) + (pagecentre . :any) + (colormodel . :any) + (useDingbats . :any) + (horizontal . :any) + (results . ((file list vector table scalar verbatim) + (raw org html latex code pp wrap) + (replace silent append prepend) + (output value graphics)))) "R-specific header arguments.") (defvar org-babel-default-header-args:R '()) -(defvar org-babel-R-command "R --slave --no-save" - "Name of command to use for executing R code.") +(defcustom org-babel-R-command "R --slave --no-save" + "Name of command to use for executing R code." + :group 'org-babel + :version "24.1" + :type 'string) -(defvar ess-local-process-name) +(defvar ess-local-process-name) ; dynamically scoped (defun org-babel-edit-prep:R (info) (let ((session (cdr (assoc :session (nth 2 info))))) (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) - (save-match-data (org-babel-R-initiate-session session nil)) - (setq ess-local-process-name (match-string 1 session))))) + (save-match-data (org-babel-R-initiate-session session nil))))) (defun org-babel-expand-body:R (body params &optional graphics-file) "Expand BODY according to PARAMS, return the expanded body." @@ -120,7 +144,7 @@ This function is called by `org-babel-execute-src-block'." ;; helper functions (defun org-babel-variable-assignments:R (params) - "Return list of R statements assigning the block's variables" + "Return list of R statements assigning the block's variables." (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) (mapcar (lambda (pair) @@ -146,25 +170,45 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-R-assign-elisp (name value colnames-p rownames-p) "Construct R code assigning the elisp VALUE to a variable named NAME." (if (listp value) - (let ((transition-file (org-babel-temp-file "R-import-"))) + (let ((max (apply #'max (mapcar #'length (org-remove-if-not + #'sequencep value)))) + (min (apply #'min (mapcar #'length (org-remove-if-not + #'sequencep value)))) + (transition-file (org-babel-temp-file "R-import-"))) ;; ensure VALUE has an orgtbl structure (depth of at least 2) (unless (listp (car value)) (setq value (list value))) (with-temp-file transition-file - (insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))) - (insert "\n")) - (format "%s <- read.table(\"%s\", header=%s, row.names=%s, sep=\"\\t\", as.is=TRUE)" - name (org-babel-process-file-name transition-file 'noquote) - (if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE") - (if rownames-p "1" "NULL"))) + (insert + (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)) + "\n")) + (let ((file (org-babel-process-file-name transition-file 'noquote)) + (header (if (or (eq (nth 1 value) 'hline) colnames-p) + "TRUE" "FALSE")) + (row-names (if rownames-p "1" "NULL"))) + (if (= max min) + (format "%s <- read.table(\"%s\", + header=%s, + row.names=%s, + sep=\"\\t\", + as.is=TRUE)" name file header row-names) + (format "%s <- read.table(\"%s\", + header=%s, + row.names=%s, + sep=\"\\t\", + as.is=TRUE, + fill=TRUE, + col.names = paste(\"V\", seq_len(%d), sep =\"\"))" + name file header row-names max)))) (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) -(defvar ess-ask-for-ess-directory nil) +(defvar ess-ask-for-ess-directory) ; dynamically scoped (defun org-babel-R-initiate-session (session params) "If there is not a current R process then create one." (unless (string= session "none") (let ((session (or session "*R*")) (ess-ask-for-ess-directory - (and ess-ask-for-ess-directory (not (cdr (assoc :dir params)))))) + (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory) + (not (cdr (assoc :dir params)))))) (if (org-babel-comint-buffer-livep session) session (save-window-excursion @@ -177,7 +221,6 @@ This function is called by `org-babel-execute-src-block'." (buffer-name)))) (current-buffer)))))) -(defvar ess-local-process-name nil) (defun org-babel-R-associate-session (session) "Associate R code buffer with an R session. Make SESSION be the inferior ESS process associated with the @@ -219,7 +262,7 @@ current code buffer." (setq args (mapconcat (lambda (pair) (if (member (car pair) allowed-args) - (format ",%s=%s" + (format ",%s=%S" (substring (symbol-name (car pair)) 1) (cdr pair)) "")) params "")) @@ -245,7 +288,7 @@ current code buffer." (body result-type result-params column-names-p row-names-p) "Evaluate BODY in external R process. If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (case result-type (value @@ -272,7 +315,7 @@ last statement in BODY, as elisp." (session body result-type result-params column-names-p row-names-p) "Evaluate BODY in SESSION. If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (case result-type (value diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el index d95829c7f79..a3c5e3db954 100644 --- a/lisp/org/ob-asymptote.el +++ b/lisp/org/ob-asymptote.el @@ -88,7 +88,7 @@ Asymptote does not support sessions" (error "Asymptote does not support sessions")) (defun org-babel-variable-assignments:asymptote (params) - "Return list of asymptote statements assigning the block's variables" + "Return list of asymptote statements assigning the block's variables." (mapcar #'org-babel-asymptote-var-to-asymptote (mapcar #'cdr (org-babel-get-header params :var)))) @@ -128,7 +128,7 @@ a variable of the same value." DATA is a list. Return type as a symbol. The type is `string' if any element in DATA is -a string. Otherwise, it is either `real', if some elements are +a string. Otherwise, it is either `real', if some elements are floats, or `int'." (let* ((type 'int) find-type ; for byte-compiler diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el index 682d802c11c..6e139966eee 100644 --- a/lisp/org/ob-awk.el +++ b/lisp/org/ob-awk.el @@ -33,6 +33,7 @@ ;;; Code: (require 'ob) (require 'ob-eval) +(require 'org-compat) (eval-when-compile (require 'cl)) (declare-function org-babel-ref-resolve "ob-ref" (ref)) @@ -96,13 +97,13 @@ called by `org-babel-execute-src-block'" (defun org-babel-awk-var-to-awk (var &optional sep) "Return a printed value of VAR suitable for parsing with awk." - (flet ((echo-var (v) (if (stringp v) v (format "%S" v)))) + (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) (cond ((and (listp var) (listp (car var))) - (orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var))) + (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) ((listp var) - (mapconcat #'echo-var var "\n")) - (t (echo-var var))))) + (mapconcat echo-var var "\n")) + (t (funcall echo-var var))))) (defun org-babel-awk-table-or-string (results) "If the results look like a table, then convert them into an diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el index f8ad7e3374e..c79d0b5d1b4 100644 --- a/lisp/org/ob-calc.el +++ b/lisp/org/ob-calc.el @@ -71,16 +71,16 @@ (cond ((numberp res) res) ((math-read-number res) (math-read-number res)) - ((listp res) (error "calc error \"%s\" on input \"%s\"" + ((listp res) (error "Calc error \"%s\" on input \"%s\"" (cadr res) line)) (t (replace-regexp-in-string - "'\\[" "[" + "'" "" (calc-eval (math-evaluate-expr ;; resolve user variables, calc built in ;; variables are handled automatically ;; upstream by calc - (mapcar #'ob-calc-maybe-resolve-var + (mapcar #'org-babel-calc-maybe-resolve-var ;; parse line into calc objects (car (math-read-exprs line))))))))) (calc-eval line)))))))) @@ -91,14 +91,14 @@ (calc-eval (calc-top 1))))) (defvar var-syms) ; Dynamically scoped from org-babel-execute:calc -(defun ob-calc-maybe-resolve-var (el) +(defun org-babel-calc-maybe-resolve-var (el) (if (consp el) (if (and (equal 'var (car el)) (member (cadr el) var-syms)) (progn (calc-recall (cadr el)) (prog1 (calc-top 1) (calc-pop 1))) - (mapcar #'ob-calc-maybe-resolve-var el)) + (mapcar #'org-babel-calc-maybe-resolve-var el)) el)) (provide 'ob-calc) diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index 69d3db86de4..f3894047c72 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -45,7 +45,7 @@ (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) (defvar org-babel-default-header-args:clojure '()) -(defvar org-babel-header-arg-names:clojure '(package)) +(defvar org-babel-header-args:clojure '((package . :any))) (defun org-babel-expand-body:clojure (body params) "Expand BODY according to PARAMS, return the expanded body." diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index a0712b90f35..ba3b99d5d70 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -31,6 +31,7 @@ ;;; Code: (require 'ob) +(require 'org-compat) (require 'comint) (eval-when-compile (require 'cl)) (declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) @@ -50,7 +51,7 @@ executed inside the protection of `save-excursion' and `(save-excursion (save-match-data (unless (org-babel-comint-buffer-livep ,buffer) - (error "buffer %s doesn't exist or has no process" ,buffer)) + (error "Buffer %s does not exist or has no process" ,buffer)) (set-buffer ,buffer) ,@body))) (def-edebug-spec org-babel-comint-in-buffer (form body)) @@ -74,39 +75,40 @@ or user `keyboard-quit' during execution of body." (full-body (cadr (cdr (cdr meta))))) `(org-babel-comint-in-buffer ,buffer (let ((string-buffer "") dangling-text raw) - (flet ((my-filt (text) - (setq string-buffer (concat string-buffer text)))) - ;; setup filter - (add-hook 'comint-output-filter-functions 'my-filt) - (unwind-protect - (progn - ;; got located, and save dangling text - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (let ((start (point)) - (end (point-max))) - (setq dangling-text (buffer-substring start end)) - (delete-region start end)) - ;; pass FULL-BODY to process - ,@body - ;; wait for end-of-evaluation indicator - (while (progn - (goto-char comint-last-input-end) - (not (save-excursion - (and (re-search-forward - (regexp-quote ,eoe-indicator) nil t) - (re-search-forward - comint-prompt-regexp nil t))))) - (accept-process-output (get-buffer-process (current-buffer))) - ;; thought the following this would allow async - ;; background running, but I was wrong... - ;; (run-with-timer .5 .5 'accept-process-output - ;; (get-buffer-process (current-buffer))) - ) - ;; replace cut dangling text - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert dangling-text)) - ;; remove filter - (remove-hook 'comint-output-filter-functions 'my-filt))) + ;; setup filter + (setq comint-output-filter-functions + (cons (lambda (text) (setq string-buffer (concat string-buffer text))) + comint-output-filter-functions)) + (unwind-protect + (progn + ;; got located, and save dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (let ((start (point)) + (end (point-max))) + (setq dangling-text (buffer-substring start end)) + (delete-region start end)) + ;; pass FULL-BODY to process + ,@body + ;; wait for end-of-evaluation indicator + (while (progn + (goto-char comint-last-input-end) + (not (save-excursion + (and (re-search-forward + (regexp-quote ,eoe-indicator) nil t) + (re-search-forward + comint-prompt-regexp nil t))))) + (accept-process-output (get-buffer-process (current-buffer))) + ;; thought the following this would allow async + ;; background running, but I was wrong... + ;; (run-with-timer .5 .5 'accept-process-output + ;; (get-buffer-process (current-buffer))) + ) + ;; replace cut dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert dangling-text)) + ;; remove filter + (setq comint-output-filter-functions + (cdr comint-output-filter-functions))) ;; remove echo'd FULL-BODY from input (if (and ,remove-echo ,full-body (string-match @@ -142,10 +144,10 @@ statement (not large blocks of code)." (defun org-babel-comint-eval-invisibly-and-wait-for-file (buffer file string &optional period) "Evaluate STRING in BUFFER invisibly. -Don't return until FILE exists. Code in STRING must ensure that +Don't return until FILE exists. Code in STRING must ensure that FILE exists at end of evaluation." (unless (org-babel-comint-buffer-livep buffer) - (error "buffer %s doesn't exist or has no process" buffer)) + (error "Buffer %s does not exist or has no process" buffer)) (if (file-exists-p file) (delete-file file)) (process-send-string (get-buffer-process buffer) @@ -154,7 +156,7 @@ FILE exists at end of evaluation." (if (file-remote-p default-directory) (let (v) (with-parsed-tramp-file-name default-directory nil - (tramp-flush-directory-property v "")))) + (tramp-flush-directory-property v "")))) (while (not (file-exists-p file)) (sit-for (or period 0.25)))) (provide 'ob-comint) diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el index a9ac1cfa20f..6259ebc0c2f 100644 --- a/lisp/org/ob-css.el +++ b/lisp/org/ob-css.el @@ -34,7 +34,7 @@ (defun org-babel-execute:css (body params) "Execute a block of CSS code. This function is called by `org-babel-execute-src-block'." - body) + body) (defun org-babel-prep-session:css (session params) "Return an error if the :session header argument is set. diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el index 57ae4b94758..ae7794b659c 100644 --- a/lisp/org/ob-ditaa.el +++ b/lisp/org/ob-ditaa.el @@ -34,15 +34,28 @@ ;; 3) we are adding the "file" and "cmdline" header arguments ;; ;; 4) there are no variables (at least for now) +;; +;; 5) it depends on a variable defined in org-exp-blocks (namely +;; `org-ditaa-jar-path') so be sure you have org-exp-blocks loaded ;;; Code: (require 'ob) +(defvar org-ditaa-jar-path) ;; provided by org-exp-blocks + (defvar org-babel-default-header-args:ditaa - '((:results . "file") (:exports . "results") (:java . "-Dfile.encoding=UTF-8")) + '((:results . "file") + (:exports . "results") + (:java . "-Dfile.encoding=UTF-8")) "Default arguments for evaluating a ditaa source block.") -(defvar org-ditaa-jar-path) +(defcustom org-ditaa-jar-option "-jar" + "Option for the ditaa jar file. +Do not leave leading or trailing spaces in this string." + :group 'org-babel + :version "24.1" + :type 'string) + (defun org-babel-execute:ditaa (body params) "Execute a block of Ditaa code with org-babel. This function is called by `org-babel-execute-src-block'." @@ -55,7 +68,7 @@ This function is called by `org-babel-execute-src-block'." (cmdline (cdr (assoc :cmdline params))) (java (cdr (assoc :java params))) (in-file (org-babel-temp-file "ditaa-")) - (cmd (concat "java " java " -jar " + (cmd (concat "java " java " " org-ditaa-jar-option " " (shell-quote-argument (expand-file-name org-ditaa-jar-path)) " " cmdline diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el index 1d4b7da7e18..99748b0a95b 100644 --- a/lisp/org/ob-dot.el +++ b/lisp/org/ob-dot.el @@ -64,7 +64,8 @@ "Execute a block of Dot code with org-babel. This function is called by `org-babel-execute-src-block'." (let* ((result-params (cdr (assoc :result-params params))) - (out-file (cdr (assoc :file params))) + (out-file (cdr (or (assoc :file params) + (error "You need to specify a :file parameter")))) (cmdline (or (cdr (assoc :cmdline params)) (format "-T%s" (file-name-extension out-file)))) (cmd (or (cdr (assoc :cmd params)) "dot")) diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index c8af6062002..d83ca246a84 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -41,12 +41,12 @@ (result-params (cdr (assoc :result-params params))) (print-level nil) (print-length nil) (body (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) - (format "%S" (print `(,(car var) ',(cdr var))))) - vars "\n ") - ")\n" body "\n)") + (concat "(let (" + (mapconcat + (lambda (var) + (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body "\n)") (concat body "\n")))) (if (or (member "code" result-params) (member "pp" result-params)) diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el index 0ac6ab004b7..ddad067a560 100644 --- a/lisp/org/ob-eval.el +++ b/lisp/org/ob-eval.el @@ -64,8 +64,8 @@ STDERR with `org-babel-eval-error-notify'." (buffer-string))) (defun org-babel-shell-command-on-region (start end command - &optional output-buffer replace - error-buffer display-error-buffer) + &optional output-buffer replace + error-buffer display-error-buffer) "Execute COMMAND in an inferior shell with region as input. Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region' diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 0f0cca3d94b..d17fd3475ae 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -32,10 +32,18 @@ (defvar org-current-export-file) (defvar org-babel-lob-one-liner-regexp) (defvar org-babel-ref-split-regexp) +(defvar org-list-forbidden-blocks) + (declare-function org-babel-lob-get-info "ob-lob" ()) (declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) -(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements)) +(declare-function org-heading-components "org" ()) +(declare-function org-link-search "org" (s &optional type avoid-pos stealth)) +(declare-function org-fill-template "org" (template alist)) +(declare-function org-in-verbatim-emphasis "org" ()) +(declare-function org-in-block-p "org" (names)) +(declare-function org-between-regexps-p "org" (start-re end-re &optional lim-up lim-down)) +(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements)) (org-export-blocks-add-block '(src org-babel-exp-src-block nil)) (defcustom org-export-babel-evaluate t @@ -47,28 +55,33 @@ process." :type 'boolean) (put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) +(defun org-babel-exp-get-export-buffer () + "Return the current export buffer if possible." + (cond + ((bufferp org-current-export-file) org-current-export-file) + (org-current-export-file (get-file-buffer org-current-export-file)) + ('otherwise + (error "Requested export buffer when `org-current-export-file' is nil")))) + (defmacro org-babel-exp-in-export-file (lang &rest body) (declare (indent 1)) `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang))) (heading (nth 4 (ignore-errors (org-heading-components)))) - (link (when org-current-export-file - (org-make-link-string - (if heading - (concat org-current-export-file "::" heading) - org-current-export-file)))) - (export-buffer (current-buffer)) results) - (when link + (export-buffer (current-buffer)) + (original-buffer (org-babel-exp-get-export-buffer)) results) + (when original-buffer ;; resolve parameters in the original file so that ;; headline and file-wide parameters are included, attempt ;; to go to the same heading in the original file - (set-buffer (get-file-buffer org-current-export-file)) + (set-buffer original-buffer) (save-restriction - (condition-case nil - (let ((org-link-search-inhibit-query t)) - (org-open-link-from-string link)) - (error (when heading - (goto-char (point-min)) - (re-search-forward (regexp-quote heading) nil t)))) + (when heading + (condition-case nil + (let ((org-link-search-inhibit-query t)) + (org-link-search heading)) + (error (when heading + (goto-char (point-min)) + (re-search-forward (regexp-quote heading) nil t))))) (setq results ,@body)) (set-buffer export-buffer) results))) @@ -108,15 +121,25 @@ none ----- do not display either code or results upon export" (if (boundp lang-headers) (eval lang-headers) nil) raw-params)))) (setf hash (org-babel-sha1-hash info))) - ;; expand noweb references in the original file - (setf (nth 1 info) - (if (and (cdr (assoc :noweb (nth 2 info))) - (string= "yes" (cdr (assoc :noweb (nth 2 info))))) - (org-babel-expand-noweb-references - info (get-file-buffer org-current-export-file)) - (nth 1 info))) (org-babel-exp-do-export info 'block hash))))) +(defcustom org-babel-exp-call-line-template + "" + "Template used to export call lines. +This template may be customized to include the call line name +with any export markup. The template is filled out using +`org-fill-template', and the following %keys may be used. + + line --- call line + +An example value would be \"\\n: call: %line\" to export the call line +wrapped in a verbatim environment. + +Note: the results are inserted separately after the contents of +this template." + :group 'org-babel + :type 'string) + (defvar org-babel-default-lob-header-args) (defun org-babel-exp-non-block-elements (start end) "Process inline source and call lines between START and END for export." @@ -147,7 +170,7 @@ none ----- do not display either code or results upon export" (if (and (cdr (assoc :noweb params)) (string= "yes" (cdr (assoc :noweb params)))) (org-babel-expand-noweb-references - info (get-file-buffer org-current-export-file)) + info (org-babel-exp-get-export-buffer)) (nth 1 info))) (let ((code-replacement (save-match-data (org-babel-exp-do-export @@ -163,22 +186,24 @@ none ----- do not display either code or results upon export" (inlinep (match-string 11)) (inline-start (match-end 11)) (inline-end (match-end 0)) - (rep (let ((lob-info (org-babel-lob-get-info))) - (save-match-data - (org-babel-exp-do-export - (list "emacs-lisp" "results" - (org-babel-merge-params - org-babel-default-header-args - org-babel-default-lob-header-args - (org-babel-params-from-properties) - (org-babel-parse-header-arguments - (org-babel-clean-text-properties - (concat ":var results=" - (mapconcat #'identity - (butlast lob-info) - " "))))) - "" nil (car (last lob-info))) - 'lob))))) + (results (save-match-data + (org-babel-exp-do-export + (list "emacs-lisp" "results" + (org-babel-merge-params + org-babel-default-header-args + org-babel-default-lob-header-args + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-no-properties + (concat ":var results=" + (mapconcat #'identity + (butlast lob-info) + " "))))) + "" nil (car (last lob-info))) + 'lob))) + (rep (org-fill-template + org-babel-exp-call-line-template + `(("line" . ,(nth 0 lob-info)))))) (if inlinep (save-excursion (goto-char inline-start) @@ -202,26 +227,58 @@ org-mode text." (defun org-babel-exp-do-export (info type &optional hash) "Return a string with the exported content of a code block. The function respects the value of the :exports header argument." - (flet ((silently () (let ((session (cdr (assoc :session (nth 2 info))))) - (when (not (and session (equal "none" session))) - (org-babel-exp-results info type 'silent)))) - (clean () (unless (eq type 'inline) (org-babel-remove-result info)))) + (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info))))) + (when (not (and session (equal "none" session))) + (org-babel-exp-results info type 'silent))))) + (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info))))) (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) - ('none (silently) (clean) "") - ('code (silently) (clean) (org-babel-exp-code info)) + ('none (funcall silently) (funcall clean) "") + ('code (funcall silently) (funcall clean) (org-babel-exp-code info)) ('results (org-babel-exp-results info type nil hash) "") ('both (org-babel-exp-results info type nil hash) (org-babel-exp-code info))))) +(defcustom org-babel-exp-code-template + "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC" + "Template used to export the body of code blocks. +This template may be customized to include additional information +such as the code block name, or the values of particular header +arguments. The template is filled out using `org-fill-template', +and the following %keys may be used. + + lang ------ the language of the code block + name ------ the name of the code block + body ------ the body of the code block + flags ----- the flags passed to the code block + +In addition to the keys mentioned above, every header argument +defined for the code block may be used as a key and will be +replaced with its value." + :group 'org-babel + :type 'string) + (defun org-babel-exp-code (info) "Return the original code block formatted for export." + (setf (nth 1 info) + (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info)))) + (replace-regexp-in-string + (org-babel-noweb-wrap) "" (nth 1 info)) + (if (org-babel-noweb-p (nth 2 info) :export) + (org-babel-expand-noweb-references + info (org-babel-exp-get-export-buffer)) + (nth 1 info)))) (org-fill-template - "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC" + org-babel-exp-code-template `(("lang" . ,(nth 0 info)) - ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info))) ("body" . ,(if (string= (nth 0 info) "org") (replace-regexp-in-string "^" "," (nth 1 info)) - (nth 1 info)))))) + (nth 1 info))) + ,@(mapcar (lambda (pair) + (cons (substring (symbol-name (car pair)) 1) + (format "%S" (cdr pair)))) + (nth 2 info)) + ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info))) + ("name" . ,(or (nth 4 info) ""))))) (defun org-babel-exp-results (info type &optional silent hash) "Evaluate and return the results of the current code block for export. @@ -232,11 +289,16 @@ inhibit insertion of results into the buffer." (when (and org-export-babel-evaluate (not (and hash (equal hash (org-babel-current-result-hash))))) (let ((lang (nth 0 info)) - (body (nth 1 info))) + (body (if (org-babel-noweb-p (nth 2 info) :eval) + (org-babel-expand-noweb-references + info (org-babel-exp-get-export-buffer)) + (nth 1 info))) + (info (copy-sequence info))) ;; skip code blocks which we can't evaluate (when (fboundp (intern (concat "org-babel-execute:" lang))) (org-babel-eval-wipe-error-buffer) (prog1 nil + (setf (nth 1 info) body) (setf (nth 2 info) (org-babel-exp-in-export-file lang (org-babel-process-params diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el index fe38edbce1e..7f2d1a8054b 100644 --- a/lisp/org/ob-fortran.el +++ b/lisp/org/ob-fortran.el @@ -8,7 +8,7 @@ ;; Homepage: http://orgmode.org ;; This file is part of GNU Emacs. - +;; ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or @@ -46,7 +46,7 @@ (defun org-babel-execute:fortran (body params) "This function should only be called by `org-babel-execute:fortran'" (let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90")) - (tmp-bin-file (org-babel-temp-file "fortran-bin-")) + (tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext)) (cmdline (cdr (assoc :cmdline params))) (flags (cdr (assoc :flags params))) (full-body (org-babel-expand-body:fortran body params)) @@ -72,8 +72,8 @@ (org-babel-pick-name (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) (defun org-babel-expand-body:fortran (body params) "Expand a block of fortran or fortran code with org-babel according to @@ -85,42 +85,42 @@ it's header arguments." (defines (org-babel-read (or (cdr (assoc :defines params)) (org-babel-read (org-entry-get nil "defines" t)))))) - (mapconcat 'identity - (list - ;; includes - (mapconcat - (lambda (inc) (format "#include %s" inc)) - (if (listp includes) includes (list includes)) "\n") - ;; defines - (mapconcat - (lambda (inc) (format "#define %s" inc)) - (if (listp defines) defines (list defines)) "\n") - ;; body - (if main-p - (org-babel-fortran-ensure-main-wrap - (concat - ;; variables - (mapconcat 'org-babel-fortran-var-to-fortran vars "\n") - body) params) - body) "\n") "\n"))) + (mapconcat 'identity + (list + ;; includes + (mapconcat + (lambda (inc) (format "#include %s" inc)) + (if (listp includes) includes (list includes)) "\n") + ;; defines + (mapconcat + (lambda (inc) (format "#define %s" inc)) + (if (listp defines) defines (list defines)) "\n") + ;; body + (if main-p + (org-babel-fortran-ensure-main-wrap + (concat + ;; variables + (mapconcat 'org-babel-fortran-var-to-fortran vars "\n") + body) params) + body) "\n") "\n"))) (defun org-babel-fortran-ensure-main-wrap (body params) "Wrap body in a \"program ... end program\" block if none exists." (if (string-match "^[ \t]*program[ \t]*.*" (capitalize body)) - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (if vars (error "cannot use :vars if 'program' statement is present")) - body) + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (if vars (error "Cannot use :vars if 'program' statement is present")) + body) (format "program main\n%s\nend program main\n" body))) (defun org-babel-prep-session:fortran (session params) "This function does nothing as fortran is a compiled language with no support for sessions" - (error "fortran is a compiled languages -- no support for sessions")) + (error "Fortran is a compiled languages -- no support for sessions")) (defun org-babel-load-session:fortran (session body params) "This function does nothing as fortran is a compiled language with no support for sessions" - (error "fortran is a compiled languages -- no support for sessions")) + (error "Fortran is a compiled languages -- no support for sessions")) ;; helper functions @@ -146,15 +146,15 @@ of the same value." (length val) var val)) ((listp val) (format "real, parameter :: %S(%d) = %s\n" - var (length val) (ob-fortran-transform-list val))) + var (length val) (org-babel-fortran-transform-list val))) (t (error (format "the type of parameter %s is not supported by ob-fortran" var)))))) -(defun ob-fortran-transform-list (val) +(defun org-babel-fortran-transform-list (val) "Return a fortran representation of enclose syntactic lists." (if (listp val) - (concat "(/" (mapconcat #'ob-fortran-transform-list val ", ") "/)") + (concat "(/" (mapconcat #'org-babel-fortran-transform-list val ", ") "/)") (format "%S" val))) (provide 'ob-fortran) diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index 5d07366e774..55c415320d6 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -87,46 +87,45 @@ code." (timefmt (plist-get params :timefmt)) (time-ind (or (plist-get params :timeind) (when timefmt 1))) + (add-to-body (lambda (text) (setq body (concat text "\n" body)))) output) - (flet ((add-to-body (text) - (setq body (concat text "\n" body)))) - ;; append header argument settings to body - (when title (add-to-body (format "set title '%s'" title))) ;; title - (when lines (mapc (lambda (el) (add-to-body el)) lines)) ;; line - (when sets - (mapc (lambda (el) (add-to-body (format "set %s" el))) sets)) - (when x-labels - (add-to-body - (format "set xtics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) - x-labels ", ")))) - (when y-labels - (add-to-body - (format "set ytics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) - y-labels ", ")))) - (when time-ind - (add-to-body "set xdata time") - (add-to-body (concat "set timefmt \"" - (or timefmt - "%Y-%m-%d-%H:%M:%S") "\""))) - (when out-file (add-to-body (format "set output \"%s\"" out-file))) - (when term (add-to-body (format "set term %s" term))) - ;; insert variables into code body: this should happen last - ;; placing the variables at the *top* of the code in case their - ;; values are used later - (add-to-body (mapconcat #'identity - (org-babel-variable-assignments:gnuplot params) - "\n")) - ;; replace any variable names preceded by '$' with the actual - ;; value of the variable - (mapc (lambda (pair) - (setq body (replace-regexp-in-string - (format "\\$%s" (car pair)) (cdr pair) body))) - vars)) - body))) + ;; append header argument settings to body + (when title (funcall add-to-body (format "set title '%s'" title))) ;; title + (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) ;; line + (when sets + (mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets)) + (when x-labels + (funcall add-to-body + (format "set xtics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + x-labels ", ")))) + (when y-labels + (funcall add-to-body + (format "set ytics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + y-labels ", ")))) + (when time-ind + (funcall add-to-body "set xdata time") + (funcall add-to-body (concat "set timefmt \"" + (or timefmt + "%Y-%m-%d-%H:%M:%S") "\""))) + (when out-file (funcall add-to-body (format "set output \"%s\"" out-file))) + (when term (funcall add-to-body (format "set term %s" term))) + ;; insert variables into code body: this should happen last + ;; placing the variables at the *top* of the code in case their + ;; values are used later + (funcall add-to-body (mapconcat #'identity + (org-babel-variable-assignments:gnuplot params) + "\n")) + ;; replace any variable names preceded by '$' with the actual + ;; value of the variable + (mapc (lambda (pair) + (setq body (replace-regexp-in-string + (format "\\$%s" (car pair)) (cdr pair) body))) + vars)) + body)) (defun org-babel-execute:gnuplot (body params) "Execute a block of Gnuplot code. @@ -183,7 +182,7 @@ This function is called by `org-babel-execute-src-block'." buffer))) (defun org-babel-variable-assignments:gnuplot (params) - "Return list of gnuplot statements assigning the block's variables" + "Return list of gnuplot statements assigning the block's variables." (mapcar (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) (org-babel-gnuplot-process-vars params))) diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index 53c55329752..1588f99f1e4 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -125,12 +125,12 @@ then create one. Return the initialized session." (current-buffer)))) (defun org-babel-variable-assignments:haskell (params) - "Return list of haskell statements assigning the block's variables" + "Return list of haskell statements assigning the block's variables." (mapcar (lambda (pair) (format "let %s = %s" (car pair) (org-babel-haskell-var-to-haskell (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (mapcar #'cdr (org-babel-get-header params :var)))) (defun org-babel-haskell-table-or-string (results) "Convert RESULTS to an Emacs-lisp table or string. diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el new file mode 100644 index 00000000000..20648266056 --- /dev/null +++ b/lisp/org/ob-io.el @@ -0,0 +1,122 @@ +;;; ob-io.el --- org-babel functions for Io evaluation + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Andrzej Lichnerowicz +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; Currently only supports the external execution. No session support yet. +;; :results output -- runs in scripting mode +;; :results output repl -- runs in repl mode + +;;; Requirements: +;; - Io language :: http://iolanguage.org/ +;; - Io major mode :: Can be installed from Io sources +;; https://github.com/stevedekorte/io/blob/master/extras/SyntaxHighlighters/Emacs/io-mode.el + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(add-to-list 'org-babel-tangle-lang-exts '("io" . "io")) +(defvar org-babel-default-header-args:io '()) +(defvar org-babel-io-command "io" + "Name of the command to use for executing Io code.") + + +(defun org-babel-execute:io (body params) + "Execute a block of Io code with org-babel. This function is +called by `org-babel-execute-src-block'" + (message "executing Io source code block") + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-io-initiate-session (nth 0 processed-params))) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params)) + (result (org-babel-io-evaluate + session full-body result-type result-params))) + + (org-babel-reassemble-table + result + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + + +(defun org-babel-io-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + + +(defvar org-babel-io-wrapper-method + "( +%s +) asString print +") + + +(defun org-babel-io-evaluate (session body &optional result-type result-params) + "Evaluate BODY in external Io process. +If RESULT-TYPE equals 'output then return standard output as a string. +If RESULT-TYPE equals 'value then return the value of the last statement +in BODY as elisp." + (when session (error "Sessions are not (yet) supported for Io")) + (case result-type + (output + (if (member "repl" result-params) + (org-babel-eval org-babel-io-command body) + (let ((src-file (org-babel-temp-file "io-"))) + (progn (with-temp-file src-file (insert body)) + (org-babel-eval + (concat org-babel-io-command " " src-file) ""))))) + (value (let* ((src-file (org-babel-temp-file "io-")) + (wrapper (format org-babel-io-wrapper-method body))) + (with-temp-file src-file (insert wrapper)) + ((lambda (raw) + (if (member "code" result-params) + raw + (org-babel-io-table-or-string raw))) + (org-babel-eval + (concat org-babel-io-command " " src-file) "")))))) + + +(defun org-babel-prep-session:io (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "Sessions are not (yet) supported for Io")) + +(defun org-babel-io-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session. Sessions are not +supported in Io." + nil) + +(provide 'ob-io) + + + +;;; ob-io.el ends here diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index 20cad4e6b40..21381725cb1 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -130,7 +130,7 @@ specifying a variable of the same value." session)) (defun org-babel-variable-assignments:js (params) - "Return list of Javascript statements assigning the block's variables" + "Return list of Javascript statements assigning the block's variables." (mapcar (lambda (pair) (format "var %s=%s;" (car pair) (org-babel-js-var-to-js (cdr pair)))) @@ -152,9 +152,9 @@ then create. Return the initialized session." (sit-for .5) (org-babel-js-initiate-session session)))) ((string= "node" org-babel-js-cmd ) - (error "session evaluation with node.js is not supported")) + (error "Session evaluation with node.js is not supported")) (t - (error "sessions are only supported with mozrepl add \":cmd mozrepl\""))))) + (error "Sessions are only supported with mozrepl add \":cmd mozrepl\""))))) (provide 'ob-js) diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el index 23e8d91fecd..43f673edf59 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -132,7 +132,7 @@ This function is called by `org-babel-execute-src-block'." (when (file-exists-p transient-pdf-file) (delete-file transient-pdf-file)))))) ((string-match "\\.\\([^\\.]+\\)$" out-file) - (error "can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" + (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" (match-string 1 out-file)))) nil) ;; signal that output has already been written to file body)) diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el index a454d51e391..2635730a93a 100644 --- a/lisp/org/ob-ledger.el +++ b/lisp/org/ob-ledger.el @@ -52,8 +52,8 @@ called by `org-babel-execute-src-block'." (out-file (org-babel-temp-file "ledger-output-"))) (with-temp-file in-file (insert body)) (message "%s" (concat "ledger" - " -f " (org-babel-process-file-name in-file) - " " cmdline)) + " -f " (org-babel-process-file-name in-file) + " " cmdline)) (with-output-to-string (shell-command (concat "ledger" " -f " (org-babel-process-file-name in-file) diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el index b3e77f32e55..e19b0c34c6a 100644 --- a/lisp/org/ob-lilypond.el +++ b/lisp/org/ob-lilypond.el @@ -23,10 +23,14 @@ ;;; Commentary: -;; Installation / usage info, and examples are available at -;; https://github.com/mjago/ob-lilypond +;; Installation, ob-lilypond documentation, and examples are available at +;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html +;; +;; Lilypond documentation can be found at +;; http://lilypond.org/manuals.html ;;; Code: + (require 'ob) (require 'ob-eval) (require 'ob-tangle) @@ -36,7 +40,9 @@ (add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly")) (defvar org-babel-default-header-args:lilypond '() - "Default header arguments for js code blocks.") + "Default header arguments for lilypond code blocks. +NOTE: The arguments are determined at lilypond compile time. +See (ly-set-header-args)") (defvar ly-compile-post-tangle t "Following the org-babel-tangle (C-c C-v t) command, @@ -48,14 +54,14 @@ Default value is t") (defvar ly-display-pdf-post-tangle t "Following a successful LilyPond compilation ly-display-pdf-post-tangle determines whether to automate the -drawing / redrawing of the resultant pdf. If the value is nil, -the pdf is not automatically redrawn. Default value is t") +drawing / redrawing of the resultant pdf. If the value is nil, +the pdf is not automatically redrawn. Default value is t") (defvar ly-play-midi-post-tangle t "Following a successful LilyPond compilation ly-play-midi-post-tangle determines whether to automate the -playing of the resultant midi file. If the value is nil, -the midi file is not automatically played. Default value is t") +playing of the resultant midi file. If the value is nil, +the midi file is not automatically played. Default value is t") (defvar ly-OSX-ly-path "/Applications/lilypond.app/Contents/Resources/bin/lilypond") @@ -71,24 +77,28 @@ the midi file is not automatically played. Default value is t") (defvar ly-w32-midi-path "") (defvar ly-gen-png nil -"Image generation (png) can be turned on by default by setting + "Image generation (png) can be turned on by default by setting LY-GEN-PNG to t") (defvar ly-gen-svg nil -"Image generation (SVG) can be turned on by default by setting + "Image generation (SVG) can be turned on by default by setting LY-GEN-SVG to t") (defvar ly-gen-html nil -"HTML generation can be turned on by default by setting + "HTML generation can be turned on by default by setting LY-GEN-HTML to t") +(defvar ly-gen-pdf nil + "PDF generation can be turned on by default by setting +LY-GEN-PDF to t") + (defvar ly-use-eps nil -"You can force the compiler to use the EPS backend by setting + "You can force the compiler to use the EPS backend by setting LY-USE-EPS to t") (defvar ly-arrange-mode nil "Arrange mode is turned on by setting LY-ARRANGE-MODE -to t. In Arrange mode the following settings are altered +to t. In Arrange mode the following settings are altered from default... :tangle yes, :noweb yes :results silent :comments yes. @@ -97,7 +107,6 @@ blocks") (defun org-babel-expand-body:lilypond (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) (mapc (lambda (pair) @@ -117,7 +126,6 @@ Depending on whether we are in arrange mode either: 1. Attempt to execute lilypond block according to header settings (This is the default basic mode) 2. Tangle all lilypond blocks and process the result (arrange mode)" - (ly-set-header-args ly-arrange-mode) (if ly-arrange-mode (ly-tangle) @@ -125,16 +133,14 @@ Depending on whether we are in arrange mode either: (defun ly-tangle () "ob-lilypond specific tangle, attempts to invoke -=ly-execute-tangled-ly= if tangle is successful. Also passes +=ly-execute-tangled-ly= if tangle is successful. Also passes specific arguments to =org-babel-tangle=" - (interactive) (if (org-babel-tangle nil "yes" "lilypond") (ly-execute-tangled-ly) nil)) (defun ly-process-basic (body params) - "Execute a lilypond block in basic mode" - + "Execute a lilypond block in basic mode." (let* ((result-params (cdr (assoc :result-params params))) (out-file (cdr (assoc :file params))) (cmdline (or (cdr (assoc :cmdline params)) @@ -143,7 +149,6 @@ specific arguments to =org-babel-tangle=" (with-temp-file in-file (insert (org-babel-expand-body:generic body params))) - (org-babel-eval (concat (ly-determine-ly-path) @@ -155,18 +160,15 @@ specific arguments to =org-babel-tangle=" (file-name-sans-extension out-file) " " cmdline - in-file) "") - ) nil) + in-file) "")) nil) (defun org-babel-prep-session:lilypond (session params) "Return an error because LilyPond exporter does not support sessions." - (error "Sorry, LilyPond does not currently support sessions!")) (defun ly-execute-tangled-ly () "Compile result of block tangle with lilypond. If error in compilation, attempt to mark the error in lilypond org file" - (when ly-compile-post-tangle (let ((ly-tangled-file (ly-switch-extension (buffer-file-name) ".lilypond")) @@ -193,24 +195,25 @@ If error in compilation, attempt to mark the error in lilypond org file" (defun ly-compile-lilyfile (file-name &optional test) "Compile lilypond file and check for compile errors FILE-NAME is full path to lilypond (.ly) file" - (message "Compiling LilyPond...") (let ((arg-1 (ly-determine-ly-path)) ;program (arg-2 nil) ;infile (arg-3 "*lilypond*") ;buffer (arg-4 t) ;display - (arg-5 (if ly-gen-png "--png" "")) ;&rest... - (arg-6 (if ly-gen-html "--html" "")) - (arg-7 (if ly-use-eps "-dbackend=eps" "")) - (arg-8 (if ly-gen-svg "-dbackend=svg" "")) - (arg-9 (concat "--output=" (file-name-sans-extension file-name))) - (arg-10 file-name)) + (arg-4 t) ;display + (arg-5 (if ly-gen-png "--png" "")) ;&rest... + (arg-6 (if ly-gen-html "--html" "")) + (arg-7 (if ly-gen-pdf "--pdf" "")) + (arg-8 (if ly-use-eps "-dbackend=eps" "")) + (arg-9 (if ly-gen-svg "-dbackend=svg" "")) + (arg-10 (concat "--output=" (file-name-sans-extension file-name))) + (arg-11 file-name)) (if test - `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 - ,arg-6 ,arg-7 ,arg-8 ,arg-9 ,arg-10) + `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6 + ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11) (call-process - arg-1 arg-2 arg-3 arg-4 arg-5 - arg-6 arg-7 arg-8 arg-9 arg-10)))) + arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 + arg-7 arg-8 arg-9 arg-10 arg-11)))) (defun ly-check-for-compile-error (file-name &optional test) "Check for compile error. @@ -229,7 +232,6 @@ nil as file-name since it is unused in this context" (defun ly-process-compile-error (file-name) "Process the compilation error that has occurred. FILE-NAME is full path to lilypond file" - (let ((line-num (ly-parse-line-num))) (let ((error-lines (ly-parse-error-line file-name line-num))) (ly-mark-error-line file-name error-lines) @@ -239,7 +241,6 @@ FILE-NAME is full path to lilypond file" "Mark the erroneous lines in the lilypond org buffer. FILE-NAME is full path to lilypond file. LINE is the erroneous line" - (switch-to-buffer-other-window (concat (file-name-nondirectory (ly-switch-extension file-name ".org")))) @@ -255,7 +256,6 @@ LINE is the erroneous line" (defun ly-parse-line-num (&optional buffer) "Extract error line number." - (when buffer (set-buffer buffer)) (let ((start @@ -280,7 +280,6 @@ LINE is the erroneous line" "Extract the erroneous line from the tangled .ly file FILE-NAME is full path to lilypond file. LINENO is the number of the erroneous line" - (with-temp-buffer (insert-file-contents (ly-switch-extension file-name ".ly") nil nil nil t) @@ -295,7 +294,6 @@ LINENO is the number of the erroneous line" "Attempt to display the generated pdf file FILE-NAME is full path to lilypond file If TEST is non-nil, the shell command is returned and is not run" - (when ly-display-pdf-post-tangle (let ((pdf-file (ly-switch-extension file-name ".pdf"))) (if (file-exists-p pdf-file) @@ -303,14 +301,17 @@ If TEST is non-nil, the shell command is returned and is not run" (concat (ly-determine-pdf-path) " " pdf-file))) (if test cmd-string - (shell-command cmd-string))) - (message "No pdf file generated so can't display!"))))) + (start-process + "\"Audition pdf\"" + "*lilypond*" + (ly-determine-pdf-path) + pdf-file))) + (message "No pdf file generated so can't display!"))))) (defun ly-attempt-to-play-midi (file-name &optional test) "Attempt to play the generated MIDI file FILE-NAME is full path to lilypond file If TEST is non-nil, the shell command is returned and is not run" - (when ly-play-midi-post-tangle (let ((midi-file (ly-switch-extension file-name ".midi"))) (if (file-exists-p midi-file) @@ -318,13 +319,16 @@ If TEST is non-nil, the shell command is returned and is not run" (concat (ly-determine-midi-path) " " midi-file))) (if test cmd-string - (shell-command cmd-string))) + (start-process + "\"Audition midi\"" + "*lilypond*" + (ly-determine-midi-path) + midi-file))) (message "No midi file generated so can't play!"))))) (defun ly-determine-ly-path (&optional test) "Return correct path to ly binary depending on OS If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type (or test system-type))) (cond ((string= sys-type "darwin") @@ -336,7 +340,6 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" (defun ly-determine-pdf-path (&optional test) "Return correct path to pdf viewer depending on OS If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type (or test system-type))) (cond ((string= sys-type "darwin") @@ -348,7 +351,6 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" (defun ly-determine-midi-path (&optional test) "Return correct path to midi player depending on OS If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type (or test test system-type))) (cond ((string= sys-type "darwin") @@ -358,8 +360,7 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" (t ly-nix-midi-path)))) (defun ly-toggle-midi-play () - "Toggle whether midi will be played following a successful compilation" - + "Toggle whether midi will be played following a successful compilation." (interactive) (setq ly-play-midi-post-tangle (not ly-play-midi-post-tangle)) @@ -368,8 +369,7 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" "ENABLED." "DISABLED.")))) (defun ly-toggle-pdf-display () - "Toggle whether pdf will be displayed following a successful compilation" - + "Toggle whether pdf will be displayed following a successful compilation." (interactive) (setq ly-display-pdf-post-tangle (not ly-display-pdf-post-tangle)) @@ -378,26 +378,28 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" "ENABLED." "DISABLED.")))) (defun ly-toggle-png-generation () - "Toggle whether png image will be generated by compilation" - + "Toggle whether png image will be generated by compilation." (interactive) - (setq ly-gen-png - (not ly-gen-png)) + (setq ly-gen-png (not ly-gen-png)) (message (concat "PNG image generation has been " (if ly-gen-png "ENABLED." "DISABLED.")))) (defun ly-toggle-html-generation () - "Toggle whether html will be generated by compilation" - + "Toggle whether html will be generated by compilation." (interactive) - (setq ly-gen-html - (not ly-gen-html)) + (setq ly-gen-html (not ly-gen-html)) (message (concat "HTML generation has been " (if ly-gen-html "ENABLED." "DISABLED.")))) -(defun ly-toggle-arrange-mode () - "Toggle whether in Arrange mode or Basic mode" +(defun ly-toggle-pdf-generation () + "Toggle whether pdf will be generated by compilation." + (interactive) + (setq ly-gen-pdf (not ly-gen-pdf)) + (message (concat "PDF generation has been " + (if ly-gen-pdf "ENABLED." "DISABLED.")))) +(defun ly-toggle-arrange-mode () + "Toggle whether in Arrange mode or Basic mode." (interactive) (setq ly-arrange-mode (not ly-arrange-mode)) @@ -406,18 +408,18 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" (defun ly-switch-extension (file-name ext) "Utility command to swap current FILE-NAME extension with EXT" - (concat (file-name-sans-extension file-name) ext)) (defun ly-get-header-args (mode) "Default arguments to use when evaluating a lilypond -source block. These depend upon whether we are in arrange -mode i.e. ARRANGE-MODE is t" +source block. These depend upon whether we are in arrange +mode i.e. ARRANGE-MODE is t" (cond (mode '((:tangle . "yes") (:noweb . "yes") (:results . "silent") + (:cache . "yes") (:comments . "yes"))) (t '((:results . "file") @@ -431,6 +433,4 @@ dependent on LY-ARRANGE-MODE" (provide 'ob-lilypond) - - ;;; ob-lilypond.el ends here diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index 8fb67219692..71e80bdf9ea 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -41,7 +41,7 @@ (add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp")) (defvar org-babel-default-header-args:lisp '()) -(defvar org-babel-header-arg-names:lisp '(package)) +(defvar org-babel-header-args:lisp '((package . :any))) (defcustom org-babel-lisp-dir-fmt "(let ((*default-pathname-defaults* #P%S)) %%s)" @@ -85,8 +85,8 @@ current directory string." (insert (org-babel-expand-body:lisp body params)) (slime-eval `(swank:eval-and-grab-output ,(let ((dir (if (assoc :dir params) - (cdr (assoc :dir params)) - default-directory))) + (cdr (assoc :dir params)) + default-directory))) (format (if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)") (buffer-substring-no-properties diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index 7828f1d51c2..6aafe34dcd3 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -97,38 +97,49 @@ if so then run the appropriate source block from the Library." ;;;###autoload (defun org-babel-lob-get-info () "Return a Library of Babel function call as a string." - (flet ((nonempty (a b) - (let ((it (match-string a))) - (if (= (length it) 0) (match-string b) it)))) - (let ((case-fold-search t)) - (save-excursion - (beginning-of-line 1) - (when (looking-at org-babel-lob-one-liner-regexp) - (append - (mapcar #'org-babel-clean-text-properties - (list - (format "%s%s(%s)%s" - (nonempty 3 12) - (if (not (= 0 (length (nonempty 5 14)))) - (concat "[" (nonempty 5 14) "]") "") - (or (nonempty 7 16) "") - (or (nonempty 8 19) "")) - (nonempty 9 18))) - (list (length (if (= (length (match-string 12)) 0) - (match-string 2) (match-string 11)))))))))) + (let ((case-fold-search t) + (nonempty (lambda (a b) + (let ((it (match-string a))) + (if (= (length it) 0) (match-string b) it))))) + (save-excursion + (beginning-of-line 1) + (when (looking-at org-babel-lob-one-liner-regexp) + (append + (mapcar #'org-no-properties + (list + (format "%s%s(%s)%s" + (funcall nonempty 3 12) + (if (not (= 0 (length (funcall nonempty 5 14)))) + (concat "[" (funcall nonempty 5 14) "]") "") + (or (funcall nonempty 7 16) "") + (or (funcall nonempty 8 19) "")) + (funcall nonempty 9 18))) + (list (length (if (= (length (match-string 12)) 0) + (match-string 2) (match-string 11))))))))) (defun org-babel-lob-execute (info) "Execute the lob call specified by INFO." - (let ((params (org-babel-process-params - (org-babel-merge-params - org-babel-default-header-args - (org-babel-params-from-properties) - (org-babel-parse-header-arguments - (org-babel-clean-text-properties - (concat ":var results=" - (mapconcat #'identity (butlast info) " ")))))))) - (org-babel-execute-src-block - nil (list "emacs-lisp" "results" params nil nil (nth 2 info))))) + (let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info)))) + (pre-params (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-no-properties + (concat ":var results=" + (mapconcat #'identity (butlast info) " ")))))) + (pre-info (funcall mkinfo pre-params)) + (cache? (and (cdr (assoc :cache pre-params)) + (string= "yes" (cdr (assoc :cache pre-params))))) + (new-hash (when cache? (org-babel-sha1-hash pre-info))) + (old-hash (when cache? (org-babel-current-result-hash)))) + (if (and cache? (equal new-hash old-hash)) + (save-excursion (goto-char (org-babel-where-is-src-block-result)) + (forward-line 1) + (message "%S" (org-babel-read-result))) + (prog1 (org-babel-execute-src-block + nil (funcall mkinfo (org-babel-process-params pre-params))) + ;; update the hash + (when new-hash (org-babel-set-current-result-hash new-hash)))))) (provide 'ob-lob) diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el index b092e1330e7..06fa3cfe884 100644 --- a/lisp/org/ob-maxima.el +++ b/lisp/org/ob-maxima.el @@ -48,21 +48,21 @@ (defun org-babel-maxima-expand (body params) "Expand a block of Maxima code according to its header arguments." (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (mapconcat 'identity - (list - ;; graphic output - (let ((graphic-file (org-babel-maxima-graphical-output-file params))) - (if graphic-file - (format - "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);" - graphic-file) - "")) - ;; variables - (mapconcat 'org-babel-maxima-var-to-maxima vars "\n") - ;; body - body - "gnuplot_close ()$") - "\n"))) + (mapconcat 'identity + (list + ;; graphic output + (let ((graphic-file (org-babel-maxima-graphical-output-file params))) + (if graphic-file + (format + "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);" + graphic-file) + "")) + ;; variables + (mapconcat 'org-babel-maxima-var-to-maxima vars "\n") + ;; body + body + "gnuplot_close ()$") + "\n"))) (defun org-babel-execute:maxima (body params) "Execute a block of Maxima entries with org-babel. This function is @@ -70,7 +70,7 @@ called by `org-babel-execute-src-block'." (message "executing Maxima source code block") (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) (result - (let* ((cmdline (cdr (assoc :cmdline params))) + (let* ((cmdline (or (cdr (assoc :cmdline params)) "")) (in-file (org-babel-temp-file "maxima-" ".max")) (cmd (format "%s --very-quiet -r 'batchload(%S)$' %s" org-babel-maxima-command in-file cmdline))) @@ -110,8 +110,8 @@ of the same value." (setq val (symbol-name val)) (when (= (length val) 1) (setq val (string-to-char val)))) - (format "%S: %s$" var - (org-babel-maxima-elisp-to-maxima val)))) + (format "%S: %s$" var + (org-babel-maxima-elisp-to-maxima val)))) (defun org-babel-maxima-graphical-output-file (params) "Name of file to which maxima should send graphical output." diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el index b40f9a39cef..64d35457b6b 100644 --- a/lisp/org/ob-mscgen.el +++ b/lisp/org/ob-mscgen.el @@ -24,7 +24,7 @@ ;;; Commentary: ;; ;; This software provides EMACS org-babel export support for message -;; sequence charts. The mscgen utility is used for processing the +;; sequence charts. The mscgen utility is used for processing the ;; sequence definition, and must therefore be installed in the system. ;; ;; Mscgen is available and documented at @@ -64,13 +64,13 @@ (defun org-babel-execute:mscgen (body params) "Execute a block of Mscgen code with Babel. This function is called by `org-babel-execute-src-block'. -Default filetype is png. Modify by setting :filetype parameter to +Default filetype is png. Modify by setting :filetype parameter to mscgen supported formats." (let* ((out-file (or (cdr (assoc :file params)) "output.png" )) (filetype (or (cdr (assoc :filetype params)) "png" ))) (unless (cdr (assoc :file params)) (error " -ERROR: no output file specified. Add \":file name.png\" to the src header")) +ERROR: no output file specified. Add \":file name.png\" to the src header")) (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) nil)) ;; signal that output has already been written to file diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el index 8d61ff37e6e..d2bf36636a5 100644 --- a/lisp/org/ob-ocaml.el +++ b/lisp/org/ob-ocaml.el @@ -72,7 +72,7 @@ (progn (setq out nil) line) (when (string-match re line) (progn (setq out t) nil)))) - (mapcar #'org-babel-trim (reverse raw)))))))) + (mapcar #'org-babel-trim (reverse raw)))))))) (org-babel-reassemble-table (org-babel-ocaml-parse-output (org-babel-trim clean)) (org-babel-pick-name @@ -93,7 +93,7 @@ (get-buffer tuareg-interactive-buffer-name)))) (defun org-babel-variable-assignments:ocaml (params) - "Return list of ocaml statements assigning the block's variables" + "Return list of ocaml statements assigning the block's variables." (mapcar (lambda (pair) (format "let %s = %s;;" (car pair) (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) @@ -131,11 +131,11 @@ Emacs-lisp table, otherwise return the results as a string." "Convert RESULTS into an elisp table or string. If the results look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape - (replace-regexp-in-string - "\\[|" "[" (replace-regexp-in-string - "|\\]" "]" (replace-regexp-in-string - "; " "," results))))) + (org-babel-script-escape + (replace-regexp-in-string + "\\[|" "[" (replace-regexp-in-string + "|\\]" "]" (replace-regexp-in-string + "; " "," results))))) (provide 'ob-ocaml) diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index 9e8575768dc..73f25eca155 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -52,7 +52,7 @@ to a non-nil value.") (defvar org-babel-matlab-emacs-link-wrapper-method - "%s + "%s if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); else, save -ascii %s ans end @@ -110,7 +110,7 @@ end") (org-babel-prep-session:octave session params 'matlab)) (defun org-babel-variable-assignments:octave (params) - "Return list of octave statements assigning the block's variables" + "Return list of octave statements assigning the block's variables." (mapcar (lambda (pair) (format "%s=%s;" @@ -147,13 +147,13 @@ specifying a variable of the same value." (defun org-babel-matlab-initiate-session (&optional session params) "Create a matlab inferior process buffer. If there is not a current inferior-process-buffer in SESSION then -create. Return the initialized session." +create. Return the initialized session." (org-babel-octave-initiate-session session params 'matlab)) (defun org-babel-octave-initiate-session (&optional session params matlabp) "Create an octave inferior process buffer. If there is not a current inferior-process-buffer in SESSION then -create. Return the initialized session." +create. Return the initialized session." (if matlabp (require 'matlab) (require 'octave-inf)) (unless (string= session "none") (let ((session (or session @@ -225,9 +225,9 @@ value of the last statement in BODY, as elisp." (message "Waiting for Matlab Emacs Link") (while (file-exists-p wait-file) (sit-for 0.01)) "")) ;; matlab-shell-run-region doesn't seem to - ;; make *matlab* buffer contents easily - ;; available, so :results output currently - ;; won't work + ;; make *matlab* buffer contents easily + ;; available, so :results output currently + ;; won't work (org-babel-comint-with-output (session (if matlabp @@ -265,7 +265,7 @@ This removes initial blank and comment lines and then calls (org-babel-import-elisp-from-file temp-file '(16)))) (defun org-babel-octave-read-string (string) - "Strip \\\"s from around octave string" + "Strip \\\"s from around octave string." (if (string-match "^\"\\([^\000]+\\)\"$" string) (match-string 1 string) string)) diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el index d57f8b506d1..64de4b2ce45 100644 --- a/lisp/org/ob-org.el +++ b/lisp/org/ob-org.el @@ -32,7 +32,7 @@ (declare-function org-export-string "org-exp" (string fmt &optional dir)) (defvar org-babel-default-header-args:org - '((:results . "raw silent") (:exports . "results")) + '((:results . "raw silent") (:exports . "code")) "Default arguments for evaluating a org source block.") (defvar org-babel-org-default-header diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el index 71e02b05054..abf0ed637d7 100644 --- a/lisp/org/ob-perl.el +++ b/lisp/org/ob-perl.el @@ -47,7 +47,7 @@ This function is called by `org-babel-execute-src-block'." (result-type (cdr (assoc :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:perl params))) - (session (org-babel-perl-initiate-session session))) + (session (org-babel-perl-initiate-session session))) (org-babel-reassemble-table (org-babel-perl-evaluate session full-body result-type) (org-babel-pick-name @@ -57,10 +57,10 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-prep-session:perl (session params) "Prepare SESSION according to the header arguments in PARAMS." - (error "Sessions are not supported for Perl.")) + (error "Sessions are not supported for Perl")) (defun org-babel-variable-assignments:perl (params) - "Return list of perl statements assigning the block's variables" + "Return list of perl statements assigning the block's variables." (mapcar (lambda (pair) (format "$%s=%s;" @@ -81,8 +81,8 @@ specifying a var of the same value." (defvar org-babel-perl-buffers '(:default . nil)) (defun org-babel-perl-initiate-session (&optional session params) - "Return nil because sessions are not supported by perl" -nil) + "Return nil because sessions are not supported by perl." + nil) (defvar org-babel-perl-wrapper-method " @@ -101,7 +101,7 @@ print o join(\"\\n\", @r), \"\\n\"") If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (when session (error "Sessions are not supported for Perl.")) + (when session (error "Sessions are not supported for Perl")) (case result-type (output (org-babel-eval org-babel-perl-command body)) (value (let ((tmp-file (org-babel-temp-file "perl-"))) diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el index 06c9ab8df60..dd0704fc14e 100644 --- a/lisp/org/ob-picolisp.el +++ b/lisp/org/ob-picolisp.el @@ -25,16 +25,16 @@ ;;; Commentary: ;; This library enables the use of PicoLisp in the multi-language -;; programming framework Org-Babel. PicoLisp is a minimal yet +;; programming framework Org-Babel. PicoLisp is a minimal yet ;; fascinating lisp dialect and a highly productive application ;; framework for web-based client-server applications on top of -;; object-oriented databases. A good way to learn PicoLisp is to first +;; object-oriented databases. A good way to learn PicoLisp is to first ;; read Paul Grahams essay "The hundred year language" ;; (http://www.paulgraham.com/hundred.html) and then study the various ;; documents and essays published in the PicoLisp wiki ;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some ;; GNU/Linux Distributions, and can be downloaded here: -;; http://software-lab.de/down.html. It ships with a picolisp-mode and +;; http://software-lab.de/down.html. It ships with a picolisp-mode and ;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/ ;; directory). diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el index 7da689393a3..37d8b7d1ee0 100644 --- a/lisp/org/ob-plantuml.el +++ b/lisp/org/ob-plantuml.el @@ -52,7 +52,7 @@ This function is called by `org-babel-execute-src-block'." (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) (out-file (or (cdr (assoc :file params)) - (error "plantuml requires a \":file\" header argument"))) + (error "PlantUML requires a \":file\" header argument"))) (cmdline (cdr (assoc :cmdline params))) (in-file (org-babel-temp-file "plantuml-")) (java (or (cdr (assoc :java params)) "")) diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index 348248f35cf..71adf73073b 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -44,7 +44,7 @@ (defvar org-babel-default-header-args:python '()) (defvar org-babel-python-command "python" - "Name of command for executing python code.") + "Name of command for executing Python code.") (defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python) "Preferred python mode for use in running python interactively. @@ -99,7 +99,7 @@ VARS contains resolved variable references" ;; helper functions (defun org-babel-variable-assignments:python (params) - "Return list of python statements assigning the block's variables" + "Return a list of Python statements assigning the block's variables." (mapcar (lambda (pair) (format "%s=%s" @@ -160,7 +160,7 @@ then create. Return the initialized session." (py-shell) (setq python-buffer (concat "*" bufname "*")))) (t - (error "No function available for running an inferior python."))) + (error "No function available for running an inferior Python"))) (setq org-babel-python-buffers (cons (cons session python-buffer) (assq-delete-all session org-babel-python-buffers))) @@ -190,7 +190,7 @@ open('%s', 'w').write( pprint.pformat(main()) )") (defun org-babel-python-evaluate (session body &optional result-type result-params preamble) - "Evaluate BODY as python code." + "Evaluate BODY as Python code." (if session (org-babel-python-evaluate-session session body result-type result-params) @@ -201,7 +201,7 @@ open('%s', 'w').write( pprint.pformat(main()) )") (body &optional result-type result-params preamble) "Evaluate BODY in external python process. If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." ((lambda (raw) (if (or (member "code" result-params) @@ -236,24 +236,25 @@ last statement in BODY, as elisp." (session body &optional result-type result-params) "Pass BODY to the Python process in SESSION. If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (flet ((send-wait () (comint-send-input nil t) (sleep-for 0 5)) + (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5))) (dump-last-value - (tmp-file pp) - (mapc - (lambda (statement) (insert statement) (send-wait)) - (if pp - (list - "import pprint" - (format "open('%s', 'w').write(pprint.pformat(_))" - (org-babel-process-file-name tmp-file 'noquote))) - (list (format "open('%s', 'w').write(str(_))" - (org-babel-process-file-name tmp-file 'noquote)))))) - (input-body (body) - (mapc (lambda (line) (insert line) (send-wait)) - (split-string body "[\r\n]")) - (send-wait))) + (lambda + (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (funcall send-wait)) + (if pp + (list + "import pprint" + (format "open('%s', 'w').write(pprint.pformat(_))" + (org-babel-process-file-name tmp-file 'noquote))) + (list (format "open('%s', 'w').write(str(_))" + (org-babel-process-file-name tmp-file 'noquote))))))) + (input-body (lambda (body) + (mapc (lambda (line) (insert line) (funcall send-wait)) + (split-string body "[\r\n]")) + (funcall send-wait)))) ((lambda (results) (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results) (if (or (member "code" result-params) @@ -269,25 +270,25 @@ last statement in BODY, as elisp." (butlast (org-babel-comint-with-output (session org-babel-python-eoe-indicator t body) - (input-body body) - (send-wait) (send-wait) + (funcall input-body body) + (funcall send-wait) (funcall send-wait) (insert org-babel-python-eoe-indicator) - (send-wait)) + (funcall send-wait)) 2) "\n")) (value (let ((tmp-file (org-babel-temp-file "python-"))) (org-babel-comint-with-output (session org-babel-python-eoe-indicator nil body) (let ((comint-process-echoes nil)) - (input-body body) - (dump-last-value tmp-file (member "pp" result-params)) - (send-wait) (send-wait) + (funcall input-body body) + (funcall dump-last-value tmp-file (member "pp" result-params)) + (funcall send-wait) (funcall send-wait) (insert org-babel-python-eoe-indicator) - (send-wait))) + (funcall send-wait))) (org-babel-eval-read-file tmp-file))))))) (defun org-babel-python-read-string (string) - "Strip 's from around python string" + "Strip 's from around Python string." (if (string-match "^'\\([^\000]+\\)'$" string) (match-string 1 string) string)) diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 08cb4e3a25f..79861f1b78a 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -120,89 +120,89 @@ the variable." (defun org-babel-ref-resolve (ref) "Resolve the reference REF and return its value." (save-window-excursion - (save-excursion - (let ((case-fold-search t) - type args new-refere new-header-args new-referent result - lob-info split-file split-ref index index-row index-col id) - ;; if ref is indexed grab the indices -- beware nested indices - (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) - (let ((str (substring ref 0 (match-beginning 0)))) - (= (org-count ?( str) (org-count ?) str)))) - (setq index (match-string 1 ref)) - (setq ref (substring ref 0 (match-beginning 0)))) - ;; assign any arguments to pass to source block - (when (string-match - "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref) - (setq new-refere (match-string 1 ref)) - (setq new-header-args (match-string 3 ref)) - (setq new-referent (match-string 5 ref)) - (when (> (length new-refere) 0) - (when (> (length new-referent) 0) - (setq args (mapcar (lambda (ref) (cons :var ref)) - (org-babel-ref-split-args new-referent)))) - (when (> (length new-header-args) 0) - (setq args (append (org-babel-parse-header-arguments - new-header-args) args))) - (setq ref new-refere))) - (when (string-match "^\\(.+\\):\\(.+\\)$" ref) - (setq split-file (match-string 1 ref)) - (setq split-ref (match-string 2 ref)) - (find-file split-file) (setq ref split-ref)) - (save-restriction - (widen) - (goto-char (point-min)) - (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref)) - (res-rx (org-babel-named-data-regexp-for-name ref))) - ;; goto ref in the current buffer - (or - ;; check for code blocks - (re-search-forward src-rx nil t) - ;; check for named data - (re-search-forward res-rx nil t) - ;; check for local or global headlines by id - (setq id (org-babel-ref-goto-headline-id ref)) - ;; check the Library of Babel - (setq lob-info (cdr (assoc (intern ref) - org-babel-library-of-babel))))) - (unless (or lob-info id) (goto-char (match-beginning 0))) - ;; ;; TODO: allow searching for names in other buffers - ;; (setq id-loc (org-id-find ref 'marker) - ;; buffer (marker-buffer id-loc) - ;; loc (marker-position id-loc)) - ;; (move-marker id-loc nil) - (error "reference '%s' not found in this buffer" ref)) - (cond - (lob-info (setq type 'lob)) - (id (setq type 'id)) - ((and (looking-at org-babel-src-name-regexp) - (save-excursion - (forward-line 1) - (or (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp)))) - (setq type 'source-block)) - (t (while (not (setq type (org-babel-ref-at-ref-p))) - (forward-line 1) - (beginning-of-line) - (if (or (= (point) (point-min)) (= (point) (point-max))) - (error "reference not found"))))) - (let ((params (append args '((:results . "silent"))))) - (setq result - (case type - (results-line (org-babel-read-result)) - (table (org-babel-read-table)) - (list (org-babel-read-list)) - (file (org-babel-read-link)) - (source-block (org-babel-execute-src-block - nil nil (if org-babel-update-intermediate - nil params))) - (lob (org-babel-execute-src-block - nil lob-info params)) - (id (org-babel-ref-headline-body))))) - (if (symbolp result) - (format "%S" result) - (if (and index (listp result)) - (org-babel-ref-index-list index result) - result))))))) + (save-excursion + (let ((case-fold-search t) + type args new-refere new-header-args new-referent result + lob-info split-file split-ref index index-row index-col id) + ;; if ref is indexed grab the indices -- beware nested indices + (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) + (let ((str (substring ref 0 (match-beginning 0)))) + (= (org-count ?( str) (org-count ?) str)))) + (setq index (match-string 1 ref)) + (setq ref (substring ref 0 (match-beginning 0)))) + ;; assign any arguments to pass to source block + (when (string-match + "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref) + (setq new-refere (match-string 1 ref)) + (setq new-header-args (match-string 3 ref)) + (setq new-referent (match-string 5 ref)) + (when (> (length new-refere) 0) + (when (> (length new-referent) 0) + (setq args (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args new-referent)))) + (when (> (length new-header-args) 0) + (setq args (append (org-babel-parse-header-arguments + new-header-args) args))) + (setq ref new-refere))) + (when (string-match "^\\(.+\\):\\(.+\\)$" ref) + (setq split-file (match-string 1 ref)) + (setq split-ref (match-string 2 ref)) + (find-file split-file) (setq ref split-ref)) + (save-restriction + (widen) + (goto-char (point-min)) + (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref)) + (res-rx (org-babel-named-data-regexp-for-name ref))) + ;; goto ref in the current buffer + (or + ;; check for code blocks + (re-search-forward src-rx nil t) + ;; check for named data + (re-search-forward res-rx nil t) + ;; check for local or global headlines by id + (setq id (org-babel-ref-goto-headline-id ref)) + ;; check the Library of Babel + (setq lob-info (cdr (assoc (intern ref) + org-babel-library-of-babel))))) + (unless (or lob-info id) (goto-char (match-beginning 0))) + ;; ;; TODO: allow searching for names in other buffers + ;; (setq id-loc (org-id-find ref 'marker) + ;; buffer (marker-buffer id-loc) + ;; loc (marker-position id-loc)) + ;; (move-marker id-loc nil) + (error "Reference '%s' not found in this buffer" ref)) + (cond + (lob-info (setq type 'lob)) + (id (setq type 'id)) + ((and (looking-at org-babel-src-name-regexp) + (save-excursion + (forward-line 1) + (or (looking-at org-babel-src-block-regexp) + (looking-at org-babel-multi-line-header-regexp)))) + (setq type 'source-block)) + (t (while (not (setq type (org-babel-ref-at-ref-p))) + (forward-line 1) + (beginning-of-line) + (if (or (= (point) (point-min)) (= (point) (point-max))) + (error "Reference not found"))))) + (let ((params (append args '((:results . "silent"))))) + (setq result + (case type + (results-line (org-babel-read-result)) + (table (org-babel-read-table)) + (list (org-babel-read-list)) + (file (org-babel-read-link)) + (source-block (org-babel-execute-src-block + nil nil (if org-babel-update-intermediate + nil params))) + (lob (org-babel-execute-src-block + nil lob-info params)) + (id (org-babel-ref-headline-body))))) + (if (symbolp result) + (format "%S" result) + (if (and index (listp result)) + (org-babel-ref-index-list index result) + result))))))) (defun org-babel-ref-index-list (index lis) "Return the subset of LIS indexed by INDEX. @@ -218,28 +218,29 @@ returned, or an empty string or \"*\" both of which are interpreted to mean the entire range and as such are equivalent to \"0:-1\"." (if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index)) - (let ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)") - (length (length lis)) - (portion (match-string 1 index)) - (remainder (substring index (match-end 0)))) - (flet ((wrap (num) (if (< num 0) (+ length num) num)) - (open (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls))) - (open - (mapcar - (lambda (sub-lis) - (if (listp sub-lis) - (org-babel-ref-index-list remainder sub-lis) - sub-lis)) - (if (or (= 0 (length portion)) (string-match ind-re portion)) - (mapcar - (lambda (n) (nth n lis)) - (apply 'org-number-sequence - (if (and (> (length portion) 0) (match-string 2 portion)) - (list - (wrap (string-to-number (match-string 2 portion))) - (wrap (string-to-number (match-string 3 portion)))) - (list (wrap 0) (wrap -1))))) - (list (nth (wrap (string-to-number portion)) lis))))))) + (let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)") + (lgth (length lis)) + (portion (match-string 1 index)) + (remainder (substring index (match-end 0))) + (wrap (lambda (num) (if (< num 0) (+ lgth num) num))) + (open (lambda (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls)))) + (funcall + open + (mapcar + (lambda (sub-lis) + (if (listp sub-lis) + (org-babel-ref-index-list remainder sub-lis) + sub-lis)) + (if (or (= 0 (length portion)) (string-match ind-re portion)) + (mapcar + (lambda (n) (nth n lis)) + (apply 'org-number-sequence + (if (and (> (length portion) 0) (match-string 2 portion)) + (list + (funcall wrap (string-to-number (match-string 2 portion))) + (funcall wrap (string-to-number (match-string 3 portion)))) + (list (funcall wrap 0) (funcall wrap -1))))) + (list (nth (funcall wrap (string-to-number portion)) lis)))))) lis)) (defun org-babel-ref-split-args (arg-string) diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index 19cce58d820..54077d0d685 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -64,12 +64,12 @@ This function is called by `org-babel-execute-src-block'." body params (org-babel-variable-assignments:ruby params))) (result (if (member "xmp" result-params) (with-temp-buffer - (require 'rcodetools) - (insert full-body) - (xmp (cdr (assoc :xmp-option params))) - (buffer-string)) + (require 'rcodetools) + (insert full-body) + (xmp (cdr (assoc :xmp-option params))) + (buffer-string)) (org-babel-ruby-evaluate - session full-body result-type result-params)))) + session full-body result-type result-params)))) (org-babel-reassemble-table result (org-babel-pick-name (cdr (assoc :colname-names params)) @@ -102,7 +102,7 @@ This function is called by `org-babel-execute-src-block'." ;; helper functions (defun org-babel-variable-assignments:ruby (params) - "Return list of ruby statements assigning the block's variables" + "Return list of ruby statements assigning the block's variables." (mapcar (lambda (pair) (format "%s=%s" diff --git a/lisp/org/ob-scala.el b/lisp/org/ob-scala.el new file mode 100644 index 00000000000..b5eb18484b9 --- /dev/null +++ b/lisp/org/ob-scala.el @@ -0,0 +1,120 @@ +;;; ob-scala.el --- org-babel functions for Scala evaluation + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Andrzej Lichnerowicz +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; Currently only supports the external execution. No session support yet. + +;;; Requirements: +;; - Scala language :: http://www.scala-lang.org/ +;; - Scala major mode :: Can be installed from Scala sources +;; https://github.com/scala/scala-dist/blob/master/tool-support/src/emacs/scala-mode.el + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala")) +(defvar org-babel-default-header-args:scala '()) +(defvar org-babel-scala-command "scala" + "Name of the command to use for executing Scala code.") + + +(defun org-babel-execute:scala (body params) + "Execute a block of Scala code with org-babel. This function is +called by `org-babel-execute-src-block'" + (message "executing Scala source code block") + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-scala-initiate-session (nth 0 processed-params))) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params)) + (result (org-babel-scala-evaluate + session full-body result-type result-params))) + + (org-babel-reassemble-table + result + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + + +(defun org-babel-scala-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + + +(defvar org-babel-scala-wrapper-method + "( +%s +) asString print +") + + +(defun org-babel-scala-evaluate + (session body &optional result-type result-params) + "Evaluate BODY in external Scala process. +If RESULT-TYPE equals 'output then return standard output as a string. +If RESULT-TYPE equals 'value then return the value of the last statement +in BODY as elisp." + (when session (error "Sessions are not (yet) supported for Scala")) + (case result-type + (output + (let ((src-file (org-babel-temp-file "scala-"))) + (progn (with-temp-file src-file (insert body)) + (org-babel-eval + (concat org-babel-scala-command " " src-file) "")))) + (value + (let* ((src-file (org-babel-temp-file "scala-")) + (wrapper (format org-babel-scala-wrapper-method body))) + (with-temp-file src-file (insert wrapper)) + ((lambda (raw) + (if (member "code" result-params) + raw + (org-babel-scala-table-or-string raw))) + (org-babel-eval + (concat org-babel-scala-command " " src-file) "")))))) + + +(defun org-babel-prep-session:scala (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "Sessions are not (yet) supported for Scala")) + +(defun org-babel-scala-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session. Sessions are not +supported in Scala." + nil) + +(provide 'ob-scala) + + + +;;; ob-scala.el ends here diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index 37cdb28690a..c6288924235 100644 --- a/lisp/org/ob-screen.el +++ b/lisp/org/ob-screen.el @@ -23,7 +23,7 @@ ;;; Commentary: -;; Org-Babel support for interactive terminals. Mostly shell scripts. +;; Org-Babel support for interactive terminals. Mostly shell scripts. ;; Heavily inspired by 'eev' from Eduardo Ochs ;; ;; Adding :cmd and :terminal as header arguments @@ -64,8 +64,8 @@ In case you want to use a different screen than one selected by your $PATH") (process-name (concat "org-babel: terminal (" session ")"))) (apply 'start-process process-name "*Messages*" terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location - "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) - ,cmd)) + "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) + ,cmd)) ;; XXX: Is there a better way than the following? (while (not (org-babel-screen-session-socketname session)) ;; wait until screen session is available before returning @@ -81,8 +81,8 @@ In case you want to use a different screen than one selected by your $PATH") (apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*" org-babel-screen-location `("-S" ,socket "-X" "eval" "msgwait 0" - ,(concat "readreg z " tmpfile) - "paste z")))))) + ,(concat "readreg z " tmpfile) + "paste z")))))) (defun org-babel-screen-session-socketname (session) "Check if SESSION exists by parsing output of \"screen -ls\"." @@ -137,7 +137,7 @@ The terminal should shortly flicker." (message (concat "org-babel-screen: Setup " (if (string-match random-string tmp-string) "WORKS." - "DOESN'T work."))))) + "DOESN'T work."))))) (provide 'ob-screen) diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el index 6f4cb4ffdfc..1cb607f148d 100644 --- a/lisp/org/ob-sh.el +++ b/lisp/org/ob-sh.el @@ -56,14 +56,13 @@ This will be passed to `shell-command-on-region'") This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-sh-initiate-session (cdr (assoc :session params)))) - (result-params (cdr (assoc :result-params params))) (stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string - (org-babel-ref-resolve stdin)))) + (org-babel-ref-resolve stdin)))) (cdr (assoc :stdin params)))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:sh params)))) (org-babel-reassemble-table - (org-babel-sh-evaluate session full-body result-params stdin) + (org-babel-sh-evaluate session full-body params stdin) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name @@ -91,7 +90,7 @@ This function is called by `org-babel-execute-src-block'." ;; helper functions (defun org-babel-variable-assignments:sh (params) - "Return list of shell statements assigning the block's variables" + "Return list of shell statements assigning the block's variables." (let ((sep (cdr (assoc :separator params)))) (mapcar (lambda (pair) @@ -108,13 +107,13 @@ var of the same value." (defun org-babel-sh-var-to-string (var &optional sep) "Convert an elisp value to a string." - (flet ((echo-var (v) (if (stringp v) v (format "%S" v)))) + (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) (cond ((and (listp var) (listp (car var))) - (orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var))) + (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) ((listp var) - (mapconcat #'echo-var var "\n")) - (t (echo-var var))))) + (mapconcat echo-var var "\n")) + (t (funcall echo-var var))))) (defun org-babel-sh-table-or-results (results) "Convert RESULTS to an appropriate elisp value. @@ -134,29 +133,38 @@ Emacs-lisp table, otherwise return the results as a string." (defvar org-babel-sh-eoe-output "org_babel_sh_eoe" "String to indicate that evaluation has completed.") -(defun org-babel-sh-evaluate (session body &optional result-params stdin) +(defun org-babel-sh-evaluate (session body &optional params stdin) "Pass BODY to the Shell process in BUFFER. If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY." ((lambda (results) (when results - (if (or (member "scalar" result-params) - (member "verbatim" result-params) - (member "output" result-params)) - results - (let ((tmp-file (org-babel-temp-file "sh-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))))) + (let ((result-params (cdr (assoc :result-params params)))) + (if (or (member "scalar" result-params) + (member "verbatim" result-params) + (member "output" result-params)) + results + (let ((tmp-file (org-babel-temp-file "sh-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file)))))) (cond (stdin ; external shell script w/STDIN (let ((script-file (org-babel-temp-file "sh-script-")) - (stdin-file (org-babel-temp-file "sh-stdin-"))) - (with-temp-file script-file (insert body)) + (stdin-file (org-babel-temp-file "sh-stdin-")) + (shebang (cdr (assoc :shebang params))) + (padline (not (string= "no" (cdr (assoc :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) (with-temp-file stdin-file (insert stdin)) (with-temp-buffer (call-process-shell-command - (format "%s %s" org-babel-sh-command script-file) + (if shebang + script-file + (format "%s %s" org-babel-sh-command script-file)) stdin-file (current-buffer)) (buffer-string)))) @@ -182,7 +190,18 @@ return the value of the last statement in BODY." (list org-babel-sh-eoe-indicator)))) 2)) "\n")) ('otherwise ; external shell script - (org-babel-eval org-babel-sh-command (org-babel-trim body)))))) + (if (and (cdr (assoc :shebang params)) + (> (length (cdr (assoc :shebang params))) 0)) + (let ((script-file (org-babel-temp-file "sh-script-")) + (shebang (cdr (assoc :shebang params))) + (padline (not (string= "no" (cdr (assoc :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) + (org-babel-eval script-file "")) + (org-babel-eval org-babel-sh-command (org-babel-trim body))))))) (defun org-babel-sh-strip-weird-long-prompt (string) "Remove prompt cruft from a string of shell output." diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 68bd95af9f9..ad7b1e29a93 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -51,8 +51,9 @@ (defvar org-babel-default-header-args:sql '()) -(defvar org-babel-header-arg-names:sql - '(engine out-file)) +(defvar org-babel-header-args:sql + '((engine . :any) + (out-file . :any))) (defun org-babel-expand-body:sql (body params) "Expand BODY according to the values of PARAMS." @@ -70,6 +71,15 @@ This function is called by `org-babel-execute-src-block'." (org-babel-temp-file "sql-out-"))) (header-delim "") (command (case (intern engine) + ('dbi (format "dbish --batch '%s' < %s | sed '%s' > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + "/^+/d;s/^\|//;$d" + (org-babel-process-file-name out-file))) + ('monetdb (format "mclient -f tab %s < %s > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) ('msosql (format "osql %s -s \"\t\" -i %s -o %s" (or cmdline "") (org-babel-process-file-name in-file) @@ -80,12 +90,16 @@ This function is called by `org-babel-execute-src-block'." (org-babel-process-file-name out-file))) ('postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) - (t (error "no support for the %s sql engine" engine))))) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) + (t (error "No support for the %s SQL engine" engine))))) (with-temp-file in-file - (insert (org-babel-expand-body:sql body params))) + (insert + (case (intern engine) + ('dbi "/format partbox\n") + (t "")) + (org-babel-expand-body:sql body params))) (message command) (shell-command command) (if (or (member "scalar" result-params) @@ -134,8 +148,8 @@ This function is called by `org-babel-execute-src-block'." (with-temp-file data-file (insert (orgtbl-to-csv val '(:fmt (lambda (el) (if (stringp el) - el - (format "%S" el))))))) + el + (format "%S" el))))))) data-file) (org-babel-temp-file "sql-data-")) (if (stringp val) val (format "%S" val)))) @@ -146,7 +160,7 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-prep-session:sql (session params) "Raise an error because Sql sessions aren't implemented." - (error "sql sessions not yet implemented")) + (error "SQL sessions not yet implemented")) (provide 'ob-sql) diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el index 84d6bb26bae..24a7dd58c2c 100644 --- a/lisp/org/ob-sqlite.el +++ b/lisp/org/ob-sqlite.el @@ -37,8 +37,18 @@ (defvar org-babel-default-header-args:sqlite '()) -(defvar org-babel-header-arg-names:sqlite - '(db header echo bail csv column html line list separator nullvalue) +(defvar org-babel-header-args:sqlite + '((db . :any) + (header . :any) + (echo . :any) + (bail . :any) + (csv . :any) + (column . :any) + (html . :any) + (line . :any) + (list . :any) + (separator . :any) + (nullvalue . :any)) "Sqlite specific header args.") (defun org-babel-expand-body:sqlite (body params) @@ -61,7 +71,7 @@ This function is called by `org-babel-execute-src-block'." (list :header :echo :bail :column :csv :html :line :list)))) exit-code) - (unless db (error "ob-sqlite: can't evaluate without a database.")) + (unless db (error "ob-sqlite: can't evaluate without a database")) (with-temp-buffer (insert (org-babel-eval @@ -118,8 +128,8 @@ This function is called by `org-babel-execute-src-block'." (with-temp-file data-file (insert (orgtbl-to-csv val '(:fmt (lambda (el) (if (stringp el) - el - (format "%S" el))))))) + el + (format "%S" el))))))) data-file) (org-babel-temp-file "sqlite-data-")) (if (stringp val) val (format "%S" val)))) @@ -145,9 +155,9 @@ This function is called by `org-babel-execute-src-block'." table)) (defun org-babel-prep-session:sqlite (session params) - "Raise an error because support for sqlite sessions isn't implemented. + "Raise an error because support for SQLite sessions isn't implemented. Prepare SESSION according to the header arguments specified in PARAMS." - (error "sqlite sessions not yet implemented")) + (error "SQLite sessions not yet implemented")) (provide 'ob-sqlite) diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el index f636415d987..242ddf09020 100644 --- a/lisp/org/ob-table.el +++ b/lisp/org/ob-table.el @@ -99,7 +99,7 @@ as shown in the example below. (prog1 nil (setq quote t)) (prog1 (if quote (format "\"%s\"" el) - (org-babel-clean-text-properties el)) + (org-no-properties el)) (setq quote nil)))) (cdr var))))) variables))) diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index db4721b70bc..7077a1571eb 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -122,13 +122,15 @@ represented in the file." `progn', then kill the FILE buffer returning the result of evaluating BODY." (declare (indent 1)) - (let ((temp-result (make-symbol "temp-result")) + (let ((temp-path (make-symbol "temp-path")) + (temp-result (make-symbol "temp-result")) (temp-file (make-symbol "temp-file")) (visited-p (make-symbol "visited-p"))) - `(let (,temp-result ,temp-file - (,visited-p (get-file-buffer ,file))) - (org-babel-find-file-noselect-refresh ,file) - (setf ,temp-file (get-file-buffer ,file)) + `(let* ((,temp-path ,file) + (,visited-p (get-file-buffer ,temp-path)) + ,temp-result ,temp-file) + (org-babel-find-file-noselect-refresh ,temp-path) + (setf ,temp-file (get-file-buffer ,temp-path)) (with-current-buffer ,temp-file (setf ,temp-result (progn ,@body))) (unless ,visited-p (kill-buffer ,temp-file)) @@ -142,19 +144,19 @@ This function exports the source code using `org-babel-tangle' and then loads the resulting file using `load-file'." (interactive "fFile to load: ") - (flet ((age (file) - (float-time - (time-subtract (current-time) - (nth 5 (or (file-attributes (file-truename file)) - (file-attributes file))))))) - (let* ((base-name (file-name-sans-extension file)) - (exported-file (concat base-name ".el"))) - ;; tangle if the org-mode file is newer than the elisp file - (unless (and (file-exists-p exported-file) - (> (age file) (age exported-file))) - (org-babel-tangle-file file exported-file "emacs-lisp")) - (load-file exported-file) - (message "loaded %s" exported-file)))) + (let* ((age (lambda (file) + (float-time + (time-subtract (current-time) + (nth 5 (or (file-attributes (file-truename file)) + (file-attributes file))))))) + (base-name (file-name-sans-extension file)) + (exported-file (concat base-name ".el"))) + ;; tangle if the org-mode file is newer than the elisp file + (unless (and (file-exists-p exported-file) + (> (funcall age file) (funcall age exported-file))) + (org-babel-tangle-file file exported-file "emacs-lisp")) + (load-file exported-file) + (message "Loaded %s" exported-file))) ;;;###autoload (defun org-babel-tangle-file (file &optional target-file lang) @@ -189,96 +191,95 @@ exported source code blocks by language." (run-hooks 'org-babel-pre-tangle-hook) ;; possibly restrict the buffer to the current code block (save-restriction - (when only-this-block - (unless (org-babel-where-is-src-block-head) - (error "Point is not currently inside of a code block")) - (save-match-data - (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info)))) - target-file) - (setq target-file - (read-from-minibuffer "Tangle to: " (buffer-file-name))))) - (narrow-to-region (match-beginning 0) (match-end 0))) - (save-excursion - (let ((block-counter 0) - (org-babel-default-header-args - (if target-file - (org-babel-merge-params org-babel-default-header-args - (list (cons :tangle target-file))) - org-babel-default-header-args)) - path-collector) - (mapc ;; map over all languages - (lambda (by-lang) - (let* ((lang (car by-lang)) - (specs (cdr by-lang)) - (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang)) - (lang-f (intern - (concat - (or (and (cdr (assoc lang org-src-lang-modes)) - (symbol-name - (cdr (assoc lang org-src-lang-modes)))) - lang) - "-mode"))) - she-banged) - (mapc - (lambda (spec) - (flet ((get-spec (name) - (cdr (assoc name (nth 4 spec))))) - (let* ((tangle (get-spec :tangle)) - (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) - (get-spec :shebang))) - (base-name (cond - ((string= "yes" tangle) - (file-name-sans-extension - (buffer-file-name))) - ((string= "no" tangle) nil) - ((> (length tangle) 0) tangle))) - (file-name (when base-name - ;; decide if we want to add ext to base-name - (if (and ext (string= "yes" tangle)) - (concat base-name "." ext) base-name)))) - (when file-name - ;; possibly create the parent directories for file - (when ((lambda (m) (and m (not (string= m "no")))) - (get-spec :mkdirp)) - (make-directory (file-name-directory file-name) 'parents)) - ;; delete any old versions of file - (when (and (file-exists-p file-name) - (not (member file-name path-collector))) - (delete-file file-name)) - ;; drop source-block to file - (with-temp-buffer - (when (fboundp lang-f) (ignore-errors (funcall lang-f))) - (when (and she-bang (not (member file-name she-banged))) - (insert (concat she-bang "\n")) - (setq she-banged (cons file-name she-banged))) - (org-babel-spec-to-string spec) - ;; We avoid append-to-file as it does not work with tramp. - (let ((content (buffer-string))) - (with-temp-buffer - (if (file-exists-p file-name) - (insert-file-contents file-name)) - (goto-char (point-max)) - (insert content) - (write-region nil nil file-name)))) - ;; if files contain she-bangs, then make the executable - (when she-bang (set-file-modes file-name #o755)) - ;; update counter - (setq block-counter (+ 1 block-counter)) - (add-to-list 'path-collector file-name))))) - specs))) - (org-babel-tangle-collect-blocks lang)) - (message "tangled %d code block%s from %s" block-counter - (if (= block-counter 1) "" "s") - (file-name-nondirectory - (buffer-file-name (or (buffer-base-buffer) (current-buffer))))) - ;; run `org-babel-post-tangle-hook' in all tangled files - (when org-babel-post-tangle-hook - (mapc - (lambda (file) - (org-babel-with-temp-filebuffer file - (run-hooks 'org-babel-post-tangle-hook))) - path-collector)) - path-collector)))) + (when only-this-block + (unless (org-babel-where-is-src-block-head) + (error "Point is not currently inside of a code block")) + (save-match-data + (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info)))) + target-file) + (setq target-file + (read-from-minibuffer "Tangle to: " (buffer-file-name))))) + (narrow-to-region (match-beginning 0) (match-end 0))) + (save-excursion + (let ((block-counter 0) + (org-babel-default-header-args + (if target-file + (org-babel-merge-params org-babel-default-header-args + (list (cons :tangle target-file))) + org-babel-default-header-args)) + path-collector) + (mapc ;; map over all languages + (lambda (by-lang) + (let* ((lang (car by-lang)) + (specs (cdr by-lang)) + (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang)) + (lang-f (intern + (concat + (or (and (cdr (assoc lang org-src-lang-modes)) + (symbol-name + (cdr (assoc lang org-src-lang-modes)))) + lang) + "-mode"))) + she-banged) + (mapc + (lambda (spec) + (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec)))))) + (let* ((tangle (funcall get-spec :tangle)) + (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) + (funcall get-spec :shebang))) + (base-name (cond + ((string= "yes" tangle) + (file-name-sans-extension + (buffer-file-name))) + ((string= "no" tangle) nil) + ((> (length tangle) 0) tangle))) + (file-name (when base-name + ;; decide if we want to add ext to base-name + (if (and ext (string= "yes" tangle)) + (concat base-name "." ext) base-name)))) + (when file-name + ;; possibly create the parent directories for file + (when ((lambda (m) (and m (not (string= m "no")))) + (funcall get-spec :mkdirp)) + (make-directory (file-name-directory file-name) 'parents)) + ;; delete any old versions of file + (when (and (file-exists-p file-name) + (not (member file-name path-collector))) + (delete-file file-name)) + ;; drop source-block to file + (with-temp-buffer + (when (fboundp lang-f) (ignore-errors (funcall lang-f))) + (when (and she-bang (not (member file-name she-banged))) + (insert (concat she-bang "\n")) + (setq she-banged (cons file-name she-banged))) + (org-babel-spec-to-string spec) + ;; We avoid append-to-file as it does not work with tramp. + (let ((content (buffer-string))) + (with-temp-buffer + (if (file-exists-p file-name) + (insert-file-contents file-name)) + (goto-char (point-max)) + (insert content) + (write-region nil nil file-name)))) + ;; if files contain she-bangs, then make the executable + (when she-bang (set-file-modes file-name #o755)) + ;; update counter + (setq block-counter (+ 1 block-counter)) + (add-to-list 'path-collector file-name))))) + specs))) + (org-babel-tangle-collect-blocks lang)) + (message "Tangled %d code block%s from %s" block-counter + (if (= block-counter 1) "" "s") + (file-name-nondirectory + (buffer-file-name (or (buffer-base-buffer) (current-buffer))))) + ;; run `org-babel-post-tangle-hook' in all tangled files + (when org-babel-post-tangle-hook + (mapc + (lambda (file) + (org-babel-with-temp-filebuffer file + (run-hooks 'org-babel-post-tangle-hook))) + path-collector)) + path-collector)))) (defun org-babel-tangle-clean () "Remove comments inserted by `org-babel-tangle'. @@ -290,12 +291,59 @@ references." (interactive) (goto-char (point-min)) (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t) - (re-search-forward "<<[^[:space:]]*>>" nil t)) + (re-search-forward (org-babel-noweb-wrap) nil t)) (delete-region (save-excursion (beginning-of-line 1) (point)) (save-excursion (end-of-line 1) (forward-char 1) (point))))) (defvar org-stored-links) (defvar org-bracket-link-regexp) +(defun org-babel-spec-to-string (spec) + "Insert SPEC into the current file. +Insert the source-code specified by SPEC into the current +source code file. This function uses `comment-region' which +assumes that the appropriate major-mode is set. SPEC has the +form + + (start-line file link source-name params body comment)" + (let* ((start-line (nth 0 spec)) + (file (nth 1 spec)) + (link (nth 2 spec)) + (source-name (nth 3 spec)) + (body (nth 5 spec)) + (comment (nth 6 spec)) + (comments (cdr (assoc :comments (nth 4 spec)))) + (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec)))))) + (link-p (or (string= comments "both") (string= comments "link") + (string= comments "yes") (string= comments "noweb"))) + (link-data (mapcar (lambda (el) + (cons (symbol-name el) + ((lambda (le) + (if (stringp le) le (format "%S" le))) + (eval el)))) + '(start-line file link source-name))) + (insert-comment (lambda (text) + (when (and comments (not (string= comments "no")) + (> (length text) 0)) + (when padline (insert "\n")) + (comment-region (point) (progn (insert text) (point))) + (end-of-line nil) (insert "\n"))))) + (when comment (funcall insert-comment comment)) + (when link-p + (funcall + insert-comment + (org-fill-template org-babel-tangle-comment-format-beg link-data))) + (when padline (insert "\n")) + (insert + (format + "%s\n" + (replace-regexp-in-string + "^," "" + (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) + (when link-p + (funcall + insert-comment + (org-fill-template org-babel-tangle-comment-format-end link-data))))) + (defun org-babel-tangle-collect-blocks (&optional language) "Collect source blocks in the current Org-mode file. Return an association list of source-code block specifications of @@ -312,7 +360,8 @@ code blocks by language." (setq block-counter (+ 1 block-counter)))) (replace-regexp-in-string "[ \t]" "-" (condition-case nil - (nth 4 (org-heading-components)) + (or (nth 4 (org-heading-components)) + "(dummy for heading without text)") (error (buffer-file-name))))) (let* ((start-line (save-restriction (widen) (+ 1 (line-number-at-pos (point))))) @@ -326,7 +375,7 @@ code blocks by language." (link ((lambda (link) (and (string-match org-bracket-link-regexp link) (match-string 1 link))) - (org-babel-clean-text-properties + (org-no-properties (org-store-link nil)))) (source-name (intern (or (nth 4 info) @@ -351,11 +400,7 @@ code blocks by language." body params (and (fboundp assignments-cmd) (funcall assignments-cmd params)))))) - (if (and (cdr (assoc :noweb params)) ;; expand noweb refs - (let ((nowebs (split-string - (cdr (assoc :noweb params))))) - (or (member "yes" nowebs) - (member "tangle" nowebs)))) + (if (org-babel-noweb-p params :tangle) (org-babel-expand-noweb-references info) (nth 1 info))))) (comment @@ -392,57 +437,12 @@ code blocks by language." blocks)) blocks)) -(defun org-babel-spec-to-string (spec) - "Insert SPEC into the current file. -Insert the source-code specified by SPEC into the current -source code file. This function uses `comment-region' which -assumes that the appropriate major-mode is set. SPEC has the -form - - (start-line file link source-name params body comment)" - (let* ((start-line (nth 0 spec)) - (file (nth 1 spec)) - (link (nth 2 spec)) - (source-name (nth 3 spec)) - (body (nth 5 spec)) - (comment (nth 6 spec)) - (comments (cdr (assoc :comments (nth 4 spec)))) - (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec)))))) - (link-p (or (string= comments "both") (string= comments "link") - (string= comments "yes") (string= comments "noweb"))) - (link-data (mapcar (lambda (el) - (cons (symbol-name el) - ((lambda (le) - (if (stringp le) le (format "%S" le))) - (eval el)))) - '(start-line file link source-name)))) - (flet ((insert-comment (text) - (when (and comments (not (string= comments "no")) - (> (length text) 0)) - (when padline (insert "\n")) - (comment-region (point) (progn (insert text) (point))) - (end-of-line nil) (insert "\n")))) - (when comment (insert-comment comment)) - (when link-p - (insert-comment - (org-fill-template org-babel-tangle-comment-format-beg link-data))) - (when padline (insert "\n")) - (insert - (format - "%s\n" - (replace-regexp-in-string - "^," "" - (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) - (when link-p - (insert-comment - (org-fill-template org-babel-tangle-comment-format-end link-data)))))) - (defun org-babel-tangle-comment-links ( &optional info) "Return a list of begin and end link comments for the code block at point." (let* ((start-line (org-babel-where-is-src-block-head)) (file (buffer-file-name)) (link (org-link-escape (progn (call-interactively 'org-store-link) - (org-babel-clean-text-properties + (org-no-properties (car (pop org-stored-links)))))) (source-name (nth 4 (or info (org-babel-get-src-block-info 'light)))) (link-data (mapcar (lambda (el) @@ -475,7 +475,7 @@ which enable the original code blocks to be found." (org-babel-update-block-body new-body))) (setq counter (+ 1 counter))) (goto-char end)) - (prog1 counter (message "detangled %d code blocks" counter))))) + (prog1 counter (message "Detangled %d code blocks" counter))))) (defun org-babel-tangle-jump-to-org () "Jump from a tangled code file to the related Org-mode file." @@ -498,7 +498,7 @@ which enable the original code blocks to be found." " ends here") nil t) (setq end (point-at-bol)))))))) (unless (and start (< start mid) (< mid end)) - (error "not in tangled code")) + (error "Not in tangled code")) (setq body (org-babel-trim (buffer-substring start end)))) (when (string-match "::" path) (setq path (substring path 0 (match-beginning 0)))) diff --git a/lisp/org/ob.el b/lisp/org/ob.el index 05122487588..f15457d68e2 100644 --- a/lisp/org/ob.el +++ b/lisp/org/ob.el @@ -27,12 +27,19 @@ (require 'cl)) (require 'ob-eval) (require 'org-macs) +(require 'org-compat) +(defconst org-babel-exeext + (if (memq system-type '(windows-nt cygwin)) + ".exe" + nil)) (defvar org-babel-call-process-region-original) (defvar org-src-lang-modes) (defvar org-babel-library-of-babel) (declare-function show-all "outline" ()) (declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) +(declare-function org-mark-ring-push "org" (&optional pos buffer)) +(declare-function org-strip-protective-commas "org" (beg end)) (declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag)) (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) @@ -44,7 +51,7 @@ (&optional context code edit-buffer-name quietp)) (declare-function org-edit-src-exit "org-src" (&optional context)) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) -(declare-function org-save-outline-visibility "org" (use-markers &rest body)) +(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body)) (declare-function org-outline-overlay-data "org" (&optional use-markers)) (declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-narrow-to-subtree "org" ()) @@ -57,6 +64,7 @@ (declare-function org-cycle "org" (&optional arg)) (declare-function org-uniquify "org" (list)) (declare-function org-current-level "org" ()) +(declare-function org-strip-protective-commas "org" (beg end)) (declare-function org-table-import "org-table" (file arg)) (declare-function org-add-hook "org-compat" (hook function &optional append local)) @@ -80,6 +88,9 @@ (declare-function org-list-prevs-alist "org-list" (struct)) (declare-function org-list-get-list-end "org-list" (item struct prevs)) (declare-function org-strip-protective-commas "org" (beg end)) +(declare-function org-remove-if "org" (predicate seq)) +(declare-function org-completing-read "org" (&rest args)) +(declare-function org-add-protective-commas "org-src" (beg end)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -104,9 +115,9 @@ remove code block execution from C-c C-c as further protection against accidental code block evaluation. The `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to remove code block execution from the C-c C-c keybinding." - :group 'org-babel - :version "24.1" - :type '(choice boolean function)) + :group 'org-babel + :version "24.1" + :type '(choice boolean function)) ;; don't allow this variable to be changed through file settings (put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) @@ -123,6 +134,23 @@ be used." :group 'org-babel :type 'string) +(defcustom org-babel-noweb-wrap-start "<<" + "String used to begin a noweb reference in a code block. +See also `org-babel-noweb-wrap-end'." + :group 'org-babel + :type 'string) + +(defcustom org-babel-noweb-wrap-end ">>" + "String used to end a noweb reference in a code block. +See also `org-babel-noweb-wrap-start'." + :group 'org-babel + :type 'string) + +(defun org-babel-noweb-wrap (&optional regexp) + (concat org-babel-noweb-wrap-start + (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") + org-babel-noweb-wrap-end)) + (defvar org-babel-src-name-regexp "^[ \t]*#\\+name:[ \t]*" "Regular expression used to match a source name line.") @@ -227,7 +255,7 @@ Returns a list (nth 2 info) (org-babel-parse-header-arguments (match-string 1))))) (when (looking-at org-babel-src-name-w-name-regexp) - (setq name (org-babel-clean-text-properties (match-string 3))) + (setq name (org-no-properties (match-string 3))) (when (and (match-string 5) (> (length (match-string 5)) 0)) (setf (nth 2 info) ;; merge functional-syntax vars and header-args (org-babel-merge-params @@ -263,15 +291,18 @@ of potentially harmful code." (let* ((eval (or (cdr (assoc :eval (nth 2 info))) (when (assoc :noeval (nth 2 info)) "no"))) (query (cond ((equal eval "query") t) - ((and org-current-export-file + ((and (boundp 'org-current-export-file) + org-current-export-file (equal eval "query-export")) t) ((functionp org-confirm-babel-evaluate) (funcall org-confirm-babel-evaluate (nth 0 info) (nth 1 info))) (t org-confirm-babel-evaluate)))) (if (or (equal eval "never") (equal eval "no") - (and org-current-export-file (or (equal eval "no-export") - (equal eval "never-export"))) + (and (boundp 'org-current-export-file) + org-current-export-file + (or (equal eval "no-export") + (equal eval "never-export"))) (and query (not (yes-or-no-p (format "Evaluate this%scode block%son your system? " @@ -314,27 +345,27 @@ then run `org-babel-execute-src-block'." This includes header arguments, language and name, and is largely a window into the `org-babel-get-src-block-info' function." (interactive) - (let ((info (org-babel-get-src-block-info 'light))) - (flet ((full (it) (> (length it) 0)) - (printf (fmt &rest args) (princ (apply #'format fmt args)))) - (when info - (with-help-window (help-buffer) - (let ((name (nth 4 info)) - (lang (nth 0 info)) - (switches (nth 3 info)) - (header-args (nth 2 info))) - (when name (printf "Name: %s\n" name)) - (when lang (printf "Lang: %s\n" lang)) - (when (full switches) (printf "Switches: %s\n" switches)) - (printf "Header Arguments:\n") - (dolist (pair (sort header-args - (lambda (a b) (string< (symbol-name (car a)) - (symbol-name (car b)))))) - (when (full (cdr pair)) - (printf "\t%S%s\t%s\n" - (car pair) - (if (> (length (format "%S" (car pair))) 7) "" "\t") - (cdr pair)))))))))) + (let ((info (org-babel-get-src-block-info 'light)) + (full (lambda (it) (> (length it) 0))) + (printf (lambda (fmt &rest args) (princ (apply #'format fmt args))))) + (when info + (with-help-window (help-buffer) + (let ((name (nth 4 info)) + (lang (nth 0 info)) + (switches (nth 3 info)) + (header-args (nth 2 info))) + (when name (funcall printf "Name: %s\n" name)) + (when lang (funcall printf "Lang: %s\n" lang)) + (when (funcall full switches) (funcall printf "Switches: %s\n" switches)) + (funcall printf "Header Arguments:\n") + (dolist (pair (sort header-args + (lambda (a b) (string< (symbol-name (car a)) + (symbol-name (car b)))))) + (when (funcall full (cdr pair)) + (funcall printf "\t%S%s\t%s\n" + (car pair) + (if (> (length (format "%S" (car pair))) 7) "" "\t") + (cdr pair))))))))) ;;;###autoload (defun org-babel-expand-src-block-maybe () @@ -380,24 +411,26 @@ then run `org-babel-pop-to-session'." (eval . ((never query))) (exports . ((code results both none))) (file . :any) + (file-desc . :any) (hlines . ((no yes))) (mkdirp . ((yes no))) (no-expand) (noeval) - (noweb . ((yes no tangle))) + (noweb . ((yes no tangle no-export strip-export))) (noweb-ref . :any) (noweb-sep . :any) (padline . ((yes no))) (results . ((file list vector table scalar verbatim) - (raw org html latex code pp wrap) - (replace silent append prepend) - (output value))) + (raw html latex org code pp drawer) + (replace silent append prepend) + (output value))) (rownames . ((no yes))) (sep . :any) (session . :any) (shebang . :any) (tangle . ((tangle yes no :any))) - (var . :any))) + (var . :any) + (wrap . :any))) (defconst org-babel-header-arg-names (mapcar #'car org-babel-common-header-args-w-values) @@ -415,7 +448,7 @@ specific header arguments as well.") '((:session . "none") (:results . "replace") (:exports . "results")) "Default arguments to use when evaluating an inline source block.") -(defvar org-babel-data-names '("TBLNAME" "RESULTS" "NAME")) +(defvar org-babel-data-names '("tblname" "results" "name")) (defvar org-babel-result-regexp (concat "^[ \t]*#\\+" @@ -433,8 +466,8 @@ be saved in the second match data.") "The minimum number of lines for block output. If number of lines of output is equal to or exceeds this value, the output is placed in a #+begin_example...#+end_example -block. Otherwise the output is marked as literal by inserting -colons at the starts of the lines. This variable only takes +block. Otherwise the output is marked as literal by inserting +colons at the starts of the lines. This variable only takes effect if the :results output option is in effect.") (defvar org-babel-noweb-error-langs nil @@ -452,7 +485,7 @@ can not be resolved.") (defun org-babel-named-src-block-regexp-for-name (name) "This generates a regexp used to match a src block named NAME." (concat org-babel-src-name-regexp (regexp-quote name) - "\\([ \t]\\|$\\|(\\)" ".*[\r\n]" + "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*" (substring org-babel-src-block-regexp 1))) (defun org-babel-named-data-regexp-for-name (name) @@ -495,15 +528,13 @@ block." (new-hash (when cache? (org-babel-sha1-hash info))) (old-hash (when cache? (org-babel-current-result-hash))) (body (setf (nth 1 info) - (let ((noweb (cdr (assoc :noweb params)))) - (if (and noweb - (or (string= "yes" noweb) - (string= "tangle" noweb))) - (org-babel-expand-noweb-references info) - (nth 1 info))))) + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) + (nth 1 info)))) (dir (cdr (assoc :dir params))) (default-directory - (or (and dir (file-name-as-directory dir)) default-directory)) + (or (and dir (file-name-as-directory (expand-file-name dir))) + default-directory)) (org-babel-call-process-region-original (if (boundp 'org-babel-call-process-region-original) org-babel-call-process-region-original @@ -511,15 +542,16 @@ block." (indent (car (last info))) result cmd) (unwind-protect - (flet ((call-process-region (&rest args) - (apply 'org-babel-tramp-handle-call-process-region args))) - (flet ((lang-check (f) - (let ((f (intern (concat "org-babel-execute:" f)))) - (when (fboundp f) f)))) + (let ((call-process-region + (lambda (&rest args) + (apply 'org-babel-tramp-handle-call-process-region args)))) + (let ((lang-check (lambda (f) + (let ((f (intern (concat "org-babel-execute:" f)))) + (when (fboundp f) f))))) (setq cmd - (or (lang-check lang) - (lang-check (symbol-name - (cdr (assoc lang org-src-lang-modes)))) + (or (funcall lang-check lang) + (funcall lang-check (symbol-name + (cdr (assoc lang org-src-lang-modes)))) (error "No org-babel-execute function for %s!" lang)))) (if (and (not arg) new-hash (equal new-hash old-hash)) (save-excursion ;; return cached result @@ -572,10 +604,9 @@ arguments and pop open the results in a preview buffer." (params (setf (nth 2 info) (sort (org-babel-merge-params (nth 2 info) params) (lambda (el1 el2) (string< (symbol-name (car el1)) - (symbol-name (car el2))))))) + (symbol-name (car el2))))))) (body (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) + (if (org-babel-noweb-p params :eval) (org-babel-expand-noweb-references info) (nth 1 info)))) (expand-cmd (intern (concat "org-babel-expand-body:" lang))) (assignments-cmd (intern (concat "org-babel-variable-assignments:" @@ -592,17 +623,32 @@ arguments and pop open the results in a preview buffer." "Return the edit (levenshtein) distance between strings S1 S2." (let* ((l1 (length s1)) (l2 (length s2)) - (dist (map 'vector (lambda (_) (make-vector (1+ l2) nil)) - (number-sequence 1 (1+ l1))))) - (flet ((in (i j) (aref (aref dist i) j)) - (mmin (&rest lst) (apply #'min (remove nil lst)))) - (setf (aref (aref dist 0) 0) 0) - (dolist (i (number-sequence 1 l1)) - (dolist (j (number-sequence 1 l2)) - (setf (aref (aref dist i) j) - (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1) - (mmin (in (1- i) j) (in i (1- j)) (in (1- i) (1- j))))))) - (in l1 l2)))) + (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil)) + (number-sequence 1 (1+ l1))))) + (in (lambda (i j) (aref (aref dist i) j))) + (mmin (lambda (&rest lst) (apply #'min (remove nil lst))))) + (setf (aref (aref dist 0) 0) 0) + (dolist (i (number-sequence 1 l1)) + (dolist (j (number-sequence 1 l2)) + (setf (aref (aref dist i) j) + (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1) + (funcall mmin (funcall in (1- i) j) + (funcall in i (1- j)) + (funcall in (1- i) (1- j))))))) + (funcall in l1 l2))) + +(defun org-babel-combine-header-arg-lists (original &rest others) + "Combine a number of lists of header argument names and arguments." + (let ((results (copy-sequence original))) + (dolist (new-list others) + (dolist (arg-pair new-list) + (let ((header (car arg-pair)) + (args (cdr arg-pair))) + (setq results + (cons arg-pair (org-remove-if + (lambda (pair) (equal header (car pair))) + results)))))) + results)) ;;;###autoload (defun org-babel-check-src-block () @@ -616,13 +662,13 @@ arguments and pop open the results in a preview buffer." (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1)) (and (org-babel-where-is-src-block-head) (org-babel-parse-header-arguments - (org-babel-clean-text-properties + (org-no-properties (match-string 4)))))) (dolist (name names) (when (and (not (string= header name)) (<= (org-babel-edit-distance header name) too-close) (not (member header names))) - (error "supplied header \"%S\" is suspiciously close to \"%S\"" + (error "Supplied header \"%S\" is suspiciously close to \"%S\"" header name)))) (message "No suspicious header arguments found."))) @@ -631,17 +677,15 @@ arguments and pop open the results in a preview buffer." "Insert a header argument selecting from lists of common args and values." (interactive) (let* ((lang (car (org-babel-get-src-block-info 'light))) - (lang-headers (intern (concat "org-babel-header-arg-names:" lang))) - (headers (append (if (boundp lang-headers) - (mapcar (lambda (h) (cons h :any)) - (eval lang-headers)) - nil) - org-babel-common-header-args-w-values)) + (lang-headers (intern (concat "org-babel-header-args:" lang))) + (headers (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (if (boundp lang-headers) (eval lang-headers) nil))) (arg (org-icompleting-read - "Header Arg: " - (mapcar - (lambda (header-spec) (symbol-name (car header-spec))) - headers)))) + "Header Arg: " + (mapcar + (lambda (header-spec) (symbol-name (car header-spec))) + headers)))) (insert ":" arg) (let ((vals (cdr (assoc (intern arg) headers)))) (when vals @@ -661,6 +705,30 @@ arguments and pop open the results in a preview buffer." ""))) vals "")))))))) +;; Add support for completing-read insertion of header arguments after ":" +(defun org-babel-header-arg-expand () + "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts." + (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head)) + (org-babel-enter-header-arg-w-completion (match-string 2)))) + +(defun org-babel-enter-header-arg-w-completion (&optional lang) + "Insert header argument appropriate for LANG with completion." + (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang))) + (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var))) + (headers-w-values (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values lang-headers)) + (headers (mapcar #'symbol-name (mapcar #'car headers-w-values))) + (header (org-completing-read "Header Arg: " headers)) + (args (cdr (assoc (intern header) headers-w-values))) + (arg (when (and args (listp args)) + (org-completing-read + (format "%s: " header) + (mapcar #'symbol-name (apply #'append args)))))) + (insert (concat header " " (or arg ""))) + (cons header arg))) + +(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand) + ;;;###autoload (defun org-babel-load-in-session (&optional arg info) "Load the body of the current source-code block. @@ -672,8 +740,7 @@ session." (lang (nth 0 info)) (params (nth 2 info)) (body (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) + (if (org-babel-noweb-p params :eval) (org-babel-expand-noweb-references info) (nth 1 info)))) (session (cdr (assoc :session params))) @@ -691,7 +758,7 @@ session." "Initiate session for current code block. If called with a prefix argument then resolve any variable references in the header arguments and assign these variables in -the session. Copy the body of the code block to the kill ring." +the session. Copy the body of the code block to the kill ring." (interactive "P") (let* ((info (or info (org-babel-get-src-block-info (not arg)))) (lang (nth 0 info)) @@ -718,7 +785,7 @@ the session. Copy the body of the code block to the kill ring." ;;;###autoload (defun org-babel-switch-to-session (&optional arg info) "Switch to the session of the current code block. -Uses `org-babel-initiate-session' to start the session. If called +Uses `org-babel-initiate-session' to start the session. If called with a prefix argument then this is passed on to `org-babel-initiate-session'." (interactive "P") @@ -731,18 +798,18 @@ with a prefix argument then this is passed on to (defun org-babel-switch-to-session-with-code (&optional arg info) "Switch to code buffer and display session." (interactive "P") - (flet ((swap-windows - () - (let ((other-window-buffer (window-buffer (next-window)))) - (set-window-buffer (next-window) (current-buffer)) - (set-window-buffer (selected-window) other-window-buffer)) - (other-window 1))) - (let ((info (org-babel-get-src-block-info)) - (org-src-window-setup 'reorganize-frame)) - (save-excursion - (org-babel-switch-to-session arg info)) - (org-edit-src-code)) - (swap-windows))) + (let ((swap-windows + (lambda () + (let ((other-window-buffer (window-buffer (next-window)))) + (set-window-buffer (next-window) (current-buffer)) + (set-window-buffer (selected-window) other-window-buffer)) + (other-window 1))) + (info (org-babel-get-src-block-info)) + (org-src-window-setup 'reorganize-frame)) + (save-excursion + (org-babel-switch-to-session arg info)) + (org-edit-src-code) + (funcall swap-windows))) (defmacro org-babel-do-in-edit-buffer (&rest body) "Evaluate BODY in edit buffer if there is a code block at point. @@ -759,9 +826,9 @@ Return t if a code block was found at point, nil otherwise." (defun org-babel-do-key-sequence-in-edit-buffer (key) "Read key sequence and execute the command in edit buffer. Enter a key sequence to be executed in the language major-mode -edit buffer. For example, TAB will alter the contents of the +edit buffer. For example, TAB will alter the contents of the Org-mode code block according to the effect of TAB in the -language major-mode buffer. For languages that support +language major-mode buffer. For languages that support interactive sessions, this can be used to send code from the Org buffer to the session for evaluation using the native major-mode evaluation mechanisms." @@ -959,11 +1026,11 @@ the current subtree." (setf (nth 2 info) (sort (copy-sequence (nth 2 info)) (lambda (a b) (string< (car a) (car b))))) - (labels ((rm (lst) + (let* ((rm (lambda (lst) (dolist (p '("replace" "silent" "append" "prepend")) (setq lst (remove p lst))) - lst) - (norm (arg) + lst)) + (norm (lambda (arg) (let ((v (if (and (listp (cdr arg)) (null (cddr arg))) (copy-sequence (cdr arg)) (cdr arg)))) @@ -973,19 +1040,19 @@ the current subtree." (cond ((and (listp v) ; lists are sorted (member (car arg) '(:result-params))) - (sort (rm v) #'string<)) + (sort (funcall rm v) #'string<)) ((and (stringp v) ; strings are sorted (member (car arg) '(:results :exports))) - (mapconcat #'identity (sort (rm (split-string v)) + (mapconcat #'identity (sort (funcall rm (split-string v)) #'string<) " ")) - (t v)))))) + (t v))))))) ((lambda (hash) (when (org-called-interactively-p 'interactive) (message hash)) hash) (let ((it (format "%s-%s" (mapconcat #'identity (delq nil (mapcar (lambda (arg) - (let ((normalized (norm arg))) + (let ((normalized (funcall norm arg))) (when normalized (format "%S" normalized)))) (nth 2 info))) ":") @@ -993,9 +1060,17 @@ the current subtree." (sha1 it)))))) (defun org-babel-current-result-hash () - "Return the in-buffer hash associated with INFO." + "Return the current in-buffer hash." + (org-babel-where-is-src-block-result) + (org-no-properties (match-string 3))) + +(defun org-babel-set-current-result-hash (hash) + "Set the current in-buffer hash to HASH." (org-babel-where-is-src-block-result) - (org-babel-clean-text-properties (match-string 3))) + (save-excursion (goto-char (match-beginning 3)) + ;; (mapc #'delete-overlay (overlays-at (point))) + (replace-match hash nil nil nil 3) + (org-babel-hide-hash))) (defun org-babel-hide-hash () "Hide the hash in the current results line. @@ -1136,22 +1211,23 @@ may be specified in the properties of the current outline entry." (cons (intern (concat ":" header-arg)) (org-babel-read val)))) (mapcar - 'symbol-name - (append - org-babel-header-arg-names - (progn - (setq sym (intern (concat "org-babel-header-arg-names:" - lang))) - (and (boundp sym) (eval sym))))))))))) + #'symbol-name + (mapcar + #'car + (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (progn + (setq sym (intern (concat "org-babel-header-args:" lang))) + (and (boundp sym) (eval sym)))))))))))) (defvar org-src-preserve-indentation) (defun org-babel-parse-src-block-match () "Parse the results from a match of the `org-babel-src-block-regexp'." (let* ((block-indentation (length (match-string 1))) - (lang (org-babel-clean-text-properties (match-string 2))) + (lang (org-no-properties (match-string 2))) (lang-headers (intern (concat "org-babel-default-header-args:" lang))) (switches (match-string 3)) - (body (org-babel-clean-text-properties + (body (org-no-properties (let* ((body (match-string 5)) (sub-length (- (length body) 1))) (if (and (> sub-length 0) @@ -1173,23 +1249,23 @@ may be specified in the properties of the current outline entry." (org-babel-params-from-properties lang) (if (boundp lang-headers) (eval lang-headers) nil) (org-babel-parse-header-arguments - (org-babel-clean-text-properties (or (match-string 4) "")))) + (org-no-properties (or (match-string 4) "")))) switches block-indentation))) (defun org-babel-parse-inline-src-block-match () "Parse the results from a match of the `org-babel-inline-src-block-regexp'." - (let* ((lang (org-babel-clean-text-properties (match-string 2))) + (let* ((lang (org-no-properties (match-string 2))) (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) (list lang (org-babel-strip-protective-commas - (org-babel-clean-text-properties (match-string 5)) lang) + (org-no-properties (match-string 5)) lang) (org-babel-merge-params org-babel-default-inline-header-args (org-babel-params-from-properties lang) (if (boundp lang-headers) (eval lang-headers) nil) (org-babel-parse-header-arguments - (org-babel-clean-text-properties (or (match-string 4) ""))))))) + (org-no-properties (or (match-string 4) ""))))))) (defun org-babel-balanced-split (string alts) "Split STRING on instances of ALTS. @@ -1197,43 +1273,44 @@ ALTS is a cons of two character options where each option may be either the numeric code of a single character or a list of character alternatives. For example to split on balanced instances of \"[ \t]:\" set ALTS to '((32 9) . 58)." - (flet ((matches (ch spec) (if (listp spec) (member ch spec) (equal spec ch))) - (matched (ch last) - (if (consp alts) - (and (matches ch (cdr alts)) - (matches last (car alts))) - (matches ch alts)))) - (let ((balance 0) (quote nil) (partial nil) (lst nil) (last 0)) - (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]: - (setq balance (+ balance - (cond ((or (equal 91 ch) (equal 40 ch)) 1) - ((or (equal 93 ch) (equal 41 ch)) -1) - (t 0)))) - (when (and (equal 34 ch) (not (equal 92 last))) - (setq quote (not quote))) - (setq partial (cons ch partial)) - (when (and (= balance 0) (not quote) (matched ch last)) - (setq lst (cons (apply #'string (nreverse - (if (consp alts) - (cddr partial) - (cdr partial)))) - lst)) - (setq partial nil)) - (setq last ch)) - (string-to-list string)) - (nreverse (cons (apply #'string (nreverse partial)) lst))))) + (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))) + (matched (lambda (ch last) + (if (consp alts) + (and (funcall matches ch (cdr alts)) + (funcall matches last (car alts))) + (funcall matches ch alts)))) + (balance 0) (last 0) + quote partial lst) + (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]: + (setq balance (+ balance + (cond ((or (equal 91 ch) (equal 40 ch)) 1) + ((or (equal 93 ch) (equal 41 ch)) -1) + (t 0)))) + (when (and (equal 34 ch) (not (equal 92 last))) + (setq quote (not quote))) + (setq partial (cons ch partial)) + (when (and (= balance 0) (not quote) (funcall matched ch last)) + (setq lst (cons (apply #'string (nreverse + (if (consp alts) + (cddr partial) + (cdr partial)))) + lst)) + (setq partial nil)) + (setq last ch)) + (string-to-list string)) + (nreverse (cons (apply #'string (nreverse partial)) lst)))) (defun org-babel-join-splits-near-ch (ch list) "Join splits where \"=\" is on either end of the split." - (flet ((last= (str) (= ch (aref str (1- (length str))))) - (first= (str) (= ch (aref str 0)))) + (let ((last= (lambda (str) (= ch (aref str (1- (length str)))))) + (first= (lambda (str) (= ch (aref str 0))))) (reverse (org-reduce (lambda (acc el) - (let ((head (car acc))) - (if (and head (or (last= head) (first= el))) - (cons (concat head el) (cdr acc)) - (cons el acc)))) - list :initial-value nil)))) + (let ((head (car acc))) + (if (and head (or (funcall last= head) (funcall first= el))) + (cons (concat head el) (cdr acc)) + (cons el acc)))) + list :initial-value nil)))) (defun org-babel-parse-header-arguments (arg-string) "Parse a string of header arguments returning an alist." @@ -1322,20 +1399,20 @@ names." Return a cons cell, the `car' of which contains the TABLE less colnames, and the `cdr' of which contains a list of the column names. Note: this function removes any hlines in TABLE." - (flet ((trans (table) (apply #'mapcar* #'list table))) - (let* ((width (apply 'max - (mapcar (lambda (el) (if (listp el) (length el) 0)) table))) - (table (trans (mapcar (lambda (row) - (if (not (equal row 'hline)) - row - (setq row '()) - (dotimes (n width) - (setq row (cons 'hline row))) - row)) - table)))) - (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row)) - (trans (cdr table))) - (remove 'hline (car table)))))) + (let* ((trans (lambda (table) (apply #'mapcar* #'list table))) + (width (apply 'max + (mapcar (lambda (el) (if (listp el) (length el) 0)) table))) + (table (funcall trans (mapcar (lambda (row) + (if (not (equal row 'hline)) + row + (setq row '()) + (dotimes (n width) + (setq row (cons 'hline row))) + row)) + table)))) + (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row)) + (funcall trans (cdr table))) + (remove 'hline (car table))))) (defun org-babel-put-colnames (table colnames) "Add COLNAMES to TABLE if they exist." @@ -1410,7 +1487,7 @@ to the table for reinsertion to org-mode." Return the point at the beginning of the current source block. Specifically at the beginning of the #+BEGIN_SRC line. If the point is not on a source block then return nil." - (let ((initial (point)) top bottom) + (let ((initial (point)) (case-fold-search t) top bottom) (or (save-excursion ;; on a source name line or a #+header line (beginning-of-line 1) @@ -1418,7 +1495,8 @@ If the point is not on a source block then return nil." (looking-at org-babel-multi-line-header-regexp)) (progn (while (and (forward-line 1) - (looking-at org-babel-multi-line-header-regexp))) + (or (looking-at org-babel-src-name-regexp) + (looking-at org-babel-multi-line-header-regexp)))) (looking-at org-babel-src-block-regexp)) (point))) (save-excursion ;; on a #+begin_src line @@ -1439,26 +1517,49 @@ If the point is not on a source block then return nil." "Go to the beginning of the current code block." (interactive) ((lambda (head) - (if head (goto-char head) (error "not currently in a code block"))) + (if head (goto-char head) (error "Not currently in a code block"))) (org-babel-where-is-src-block-head))) ;;;###autoload (defun org-babel-goto-named-src-block (name) "Go to a named source-code block." (interactive - (let ((completion-ignore-case t)) - (list (org-icompleting-read "source-block name: " - (org-babel-src-block-names) nil t)))) + (let ((completion-ignore-case t) + (case-fold-search t) + (under-point (thing-at-point 'line))) + (list (org-icompleting-read + "source-block name: " (org-babel-src-block-names) nil t + (cond + ;; noweb + ((string-match (org-babel-noweb-wrap) under-point) + (let ((block-name (match-string 1 under-point))) + (string-match "[^(]*" block-name) + (match-string 0 block-name))) + ;; #+call: + ((string-match org-babel-lob-one-liner-regexp under-point) + (let ((source-info (car (org-babel-lob-get-info)))) + (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info) + (let ((source-name (match-string 1 source-info))) + source-name)))) + ;; #+results: + ((string-match (concat "#\\+" org-babel-results-keyword + "\\:\s+\\([^\\(]*\\)") under-point) + (match-string 1 under-point)) + ;; symbol-at-point + ((and (thing-at-point 'symbol)) + (org-babel-find-named-block (thing-at-point 'symbol)) + (thing-at-point 'symbol)) + ("")))))) (let ((point (org-babel-find-named-block name))) (if point ;; taken from `org-open-at-point' - (progn (goto-char point) (org-show-context)) + (progn (org-mark-ring-push) (goto-char point) (org-show-context)) (message "source-code block '%s' not found in this buffer" name)))) (defun org-babel-find-named-block (name) "Find a named source-code block. Return the location of the source block identified by source -NAME, or nil if no such block exists. Set match data according to +NAME, or nil if no such block exists. Set match data according to org-babel-named-src-block-regexp." (save-excursion (let ((case-fold-search t) @@ -1472,7 +1573,7 @@ org-babel-named-src-block-regexp." "Returns the names of source blocks in FILE or the current buffer." (save-excursion (when file (find-file file)) (goto-char (point-min)) - (let (names) + (let ((case-fold-search t) names) (while (re-search-forward org-babel-src-name-w-name-regexp nil t) (setq names (cons (match-string 3) names))) names))) @@ -1495,23 +1596,24 @@ org-babel-named-src-block-regexp." Return the location of the result named NAME in the current buffer or nil if no such result exists." (save-excursion - (goto-char (or point (point-min))) - (catch 'is-a-code-block - (when (re-search-forward - (concat org-babel-result-regexp - "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t) - (when (and (string= "name" (downcase (match-string 1))) - (or (beginning-of-line 1) - (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp))) - (throw 'is-a-code-block (org-babel-find-named-result name (point)))) - (beginning-of-line 0) (point))))) + (let ((case-fold-search t)) + (goto-char (or point (point-min))) + (catch 'is-a-code-block + (when (re-search-forward + (concat org-babel-result-regexp + "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t) + (when (and (string= "name" (downcase (match-string 1))) + (or (beginning-of-line 1) + (looking-at org-babel-src-block-regexp) + (looking-at org-babel-multi-line-header-regexp))) + (throw 'is-a-code-block (org-babel-find-named-result name (point)))) + (beginning-of-line 0) (point)))))) (defun org-babel-result-names (&optional file) "Returns the names of results in FILE or the current buffer." (save-excursion (when file (find-file file)) (goto-char (point-min)) - (let (names) + (let ((case-fold-search t) names) (while (re-search-forward org-babel-result-w-name-regexp nil t) (setq names (cons (match-string 4) names))) names))) @@ -1541,7 +1643,7 @@ With optional prefix argument ARG, jump backward ARG many source blocks." ;;;###autoload (defun org-babel-mark-block () - "Mark current src block" + "Mark current src block." (interactive) ((lambda (head) (when head @@ -1585,13 +1687,13 @@ region is not active then the point is demarcated." "" (concat "\n" (make-string (current-column) ? ))))))) (move-end-of-line 2)) - (sort (if (region-active-p) (list (mark) (point)) (list (point))) #'>)) + (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>)) (let ((start (point)) (lang (org-icompleting-read "Lang: " (mapcar (lambda (el) (symbol-name (car el))) org-babel-load-languages))) (body (delete-and-extract-region - (if (region-active-p) (mark) (point)) (point)))) + (if (org-region-active-p) (mark) (point)) (point)))) (insert (concat (if (looking-at "^") "" "\n") (if arg (concat stars "\n") "") "#+begin_src " lang "\n" @@ -1609,11 +1711,12 @@ source block. Specifically at the beginning of the results line. If no result exists for this block then create a results line following the source block." (save-excursion - (let* ((on-lob-line (save-excursion + (let* ((case-fold-search t) + (on-lob-line (save-excursion (beginning-of-line 1) (looking-at org-babel-lob-one-liner-regexp))) (inlinep (when (org-babel-get-inline-src-block-matches) - (match-end 0))) + (match-end 0))) (name (if on-lob-line (mapconcat #'identity (butlast (org-babel-lob-get-info)) "") (nth 4 (or info (org-babel-get-src-block-info 'light))))) @@ -1722,7 +1825,7 @@ If the path of the link is a file path it is expanded using `expand-file-name'." (let* ((case-fold-search t) (raw (and (looking-at org-bracket-link-regexp) - (org-babel-clean-text-properties (match-string 1)))) + (org-no-properties (match-string 1)))) (type (and (string-match org-link-types-re raw) (match-string 1 raw)))) (cond @@ -1734,17 +1837,13 @@ If the path of the link is a file path it is expanded using (defun org-babel-format-result (result &optional sep) "Format RESULT for writing to file." - (flet ((echo-res (result) - (if (stringp result) result (format "%S" result)))) + (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r))))) (if (listp result) ;; table result (orgtbl-to-generic - result - (list - :sep (or sep "\t") - :fmt 'echo-res)) + result (list :sep (or sep "\t") :fmt echo-res)) ;; scalar result - (echo-res result)))) + (funcall echo-res result)))) (defun org-babel-insert-result (result &optional result-params info hash indent lang) @@ -1752,7 +1851,7 @@ If the path of the link is a file path it is expanded using By default RESULT is inserted after the end of the current source block. With optional argument RESULT-PARAMS controls insertion of results in the org-mode file. -RESULT-PARAMS can take the following values... +RESULT-PARAMS can take the following values: replace - (default option) insert results after the source block replacing any previously inserted results @@ -1768,16 +1867,13 @@ raw ----- results are added directly to the Org-mode file. This is a good option if you code block will output org-mode formatted text. -wrap ---- results are added directly to the Org-mode file as with +drawer -- results are added directly to the Org-mode file as with \"raw\", but are wrapped in a RESULTS drawer, allowing them to later be replaced or removed automatically. -org ----- similar in effect to raw, only the results are wrapped - in an org code block. Similar to the raw option, on - export the results will be interpreted as org-formatted - text, however by wrapping the results in an org code - block they can be replaced upon re-execution of the - code block. +org ----- results are added inside of a \"#+BEGIN_SRC org\" block. + They are not comma-escaped when inserted, but Org syntax + here will be discarded when exporting the file. html ---- results are added inside of a #+BEGIN_HTML block. This is a good option if you code block will output html @@ -1794,9 +1890,12 @@ code ---- the results are extracted in the syntax of the source optional LANG argument." (if (stringp result) (progn - (setq result (org-babel-clean-text-properties result)) + (setq result (org-no-properties result)) (when (member "file" result-params) - (setq result (org-babel-result-to-file result)))) + (setq result (org-babel-result-to-file + result (when (assoc :file-desc (nth 2 info)) + (or (cdr (assoc :file-desc (nth 2 info))) + result)))))) (unless (listp result) (setq result (format "%S" result)))) (if (and result-params (member "silent" result-params)) (progn @@ -1838,12 +1937,13 @@ code ---- the results are extracted in the syntax of the source ((member "prepend" result-params)))) ; already there (setq results-switches (if results-switches (concat " " results-switches) "")) - (flet ((wrap (start finish) - (goto-char end) (insert (concat finish "\n")) - (goto-char beg) (insert (concat start "\n")) - (goto-char end) (goto-char (point-at-eol)) - (setq end (point-marker))) - (proper-list-p (it) (and (listp it) (null (cdr (last it)))))) + (let ((wrap (lambda (start finish &optional escape) + (goto-char end) (insert (concat finish "\n")) + (goto-char beg) (insert (concat start "\n")) + (if escape (org-add-protective-commas (point) end)) + (goto-char end) (goto-char (point-at-eol)) + (setq end (point-marker)))) + (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it))))))) ;; insert results based on type (cond ;; do nothing for an empty result @@ -1860,7 +1960,7 @@ code ---- the results are extracted in the syntax of the source '(:splicep nil :istart "- " :iend "\n"))) "\n")) ;; assume the result is a table if it's not a string - ((proper-list-p result) + ((funcall proper-list-p result) (goto-char beg) (insert (concat (orgtbl-to-orgtbl (if (or (eq 'hline (car result)) @@ -1869,30 +1969,35 @@ code ---- the results are extracted in the syntax of the source result (list result)) '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) (goto-char beg) (when (org-at-table-p) (org-table-align))) - ((and (listp result) (not (proper-list-p result))) + ((and (listp result) (not (funcall proper-list-p result))) (insert (format "%s\n" result))) ((member "file" result-params) (when inlinep (goto-char inlinep)) (insert result)) (t (goto-char beg) (insert result))) - (when (proper-list-p result) (goto-char (org-table-end))) + (when (funcall proper-list-p result) (goto-char (org-table-end))) (setq end (point-marker)) ;; possibly wrap result (cond + ((assoc :wrap (nth 2 info)) + (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS"))) + (funcall wrap (concat "#+BEGIN_" name) (concat "#+END_" name)))) ((member "html" result-params) - (wrap "#+BEGIN_HTML" "#+END_HTML")) + (funcall wrap "#+BEGIN_HTML" "#+END_HTML")) ((member "latex" result-params) - (wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) - ((member "code" result-params) - (wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) - "#+END_SRC")) + (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) ((member "org" result-params) - (wrap "#+BEGIN_ORG" "#+END_ORG")) + (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" 'escape)) + ((member "code" result-params) + (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) + "#+END_SRC")) ((member "raw" result-params) (goto-char beg) (if (org-at-table-p) (org-cycle))) - ((member "wrap" result-params) - (wrap ":RESULTS:" ":END:")) - ((and (not (proper-list-p result)) + ((or (member "drawer" result-params) + ;; Stay backward compatible with <7.9.2 + (member "wrap" result-params)) + (funcall wrap ":RESULTS:" ":END:")) + ((and (not (funcall proper-list-p result)) (not (member "file" result-params))) (org-babel-examplize-region beg end results-switches) (setq end (point))))) @@ -1919,44 +2024,40 @@ code ---- the results are extracted in the syntax of the source (delete-region start (org-babel-result-end)))))) (defun org-babel-result-end () - "Return the point at the end of the current set of results" + "Return the point at the end of the current set of results." (save-excursion (cond ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) ((org-at-item-p) (let* ((struct (org-list-struct)) (prvs (org-list-prevs-alist struct))) (org-list-get-list-end (point-at-bol) struct prvs))) - ((looking-at "^\\([ \t]*\\):RESULTS:") + ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:")) (progn (re-search-forward (concat "^" (match-string 1) ":END:")) (forward-char 1) (point))) (t - (let ((case-fold-search t) - (blocks-re (regexp-opt - (list "latex" "html" "example" "src" "result" "org")))) - (if (looking-at (concat "[ \t]*#\\+begin_" blocks-re)) - (progn (re-search-forward (concat "[ \t]*#\\+end_" blocks-re) nil t) + (let ((case-fold-search t)) + (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)")) + (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1)) + nil t) (forward-char 1)) (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") (forward-line 1)))) (point))))) -(defun org-babel-result-to-file (result) - "Convert RESULT into an `org-mode' link. +(defun org-babel-result-to-file (result &optional description) + "Convert RESULT into an `org-mode' link with optional DESCRIPTION. If the `default-directory' is different from the containing file's directory then expand relative links." - (flet ((cond-exp (file) - (if (and default-directory - buffer-file-name - (not (string= (expand-file-name default-directory) - (expand-file-name - (file-name-directory buffer-file-name))))) - (expand-file-name file default-directory) - file))) - (if (stringp result) - (format "[[file:%s]]" (cond-exp result)) - (when (and (listp result) (= 2 (length result)) - (stringp (car result)) (stringp (cadr result))) - (format "[[file:%s][%s]]" (car result) (cadr result)))))) + (when (stringp result) + (format "[[file:%s]%s]" + (if (and default-directory + buffer-file-name + (not (string= (expand-file-name default-directory) + (expand-file-name + (file-name-directory buffer-file-name))))) + (expand-file-name result default-directory) + result) + (if description (concat "[" description "]") "")))) (defvar org-babel-capitalize-examplize-region-markers nil "Make true to capitalize begin/end example markers inserted by code blocks.") @@ -1964,12 +2065,12 @@ file's directory then expand relative links." (defun org-babel-examplize-region (beg end &optional results-switches) "Comment out region using the inline '==' or ': ' org example quote." (interactive "*r") - (flet ((chars-between (b e) - (not (string-match "^[\\s]*$" (buffer-substring b e)))) - (maybe-cap (str) (if org-babel-capitalize-examplize-region-markers - (upcase str) str))) - (if (or (chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) - (chars-between end (save-excursion (goto-char end) (point-at-eol)))) + (let ((chars-between (lambda (b e) + (not (string-match "^[\\s]*$" (buffer-substring b e))))) + (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers + (upcase str) str)))) + (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) + (funcall chars-between end (save-excursion (goto-char end) (point-at-eol)))) (save-excursion (goto-char beg) (insert (format "=%s=" (prog1 (buffer-substring beg end) @@ -1985,16 +2086,16 @@ file's directory then expand relative links." (goto-char beg) (insert (if results-switches (format "%s%s\n" - (maybe-cap "#+begin_example") + (funcall maybe-cap "#+begin_example") results-switches) - (maybe-cap "#+begin_example\n"))) + (funcall maybe-cap "#+begin_example\n"))) (if (markerp end) (goto-char end) (forward-char (- end beg))) - (insert (maybe-cap "#+end_example\n"))))))))) + (insert (funcall maybe-cap "#+end_example\n"))))))))) (defun org-babel-update-block-body (new-body) "Update the body of the current code block to NEW-BODY." (if (not (org-babel-where-is-src-block-head)) - (error "not in source block") + (error "Not in a source block") (save-match-data (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5)) (indent-rigidly (match-beginning 5) (match-end 5) 2))) @@ -2004,104 +2105,108 @@ file's directory then expand relative links." Later elements of PLISTS override the values of previous elements. This takes into account some special considerations for certain parameters when merging lists." - (let ((results-exclusive-groups - (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'results org-babel-common-header-args-w-values)))) - (exports-exclusive-groups - (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'exports org-babel-common-header-args-w-values)))) - (variable-index 0) - params results exports tangle noweb cache vars shebang comments padline) - (flet ((e-merge (exclusive-groups &rest result-params) - ;; maintain exclusivity of mutually exclusive parameters - (let (output) - (mapc (lambda (new-params) - (mapc (lambda (new-param) - (mapc (lambda (exclusive-group) - (when (member new-param exclusive-group) - (mapcar (lambda (excluded-param) - (setq output - (delete - excluded-param - output))) - exclusive-group))) - exclusive-groups) - (setq output (org-uniquify - (cons new-param output)))) - new-params)) - result-params) - output))) - (mapc - (lambda (plist) - (mapc - (lambda (pair) - (case (car pair) - (:var - (let ((name (if (listp (cdr pair)) - (cadr pair) - (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" - (cdr pair)) - (intern (match-string 1 (cdr pair))))))) - (if name - (setq vars - (append - (if (member name (mapcar #'car vars)) - (delq nil - (mapcar - (lambda (p) - (unless (equal (car p) name) p)) - vars)) - vars) - (list (cons name pair)))) - ;; if no name is given and we already have named variables - ;; then assign to named variables in order - (if (and vars (nth variable-index vars)) - (prog1 (setf (cddr (nth variable-index vars)) - (concat (symbol-name - (car (nth variable-index vars))) - "=" (cdr pair))) - (incf variable-index)) - (error "variable \"%s\" must be assigned a default value" - (cdr pair)))))) - (:results - (setq results (e-merge results-exclusive-groups - results - (split-string - (let ((r (cdr pair))) - (if (stringp r) r (eval r))))))) - (:file - (when (cdr pair) - (setq results (e-merge results-exclusive-groups - results '("file"))) - (unless (or (member "both" exports) - (member "none" exports) - (member "code" exports)) - (setq exports (e-merge exports-exclusive-groups - exports '("results")))) - (setq params (cons pair (assq-delete-all (car pair) params))))) - (:exports - (setq exports (e-merge exports-exclusive-groups - exports (split-string (cdr pair))))) - (:tangle ;; take the latest -- always overwrite - (setq tangle (or (list (cdr pair)) tangle))) - (:noweb - (setq noweb (e-merge '(("yes" "no" "tangle")) noweb - (split-string (or (cdr pair) ""))))) - (:cache - (setq cache (e-merge '(("yes" "no")) cache + (let* ((results-exclusive-groups + (mapcar (lambda (group) (mapcar #'symbol-name group)) + (cdr (assoc 'results org-babel-common-header-args-w-values)))) + (exports-exclusive-groups + (mapcar (lambda (group) (mapcar #'symbol-name group)) + (cdr (assoc 'exports org-babel-common-header-args-w-values)))) + (variable-index 0) + (e-merge (lambda (exclusive-groups &rest result-params) + ;; maintain exclusivity of mutually exclusive parameters + (let (output) + (mapc (lambda (new-params) + (mapc (lambda (new-param) + (mapc (lambda (exclusive-group) + (when (member new-param exclusive-group) + (mapcar (lambda (excluded-param) + (setq output + (delete + excluded-param + output))) + exclusive-group))) + exclusive-groups) + (setq output (org-uniquify + (cons new-param output)))) + new-params)) + result-params) + output))) + params results exports tangle noweb cache vars shebang comments padline) + + (mapc + (lambda (plist) + (mapc + (lambda (pair) + (case (car pair) + (:var + (let ((name (if (listp (cdr pair)) + (cadr pair) + (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" + (cdr pair)) + (intern (match-string 1 (cdr pair))))))) + (if name + (setq vars + (append + (if (member name (mapcar #'car vars)) + (delq nil + (mapcar + (lambda (p) + (unless (equal (car p) name) p)) + vars)) + vars) + (list (cons name pair)))) + ;; if no name is given and we already have named variables + ;; then assign to named variables in order + (if (and vars (nth variable-index vars)) + (prog1 (setf (cddr (nth variable-index vars)) + (concat (symbol-name + (car (nth variable-index vars))) + "=" (cdr pair))) + (incf variable-index)) + (error "Variable \"%s\" must be assigned a default value" + (cdr pair)))))) + (:results + (setq results (funcall e-merge results-exclusive-groups + results + (split-string + (let ((r (cdr pair))) + (if (stringp r) r (eval r))))))) + (:file + (when (cdr pair) + (setq results (funcall e-merge results-exclusive-groups + results '("file"))) + (unless (or (member "both" exports) + (member "none" exports) + (member "code" exports)) + (setq exports (funcall e-merge exports-exclusive-groups + exports '("results")))) + (setq params (cons pair (assq-delete-all (car pair) params))))) + (:exports + (setq exports (funcall e-merge exports-exclusive-groups + exports (split-string (cdr pair))))) + (:tangle ;; take the latest -- always overwrite + (setq tangle (or (list (cdr pair)) tangle))) + (:noweb + (setq noweb (funcall e-merge + '(("yes" "no" "tangle" "no-export" + "strip-export" "eval")) + noweb + (split-string (or (cdr pair) ""))))) + (:cache + (setq cache (funcall e-merge '(("yes" "no")) cache + (split-string (or (cdr pair) ""))))) + (:padline + (setq padline (funcall e-merge '(("yes" "no")) padline (split-string (or (cdr pair) ""))))) - (:padline - (setq padline (e-merge '(("yes" "no")) padline - (split-string (or (cdr pair) ""))))) - (:shebang ;; take the latest -- always overwrite - (setq shebang (or (list (cdr pair)) shebang))) - (:comments - (setq comments (e-merge '(("yes" "no")) comments - (split-string (or (cdr pair) ""))))) - (t ;; replace: this covers e.g. :session - (setq params (cons pair (assq-delete-all (car pair) params)))))) - plist)) - plists)) + (:shebang ;; take the latest -- always overwrite + (setq shebang (or (list (cdr pair)) shebang))) + (:comments + (setq comments (funcall e-merge '(("yes" "no")) comments + (split-string (or (cdr pair) ""))))) + (t ;; replace: this covers e.g. :session + (setq params (cons pair (assq-delete-all (car pair) params)))))) + plist)) + plists) (setq vars (reverse vars)) (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) (mapc @@ -2118,6 +2223,21 @@ This results in much faster noweb reference expansion but does not properly allow code blocks to inherit the \":noweb-ref\" header argument from buffer or subtree wide properties.") +(defun org-babel-noweb-p (params context) + "Check if PARAMS require expansion in CONTEXT. +CONTEXT may be one of :tangle, :export or :eval." + (let* (intersect + (intersect (lambda (as bs) + (when as + (if (member (car as) bs) + (car as) + (funcall intersect (cdr as) bs)))))) + (funcall intersect (case context + (:tangle '("yes" "tangle" "no-export" "strip-export")) + (:eval '("yes" "no-export" "strip-export" "eval")) + (:export '("yes"))) + (split-string (or (cdr (assoc :noweb params)) ""))))) + (defun org-babel-expand-noweb-references (&optional info parent-buffer) "Expand Noweb references in the body of the current source code block. @@ -2152,105 +2272,104 @@ block but are passed literally to the \"example-block\"." (info (or info (org-babel-get-src-block-info))) (lang (nth 0 info)) (body (nth 1 info)) + (ob-nww-start org-babel-noweb-wrap-start) + (ob-nww-end org-babel-noweb-wrap-end) (comment (string= "noweb" (cdr (assoc :comments (nth 2 info))))) (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|" ":noweb-ref[ \t]+" "\\)")) - (new-body "") index source-name evaluate prefix blocks-in-buffer) - (flet ((nb-add (text) (setq new-body (concat new-body text))) - (c-wrap (text) + (new-body "") + (nb-add (lambda (text) (setq new-body (concat new-body text)))) + (c-wrap (lambda (text) (with-temp-buffer (funcall (intern (concat lang "-mode"))) (comment-region (point) (progn (insert text) (point))) (org-babel-trim (buffer-string))))) - (with-temp-buffer - (insert body) (goto-char (point-min)) - (setq index (point)) - (while (and (re-search-forward "<<\\([^ \t\n].+?[^ \t\n]\\|[^ \t\n]\\)>>" - nil t)) - (save-match-data (setf source-name (match-string 1))) - (save-match-data (setq evaluate (string-match "\(.*\)" source-name))) - (save-match-data - (setq prefix - (buffer-substring (match-beginning 0) - (save-excursion - (beginning-of-line 1) (point))))) - ;; add interval to new-body (removing noweb reference) - (goto-char (match-beginning 0)) - (nb-add (buffer-substring index (point))) - (goto-char (match-end 0)) - (setq index (point)) - (nb-add - (with-current-buffer parent-buffer - (save-restriction - (widen) - (mapconcat ;; interpose PREFIX between every line - #'identity - (split-string - (if evaluate - (let ((raw (org-babel-ref-resolve source-name))) - (if (stringp raw) raw (format "%S" raw))) - (or - ;; retrieve from the library of babel - (nth 2 (assoc (intern source-name) - org-babel-library-of-babel)) - ;; return the contents of headlines literally - (save-excursion - (when (org-babel-ref-goto-headline-id source-name) - (org-babel-ref-headline-body))) - ;; find the expansion of reference in this buffer - (let ((rx (concat rx-prefix source-name "[ \t\n]")) - expansion) - (save-excursion - (goto-char (point-min)) - (if *org-babel-use-quick-and-dirty-noweb-expansion* - (while (re-search-forward rx nil t) - (let* ((i (org-babel-get-src-block-info 'light)) - (body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - ((lambda (cs) - (concat (c-wrap (car cs)) "\n" - body "\n" - (c-wrap (cadr cs)))) - (org-babel-tangle-comment-links i)) - body))) - (setq expansion (cons sep (cons full expansion))))) - (org-babel-map-src-blocks nil - (let ((i (org-babel-get-src-block-info 'light))) - (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) - (nth 4 i)) - source-name) - (let* ((body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - ((lambda (cs) - (concat (c-wrap (car cs)) "\n" - body "\n" - (c-wrap (cadr cs)))) - (org-babel-tangle-comment-links i)) - body))) - (setq expansion - (cons sep (cons full expansion))))))))) - (and expansion - (mapconcat #'identity (nreverse (cdr expansion)) ""))) - ;; possibly raise an error if named block doesn't exist - (if (member lang org-babel-noweb-error-langs) - (error "%s" (concat - "<<" source-name ">> " - "could not be resolved (see " - "`org-babel-noweb-error-langs')")) - ""))) - "[\n\r]") (concat "\n" prefix)))))) - (nb-add (buffer-substring index (point-max))))) + index source-name evaluate prefix blocks-in-buffer) + (with-temp-buffer + (org-set-local 'org-babel-noweb-wrap-start ob-nww-start) + (org-set-local 'org-babel-noweb-wrap-end ob-nww-end) + (insert body) (goto-char (point-min)) + (setq index (point)) + (while (and (re-search-forward (org-babel-noweb-wrap) nil t)) + (save-match-data (setf source-name (match-string 1))) + (save-match-data (setq evaluate (string-match "\(.*\)" source-name))) + (save-match-data + (setq prefix + (buffer-substring (match-beginning 0) + (save-excursion + (beginning-of-line 1) (point))))) + ;; add interval to new-body (removing noweb reference) + (goto-char (match-beginning 0)) + (funcall nb-add (buffer-substring index (point))) + (goto-char (match-end 0)) + (setq index (point)) + (funcall nb-add + (with-current-buffer parent-buffer + (save-restriction + (widen) + (mapconcat ;; interpose PREFIX between every line + #'identity + (split-string + (if evaluate + (let ((raw (org-babel-ref-resolve source-name))) + (if (stringp raw) raw (format "%S" raw))) + (or + ;; retrieve from the library of babel + (nth 2 (assoc (intern source-name) + org-babel-library-of-babel)) + ;; return the contents of headlines literally + (save-excursion + (when (org-babel-ref-goto-headline-id source-name) + (org-babel-ref-headline-body))) + ;; find the expansion of reference in this buffer + (let ((rx (concat rx-prefix source-name "[ \t\n]")) + expansion) + (save-excursion + (goto-char (point-min)) + (if *org-babel-use-quick-and-dirty-noweb-expansion* + (while (re-search-forward rx nil t) + (let* ((i (org-babel-get-src-block-info 'light)) + (body (org-babel-expand-noweb-references i)) + (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + "\n")) + (full (if comment + ((lambda (cs) + (concat (funcall c-wrap (car cs)) "\n" + body "\n" + (funcall c-wrap (cadr cs)))) + (org-babel-tangle-comment-links i)) + body))) + (setq expansion (cons sep (cons full expansion))))) + (org-babel-map-src-blocks nil + (let ((i (org-babel-get-src-block-info 'light))) + (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) + (nth 4 i)) + source-name) + (let* ((body (org-babel-expand-noweb-references i)) + (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + "\n")) + (full (if comment + ((lambda (cs) + (concat (funcall c-wrap (car cs)) "\n" + body "\n" + (funcall c-wrap (cadr cs)))) + (org-babel-tangle-comment-links i)) + body))) + (setq expansion + (cons sep (cons full expansion))))))))) + (and expansion + (mapconcat #'identity (nreverse (cdr expansion)) ""))) + ;; possibly raise an error if named block doesn't exist + (if (member lang org-babel-noweb-error-langs) + (error "%s" (concat + (org-babel-noweb-wrap source-name) + "could not be resolved (see " + "`org-babel-noweb-error-langs')")) + ""))) + "[\n\r]") (concat "\n" prefix)))))) + (funcall nb-add (buffer-substring index (point-max)))) new-body)) -(defun org-babel-clean-text-properties (text) - "Strip all properties from text return." - (when text - (set-text-properties 0 (length text) nil text) text)) - (defun org-babel-strip-protective-commas (body &optional lang) "Strip protective commas from bodies of source blocks." (with-temp-buffer @@ -2340,14 +2459,14 @@ If the table is trivial, then return it as a scalar." (let (result) (save-window-excursion (with-temp-buffer - (condition-case nil + (condition-case err (progn (org-table-import file-name separator) (delete-file file-name) (setq result (mapcar (lambda (row) (mapcar #'org-babel-string-read row)) (org-table-to-lisp)))) - (error nil))) + (error (message "Error reading results: %s" err) nil))) (if (null (cdr result)) ;; if result is trivial vector, then scalarize it (if (consp (car result)) (if (null (cdr (car result))) @@ -2361,7 +2480,7 @@ If the table is trivial, then return it as a scalar." (org-babel-read (or (and (stringp cell) (string-match "\\\"\\(.+\\)\\\"" cell) (match-string 1 cell)) - cell))) + cell) t)) (defun org-babel-reverse-string (string) "Return the reverse of STRING." @@ -2388,7 +2507,7 @@ of the string." (defvar org-babel-org-babel-call-process-region-original nil) (defun org-babel-tramp-handle-call-process-region (start end program &optional delete buffer display &rest args) - "Use tramp to handle call-process-region. + "Use Tramp to handle `call-process-region'. Fixes a bug in `tramp-handle-call-process-region'." (if (and (featurep 'tramp) (file-remote-p default-directory)) (let ((tmpfile (tramp-compat-make-temp-file ""))) @@ -2400,7 +2519,7 @@ Fixes a bug in `tramp-handle-call-process-region'." (apply 'process-file program tmpfile buffer display args) (delete-file tmpfile))) ;; org-babel-call-process-region-original is the original emacs - ;; definition. It is in scope from the let binding in + ;; definition. It is in scope from the let binding in ;; org-babel-execute-src-block (apply org-babel-call-process-region-original start end program delete buffer display args))) @@ -2410,17 +2529,16 @@ Fixes a bug in `tramp-handle-call-process-region'." (if (file-remote-p file) (let (localname) (with-parsed-tramp-file-name file nil - localname)) + localname)) file)) (defun org-babel-process-file-name (name &optional no-quote-p) "Prepare NAME to be used in an external process. If NAME specifies a remote location, the remote portion of the name is removed, since in that case the process will be executing -remotely. The file name is then processed by -`expand-file-name'. Unless second argument NO-QUOTE-P is non-nil, -the file name is additionally processed by -`shell-quote-argument'" +remotely. The file name is then processed by `expand-file-name'. +Unless second argument NO-QUOTE-P is non-nil, the file name is +additionally processed by `shell-quote-argument'" ((lambda (f) (if no-quote-p f (shell-quote-argument f))) (expand-file-name (org-babel-local-file-name name)))) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 2b4a001979b..32fecde2af0 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -29,15 +29,15 @@ ;; The functions `org-batch-agenda', `org-batch-agenda-csv', and ;; `org-batch-store-agenda-views' are implemented as macros to provide ;; a convenient way for extracting agenda information from the command -;; line. The Lisp does not evaluate parameters of a macro call; thus +;; line. The Lisp does not evaluate parameters of a macro call; thus ;; it is not necessary to quote the parameters passed to one of those -;; functions. E.g. you can write: +;; functions. E.g. you can write: ;; ;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)' ;; -;; To export an agenda spanning 7 days. If `org-batch-agenda' would +;; To export an agenda spanning 7 days. If `org-batch-agenda' would ;; have been implemented as a regular function you'd have to quote the -;; symbol org-agenda-span. Moreover: To use a symbol as parameter +;; symbol org-agenda-span. Moreover: To use a symbol as parameter ;; value you would have to double quote the symbol. ;; ;; This is a hack, but it works even when running Org byte-compiled. @@ -46,6 +46,7 @@ ;;; Code: (require 'org) +(require 'org-macs) (eval-when-compile (require 'cl)) @@ -80,23 +81,30 @@ (declare-function org-habit-get-priority "org-habit" (habit &optional moment)) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) - -(defvar calendar-mode-map) -(defvar org-clock-current-task) ; defined in org-clock.el -(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el -(defvar org-habit-show-habits) +(declare-function org-agenda-columns "org-colview" ()) +(declare-function org-add-archive-files "org-archive" (files)) +(declare-function org-capture "org-capture" (&optional goto keys)) + +(defvar calendar-mode-map) ; defined in calendar.el +(defvar org-clock-current-task nil) ; defined in org-clock.el +(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el +(defvar org-habit-show-habits) ; defined in org-habit.el (defvar org-habit-show-habits-only-for-today) +(defvar org-habit-show-all-today) ;; Defined somewhere in this file, but used before definition. -(defvar org-agenda-buffer-name) -(defvar org-agenda-overriding-header) +(defvar org-agenda-buffer-name "*Org Agenda*") +(defvar org-agenda-overriding-header nil) (defvar org-agenda-title-append nil) -(defvar entry) -(defvar date) -(defvar org-agenda-undo-list) -(defvar org-agenda-pending-undo-list) +(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el +(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el (defvar original-date) ; dynamically scoped, calendar.el does scope this +(defvar org-agenda-undo-list nil + "List of undoable operations in the agenda since last refresh.") +(defvar org-agenda-pending-undo-list nil + "In a series of undo commands, this is the list of remaining undo items.") + (defcustom org-agenda-confirm-kill 1 "When set, remote killing from the agenda buffer needs confirmation. When t, a confirmation is always needed. When a number N, confirmation is @@ -127,9 +135,9 @@ addresses the separator between the current and the previous block." (string))) (defgroup org-agenda-export nil - "Options concerning exporting agenda views in Org-mode." - :tag "Org Agenda Export" - :group 'org-agenda) + "Options concerning exporting agenda views in Org-mode." + :tag "Org Agenda Export" + :group 'org-agenda) (defcustom org-agenda-with-colors t "Non-nil means use colors in agenda views." @@ -152,8 +160,8 @@ before assigned to the variables. So make sure to quote values you do (sexp :tag "Value")))) (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text) - "Hook run in temporary buffer before writing it to an export file. -A useful function is `org-agenda-add-entry-text'." + "Hook run in a temporary buffer before writing the agenda to an export file. +A useful function for this hook is `org-agenda-add-entry-text'." :group 'org-agenda-export :type 'hook :options '(org-agenda-add-entry-text)) @@ -161,7 +169,7 @@ A useful function is `org-agenda-add-entry-text'." (defcustom org-agenda-add-entry-text-maxlines 0 "Maximum number of entry text lines to be added to agenda. This is only relevant when `org-agenda-add-entry-text' is part of -`org-agenda-before-write-hook', which it is by default. +`org-agenda-before-write-hook', which is the default. When this is 0, nothing will happen. When it is greater than 0, it specifies the maximum number of lines that will be added for each entry that is listed in the agenda view. @@ -180,7 +188,7 @@ When this variable nil, the URL will (also) be shown." :group 'org-agenda :type 'boolean) -(defcustom org-agenda-export-html-style "" +(defcustom org-agenda-export-html-style nil "The style specification for exported HTML Agenda files. If this variable contains a string, it will replace the default <style> section as produced by `htmlize'. @@ -216,8 +224,7 @@ or, if you want to keep the style in a file, <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> As the value of this option simply gets inserted into the HTML <head> header, -you can \"misuse\" it to also add other text to the header. However, -<style>...</style> is required, if not present the variable will be ignored." +you can \"misuse\" it to also add other text to the header." :group 'org-agenda-export :group 'org-export-html :type 'string) @@ -228,9 +235,9 @@ you can \"misuse\" it to also add other text to the header. However, :type 'boolean) (defgroup org-agenda-custom-commands nil - "Options concerning agenda views in Org-mode." - :tag "Org Agenda Custom Commands" - :group 'org-agenda) + "Options concerning agenda views in Org-mode." + :tag "Org Agenda Custom Commands" + :group 'org-agenda) (defconst org-sorting-choice '(choice @@ -247,116 +254,118 @@ you can \"misuse\" it to also add other text to the header. However, ;; Keep custom values for `org-agenda-filter-preset' compatible with ;; the new variable `org-agenda-tag-filter-preset'. -(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) +(if (fboundp 'defvaralias) + (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) + (defvaralias 'org-agenda-filter 'org-agenda-tag-filter)) (defconst org-agenda-custom-commands-local-options - `(repeat :tag "Local settings for this command. Remember to quote values" + `(repeat :tag "Local settings for this command. Remember to quote values" (choice :tag "Setting" - (list :tag "Heading for this block" - (const org-agenda-overriding-header) - (string :tag "Headline")) - (list :tag "Files to be searched" - (const org-agenda-files) - (list - (const :format "" quote) - (repeat (file)))) - (list :tag "Sorting strategy" - (const org-agenda-sorting-strategy) - (list - (const :format "" quote) - (repeat - ,org-sorting-choice))) - (list :tag "Prefix format" - (const org-agenda-prefix-format :value " %-12:c%?-12t% s") - (string)) - (list :tag "Number of days in agenda" - (const org-agenda-span) - (choice (const :tag "Day" 'day) - (const :tag "Week" 'week) - (const :tag "Month" 'month) - (const :tag "Year" 'year) - (integer :tag "Custom"))) - (list :tag "Fixed starting date" - (const org-agenda-start-day) - (string :value "2007-11-01")) - (list :tag "Start on day of week" - (const org-agenda-start-on-weekday) - (choice :value 1 - (const :tag "Today" nil) - (integer :tag "Weekday No."))) - (list :tag "Include data from diary" - (const org-agenda-include-diary) - (boolean)) - (list :tag "Deadline Warning days" - (const org-deadline-warning-days) - (integer :value 1)) - (list :tag "Category filter preset" - (const org-agenda-category-filter-preset) - (list - (const :format "" quote) - (repeat - (string :tag "+category or -category")))) - (list :tag "Tags filter preset" - (const org-agenda-tag-filter-preset) - (list - (const :format "" quote) - (repeat - (string :tag "+tag or -tag")))) - (list :tag "Set daily/weekly entry types" - (const org-agenda-entry-types) - (list - (const :format "" quote) - (set :greedy t :value (:deadline :scheduled :timestamp :sexp) - (const :deadline) - (const :scheduled) - (const :timestamp) - (const :sexp)))) - (list :tag "Standard skipping condition" - :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) - (const org-agenda-skip-function) - (list - (const :format "" quote) - (list - (choice - :tag "Skipping range" - (const :tag "Skip entry" org-agenda-skip-entry-if) - (const :tag "Skip subtree" org-agenda-skip-subtree-if)) - (repeat :inline t :tag "Conditions for skipping" - (choice - :tag "Condition type" - (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp)) - (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp)) - (list :tag "TODO state is" :inline t - (const 'todo) + (list :tag "Heading for this block" + (const org-agenda-overriding-header) + (string :tag "Headline")) + (list :tag "Files to be searched" + (const org-agenda-files) + (list + (const :format "" quote) + (repeat (file)))) + (list :tag "Sorting strategy" + (const org-agenda-sorting-strategy) + (list + (const :format "" quote) + (repeat + ,org-sorting-choice))) + (list :tag "Prefix format" + (const org-agenda-prefix-format :value " %-12:c%?-12t% s") + (string)) + (list :tag "Number of days in agenda" + (const org-agenda-span) + (choice (const :tag "Day" 'day) + (const :tag "Week" 'week) + (const :tag "Month" 'month) + (const :tag "Year" 'year) + (integer :tag "Custom"))) + (list :tag "Fixed starting date" + (const org-agenda-start-day) + (string :value "2007-11-01")) + (list :tag "Start on day of week" + (const org-agenda-start-on-weekday) + (choice :value 1 + (const :tag "Today" nil) + (integer :tag "Weekday No."))) + (list :tag "Include data from diary" + (const org-agenda-include-diary) + (boolean)) + (list :tag "Deadline Warning days" + (const org-deadline-warning-days) + (integer :value 1)) + (list :tag "Category filter preset" + (const org-agenda-category-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+category or -category")))) + (list :tag "Tags filter preset" + (const org-agenda-tag-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+tag or -tag")))) + (list :tag "Set daily/weekly entry types" + (const org-agenda-entry-types) + (list + (const :format "" quote) + (set :greedy t :value (:deadline :scheduled :timestamp :sexp) + (const :deadline) + (const :scheduled) + (const :timestamp) + (const :sexp)))) + (list :tag "Standard skipping condition" + :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) + (const org-agenda-skip-function) + (list + (const :format "" quote) + (list + (choice + :tag "Skipping range" + (const :tag "Skip entry" org-agenda-skip-entry-if) + (const :tag "Skip subtree" org-agenda-skip-subtree-if)) + (repeat :inline t :tag "Conditions for skipping" (choice - (const :tag "any not-done state" 'todo) - (const :tag "any done state" 'done) - (const :tag "any state" 'any) - (list :tag "Keyword list" - (const :format "" quote) - (repeat (string :tag "Keyword"))))) - (list :tag "TODO state is not" :inline t - (const 'nottodo) - (choice - (const :tag "any not-done state" 'todo) - (const :tag "any done state" 'done) - (const :tag "any state" 'any) - (list :tag "Keyword list" - (const :format "" quote) - (repeat (string :tag "Keyword"))))) - (const :tag "scheduled" 'scheduled) - (const :tag "not scheduled" 'notscheduled) - (const :tag "deadline" 'deadline) - (const :tag "no deadline" 'notdeadline) - (const :tag "timestamp" 'timestamp) - (const :tag "no timestamp" 'nottimestamp)))))) - (list :tag "Non-standard skipping condition" - :value (org-agenda-skip-function) - (const org-agenda-skip-function) - (sexp :tag "Function or form (quoted!)")) - (list :tag "Any variable" - (variable :tag "Variable") - (sexp :tag "Value (sexp)")))) + :tag "Condition type" + (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp)) + (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp)) + (list :tag "TODO state is" :inline t + (const 'todo) + (choice + (const :tag "any not-done state" 'todo) + (const :tag "any done state" 'done) + (const :tag "any state" 'any) + (list :tag "Keyword list" + (const :format "" quote) + (repeat (string :tag "Keyword"))))) + (list :tag "TODO state is not" :inline t + (const 'nottodo) + (choice + (const :tag "any not-done state" 'todo) + (const :tag "any done state" 'done) + (const :tag "any state" 'any) + (list :tag "Keyword list" + (const :format "" quote) + (repeat (string :tag "Keyword"))))) + (const :tag "scheduled" 'scheduled) + (const :tag "not scheduled" 'notscheduled) + (const :tag "deadline" 'deadline) + (const :tag "no deadline" 'notdeadline) + (const :tag "timestamp" 'timestamp) + (const :tag "no timestamp" 'nottimestamp)))))) + (list :tag "Non-standard skipping condition" + :value (org-agenda-skip-function) + (const org-agenda-skip-function) + (sexp :tag "Function or form (quoted!)")) + (list :tag "Any variable" + (variable :tag "Variable") + (sexp :tag "Value (sexp)")))) "Selection of examples for agenda command settings. This will be spliced into the custom type of `org-agenda-custom-commands'.") @@ -434,69 +443,69 @@ should provide a description for the prefix, like :group 'org-agenda-custom-commands :type `(repeat (choice :value ("x" "Describe command here" tags "" nil) - (list :tag "Single command" - (string :tag "Access Key(s) ") - (option (string :tag "Description")) - (choice - (const :tag "Agenda" agenda) - (const :tag "TODO list" alltodo) - (const :tag "Search words" search) - (const :tag "Stuck projects" stuck) - (const :tag "Tags/Property match (all agenda files)" tags) - (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) - (const :tag "TODO keyword search (all agenda files)" todo) - (const :tag "Tags sparse tree (current buffer)" tags-tree) - (const :tag "TODO keyword tree (current buffer)" todo-tree) - (const :tag "Occur tree (current buffer)" occur-tree) - (sexp :tag "Other, user-defined function")) - (string :tag "Match (only for some commands)") - ,org-agenda-custom-commands-local-options - (option (repeat :tag "Export" (file :tag "Export to")))) - (list :tag "Command series, all agenda files" - (string :tag "Access Key(s)") - (string :tag "Description ") - (repeat :tag "Component" - (choice - (list :tag "Agenda" - (const :format "" agenda) - (const :tag "" :format "" "") - ,org-agenda-custom-commands-local-options) - (list :tag "TODO list (all keywords)" - (const :format "" alltodo) - (const :tag "" :format "" "") - ,org-agenda-custom-commands-local-options) - (list :tag "Search words" - (const :format "" search) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "Stuck projects" - (const :format "" stuck) - (const :tag "" :format "" "") - ,org-agenda-custom-commands-local-options) - (list :tag "Tags search" - (const :format "" tags) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "Tags search, TODO entries only" - (const :format "" tags-todo) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "TODO keyword search" - (const :format "" todo) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "Other, user-defined function" - (symbol :tag "function") - (string :tag "Match") - ,org-agenda-custom-commands-local-options))) - - (repeat :tag "Settings for entire command set" - (list (variable :tag "Any variable") - (sexp :tag "Value"))) - (option (repeat :tag "Export" (file :tag "Export to")))) - (cons :tag "Prefix key documentation" - (string :tag "Access Key(s)") - (string :tag "Description "))))) + (list :tag "Single command" + (string :tag "Access Key(s) ") + (option (string :tag "Description")) + (choice + (const :tag "Agenda" agenda) + (const :tag "TODO list" alltodo) + (const :tag "Search words" search) + (const :tag "Stuck projects" stuck) + (const :tag "Tags/Property match (all agenda files)" tags) + (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) + (const :tag "TODO keyword search (all agenda files)" todo) + (const :tag "Tags sparse tree (current buffer)" tags-tree) + (const :tag "TODO keyword tree (current buffer)" todo-tree) + (const :tag "Occur tree (current buffer)" occur-tree) + (sexp :tag "Other, user-defined function")) + (string :tag "Match (only for some commands)") + ,org-agenda-custom-commands-local-options + (option (repeat :tag "Export" (file :tag "Export to")))) + (list :tag "Command series, all agenda files" + (string :tag "Access Key(s)") + (string :tag "Description ") + (repeat :tag "Component" + (choice + (list :tag "Agenda" + (const :format "" agenda) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "TODO list (all keywords)" + (const :format "" alltodo) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "Search words" + (const :format "" search) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Stuck projects" + (const :format "" stuck) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "Tags search" + (const :format "" tags) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Tags search, TODO entries only" + (const :format "" tags-todo) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "TODO keyword search" + (const :format "" todo) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Other, user-defined function" + (symbol :tag "function") + (string :tag "Match") + ,org-agenda-custom-commands-local-options))) + + (repeat :tag "Settings for entire command set" + (list (variable :tag "Any variable") + (sexp :tag "Value"))) + (option (repeat :tag "Export" (file :tag "Export to")))) + (cons :tag "Prefix key documentation" + (string :tag "Access Key(s)") + (string :tag "Description "))))) (defcustom org-agenda-query-register ?o "The register holding the current query string. @@ -550,9 +559,9 @@ this one will be used." (const :tag "equal" "="))) (defgroup org-agenda-skip nil - "Options concerning skipping parts of agenda files." - :tag "Org Agenda Skip" - :group 'org-agenda) + "Options concerning skipping parts of agenda files." + :tag "Org Agenda Skip" + :group 'org-agenda) (defcustom org-agenda-skip-function-global nil "Function to be called at each match during agenda construction. @@ -636,11 +645,11 @@ all Don't show any entries with a timestamp in the global todo list. The idea behind this is that by setting a timestamp, you have already \"taken care\" of this item. -This variable can also have an integer as a value. If positive (N), -todos with a timestamp N or more days in the future will be ignored. If +This variable can also have an integer as a value. If positive (N), +todos with a timestamp N or more days in the future will be ignored. If negative (-N), todos with a timestamp N or more days in the past will be -ignored. If 0, todos with a timestamp either today or in the future will -be ignored. For example, a value of -1 will exclude todos with a +ignored. If 0, todos with a timestamp either today or in the future will +be ignored. For example, a value of -1 will exclude todos with a timestamp in the past (yesterday or earlier), while a value of 7 will exclude todos with a timestamp a week or more in the future. @@ -674,7 +683,7 @@ all Don't show any scheduled entries in the global todo list. t Same as `all', for backward compatibility. -This variable can also have an integer as a value. See +This variable can also have an integer as a value. See `org-agenda-todo-ignore-timestamp' for more details. See also `org-agenda-todo-ignore-with-date'. @@ -715,7 +724,7 @@ all Ignore all TODO entries that do have a deadline. t Same as `near', for backward compatibility. -This variable can also have an integer as a value. See +This variable can also have an integer as a value. See `org-agenda-todo-ignore-timestamp' for more details. See also `org-agenda-todo-ignore-with-date'. @@ -774,6 +783,21 @@ but not scheduled today." (const :tag "Always" t) (const :tag "Not when scheduled today" not-today))) +(defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil + "Non-nil means skip timestamp line if same entry shows because of deadline. +In the agenda of today, an entry can show up multiple times +because it has both a plain timestamp and has a nearby deadline. +When this variable is t, then only the deadline is shown and the +fact that the entry has a timestamp for or including today is not +shown. When this variable is nil, the entry will be shown +several times." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :version "24.1" + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t))) + (defcustom org-agenda-skip-deadline-if-done nil "Non-nil means don't show deadlines when the corresponding item is done. When nil, the deadline is still shown and should give you a happy feeling. @@ -860,12 +884,14 @@ N days, just insert a special line indicating the size of the gap." When nil, the matcher string is not shown, but is put into the help-echo property so than moving the mouse over the command shows it. Setting it to nil is good if matcher strings are very long and/or if -you want to use two-column display (see `org-agenda-menu-two-column')." +you want to use two-columns display (see `org-agenda-menu-two-columns')." :group 'org-agenda :version "24.1" :type 'boolean) -(defcustom org-agenda-menu-two-column nil +(define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3") + +(defcustom org-agenda-menu-two-columns nil "Non-nil means, use two columns to show custom commands in the dispatcher. If you use this, you probably want to set `org-agenda-menu-show-matcher' to nil." @@ -873,8 +899,14 @@ to nil." :version "24.1" :type 'boolean) -(defcustom org-finalize-agenda-hook nil - "Hook run just before displaying an agenda buffer." +(define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3") +(defcustom org-agenda-finalize-hook nil + "Hook run just before displaying an agenda buffer. +The buffer is still writable when the hook is called. + +You can modify some of the buffer substrings but you should be +extra careful not to modify the text properties of the agenda +headlines as the agenda display heavily relies on them." :group 'org-agenda-startup :type 'hook) @@ -932,7 +964,8 @@ have been removed when this is called, as will any matches for regular expressions listed in `org-agenda-entry-text-exclude-regexps'.") (defvar org-agenda-include-inactive-timestamps nil - "Non-nil means include inactive time stamps in agenda and timeline.") + "Non-nil means include inactive time stamps in agenda and timeline. +Dynamically scoped.") (defgroup org-agenda-windows nil "Options concerning the windows used by the Agenda in Org Mode." @@ -975,11 +1008,11 @@ option will be ignored." :type 'boolean) (defcustom org-agenda-ndays nil - "Number of days to include in overview display. + "Number of days to include in overview display. Should be 1 or 7. Obsolete, see `org-agenda-span'." - :group 'org-agenda-daily/weekly - :type 'integer) + :group 'org-agenda-daily/weekly + :type 'integer) (make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1") @@ -1202,10 +1235,18 @@ agenda display." :type 'boolean) (defcustom org-agenda-start-with-log-mode nil - "The initial value of log-mode in a newly created agenda window." + "The initial value of log-mode in a newly created agenda window. +See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further +explanations on the possible values." :group 'org-agenda-startup :group 'org-agenda-daily/weekly - :type 'boolean) + :type '(choice (const :tag "Don't show log items" nil) + (const :tag "Show only log items" 'only) + (const :tag "Show all possible log items" 'clockcheck) + (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'" + (choice (const :tag "Show closed log items" 'closed) + (const :tag "Show clocked log items" 'clock) + (const :tag "Show all logged state changes" 'state))))) (defcustom org-agenda-start-with-clockreport-mode nil "The initial value of clockreport-mode in a newly created agenda window." @@ -1501,8 +1542,10 @@ Custom commands can set this variable in the options section." :group 'org-agenda-line-format) (defvar org-prefix-format-compiled nil - "The compiled version of the most recently used prefix format. -See the variable `org-agenda-prefix-format'.") + "The compiled prefix format and associated variables. +This is a list where first element is a list of variable bindings, and second +element is the compiled format expression. See the variable +`org-agenda-prefix-format'.") (defcustom org-agenda-todo-keyword-format "%-1s" "Format for the TODO keyword in agenda lines. @@ -1511,6 +1554,16 @@ to occupy a fixed space in the agenda display." :group 'org-agenda-line-format :type 'string) +(defcustom org-agenda-diary-sexp-prefix nil + "A regexp that matches part of a diary sexp entry +which should be treated as scheduling/deadline information in +`org-agenda'. + +For example, you can use this to extract the `diary-remind-message' from +`diary-remind' entries." + :group 'org-agenda-line-format + :type '(choice (const :tag "None" nil) (regexp :tag "Regexp"))) + (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") "Text preceding timerange entries in the agenda view. This is a list with two strings. The first applies when the range @@ -1659,7 +1712,7 @@ determines if it is a foreground or a background color." (defcustom org-agenda-day-face-function nil "Function called to determine what face should be used to display a day. -The only argument passed to that function is the day. It should +The only argument passed to that function is the day. It should returns a face, or nil if does not want to specify a face and let the normal rules apply." :group 'org-agenda-line-format @@ -1762,10 +1815,6 @@ Note that functions in this alist don't need to be quoted." :version "24.1" :group 'org-agenda) -(eval-when-compile - (require 'cl)) -(require 'org) - (defmacro org-agenda-with-point-at-orig-entry (string &rest body) "Execute BODY with point at location given by `org-hd-marker' property. If STRING is non-nil, the text property will be fetched from position 0 @@ -1789,7 +1838,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (setcdr ass (cdr entry)) (push entry org-agenda-custom-commands)))) -;;; Define the Org-agenda-mode +;;; Define the org-agenda-mode (defvar org-agenda-mode-map (make-sparse-keymap) "Keymap for `org-agenda-mode'.") @@ -1797,7 +1846,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvaralias 'org-agenda-keymap 'org-agenda-mode-map)) (defvar org-agenda-menu) ; defined later in this file. -(defvar org-agenda-restrict) ; defined later in this file. +(defvar org-agenda-restrict nil) ; defined later in this file. (defvar org-agenda-follow-mode nil) (defvar org-agenda-entry-text-mode nil) (defvar org-agenda-clockreport-mode nil) @@ -1805,10 +1854,76 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvar org-agenda-redo-command nil) (defvar org-agenda-query-string nil) (defvar org-agenda-mode-hook nil - "Hook for `org-agenda-mode', run after the mode is turned on.") + "Hook run after `org-agenda-mode' is turned on. +The buffer is still writable when this hook is called.") (defvar org-agenda-type nil) (defvar org-agenda-force-single-file nil) -(defvar org-agenda-bulk-marked-entries) ;; Defined further down in this file +(defvar org-agenda-bulk-marked-entries nil + "List of markers that refer to marked entries in the agenda.") + +;;; Multiple agenda buffers support + +(defcustom org-agenda-sticky nil + "Non-nil means agenda q key will bury agenda buffers. +Agenda commands will then show existing buffer instead of generating new ones. +When nil, `q' will kill the single agenda buffer." + :group 'org-agenda + :version "24.3" + :type 'boolean) + +;;;###autoload +(defun org-toggle-sticky-agenda (&optional arg) + "Toggle `org-agenda-sticky'." + (interactive "P") + (let ((new-value (if arg + (> (prefix-numeric-value arg) 0) + (not org-agenda-sticky)))) + (if (equal new-value org-agenda-sticky) + (and (org-called-interactively-p 'interactive) + (message "Sticky agenda was already %s" + (if org-agenda-sticky "enabled" "disabled"))) + (setq org-agenda-sticky new-value) + (org-agenda-kill-all-agenda-buffers) + (and (org-called-interactively-p 'interactive) + (message "Sticky agenda was %s" + (if org-agenda-sticky "enabled" "disabled")))))) + +(defvar org-agenda-buffer nil + "Agenda buffer currently being generated.") + +(defvar org-agenda-last-prefix-arg nil) +(defvar org-agenda-this-buffer-name nil) +(defvar org-agenda-doing-sticky-redo nil) +(defvar org-agenda-this-buffer-is-sticky nil) + +(defconst org-agenda-local-vars + '(org-agenda-this-buffer-name + org-agenda-undo-list + org-agenda-pending-undo-list + org-agenda-follow-mode + org-agenda-entry-text-mode + org-agenda-clockreport-mode + org-agenda-show-log + org-agenda-redo-command + org-agenda-query-string + org-agenda-type + org-agenda-bulk-marked-entries + org-agenda-undo-has-started-in + org-agenda-info + org-agenda-tag-filter-overlays + org-agenda-cat-filter-overlays + org-agenda-pre-window-conf + org-agenda-columns-active + org-agenda-tag-filter + org-agenda-category-filter + org-agenda-markers + org-agenda-last-search-view-search-was-boolean + org-agenda-filtered-by-category + org-agenda-filter-form + org-agenda-show-window + org-agenda-cycle-counter + org-agenda-last-prefix-arg) + "Variables that must be local in agenda buffers to allow multiple buffers.") (defun org-agenda-mode () "Mode for time-sorted view on action items in Org-mode files. @@ -1817,7 +1932,30 @@ The following commands are available: \\{org-agenda-mode-map}" (interactive) - (kill-all-local-variables) + (cond (org-agenda-doing-sticky-redo + ;; Refreshing sticky agenda-buffer + ;; + ;; Preserve the value of `org-agenda-local-vars' variables, + ;; while letting `kill-all-local-variables' kill the rest + (let ((save (buffer-local-variables))) + (kill-all-local-variables) + (mapc 'make-local-variable org-agenda-local-vars) + (dolist (elem save) + (let ((var (car elem)) + (val (cdr elem))) + (when (and val + (member var org-agenda-local-vars)) + (set var val))))) + (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) + (org-agenda-sticky + ;; Creating a sticky Agenda buffer for the first time + (kill-all-local-variables) + (mapc 'make-local-variable org-agenda-local-vars) + (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) + (t + ;; Creating a non-sticky agenda buffer + (kill-all-local-variables) + (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil))) (setq org-agenda-undo-list nil org-agenda-pending-undo-list nil org-agenda-bulk-marked-entries nil) @@ -1829,14 +1967,13 @@ The following commands are available: (easy-menu-add org-agenda-menu) (if org-startup-truncated (setq truncate-lines t)) (org-set-local 'line-move-visual nil) - (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) + (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) ;; Make sure properties are removed when copying text - (when (boundp 'buffer-substring-filters) - (org-set-local 'buffer-substring-filters - (cons (lambda (x) - (set-text-properties 0 (length x) nil x) x) - buffer-substring-filters))) + (make-local-variable 'filter-buffer-substring-functions) + (add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (substring-no-properties (funcall fun start end delete)))) (unless org-agenda-keep-modes (setq org-agenda-follow-mode org-agenda-start-with-follow-mode org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode @@ -1868,11 +2005,13 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) (org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile) (org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark) +(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all) (org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp) (org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark) -(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-remove-all-marks) -(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda) +(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-unmark-all) (org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action) +(org-defkey org-agenda-mode-map "k" 'org-agenda-capture) +(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda) (org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload) (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default) (org-defkey org-agenda-mode-map "\C-c\C-xa" 'org-agenda-toggle-archive-tag) @@ -1901,8 +2040,6 @@ The following commands are available: (org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) (org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note) (org-defkey org-agenda-mode-map "z" 'org-agenda-add-note) -(org-defkey org-agenda-mode-map "k" 'org-agenda-action) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-k" 'org-agenda-action) (org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later) (org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier) (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later) @@ -1913,7 +2050,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) (let ((l '(1 2 3 4 5 6 7 8 9 0))) (while l (org-defkey org-agenda-mode-map - (int-to-string (pop l)) 'digit-argument))) + (int-to-string (pop l)) 'digit-argument))) (org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode) (org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode) @@ -1924,21 +2061,23 @@ The following commands are available: (org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines) (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) (org-defkey org-agenda-mode-map "r" 'org-agenda-redo) -(org-defkey org-agenda-mode-map "g" 'org-agenda-redo) +(org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t))) (org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort) (org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort) (org-defkey org-agenda-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate) (org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property) (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) +(org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit) (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write) (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) (org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) -(org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority) (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags) (org-defkey org-agenda-mode-map "n" 'org-agenda-next-line) (org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line) +(org-defkey org-agenda-mode-map "N" 'org-agenda-next-item) +(org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item) (substitute-key-definition 'next-line 'org-agenda-next-line org-agenda-mode-map global-map) (substitute-key-definition 'previous-line 'org-agenda-previous-line @@ -1946,8 +2085,8 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach) (org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line) (org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line) -(org-defkey org-agenda-mode-map "," 'org-agenda-priority) (org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority) +(org-defkey org-agenda-mode-map "," 'org-agenda-priority) (org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry) (org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar) (org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date) @@ -1981,6 +2120,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag) (org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) (org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category) +(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-category) (org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) (define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note) (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) @@ -2034,7 +2174,7 @@ The following commands are available: ["Show some entry text" org-agenda-entry-text-mode :style toggle :selected org-agenda-entry-text-mode :active t] - "--" + "--" ["Show Logbook entries" org-agenda-log-mode :style toggle :selected org-agenda-show-log :active (org-agenda-check-type nil 'agenda 'timeline) @@ -2054,9 +2194,10 @@ The following commands are available: ["Show original entry" org-agenda-show t] ["Go To (other window)" org-agenda-goto t] ["Go To (this window)" org-agenda-switch-to t] + ["Capture with cursor date" org-agenda-capture t] ["Follow Mode" org-agenda-follow-mode :style toggle :selected org-agenda-follow-mode :active t] -; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] + ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] "--" ("TODO" ["Cycle TODO" org-agenda-todo t] @@ -2075,10 +2216,11 @@ The following commands are available: ["Delete subtree" org-agenda-kill t]) ("Bulk action" ["Mark entry" org-agenda-bulk-mark t] + ["Mark all" org-agenda-bulk-mark-all t] ["Mark matching regexp" org-agenda-bulk-mark-regexp t] ["Unmark entry" org-agenda-bulk-unmark t] - ["Unmark all entries" org-agenda-bulk-remove-all-marks :active t :keys "C-u s"]) - ["Act on all marked" org-agenda-bulk-action t] + ["Unmark all entries" org-agenda-bulk-unmark-all :active t :keys "U"]) + ["Act on all marked" org-agenda-bulk-action t] "--" ("Tags and Properties" ["Show all Tags" org-agenda-show-tags t] @@ -2090,11 +2232,6 @@ The following commands are available: ["Schedule" org-agenda-schedule t] ["Set Deadline" org-agenda-deadline t] "--" - ["Mark item" org-agenda-action :active t :keys "k m"] - ["Show mark item" org-agenda-action :active t :keys "k v"] - ["Schedule marked item" org-agenda-action :active t :keys "k s"] - ["Set Deadline for marked item" org-agenda-action :active t :keys "k d"] - "--" ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"] @@ -2115,7 +2252,7 @@ The following commands are available: ["Set Priority" org-agenda-priority t] ["Increase Priority" org-agenda-priority-up t] ["Decrease Priority" org-agenda-priority-down t] - ["Show Priority" org-agenda-show-priority t]) + ["Show Priority" org-show-priority t]) ("Calendar/Diary" ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)] ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)] @@ -2144,12 +2281,8 @@ The following commands are available: (defvar org-agenda-allow-remote-undo t "Non-nil means allow remote undo from the agenda buffer.") -(defvar org-agenda-undo-list nil - "List of undoable operations in the agenda since last refresh.") (defvar org-agenda-undo-has-started-in nil "Buffers that have already seen `undo-start' in the current undo sequence.") -(defvar org-agenda-pending-undo-list nil - "In a series of undo commands, this is the list of remaining undo items.") (defun org-agenda-undo () "Undo a remote editing step in the agenda. @@ -2193,14 +2326,60 @@ that have been changed along." ;;; Agenda dispatch -(defvar org-agenda-restrict nil) (defvar org-agenda-restrict-begin (make-marker)) (defvar org-agenda-restrict-end (make-marker)) (defvar org-agenda-last-dispatch-buffer nil) (defvar org-agenda-overriding-restriction nil) +(defcustom org-agenda-custom-commands-contexts nil + "Alist of custom agenda keys and contextual rules. + +For example, if you have a custom agenda command \"p\" and you +want this command to be accessible only from plain text files, +use this: + + '((\"p\" (in-file . \"\\.txt\"))) + +Here are the available contexts definitions: + + in-file: command displayed only in matching files + in-mode: command displayed only in matching modes + not-in-file: command not displayed in matching files + not-in-mode: command not displayed in matching modes + [function]: a custom function taking no argument + +If you define several checks, the agenda command will be +accessible if there is at least one valid check. + +You can also bind a key to another agenda custom command +depending on contextual rules. + + '((\"p\" \"q\" (in-file . \"\\.txt\"))) + +Here it means: in .txt files, use \"p\" as the key for the +agenda command otherwise associated with \"q\". (The command +originally associated with \"q\" is not displayed to avoid +duplicates.)" + :version "24.3" + :group 'org-agenda-custom-commands + :type '(repeat (list :tag "Rule" + (string :tag " Agenda key") + (string :tag "Replace by command") + (repeat :tag "Available when" + (choice + (cons :tag "Condition" + (choice + (const :tag "In file" in-file) + (const :tag "Not in file" not-in-file) + (const :tag "In mode" in-mode) + (const :tag "Not in mode" not-in-mode)) + (regexp)) + (function :tag "Custom function")))))) + +(defvar org-keys nil) +(defvar org-match nil) ;;;###autoload -(defun org-agenda (&optional arg keys restriction) +(defun org-agenda (&optional arg org-keys restriction) "Dispatch agenda commands to collect entries to the agenda buffer. Prompts for a command to execute. Any prefix arg will be passed on to the selected command. The default selections are: @@ -2215,6 +2394,7 @@ M Like `m', but select only TODO entries, no ordinary headlines. L Create a timeline for the current buffer. e Export views to associated files. s Search entries for keywords. +S Search entries for keywords, only with TODO keywords. / Multi occur across all agenda files and also files listed in `org-agenda-text-search-extra-files'. < Restrict agenda commands to buffer, subtree, or region. @@ -2236,6 +2416,7 @@ Pressing `<' twice means to restrict to the current subtree or region (interactive "P") (catch 'exit (let* ((prefix-descriptions nil) + (org-agenda-buffer-name org-agenda-buffer-name) (org-agenda-window-setup (if (equal (buffer-name) org-agenda-buffer-name) 'current-window @@ -2253,9 +2434,12 @@ Pressing `<' twice means to restrict to the current subtree or region ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) (t (cons (car x) (cons "" (cdr x)))))) org-agenda-custom-commands))) + (org-agenda-custom-commands + (org-contextualize-keys + org-agenda-custom-commands org-agenda-custom-commands-contexts)) (buf (current-buffer)) (bfn (buffer-file-name (buffer-base-buffer))) - entry key type match lprops ans) + entry key type org-match lprops ans) ;; Turn off restriction unless there is an overriding one, (unless org-agenda-overriding-restriction (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list) @@ -2270,10 +2454,16 @@ Pressing `<' twice means to restrict to the current subtree or region (put 'org-agenda-redo-command 'last-args nil) ;; Remember where this call originated (setq org-agenda-last-dispatch-buffer (current-buffer)) - (unless keys + (unless org-keys (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) - keys (car ans) + org-keys (car ans) restriction (cdr ans))) + ;; If we have sticky agenda buffers, set a name for the buffer, + ;; depending on the invoking keys. The user may still set this + ;; as a command option, which will overwrite what we do here. + (if org-agenda-sticky + (setq org-agenda-buffer-name + (format "*Org Agenda(%s)*" org-keys))) ;; Establish the restriction, if any (when (and (not org-agenda-overriding-restriction) restriction) (put 'org-agenda-files 'org-restrict (list bfn)) @@ -2292,11 +2482,15 @@ Pressing `<' twice means to restrict to the current subtree or region ;; For example the todo list should not need it (but does...) (cond - ((setq entry (assoc keys org-agenda-custom-commands)) + ((setq entry (assoc org-keys org-agenda-custom-commands)) (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) (progn - (setq type (nth 2 entry) match (eval (nth 3 entry)) + (setq type (nth 2 entry) org-match (eval (nth 3 entry)) lprops (nth 4 entry)) + (if org-agenda-sticky + (setq org-agenda-buffer-name + (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match)) + (format "*Org Agenda(%s)*" org-keys)))) (put 'org-agenda-redo-command 'org-lprops lprops) (cond ((eq type 'agenda) @@ -2304,44 +2498,45 @@ Pressing `<' twice means to restrict to the current subtree or region ((eq type 'alltodo) (org-let lprops '(org-todo-list current-prefix-arg))) ((eq type 'search) - (org-let lprops '(org-search-view current-prefix-arg match nil))) + (org-let lprops '(org-search-view current-prefix-arg org-match nil))) ((eq type 'stuck) (org-let lprops '(org-agenda-list-stuck-projects current-prefix-arg))) ((eq type 'tags) - (org-let lprops '(org-tags-view current-prefix-arg match))) + (org-let lprops '(org-tags-view current-prefix-arg org-match))) ((eq type 'tags-todo) - (org-let lprops '(org-tags-view '(4) match))) + (org-let lprops '(org-tags-view '(4) org-match))) ((eq type 'todo) - (org-let lprops '(org-todo-list match))) + (org-let lprops '(org-todo-list org-match))) ((eq type 'tags-tree) (org-check-for-org-mode) - (org-let lprops '(org-match-sparse-tree current-prefix-arg match))) + (org-let lprops '(org-match-sparse-tree current-prefix-arg org-match))) ((eq type 'todo-tree) (org-check-for-org-mode) (org-let lprops '(org-occur (concat "^" org-outline-regexp "[ \t]*" - (regexp-quote match) "\\>")))) + (regexp-quote org-match) "\\>")))) ((eq type 'occur-tree) (org-check-for-org-mode) - (org-let lprops '(org-occur match))) + (org-let lprops '(org-occur org-match))) ((functionp type) - (org-let lprops '(funcall type match))) + (org-let lprops '(funcall type org-match))) ((fboundp type) - (org-let lprops '(funcall type match))) + (org-let lprops '(funcall type org-match))) (t (error "Invalid custom agenda command type %s" type)))) (org-agenda-run-series (nth 1 entry) (cddr entry)))) - ((equal keys "C") + ((equal org-keys "C") (setq org-agenda-custom-commands org-agenda-custom-commands-orig) (customize-variable 'org-agenda-custom-commands)) - ((equal keys "a") (call-interactively 'org-agenda-list)) - ((equal keys "s") (call-interactively 'org-search-view)) - ((equal keys "t") (call-interactively 'org-todo-list)) - ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) - ((equal keys "m") (call-interactively 'org-tags-view)) - ((equal keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) - ((equal keys "e") (call-interactively 'org-store-agenda-views)) - ((equal keys "?") (org-tags-view nil "+FLAGGED") + ((equal org-keys "a") (call-interactively 'org-agenda-list)) + ((equal org-keys "s") (call-interactively 'org-search-view)) + ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4)))) + ((equal org-keys "t") (call-interactively 'org-todo-list)) + ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) + ((equal org-keys "m") (call-interactively 'org-tags-view)) + ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) + ((equal org-keys "e") (call-interactively 'org-store-agenda-views)) + ((equal org-keys "?") (org-tags-view nil "+FLAGGED") (org-add-hook 'post-command-hook (lambda () @@ -2357,15 +2552,15 @@ Pressing `<' twice means to restrict to the current subtree or region (copy-sequence note)) nil 'face 'org-warning))))))) t t)) - ((equal keys "L") - (unless (eq major-mode 'org-mode) + ((equal org-keys "L") + (unless (derived-mode-p 'org-mode) (error "This is not an Org-mode file")) (unless restriction (put 'org-agenda-files 'org-restrict (list bfn)) (org-call-with-arg 'org-timeline arg))) - ((equal keys "#") (call-interactively 'org-agenda-list-stuck-projects)) - ((equal keys "/") (call-interactively 'org-occur-in-agenda-files)) - ((equal keys "!") (customize-variable 'org-stuck-projects)) + ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects)) + ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files)) + ((equal org-keys "!") (customize-variable 'org-stuck-projects)) (t (error "Invalid agenda key")))))) (defun org-agenda-append-agenda () @@ -2373,11 +2568,13 @@ Pressing `<' twice means to restrict to the current subtree or region This function allows interactive building of block agendas. Agenda views are separated by `org-agenda-block-separator'." (interactive) - (unless (string= (buffer-name) org-agenda-buffer-name) + (unless (derived-mode-p 'org-agenda-mode) (error "Can only append from within agenda buffer")) (let ((org-agenda-multi t)) (org-agenda) - (widen))) + (widen) + (org-agenda-finalize) + (org-agenda-fit-window-to-buffer))) (defun org-agenda-normalize-custom-commands (cmds) (delq nil @@ -2393,7 +2590,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 (eq major-mode 'org-mode))) + (restrict-ok (and bfn (derived-mode-p 'org-mode))) (region-p (org-region-active-p)) (custom org-agenda-custom-commands) (selstring "") @@ -2406,15 +2603,15 @@ Agenda views are separated by `org-agenda-block-separator'." (erase-buffer) (insert (eval-when-compile (let ((header -" -Press key for an agenda command: < Buffer, subtree/region restriction + "Press key for an agenda command: < Buffer, subtree/region restriction -------------------------------- > Remove restriction a Agenda for current week or day e Export agenda views t List of all TODO entries T Entries with special TODO kwd m Match a TAGS/PROP/TODO query M Like m, but only TODO entries +s Search for keywords S Like s, but only TODO entries L Timeline for current buffer # List stuck projects (!=configure) -s Search for keywords C Configure custom agenda commands -/ Multi-occur ? Find :FLAGGED: entries +/ Multi-occur C Configure custom agenda commands +? Find :FLAGGED: entries * Toggle sticky agenda views ") (start 0)) (while (string-match @@ -2474,13 +2671,12 @@ s Search for keywords C Configure custom agenda commands ((stringp match) (setq match (copy-sequence match)) (org-add-props match nil 'face 'org-warning)) - (match - (format "set of %d commands" (length match))) - (t "")))) + ((listp type) + (format "set of %d commands" (length type)))))) (if (org-string-nw-p match) (add-text-properties 0 (length line) (list 'help-echo - (concat "Matcher: "match)) line))) + (concat "Matcher: " match)) line))) (push line lines))) (setq lines (nreverse lines)) (when prefixes @@ -2497,7 +2693,7 @@ s Search for keywords C Configure custom agenda commands prefixes)) ;; Check if we should display in two columns - (if org-agenda-menu-two-column + (if org-agenda-menu-two-columns (progn (setq n (length lines) n1 (+ (/ n 2) (mod n 2)) @@ -2547,6 +2743,9 @@ s Search for keywords C Configure custom agenda commands nil (cons (substring (car x) 1) (cdr x)))) custom)))) + ((eq c ?*) + (call-interactively 'org-toggle-sticky-agenda) + (sit-for 2)) ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) (message "Restriction is only possible in Org-mode buffers") (ding) (sit-for 1)) @@ -2568,7 +2767,7 @@ s Search for keywords C Configure custom agenda commands ((eq c ?>) (org-agenda-remove-restriction-lock 'noupdate) (setq restriction nil)) - ((and (equal selstring "") (memq c '(?s ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) + ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) ((and (> (length selstring) 0) (eq c ?\d)) (delete-window) @@ -2577,55 +2776,72 @@ s Search for keywords C Configure custom agenda commands ((equal c ?q) (error "Abort")) (t (error "Invalid key %c" c)))))))) -(defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter -(defvar org-agenda-last-arguments nil - "The arguments of the previous call to `org-agenda'.") +(defun org-agenda-fit-window-to-buffer () + "Fit the window to the buffer size." + (and (memq org-agenda-window-setup '(reorganize-frame)) + (fboundp 'fit-window-to-buffer) + (org-fit-window-to-buffer + nil + (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) + (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) + +(defvar org-cmd nil) +(defvar org-agenda-overriding-cmd nil) +(defvar org-agenda-overriding-arguments nil) +(defvar org-agenda-overriding-cmd-arguments nil) (defun org-agenda-run-series (name series) - (org-let (nth 1 series) '(org-prepare-agenda name)) + (org-let (nth 1 series) '(org-agenda-prepare name)) + ;; We need to reset agenda markers here, because when constructing a + ;; block agenda, the individual blocks do not do that. + (org-agenda-reset-markers) (let* ((org-agenda-multi t) (redo (list 'org-agenda-run-series name (list 'quote series))) - (org-agenda-overriding-arguments - (or org-agenda-overriding-arguments - (unless (null (delq nil (get 'org-agenda-redo-command 'last-args))) - (get 'org-agenda-redo-command 'last-args)))) (cmds (car series)) (gprops (nth 1 series)) match ;; The byte compiler incorrectly complains about this. Keep it! - cmd type lprops) - (while (setq cmd (pop cmds)) - (setq type (car cmd) match (eval (nth 1 cmd)) lprops (nth 2 cmd)) - (cond - ((eq type 'agenda) - (org-let2 gprops lprops - '(call-interactively 'org-agenda-list))) - ((eq type 'alltodo) - (org-let2 gprops lprops - '(call-interactively 'org-todo-list))) - ((eq type 'search) - (org-let2 gprops lprops - '(org-search-view current-prefix-arg match nil))) - ((eq type 'stuck) - (org-let2 gprops lprops - '(call-interactively 'org-agenda-list-stuck-projects))) - ((eq type 'tags) - (org-let2 gprops lprops - '(org-tags-view current-prefix-arg match))) - ((eq type 'tags-todo) - (org-let2 gprops lprops - '(org-tags-view '(4) match))) - ((eq type 'todo) - (org-let2 gprops lprops - '(org-todo-list match))) - ((fboundp type) - (org-let2 gprops lprops - '(funcall type match))) - (t (error "Invalid type in command series")))) + org-cmd type lprops) + (while (setq org-cmd (pop cmds)) + (setq type (car org-cmd) + match (eval (nth 1 org-cmd)) + lprops (nth 2 org-cmd)) + (let ((org-agenda-overriding-arguments + (if (eq org-agenda-overriding-cmd org-cmd) + (or org-agenda-overriding-arguments + org-agenda-overriding-cmd-arguments)))) + (cond + ((eq type 'agenda) + (org-let2 gprops lprops + '(call-interactively 'org-agenda-list))) + ((eq type 'alltodo) + (org-let2 gprops lprops + '(call-interactively 'org-todo-list))) + ((eq type 'search) + (org-let2 gprops lprops + '(org-search-view current-prefix-arg match nil))) + ((eq type 'stuck) + (org-let2 gprops lprops + '(call-interactively 'org-agenda-list-stuck-projects))) + ((eq type 'tags) + (org-let2 gprops lprops + '(org-tags-view current-prefix-arg match))) + ((eq type 'tags-todo) + (org-let2 gprops lprops + '(org-tags-view '(4) match))) + ((eq type 'todo) + (org-let2 gprops lprops + '(org-todo-list match))) + ((fboundp type) + (org-let2 gprops lprops + '(funcall type match))) + (t (error "Invalid type in command series"))))) (widen) + (let ((inhibit-read-only t)) + (add-text-properties (point-min) (point-max) + `(org-series t org-series-redo-cmd ,redo))) (setq org-agenda-redo-command redo) - (put 'org-agenda-redo-command 'last-args org-agenda-last-arguments) (goto-char (point-min))) - (org-fit-agenda-window) - (org-let (nth 1 series) '(org-finalize-agenda))) + (org-agenda-fit-window-to-buffer) + (org-let (nth 1 series) '(org-agenda-finalize))) ;;;###autoload (defmacro org-batch-agenda (cmd-key &rest parameters) @@ -2743,7 +2959,6 @@ This ensures the export commands can easily use it." (setq res (replace-match ";" t t res))) (org-trim res))) - ;;;###autoload (defun org-store-agenda-views (&rest parameters) (interactive) @@ -2756,11 +2971,18 @@ This ensures the export commands can easily use it." (pop-up-frames nil) (dir default-directory) (pars (org-make-parameter-alist parameters)) - cmd thiscmdkey files opts cmd-or-set) + cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname) (save-window-excursion (while cmds (setq cmd (pop cmds) thiscmdkey (car cmd) + thiscmdcmd (cdr cmd) + match (nth 2 thiscmdcmd) + bufname (if org-agenda-sticky + (or (and (stringp match) + (format "*Org Agenda(%s:%s)*" thiscmdkey match)) + (format "*Org Agenda(%s)*" thiscmdkey)) + org-agenda-buffer-name) cmd-or-set (nth 2 cmd) opts (nth (if (listp cmd-or-set) 3 4) cmd) files (nth (if (listp cmd-or-set) 4 5) cmd)) @@ -2769,15 +2991,17 @@ This ensures the export commands can easily use it." (org-eval-in-environment (append org-agenda-exporter-settings opts pars) (org-agenda nil thiscmdkey)) - (set-buffer org-agenda-buffer-name) + (set-buffer bufname) (while files (org-eval-in-environment (append org-agenda-exporter-settings opts pars) - (org-agenda-write (expand-file-name (pop files) dir) nil t))) - (and (get-buffer org-agenda-buffer-name) - (kill-buffer org-agenda-buffer-name))))))) + (org-agenda-write (expand-file-name (pop files) dir) nil t bufname))) + (and (get-buffer bufname) + (kill-buffer bufname))))))) (def-edebug-spec org-batch-store-agenda-views (&rest sexp)) +(defvar org-agenda-current-span nil + "The current span used in the agenda view.") ; local variable in the agenda buffer (defun org-agenda-mark-header-line (pos) "Mark the line at POS as an agenda structure header." (save-excursion @@ -2788,9 +3012,9 @@ This ensures the export commands can easily use it." (put-text-property (point-at-bol) (point-at-eol) 'org-agenda-title-append org-agenda-title-append)))) -(defvar org-mobile-creating-agendas) +(defvar org-mobile-creating-agendas) ; defined in org-mobile.el (defvar org-agenda-write-buffer-name "Agenda View") -(defun org-agenda-write (file &optional open nosettings) +(defun org-agenda-write (file &optional open nosettings agenda-bufname) "Write the current buffer (an agenda view) as a file. Depending on the extension of the file name, plain text (.txt), HTML (.html or .htm) or Postscript (.ps) is produced. @@ -2801,7 +3025,8 @@ With prefix argument OPEN, open the new file immediately. If NOSETTINGS is given, do not scope the settings of `org-agenda-exporter-settings' into the export commands. This is used when the settings have already been scoped and we do not wish to overrule other, -higher priority settings." +higher priority settings. +If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (interactive "FWrite agenda to file: \nP") (if (not (file-writable-p file)) (error "Cannot write agenda to file %s" file)) @@ -2828,9 +3053,7 @@ higher priority settings." ((string-match "\\.html?\\'" file) (require 'htmlize) (set-buffer (htmlize-buffer (current-buffer))) - - (when (and org-agenda-export-html-style - (string-match "<style>" org-agenda-export-html-style)) + (when org-agenda-export-html-style ;; replace <style> section with org-agenda-export-html-style (goto-char (point-min)) (kill-region (- (search-forward "<style") 6) @@ -2870,7 +3093,9 @@ higher priority settings." (save-buffer 0) (kill-buffer (current-buffer)) (message "Plain text written to %s" file)))))))) - (set-buffer org-agenda-buffer-name)) + (set-buffer (or agenda-bufname + (and (called-interactively-p 'any) (buffer-name)) + org-agenda-buffer-name))) (when open (org-open-file file))) (defvar org-agenda-tag-filter-overlays nil) @@ -2933,7 +3158,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 (eq major-mode 'org-mode)) + (if (not (derived-mode-p 'org-mode)) (setq txt "") (save-excursion (save-restriction @@ -3049,28 +3274,19 @@ 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 (eq major-mode 'org-mode) + (or (derived-mode-p 'org-mode) (error "Cannot execute org-mode agenda command on buffer in %s" major-mode))) -(defun org-fit-agenda-window () - "Fit the window to the buffer size." - (and (memq org-agenda-window-setup '(reorganize-frame)) - (fboundp 'fit-window-to-buffer) - (org-fit-window-to-buffer - nil - (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) - (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) - ;;; Agenda prepare and finalize (defvar org-agenda-multi nil) ; dynamically scoped -(defvar org-agenda-buffer-name "*Org Agenda*") -(defvar org-pre-agenda-window-conf nil) +(defvar org-agenda-pre-window-conf nil) (defvar org-agenda-columns-active nil) (defvar org-agenda-name nil) (defvar org-agenda-tag-filter nil) (defvar org-agenda-category-filter nil) +(defvar org-agenda-top-category-filter nil) (defvar org-agenda-tag-filter-while-redo nil) (defvar org-agenda-tag-filter-preset nil "A preset of the tags filter used for secondary agenda filtering. @@ -3092,63 +3308,107 @@ the entire agenda view. In a block agenda, it will not work reliably to define a filter for one of the individual blocks. You need to set it in the global options and expect it to be applied to the entire view.") -(defun org-prepare-agenda (&optional name) - (setq org-todo-keywords-for-agenda nil) - (setq org-drawers-for-agenda nil) - (unless org-agenda-persistent-filter - (setq org-agenda-tag-filter nil - org-agenda-category-filter nil)) - (put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset) - (put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset) - (if org-agenda-multi + +(defun org-agenda-use-sticky-p () + "Return non-nil if an agenda buffer named +`org-agenda-buffer-name' exists and should be shown instead of +generating a new one." + (and + ;; turned off by user + org-agenda-sticky + ;; For multi-agenda buffer already exists + (not org-agenda-multi) + ;; buffer found + (get-buffer org-agenda-buffer-name) + ;; C-u parameter is same as last call + (with-current-buffer (get-buffer org-agenda-buffer-name) + (and + (equal current-prefix-arg + org-agenda-last-prefix-arg) + ;; In case user turned stickiness on, while having existing + ;; Agenda buffer active, don't reuse that buffer, because it + ;; does not have org variables local + org-agenda-this-buffer-is-sticky)))) + +(defun org-agenda-prepare-window (abuf) + "Setup agenda buffer in the window." + (let* ((awin (get-buffer-window abuf)) + wconf) + (cond + ((equal (current-buffer) abuf) nil) + (awin (select-window awin)) + ((not (setq wconf (current-window-configuration)))) + ((equal org-agenda-window-setup 'current-window) + (org-pop-to-buffer-same-window abuf)) + ((equal org-agenda-window-setup 'other-window) + (org-switch-to-buffer-other-window abuf)) + ((equal org-agenda-window-setup 'other-frame) + (switch-to-buffer-other-frame abuf)) + ((equal org-agenda-window-setup 'reorganize-frame) + (delete-other-windows) + (org-switch-to-buffer-other-window abuf))) + ;; additional test in case agenda is invoked from within agenda + ;; buffer via elisp link + (unless (equal (current-buffer) abuf) + (org-pop-to-buffer-same-window abuf)) + (setq org-agenda-pre-window-conf + (or org-agenda-pre-window-conf wconf)))) + +(defun org-agenda-prepare (&optional name) + (if (org-agenda-use-sticky-p) (progn - (setq buffer-read-only nil) - (goto-char (point-max)) - (unless (or (bobp) org-agenda-compact-blocks - (not org-agenda-block-separator)) - (insert "\n" - (if (stringp org-agenda-block-separator) - org-agenda-block-separator - (make-string (window-width) org-agenda-block-separator)) - "\n")) - (narrow-to-region (point) (point-max))) - (setq org-done-keywords-for-agenda nil) - (org-agenda-reset-markers) - (setq org-agenda-contributing-files nil) - (setq org-agenda-columns-active nil) - (org-prepare-agenda-buffers (org-agenda-files nil 'ifmode)) - (setq org-todo-keywords-for-agenda - (org-uniquify org-todo-keywords-for-agenda)) - (setq org-done-keywords-for-agenda - (org-uniquify org-done-keywords-for-agenda)) - (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda)) - (let* ((abuf (get-buffer-create org-agenda-buffer-name)) - (awin (get-buffer-window abuf))) - (cond - ((equal (current-buffer) abuf) nil) - (awin (select-window awin)) - ((not (setq org-pre-agenda-window-conf (current-window-configuration)))) - ((equal org-agenda-window-setup 'current-window) - (org-pop-to-buffer-same-window abuf)) - ((equal org-agenda-window-setup 'other-window) - (org-switch-to-buffer-other-window abuf)) - ((equal org-agenda-window-setup 'other-frame) - (switch-to-buffer-other-frame abuf)) - ((equal org-agenda-window-setup 'reorganize-frame) - (delete-other-windows) - (org-switch-to-buffer-other-window abuf))) - ;; additional test in case agenda is invoked from within agenda - ;; buffer via elisp link - (unless (equal (current-buffer) abuf) - (org-pop-to-buffer-same-window abuf))) - (setq buffer-read-only nil) - (let ((inhibit-read-only t)) (erase-buffer)) - (org-agenda-mode) - (and name (not org-agenda-name) - (org-set-local 'org-agenda-name name))) - (setq buffer-read-only nil)) - -(defun org-finalize-agenda () + ;; Popup existing buffer + (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)) + (message "Sticky Agenda buffer, use `r' to refresh") + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) + (setq org-todo-keywords-for-agenda nil) + (setq org-drawers-for-agenda nil) + (unless org-agenda-persistent-filter + (setq org-agenda-tag-filter nil + org-agenda-category-filter nil)) + (put 'org-agenda-tag-filter :preset-filter + org-agenda-tag-filter-preset) + (put 'org-agenda-category-filter :preset-filter + org-agenda-category-filter-preset) + (if org-agenda-multi + (progn + (setq buffer-read-only nil) + (goto-char (point-max)) + (unless (or (bobp) org-agenda-compact-blocks + (not org-agenda-block-separator)) + (insert "\n" + (if (stringp org-agenda-block-separator) + org-agenda-block-separator + (make-string (window-width) org-agenda-block-separator)) + "\n")) + (narrow-to-region (point) (point-max))) + (setq org-done-keywords-for-agenda nil) + + ;; Setting any org variables that are in org-agenda-local-vars + ;; list need to be done after the prepare call + (org-agenda-prepare-window (get-buffer-create org-agenda-buffer-name)) + (setq buffer-read-only nil) + (org-agenda-reset-markers) + (let ((inhibit-read-only t)) (erase-buffer)) + (org-agenda-mode) + (setq org-agenda-buffer (current-buffer)) + (setq org-agenda-contributing-files nil) + (setq org-agenda-columns-active nil) + (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) + (setq org-todo-keywords-for-agenda + (org-uniquify org-todo-keywords-for-agenda)) + (setq org-done-keywords-for-agenda + (org-uniquify org-done-keywords-for-agenda)) + (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda)) + (setq org-agenda-last-prefix-arg current-prefix-arg) + (setq org-agenda-this-buffer-name org-agenda-buffer-name) + (and name (not org-agenda-name) + (org-set-local 'org-agenda-name name))) + (setq buffer-read-only nil))) + +(defvar org-agenda-overriding-columns-format) ; From org-colview.el +(defun org-agenda-finalize () "Finishing touch for the agenda buffer, called just before displaying it." (unless org-agenda-multi (save-excursion @@ -3177,13 +3437,14 @@ the global options and expect it to be applied to the entire view.") (org-agenda-entry-text-show)) (if (functionp 'org-habit-insert-consistency-graphs) (org-habit-insert-consistency-graphs)) - (run-hooks 'org-finalize-agenda-hook) + (let ((inhibit-read-only t)) + (run-hooks 'org-agenda-finalize-hook)) (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter)) (org-agenda-filter-apply org-agenda-tag-filter 'tag)) (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter)) (org-agenda-filter-apply org-agenda-category-filter 'category)) - ))) + (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))) (defun org-agenda-mark-clocking-task () "Mark the current clock entry in the agenda if it is present." @@ -3203,7 +3464,7 @@ the global options and expect it to be applied to the entire view.") (overlay-put ov 'type 'org-agenda-clocking) (overlay-put ov 'face 'org-agenda-clocking) (overlay-put ov 'help-echo - "The clock is running in this item"))))))) + "The clock is running in this item"))))))) (defun org-agenda-fontify-priorities () "Make highest priority lines bold, and lowest italic." @@ -3288,6 +3549,7 @@ A good way to set it is through options in `org-agenda-custom-commands'.") Also moves point to the end of the skipped region, so that search can continue from there." (let ((p (point-at-bol)) to) + (when (org-in-src-block-p) (throw :skip t)) (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) (get-text-property p :org-archived) (org-end-of-subtree t) @@ -3328,7 +3590,10 @@ Org-mode keeps a list of these markers and resets them when they are no longer in use." (let ((m (copy-marker (or pos (point))))) (setq org-agenda-last-marker-time (org-float-time)) - (push m org-agenda-markers) + (if org-agenda-buffer + (with-current-buffer org-agenda-buffer + (push m org-agenda-markers)) + (push m org-agenda-markers)) m)) (defun org-agenda-reset-markers () @@ -3337,9 +3602,13 @@ no longer in use." (move-marker (pop org-agenda-markers) nil))) (defun org-agenda-save-markers-for-cut-and-paste (beg end) - "Save relative positions of markers in region." - (mapc (lambda (m) (org-check-and-save-marker m beg end)) - org-agenda-markers)) + "Save relative positions of markers in region. +This check for agenda markers in all agenda buffers currently active." + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (eq major-mode 'org-agenda-mode) + (mapc (lambda (m) (org-check-and-save-marker m beg end)) + org-agenda-markers))))) ;;; Entry text mode @@ -3400,18 +3669,17 @@ under the current date. If the buffer contains an active region, only check the region for dates." (interactive "P") - (org-compile-prefix-format 'timeline) - (org-set-sorting-strategy 'timeline) (let* ((dopast t) - (doclosed org-agenda-show-log) + (org-agenda-show-log-scoped org-agenda-show-log) (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) (current-buffer)))) (date (calendar-current-date)) (beg (if (org-region-active-p) (region-beginning) (point-min))) (end (if (org-region-active-p) (region-end) (point-max))) - (day-numbers (org-get-all-dates beg end 'no-ranges - t doclosed ; always include today - org-timeline-show-empty-dates)) + (day-numbers (org-get-all-dates + beg end 'no-ranges + t org-agenda-show-log-scoped ; always include today + org-timeline-show-empty-dates)) (org-deadline-warning-days 0) (org-agenda-only-exact-dates t) (today (org-today)) @@ -3427,8 +3695,10 @@ dates." (setq day-numbers (delq nil (mapcar (lambda(x) (if (>= x today) x nil)) day-numbers)))) - (org-prepare-agenda (concat "Timeline " (file-name-nondirectory entry))) - (if doclosed (push :closed args)) + (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry))) + (org-compile-prefix-format 'timeline) + (org-set-sorting-strategy 'timeline) + (if org-agenda-show-log-scoped (push :closed args)) (push :timestamp args) (push :deadline args) (push :scheduled args) @@ -3470,13 +3740,13 @@ dates." (put-text-property s (1- (point)) 'org-agenda-date-header t) (if (equal d today) (put-text-property s (1- (point)) 'org-today t)) - (and rtn (insert (org-finalize-agenda-entries rtn) "\n")) + (and rtn (insert (org-agenda-finalize-entries rtn) "\n")) (put-text-property s (1- (point)) 'day d))))) (goto-char (point-min)) (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) (point-min))) (add-text-properties (point-min) (point-max) '(org-agenda-type timeline)) - (org-finalize-agenda) + (org-agenda-finalize) (setq buffer-read-only t))) (defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re) @@ -3489,7 +3759,7 @@ When EMPTY is non-nil, also include days without any entries." (let ((re (concat (if pre-re pre-re "") (if inactive org-ts-regexp-both org-ts-regexp))) - dates dates1 date day day1 day2 ts1 ts2 pos) + dates dates1 date day day1 day2 ts1 ts2 pos) (if force-today (setq dates (list (org-today)))) (save-excursion @@ -3528,11 +3798,9 @@ When EMPTY is non-nil, also include days without any entries." ;;; Agenda Daily/Weekly (defvar org-agenda-start-day nil ; dynamically scoped parameter -"Start day for the agenda view. + "Start day for the agenda view. Custom commands can set this variable in the options section.") (defvar org-starting-day nil) ; local variable in the agenda buffer -(defvar org-agenda-current-span nil - "The current span used in the agenda view.") ; local variable in the agenda buffer (defvar org-arg-loc nil) ; local variable (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) @@ -3568,6 +3836,7 @@ command. A good way to set it is through options in somewhat less efficient) way of determining what is included in the daily/weekly agenda, see `org-agenda-skip-function'.") +(defvar org-agenda-buffer-tmp-name nil) ;;;###autoload (defun org-agenda-list (&optional arg start-day span) "Produce a daily/weekly view from all files in variable `org-agenda-files'. @@ -3581,167 +3850,181 @@ the number of days. SPAN defaults to `org-agenda-span'. START-DAY defaults to TODAY, or to the most recent match for the weekday given in `org-agenda-start-on-weekday'." (interactive "P") - (if (and (integerp arg) (> arg 0)) - (setq span arg arg nil)) - (setq start-day (or start-day org-agenda-start-day)) (if org-agenda-overriding-arguments (setq arg (car org-agenda-overriding-arguments) start-day (nth 1 org-agenda-overriding-arguments) span (nth 2 org-agenda-overriding-arguments))) - (if (stringp start-day) - ;; Convert to an absolute day number - (setq start-day (time-to-days (org-read-date nil t start-day)))) - (setq org-agenda-last-arguments (list arg start-day span)) - (org-compile-prefix-format 'agenda) - (org-set-sorting-strategy 'agenda) - (let* ((span (org-agenda-ndays-to-span - (or span org-agenda-ndays org-agenda-span))) - (today (org-today)) - (sd (or start-day today)) - (ndays (org-agenda-span-to-ndays span sd)) - (org-agenda-start-on-weekday - (if (eq ndays 7) - org-agenda-start-on-weekday)) - (thefiles (org-agenda-files nil 'ifmode)) - (files thefiles) - (start (if (or (null org-agenda-start-on-weekday) - (< ndays 7)) - sd - (let* ((nt (calendar-day-of-week - (calendar-gregorian-from-absolute sd))) - (n1 org-agenda-start-on-weekday) - (d (- nt n1))) - (- sd (+ (if (< d 0) 7 0) d))))) - (day-numbers (list start)) - (day-cnt 0) - (inhibit-redisplay (not debug-on-error)) - s e rtn rtnall file date d start-pos end-pos todayp - clocktable-start clocktable-end filter) - (setq org-agenda-redo-command - (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span))) - (dotimes (n (1- ndays)) - (push (1+ (car day-numbers)) day-numbers)) - (setq day-numbers (nreverse day-numbers)) - (setq clocktable-start (car day-numbers) - clocktable-end (1+ (or (org-last day-numbers) 0))) - (org-prepare-agenda "Day/Week") - (org-set-local 'org-starting-day (car day-numbers)) - (org-set-local 'org-arg-loc arg) - (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) - (unless org-agenda-compact-blocks - (let* ((d1 (car day-numbers)) - (d2 (org-last day-numbers)) - (w1 (org-days-to-iso-week d1)) - (w2 (org-days-to-iso-week d2))) - (setq s (point)) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert (org-agenda-span-name span) - "-agenda" - (if (< (- d2 d1) 350) - (if (= w1 w2) - (format " (W%02d)" w1) - (format " (W%02d-W%02d)" w1 w2)) - "") - ":\n"))) - (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure - 'org-date-line t)) - (org-agenda-mark-header-line s)) - (while (setq d (pop day-numbers)) - (setq date (calendar-gregorian-from-absolute d) - s (point)) - (if (or (setq todayp (= d today)) - (and (not start-pos) (= d sd))) - (setq start-pos (point)) - (if (and start-pos (not end-pos)) - (setq end-pos (point)))) - (setq files thefiles - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (let ((org-agenda-entry-types org-agenda-entry-types)) - (unless org-agenda-include-deadlines - (setq org-agenda-entry-types - (delq :deadline org-agenda-entry-types))) - (cond - ((memq org-agenda-show-log '(only clockcheck)) - (setq rtn (org-agenda-get-day-entries - file date :closed))) - (org-agenda-show-log - (setq rtn (apply 'org-agenda-get-day-entries - file date - (append '(:closed) org-agenda-entry-types)))) - (t - (setq rtn (apply 'org-agenda-get-day-entries - file date - org-agenda-entry-types))))) - (setq rtnall (append rtnall rtn)))) ;; all entries - (if org-agenda-include-diary - (let ((org-agenda-search-headline-for-time t)) - (require 'diary-lib) - (setq rtn (org-get-entries-from-diary date)) - (setq rtnall (append rtnall rtn)))) - (if (or rtnall org-agenda-show-all-dates) - (progn - (setq day-cnt (1+ day-cnt)) - (insert - (if (stringp org-agenda-format-date) - (format-time-string org-agenda-format-date - (org-time-from-absolute date)) - (funcall org-agenda-format-date date)) - "\n") - (put-text-property s (1- (point)) 'face - (org-agenda-get-day-face date)) - (put-text-property s (1- (point)) 'org-date-line t) - (put-text-property s (1- (point)) 'org-agenda-date-header t) - (put-text-property s (1- (point)) 'org-day-cnt day-cnt) - (when todayp - (put-text-property s (1- (point)) 'org-today t)) - (if rtnall (insert ;; all entries - (org-finalize-agenda-entries - (org-agenda-add-time-grid-maybe - rtnall ndays todayp)) - "\n")) - (put-text-property s (1- (point)) 'day d) - (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) - (when (and org-agenda-clockreport-mode clocktable-start) - (let ((org-agenda-files (org-agenda-files nil 'ifmode)) - ;; the above line is to ensure the restricted range! - (p (copy-sequence org-agenda-clockreport-parameter-plist)) - tbl) - (setq p (org-plist-delete p :block)) - (setq p (plist-put p :tstart clocktable-start)) - (setq p (plist-put p :tend clocktable-end)) - (setq p (plist-put p :scope 'agenda)) - (when (and (eq org-agenda-clockreport-mode 'with-filter) - (setq filter (or org-agenda-tag-filter-while-redo - (get 'org-agenda-tag-filter :preset-filter)))) - (setq p (plist-put p :tags (mapconcat (lambda (x) - (if (string-match "[<>=]" x) - "" - x)) - filter "")))) - (setq tbl (apply 'org-get-clocktable p)) - (insert tbl))) - (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) - (unless (and (pos-visible-in-window-p (point-min)) - (pos-visible-in-window-p (point-max))) - (goto-char (1- (point-max))) - (recenter -1) - (if (not (pos-visible-in-window-p (or start-pos 1))) - (progn - (goto-char (or start-pos 1)) - (recenter 1)))) - (goto-char (or start-pos 1)) - (add-text-properties (point-min) (point-max) '(org-agenda-type agenda)) - (if (eq org-agenda-show-log 'clockcheck) - (org-agenda-show-clocking-issues)) - (org-finalize-agenda) - (setq buffer-read-only t) - (message ""))) + (if (and (integerp arg) (> arg 0)) + (setq span arg arg nil)) + (catch 'exit + (setq org-agenda-buffer-name + (or org-agenda-buffer-tmp-name + (if org-agenda-sticky + (cond ((and org-keys (stringp org-match)) + (format "*Org Agenda(%s:%s)*" org-keys org-match)) + (org-keys + (format "*Org Agenda(%s)*" org-keys)) + (t "*Org Agenda(a)*"))) + org-agenda-buffer-name)) + (org-agenda-prepare "Day/Week") + (setq start-day (or start-day org-agenda-start-day)) + (if (stringp start-day) + ;; Convert to an absolute day number + (setq start-day (time-to-days (org-read-date nil t start-day)))) + (org-compile-prefix-format 'agenda) + (org-set-sorting-strategy 'agenda) + (let* ((span (org-agenda-ndays-to-span + (or span org-agenda-ndays org-agenda-span))) + (today (org-today)) + (sd (or start-day today)) + (ndays (org-agenda-span-to-ndays span sd)) + (org-agenda-start-on-weekday + (if (eq ndays 7) + org-agenda-start-on-weekday)) + (thefiles (org-agenda-files nil 'ifmode)) + (files thefiles) + (start (if (or (null org-agenda-start-on-weekday) + (< ndays 7)) + sd + (let* ((nt (calendar-day-of-week + (calendar-gregorian-from-absolute sd))) + (n1 org-agenda-start-on-weekday) + (d (- nt n1))) + (- sd (+ (if (< d 0) 7 0) d))))) + (day-numbers (list start)) + (day-cnt 0) + (inhibit-redisplay (not debug-on-error)) + (org-agenda-show-log-scoped org-agenda-show-log) + s e rtn rtnall file date d start-pos end-pos todayp + clocktable-start clocktable-end filter) + (setq org-agenda-redo-command + (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span))) + (dotimes (n (1- ndays)) + (push (1+ (car day-numbers)) day-numbers)) + (setq day-numbers (nreverse day-numbers)) + (setq clocktable-start (car day-numbers) + clocktable-end (1+ (or (org-last day-numbers) 0))) + (org-set-local 'org-starting-day (car day-numbers)) + (org-set-local 'org-arg-loc arg) + (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) + (unless org-agenda-compact-blocks + (let* ((d1 (car day-numbers)) + (d2 (org-last day-numbers)) + (w1 (org-days-to-iso-week d1)) + (w2 (org-days-to-iso-week d2))) + (setq s (point)) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert (org-agenda-span-name span) + "-agenda" + (if (< (- d2 d1) 350) + (if (= w1 w2) + (format " (W%02d)" w1) + (format " (W%02d-W%02d)" w1 w2)) + "") + ":\n"))) + (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure + 'org-date-line t)) + (org-agenda-mark-header-line s)) + (while (setq d (pop day-numbers)) + (setq date (calendar-gregorian-from-absolute d) + s (point)) + (if (or (setq todayp (= d today)) + (and (not start-pos) (= d sd))) + (setq start-pos (point)) + (if (and start-pos (not end-pos)) + (setq end-pos (point)))) + (setq files thefiles + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (let ((org-agenda-entry-types org-agenda-entry-types)) + (unless org-agenda-include-deadlines + (setq org-agenda-entry-types + (delq :deadline org-agenda-entry-types))) + (cond + ((memq org-agenda-show-log-scoped '(only clockcheck)) + (setq rtn (org-agenda-get-day-entries + file date :closed))) + (org-agenda-show-log-scoped + (setq rtn (apply 'org-agenda-get-day-entries + file date + (append '(:closed) org-agenda-entry-types)))) + (t + (setq rtn (apply 'org-agenda-get-day-entries + file date + org-agenda-entry-types))))) + (setq rtnall (append rtnall rtn)))) ;; all entries + (if org-agenda-include-diary + (let ((org-agenda-search-headline-for-time t)) + (require 'diary-lib) + (setq rtn (org-get-entries-from-diary date)) + (setq rtnall (append rtnall rtn)))) + (if (or rtnall org-agenda-show-all-dates) + (progn + (setq day-cnt (1+ day-cnt)) + (insert + (if (stringp org-agenda-format-date) + (format-time-string org-agenda-format-date + (org-time-from-absolute date)) + (funcall org-agenda-format-date date)) + "\n") + (put-text-property s (1- (point)) 'face + (org-agenda-get-day-face date)) + (put-text-property s (1- (point)) 'org-date-line t) + (put-text-property s (1- (point)) 'org-agenda-date-header t) + (put-text-property s (1- (point)) 'org-day-cnt day-cnt) + (when todayp + (put-text-property s (1- (point)) 'org-today t)) + (setq rtnall + (org-agenda-add-time-grid-maybe rtnall ndays todayp)) + (if rtnall (insert ;; all entries + (org-agenda-finalize-entries rtnall) + "\n")) + (put-text-property s (1- (point)) 'day d) + (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) + (when (and org-agenda-clockreport-mode clocktable-start) + (let ((org-agenda-files (org-agenda-files nil 'ifmode)) + ;; the above line is to ensure the restricted range! + (p (copy-sequence org-agenda-clockreport-parameter-plist)) + tbl) + (setq p (org-plist-delete p :block)) + (setq p (plist-put p :tstart clocktable-start)) + (setq p (plist-put p :tend clocktable-end)) + (setq p (plist-put p :scope 'agenda)) + (when (and (eq org-agenda-clockreport-mode 'with-filter) + (setq filter (or org-agenda-tag-filter-while-redo + (get 'org-agenda-tag-filter :preset-filter)))) + (setq p (plist-put p :tags (mapconcat (lambda (x) + (if (string-match "[<>=]" x) + "" + x)) + filter "")))) + (setq tbl (apply 'org-get-clocktable p)) + (insert tbl))) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (unless (and (pos-visible-in-window-p (point-min)) + (pos-visible-in-window-p (point-max))) + (goto-char (1- (point-max))) + (recenter -1) + (if (not (pos-visible-in-window-p (or start-pos 1))) + (progn + (goto-char (or start-pos 1)) + (recenter 1)))) + (goto-char (or start-pos 1)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type agenda + org-last-args (,arg ,start-day ,span) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (if (eq org-agenda-show-log-scoped 'clockcheck) + (org-agenda-show-clocking-issues)) + (org-agenda-finalize) + (setq buffer-read-only t) + (message "")))) (defun org-agenda-ndays-to-span (n) "Return a span symbol for a span of N days, or N if none matches." @@ -3750,8 +4033,8 @@ given in `org-agenda-start-on-weekday'." ((= n 7) 'week) (t n))) -(defun org-agenda-span-to-ndays (span start-day) - "Return ndays from SPAN starting at START-DAY." +(defun org-agenda-span-to-ndays (span &optional start-day) + "Return ndays from SPAN, possibly starting at START-DAY." (cond ((numberp span) span) ((eq span 'day) 1) ((eq span 'week) 7) @@ -3773,13 +4056,13 @@ given in `org-agenda-start-on-weekday'." ;;; Agenda word search (defvar org-agenda-search-history nil) -(defvar org-todo-only nil) (defvar org-search-syntax-table nil "Special syntax table for org-mode search. In this table, we have single quotes not as word constituents, to that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") +(defvar org-mode-syntax-table) ; From org.el (defun org-search-syntax-table () (unless org-search-syntax-table (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table)) @@ -3834,9 +4117,10 @@ as a whole, to include whitespace. This command searches the agenda files, and in addition the files listed in `org-agenda-text-search-extra-files'." (interactive "P") - (org-compile-prefix-format 'search) - (org-set-sorting-strategy 'search) - (org-prepare-agenda "SEARCH") + (if org-agenda-overriding-arguments + (setq todo-only (car org-agenda-overriding-arguments) + string (nth 1 org-agenda-overriding-arguments) + edit-at (nth 2 org-agenda-overriding-arguments))) (let* ((props (list 'face nil 'done-face 'org-agenda-done 'org-not-done-regexp org-not-done-regexp @@ -3847,7 +4131,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 org-category-pos tags c neg re boolean + marker category 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) @@ -3855,182 +4139,194 @@ in `org-agenda-text-search-extra-files'." (setq string (read-string (if org-agenda-search-view-always-boolean "[+-]Word/{Regexp} ...: " - "Phrase, or [+-]Word/{Regexp} ...: ") + "Phrase or [+-]Word/{Regexp} ...: ") (cond ((integerp edit-at) (cons string edit-at)) (edit-at string)) 'org-agenda-search-history))) - (org-set-local 'org-todo-only todo-only) - (setq org-agenda-redo-command - (list 'org-search-view (if todo-only t nil) string - '(if current-prefix-arg 1 nil))) - (setq org-agenda-query-string string) - - (if (equal (string-to-char string) ?*) - (setq hdl-only t - words (substring string 1)) - (setq words string)) - (when (equal (string-to-char words) ?!) - (setq todo-only t - words (substring words 1))) - (when (equal (string-to-char words) ?:) - (setq full-words t - words (substring words 1))) - (if (or org-agenda-search-view-always-boolean - (member (string-to-char words) '(?- ?+ ?\{))) - (setq boolean t)) - (setq words (org-split-string words)) - (let (www w) - (while (setq w (pop words)) - (while (and (string-match "\\\\\\'" w) words) - (setq w (concat (substring w 0 -1) " " (pop words)))) - (push w www)) - (setq words (nreverse www) www nil) - (while (setq w (pop words)) - (when (and (string-match "\\`[-+]?{" w) - (not (string-match "}\\'" w))) - (while (and words (not (string-match "}\\'" (car words)))) - (setq w (concat w " " (pop words)))) - (setq w (concat w " " (pop words)))) - (push w www)) - (setq words (nreverse www))) - (setq org-agenda-last-search-view-search-was-boolean boolean) - (when boolean - (let (wds w) + (catch 'exit + (if org-agenda-sticky + (setq org-agenda-buffer-name + (if (stringp string) + (format "*Org Agenda(%s:%s)*" + (or org-keys (or (and todo-only "S") "s")) string) + (format "*Org Agenda(%s)*" (or (and todo-only "S") "s"))))) + (org-agenda-prepare "SEARCH") + (org-compile-prefix-format 'search) + (org-set-sorting-strategy 'search) + (setq org-agenda-redo-command + (list 'org-search-view (if todo-only t nil) + (list 'if 'current-prefix-arg nil string))) + (setq org-agenda-query-string string) + (if (equal (string-to-char string) ?*) + (setq hdl-only t + words (substring string 1)) + (setq words string)) + (when (equal (string-to-char words) ?!) + (setq todo-only t + words (substring words 1))) + (when (equal (string-to-char words) ?:) + (setq full-words t + words (substring words 1))) + (if (or org-agenda-search-view-always-boolean + (member (string-to-char words) '(?- ?+ ?\{))) + (setq boolean t)) + (setq words (org-split-string words)) + (let (www w) (while (setq w (pop words)) - (if (or (equal (substring w 0 1) "\"") - (and (> (length w) 1) - (member (substring w 0 1) '("+" "-")) - (equal (substring w 1 2) "\""))) - (while (and words (not (equal (substring w -1) "\""))) - (setq w (concat w " " (pop words))))) - (and (string-match "\\`\\([-+]?\\)\"" w) - (setq w (replace-match "\\1" nil nil w))) - (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) - (push w wds)) - (setq words (nreverse wds)))) - (if boolean - (mapc (lambda (w) - (setq c (string-to-char w)) - (if (equal c ?-) - (setq neg t w (substring w 1)) - (if (equal c ?+) - (setq neg nil w (substring w 1)) - (setq neg nil))) - (if (string-match "\\`{.*}\\'" w) - (setq re (substring w 1 -1)) - (if full-words - (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) - (setq re (regexp-quote (downcase w))))) - (if neg (push re regexps-) (push re regexps+))) - words) - (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+") - regexps+)) - (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) - (if (not regexps+) - (setq regexp org-outline-regexp-bol) - (setq regexp (pop regexps+)) - (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" - regexp)))) - (setq files (org-agenda-files nil 'ifmode)) - (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) - (pop org-agenda-text-search-extra-files) - (setq files (org-add-archive-files files))) - (setq files (append files org-agenda-text-search-extra-files) - rtnall nil) - (while (setq file (pop files)) - (setq ee nil) - (catch 'nextfile - (org-check-agenda-file file) - (setq buffer (if (file-exists-p file) - (org-get-agenda-file-buffer file) - (error "No such file %s" file))) - (if (not buffer) - ;; If file does not exist, make sure an error message is sent - (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" - file)))) - (with-current-buffer buffer - (with-syntax-table (org-search-syntax-table) - (unless (eq major-mode 'org-mode) - (error "Agenda file %s is not in `org-mode'" file)) - (let ((case-fold-search t)) - (save-excursion - (save-restriction - (if org-agenda-restrict - (narrow-to-region org-agenda-restrict-begin - org-agenda-restrict-end) - (widen)) - (goto-char (point-min)) - (unless (or (org-at-heading-p) - (outline-next-heading)) - (throw 'nextfile t)) - (goto-char (max (point-min) (1- (point)))) - (while (re-search-forward regexp nil t) - (org-back-to-heading t) - (skip-chars-forward "* ") - (setq beg (point-at-bol) - beg1 (point) - end (progn (outline-next-heading) (point))) - (catch :skip - (goto-char beg) - (org-agenda-skip) - (setq str (buffer-substring-no-properties - (point-at-bol) - (if hdl-only (point-at-eol) end))) - (mapc (lambda (wr) (when (string-match wr str) - (goto-char (1- end)) - (throw :skip t))) - regexps-) - (mapc (lambda (wr) (unless (string-match wr str) - (goto-char (1- end)) - (throw :skip t))) - (if todo-only - (cons (concat "^\*+[ \t]+" org-not-done-regexp) - regexps+) - regexps+)) - (goto-char beg) - (setq marker (org-agenda-new-marker (point)) - category (org-get-category) - org-category-pos (get-text-property (point) 'org-category-position) - tags (org-get-tags-at (point)) - txt (org-agenda-format-item - "" - (buffer-substring-no-properties - beg1 (point-at-eol)) - category tags)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker marker - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'priority 1000 'org-category category - 'org-category-position org-category-pos - 'type "search") - (push txt ee) - (goto-char (1- end)))))))))) - (setq rtn (nreverse ee)) - (setq rtnall (append rtnall rtn))) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert "Search words: ") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure)) - (setq pos (point)) - (insert string "\n") - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) - (setq pos (point)) - (unless org-agenda-multi - (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n") - (add-text-properties pos (1- (point)) - (list 'face 'org-agenda-structure)))) - (org-agenda-mark-header-line (point-min)) - (when rtnall - (insert (org-finalize-agenda-entries rtnall) "\n")) - (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) - (add-text-properties (point-min) (point-max) '(org-agenda-type search)) - (org-finalize-agenda) - (setq buffer-read-only t))) + (while (and (string-match "\\\\\\'" w) words) + (setq w (concat (substring w 0 -1) " " (pop words)))) + (push w www)) + (setq words (nreverse www) www nil) + (while (setq w (pop words)) + (when (and (string-match "\\`[-+]?{" w) + (not (string-match "}\\'" w))) + (while (and words (not (string-match "}\\'" (car words)))) + (setq w (concat w " " (pop words)))) + (setq w (concat w " " (pop words)))) + (push w www)) + (setq words (nreverse www))) + (setq org-agenda-last-search-view-search-was-boolean boolean) + (when boolean + (let (wds w) + (while (setq w (pop words)) + (if (or (equal (substring w 0 1) "\"") + (and (> (length w) 1) + (member (substring w 0 1) '("+" "-")) + (equal (substring w 1 2) "\""))) + (while (and words (not (equal (substring w -1) "\""))) + (setq w (concat w " " (pop words))))) + (and (string-match "\\`\\([-+]?\\)\"" w) + (setq w (replace-match "\\1" nil nil w))) + (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) + (push w wds)) + (setq words (nreverse wds)))) + (if boolean + (mapc (lambda (w) + (setq c (string-to-char w)) + (if (equal c ?-) + (setq neg t w (substring w 1)) + (if (equal c ?+) + (setq neg nil w (substring w 1)) + (setq neg nil))) + (if (string-match "\\`{.*}\\'" w) + (setq re (substring w 1 -1)) + (if full-words + (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) + (setq re (regexp-quote (downcase w))))) + (if neg (push re regexps-) (push re regexps+))) + words) + (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+") + regexps+)) + (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) + (if (not regexps+) + (setq regexp org-outline-regexp-bol) + (setq regexp (pop regexps+)) + (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" + regexp)))) + (setq files (org-agenda-files nil 'ifmode)) + (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) + (pop org-agenda-text-search-extra-files) + (setq files (org-add-archive-files files))) + (setq files (append files org-agenda-text-search-extra-files) + rtnall nil) + (while (setq file (pop files)) + (setq ee nil) + (catch 'nextfile + (org-check-agenda-file file) + (setq buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file))) + (if (not buffer) + ;; If file does not exist, make sure an error message is sent + (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" + file)))) + (with-current-buffer buffer + (with-syntax-table (org-search-syntax-table) + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in `org-mode'" file)) + (let ((case-fold-search t)) + (save-excursion + (save-restriction + (if org-agenda-restrict + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + (goto-char (point-min)) + (unless (or (org-at-heading-p) + (outline-next-heading)) + (throw 'nextfile t)) + (goto-char (max (point-min) (1- (point)))) + (while (re-search-forward regexp nil t) + (org-back-to-heading t) + (skip-chars-forward "* ") + (setq beg (point-at-bol) + beg1 (point) + end (progn (outline-next-heading) (point))) + (catch :skip + (goto-char beg) + (org-agenda-skip) + (setq str (buffer-substring-no-properties + (point-at-bol) + (if hdl-only (point-at-eol) end))) + (mapc (lambda (wr) (when (string-match wr str) + (goto-char (1- end)) + (throw :skip t))) + regexps-) + (mapc (lambda (wr) (unless (string-match wr str) + (goto-char (1- end)) + (throw :skip t))) + (if todo-only + (cons (concat "^\*+[ \t]+" org-not-done-regexp) + regexps+) + regexps+)) + (goto-char beg) + (setq marker (org-agenda-new-marker (point)) + category (org-get-category) + category-pos (get-text-property (point) 'org-category-position) + tags (org-get-tags-at (point)) + txt (org-agenda-format-item + "" + (buffer-substring-no-properties + beg1 (point-at-eol)) + category tags t)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'priority 1000 'org-category category + 'org-category-position category-pos + 'type "search") + (push txt ee) + (goto-char (1- end)))))))))) + (setq rtn (nreverse ee)) + (setq rtnall (append rtnall rtn))) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert "Search words: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure)) + (setq pos (point)) + (insert string "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (setq pos (point)) + (unless org-agenda-multi + (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n") + (add-text-properties pos (1- (point)) + (list 'face 'org-agenda-structure)))) + (org-agenda-mark-header-line (point-min)) + (when rtnall + (insert (org-agenda-finalize-entries rtnall) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type search + org-last-args (,todo-only ,string ,edit-at) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) ;;; Agenda TODO list @@ -4038,16 +4334,15 @@ in `org-agenda-text-search-extra-files'." (defvar org-last-arg nil) ;;;###autoload -(defun org-todo-list (arg) +(defun org-todo-list (&optional arg) "Show all (not done) TODO entries from all agenda file in a single list. The prefix arg can be used to select a specific TODO keyword and limit the list to these. When using \\[universal-argument], you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'." (interactive "P") - (org-compile-prefix-format 'todo) - (org-set-sorting-strategy 'todo) - (org-prepare-agenda "TODO") + (if org-agenda-overriding-arguments + (setq arg org-agenda-overriding-arguments)) (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) (let* ((today (org-today)) (date (calendar-gregorian-from-absolute today)) @@ -4061,51 +4356,67 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (when (equal arg '(4)) (setq org-select-this-todo-keyword (org-icompleting-read "Keyword (or KWD1|K2D2|...): " - (mapcar 'list kwds) nil nil))) + (mapcar 'list kwds) nil nil))) (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) - (org-set-local 'org-last-arg arg) - (setq org-agenda-redo-command - '(org-todo-list (or current-prefix-arg org-last-arg))) - (setq files (org-agenda-files nil 'ifmode) - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (setq rtn (org-agenda-get-day-entries file date :todo)) - (setq rtnall (append rtnall rtn)))) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert "Global list of TODO items of type: ") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure - 'short-heading - (concat "ToDo: " - (or org-select-this-todo-keyword "ALL")))) + (catch 'exit + (if org-agenda-sticky + (setq org-agenda-buffer-name + (if (stringp org-select-this-todo-keyword) + (format "*Org Agenda(%s:%s)*" (or org-keys "t") + org-select-this-todo-keyword) + (format "*Org Agenda(%s)*" (or org-keys "t"))))) + (org-agenda-prepare "TODO") + (org-compile-prefix-format 'todo) + (org-set-sorting-strategy 'todo) + (setq org-agenda-redo-command + `(org-todo-list (or (and (numberp current-prefix-arg) + current-prefix-arg) + ,org-select-this-todo-keyword + current-prefix-arg ,arg))) + (setq files (org-agenda-files nil 'ifmode) + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (setq rtn (org-agenda-get-day-entries file date :todo)) + (setq rtnall (append rtnall rtn)))) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert "Global list of TODO items of type: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure + 'short-heading + (concat "ToDo: " + (or org-select-this-todo-keyword "ALL")))) + (org-agenda-mark-header-line (point-min)) + (setq pos (point)) + (insert (or org-select-this-todo-keyword "ALL") "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (setq pos (point)) + (unless org-agenda-multi + (insert "Available with `N r': (0)[ALL]") + (let ((n 0) s) + (mapc (lambda (x) + (setq s (format "(%d)%s" (setq n (1+ n)) x)) + (if (> (+ (current-column) (string-width s) 1) (frame-width)) + (insert "\n ")) + (insert " " s)) + kwds)) + (insert "\n")) + (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) (org-agenda-mark-header-line (point-min)) - (setq pos (point)) - (insert (or org-select-this-todo-keyword "ALL") "\n") - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) - (setq pos (point)) - (unless org-agenda-multi - (insert "Available with `N r': (0)ALL") - (let ((n 0) s) - (mapc (lambda (x) - (setq s (format "(%d)%s" (setq n (1+ n)) x)) - (if (> (+ (current-column) (string-width s) 1) (frame-width)) - (insert "\n ")) - (insert " " s)) - kwds)) - (insert "\n")) - (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) - (org-agenda-mark-header-line (point-min)) - (when rtnall - (insert (org-finalize-agenda-entries rtnall) "\n")) - (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) - (add-text-properties (point-min) (point-max) '(org-agenda-type todo)) - (org-finalize-agenda) - (setq buffer-read-only t))) + (when rtnall + (insert (org-agenda-finalize-entries rtnall) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type todo + org-last-args ,arg + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) ;;; Agenda tags match @@ -4114,8 +4425,9 @@ for a keyword. A numeric prefix directly selects the Nth keyword in "Show all headlines for all `org-agenda-files' matching a TAGS criterion. The prefix arg TODO-ONLY limits the search to TODO entries." (interactive "P") - (org-compile-prefix-format 'tags) - (org-set-sorting-strategy 'tags) + (if org-agenda-overriding-arguments + (setq todo-only (car org-agenda-overriding-arguments) + match (nth 1 org-agenda-overriding-arguments))) (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels) (completion-ignore-case t) @@ -4125,58 +4437,71 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (setq match nil)) (setq matcher (org-make-tags-matcher match) match (car matcher) matcher (cdr matcher)) - (org-prepare-agenda (concat "TAGS " match)) - (setq org-agenda-query-string match) - (setq org-agenda-redo-command - (list 'org-tags-view (list 'quote todo-only) - (list 'if 'current-prefix-arg nil 'org-agenda-query-string))) - (setq files (org-agenda-files nil 'ifmode) - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (setq buffer (if (file-exists-p file) - (org-get-agenda-file-buffer file) - (error "No such file %s" file))) - (if (not buffer) - ;; If file does not exist, error message to agenda - (setq rtn (list - (format "ORG-AGENDA-ERROR: No such org-file %s" file)) - rtnall (append rtnall rtn)) - (with-current-buffer buffer - (unless (eq major-mode 'org-mode) - (error "Agenda file %s is not in `org-mode'" file)) - (save-excursion - (save-restriction - (if org-agenda-restrict - (narrow-to-region org-agenda-restrict-begin - org-agenda-restrict-end) - (widen)) - (setq rtn (org-scan-tags 'agenda matcher todo-only)) - (setq rtnall (append rtnall rtn)))))))) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert "Headlines with TAGS match: ") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure - 'short-heading - (concat "Match: " match))) - (setq pos (point)) - (insert match "\n") - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) - (setq pos (point)) - (unless org-agenda-multi - (insert "Press `C-u r' to search again with new search string\n")) - (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) - (org-agenda-mark-header-line (point-min)) - (when rtnall - (insert (org-finalize-agenda-entries rtnall) "\n")) - (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) - (add-text-properties (point-min) (point-max) '(org-agenda-type tags)) - (org-finalize-agenda) - (setq buffer-read-only t))) + (catch 'exit + (if org-agenda-sticky + (setq org-agenda-buffer-name + (if (stringp match) + (format "*Org Agenda(%s:%s)*" + (or org-keys (or (and todo-only "M") "m")) match) + (format "*Org Agenda(%s)*" (or (and todo-only "M") "m"))))) + (org-agenda-prepare (concat "TAGS " match)) + (org-compile-prefix-format 'tags) + (org-set-sorting-strategy 'tags) + (setq org-agenda-query-string match) + (setq org-agenda-redo-command + (list 'org-tags-view `(quote ,todo-only) + (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string)))) + (setq files (org-agenda-files nil 'ifmode) + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (setq buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file))) + (if (not buffer) + ;; If file does not exist, error message to agenda + (setq rtn (list + (format "ORG-AGENDA-ERROR: No such org-file %s" file)) + rtnall (append rtnall rtn)) + (with-current-buffer buffer + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in `org-mode'" file)) + (save-excursion + (save-restriction + (if org-agenda-restrict + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + (setq rtn (org-scan-tags 'agenda matcher todo-only)) + (setq rtnall (append rtnall rtn)))))))) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert "Headlines with TAGS match: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure + 'short-heading + (concat "Match: " match))) + (setq pos (point)) + (insert match "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (setq pos (point)) + (unless org-agenda-multi + (insert "Press `C-u r' to search again with new search string\n")) + (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) + (org-agenda-mark-header-line (point-min)) + (when rtnall + (insert (org-agenda-finalize-entries rtnall) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type tags + org-last-args (,todo-only ,match) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) ;;; Agenda Finding stuck projects @@ -4305,15 +4630,18 @@ that can be put into `org-agenda-skip-function' for the duration of a command." (not (re-search-forward (nth 1 m) end t))) (and (or (setq m (memq 'nottodo conditions)) + (setq m (memq 'todo-unblocked conditions)) + (setq m (memq 'nottodo-unblocked conditions)) (setq m (memq 'todo conditions))) (org-agenda-skip-if-todo m end))) end))) (defun org-agenda-skip-if-todo (args end) "Helper function for `org-agenda-skip-if', do not use it directly. -ARGS is a list with first element either `todo' or `nottodo'. -The remainder is either a list of TODO keywords, or a state symbol -`todo' or `done' or `any'." +ARGS is a list with first element either `todo', `nottodo', +`todo-unblocked' or `nottodo-unblocked'. The remainder is either +a list of TODO keywords, or a state symbol `todo' or `done' or +`any'." (let ((kw (car args)) (arg (cadr args)) todo-wds todo-re) @@ -4337,9 +4665,20 @@ The remainder is either a list of TODO keywords, or a state symbol (concat "^\\*+[ \t]+\\<\\(" (mapconcat 'identity todo-wds "\\|") "\\)\\>")) - (if (eq kw 'todo) - (re-search-forward todo-re end t) - (not (re-search-forward todo-re end t))))) + (cond + ((eq kw 'todo) (re-search-forward todo-re end t)) + ((eq kw 'nottodo) (not (re-search-forward todo-re end t))) + ((eq kw 'todo-unblocked) + (catch 'unblocked + (while (re-search-forward todo-re end t) + (or (org-entry-blocked-p) (throw 'unblocked t))) + nil)) + ((eq kw 'nottodo-unblocked) + (catch 'unblocked + (while (re-search-forward todo-re end t) + (or (org-entry-blocked-p) (throw 'unblocked nil))) + t)) + ))) ;;;###autoload (defun org-agenda-list-stuck-projects (&rest ignore) @@ -4357,7 +4696,7 @@ of what a project is and how to check if it stuck, customize the variable (todo (nth 1 org-stuck-projects)) (todo-wds (if (member "*" todo) (progn - (org-prepare-agenda-buffers (org-agenda-files + (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) (org-delete-all org-done-keywords-for-agenda @@ -4390,13 +4729,12 @@ of what a project is and how to check if it stuck, customize the variable (org-tags-view nil matcher) (with-current-buffer org-agenda-buffer-name (setq org-agenda-redo-command - '(org-agenda-list-stuck-projects - (or current-prefix-arg org-last-arg)))))) + `(org-agenda-list-stuck-projects ,current-prefix-arg))))) ;;; Diary integration (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. -(defvar list-diary-entries-hook) +(defvar diary-list-entries-hook) (defvar diary-time-regexp) (defun org-get-entries-from-diary (date) "Get the (Emacs Calendar) diary entries for DATE." @@ -4405,8 +4743,8 @@ of what a project is and how to check if it stuck, customize the variable (diary-display-hook '(fancy-diary-display)) (diary-display-function 'fancy-diary-display) (pop-up-frames nil) - (list-diary-entries-hook - (cons 'org-diary-default-entry list-diary-entries-hook)) + (diary-list-entries-hook + (cons 'org-diary-default-entry diary-list-entries-hook)) (diary-file-name-prefix-function nil) ; turn this feature off (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) entries @@ -4517,7 +4855,7 @@ Needed to avoid empty dates which mess up holiday display." ;;;###autoload (defun org-diary (&rest args) - "Return diary information from org-files. + "Return diary information from org files. This function can be used in a \"sexp\" diary entry in the Emacs calendar. It accesses org files and extracts information from those files to be listed in the diary. The function accepts arguments specifying what @@ -4545,6 +4883,8 @@ function from a program - use `org-agenda-get-day-entries' instead." (when (> (- (org-float-time) org-agenda-last-marker-time) 5) + ;; I am not sure if this works with sticky agendas, because the marker + ;; list is then no longer a global variable. (org-agenda-reset-markers)) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) @@ -4558,7 +4898,7 @@ function from a program - use `org-agenda-get-day-entries' instead." (> (- time org-diary-last-run-time) 3)) - (org-prepare-agenda-buffers files)) + (org-agenda-prepare-buffers files)) (setq org-diary-last-run-time time) ;; If this is called during org-agenda, don't return any entries to ;; the calendar. Org Agenda will list these entries itself. @@ -4567,7 +4907,7 @@ function from a program - use `org-agenda-get-day-entries' instead." (setq rtn (apply 'org-agenda-get-day-entries file date args)) (setq results (append results rtn))) (if results - (concat (org-finalize-agenda-entries results) "\n")))) + (concat (org-agenda-finalize-entries results) "\n")))) ;;; Agenda entry finders @@ -4588,8 +4928,9 @@ 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 (eq major-mode 'org-mode) + (unless (derived-mode-p 'org-mode) (error "Agenda file %s is not in `org-mode'" file)) + (setq org-agenda-buffer (or org-agenda-buffer buffer)) (let ((case-fold-search nil)) (save-excursion (save-restriction @@ -4608,7 +4949,7 @@ the documentation of `org-diary'." ((eq arg :timestamp) (setq rtn (org-agenda-get-blocks)) (setq results (append results rtn)) - (setq rtn (org-agenda-get-timestamps)) + (setq rtn (org-agenda-get-timestamps deadline-results)) (setq results (append results rtn))) ((eq arg :sexp) (setq rtn (org-agenda-get-sexps)) @@ -4650,7 +4991,7 @@ the documentation of `org-diary'." "|") "\\|") "\\)")) (t org-not-done-regexp)))) - marker priority category org-category-pos tags todo-state + marker priority category category-pos tags todo-state ee txt beg end) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4666,17 +5007,17 @@ the documentation of `org-diary'." (goto-char (match-beginning 2)) (setq marker (org-agenda-new-marker (match-beginning 0)) category (org-get-category) - org-category-pos (get-text-property (point) 'org-category-position) + category-pos (get-text-property (point) 'org-category-position) txt (org-trim (buffer-substring (match-beginning 2) (match-end 0))) tags (org-get-tags-at (point)) - txt (org-agenda-format-item "" txt category tags) + txt (org-agenda-format-item "" txt category tags t) 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 org-category-pos + 'org-category-position category-pos 'type "todo" 'todo-state todo-state) (push txt ee) (if org-agenda-todo-list-sublevels @@ -4685,7 +5026,7 @@ the documentation of `org-diary'." (nreverse ee))) (defun org-agenda-todo-custom-ignore-p (time n) - "Check whether timestamp is farther away then n number of days. + "Check whether timestamp is farther away than n number of days. This function is invoked if `org-agenda-todo-ignore-deadlines', `org-agenda-todo-ignore-scheduled' or `org-agenda-todo-ignore-timestamp' is set to an integer." @@ -4760,7 +5101,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (defconst org-agenda-no-heading-message "No heading for this item in buffer or region.") -(defun org-agenda-get-timestamps () +(defun org-agenda-get-timestamps (&optional deadline-results) "Return the date stamp information for agenda display." (let* ((props (list 'face 'org-agenda-calendar-event 'org-not-done-regexp org-not-done-regexp @@ -4771,13 +5112,13 @@ 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)))) (d1 (calendar-absolute-from-gregorian date)) - (remove-re - (concat - (regexp-quote - (format-time-string - "<%Y-%m-%d" - (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) - ".*?>")) + mm + (deadline-position-alist + (mapcar (lambda (a) (and (setq mm (get-text-property + 0 'org-hd-marker a)) + (cons (marker-position mm) a))) + deadline-results)) + (remove-re org-ts-regexp) (regexp (concat (if org-agenda-include-inactive-timestamps "[[<]" "<") @@ -4788,11 +5129,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (apply 'encode-time ; DATE bound by calendar (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 1 11)) - "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" + "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) marker hdmarker deadlinep scheduledp clockp closedp inactivep - donep tmp priority category org-category-pos ee txt timestr tags - b0 b3 e3 head todo-state end-of-match show-all) + donep tmp priority category category-pos ee txt timestr tags + b0 b3 e3 head todo-state end-of-match show-all warntime) (goto-char (point-min)) (while (setq end-of-match (re-search-forward regexp nil t)) (setq b0 (match-beginning 0) @@ -4824,6 +5165,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', clockp (and org-agenda-include-inactive-timestamps (or (string-match org-clock-string tmp) (string-match "]-+\\'" tmp))) + warntime (org-entry-get (point) "APPT_WARNTIME") donep (member todo-state org-done-keywords)) (if (or scheduledp deadlinep closedp clockp (and donep org-agenda-skip-timestamp-if-done)) @@ -4833,11 +5175,14 @@ 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) - org-category-pos (get-text-property b0 'org-category-position)) + 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) (goto-char (match-beginning 0)) + (if (and (eq t org-agenda-skip-timestamp-if-deadline-is-shown) + (assoc (point) deadline-position-alist)) + (throw :skip nil)) (setq hdmarker (org-agenda-new-marker) tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") @@ -4845,14 +5190,15 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (setq txt (org-agenda-format-item (if inactivep org-agenda-inactive-leader nil) head category tags timestr - remove-re))) + remove-re t))) (setq priority (org-get-priority txt)) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker) (org-add-props txt nil 'priority priority 'org-category category 'date date - 'org-category-position org-category-pos + 'org-category-position category-pos 'todo-state todo-state + 'warntime warntime 'type "timestamp") (push txt ee)) (if org-agenda-skip-additional-timestamps-same-entry @@ -4869,8 +5215,8 @@ 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 org-category-pos ee txt tags entry - result beg b sexp sexp-entry todo-state) + marker category extra category-pos ee txt tags entry + result beg b sexp sexp-entry todo-state warntime) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -4887,23 +5233,30 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (when result (setq marker (org-agenda-new-marker beg) category (org-get-category beg) - org-category-pos (get-text-property beg 'org-category-position) - todo-state (org-get-todo-state)) + category-pos (get-text-property beg 'org-category-position) + tags (save-excursion (org-backward-heading-same-level 0) + (org-get-tags-at)) + todo-state (org-get-todo-state) + warntime (org-entry-get (point) "APPT_WARNTIME")) (dolist (r (if (stringp result) (list result) result)) ;; we expect a list here + (when (and org-agenda-diary-sexp-prefix + (string-match org-agenda-diary-sexp-prefix r)) + (setq extra (match-string 0 r) + r (replace-match "" nil nil r))) (if (string-match "\\S-" r) (setq txt r) (setq txt "SEXP entry returned empty string")) (setq txt (org-agenda-format-item - "" txt category tags 'time)) + extra 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 org-category-pos - 'type "sexp") + 'org-category-position category-pos 'tags tags + 'type "sexp" 'warntime warntime) (push txt ee))))) (nreverse ee))) @@ -4977,6 +5330,7 @@ please use `org-class' instead." dayname skip-weeks))) (make-obsolete 'org-diary-class 'org-class "") +(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list' (defalias 'org-get-closed 'org-agenda-get-progress) (defun org-agenda-get-progress () "Return the logged TODO entries for agenda display." @@ -4987,9 +5341,9 @@ please use `org-class' instead." 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) - (items (if (consp org-agenda-show-log) - org-agenda-show-log - (if (eq org-agenda-show-log 'clockcheck) + (items (if (consp org-agenda-show-log-scoped) + org-agenda-show-log-scoped + (if (eq org-agenda-show-log-scoped 'clockcheck) '(clock) org-agenda-log-mode-items))) (parts @@ -5011,7 +5365,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 org-category-pos tags closedp + marker hdmarker priority category category-pos tags closedp statep clockp state ee txt extra timestr rest clocked) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5023,7 +5377,7 @@ please use `org-class' instead." clockp (not (or closedp statep)) state (and statep (match-string 2)) category (org-get-category (match-beginning 0)) - org-category-pos (get-text-property (match-beginning 0) 'org-category-position) + 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 @@ -5061,14 +5415,14 @@ please use `org-class' instead." (setq txt (org-agenda-format-item (cond (closedp "Closed: ") - (statep (concat "State: (" state ")")) - (t (concat "Clocked: (" clocked ")"))) + (statep (concat "State: (" state ")")) + (t (concat "Clocked: (" clocked ")"))) txt category tags timestr))) (setq priority 100000) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done 'priority priority 'org-category category - 'org-category-position org-category-pos + 'org-category-position category-pos 'type "closed" 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) (push txt ee)) @@ -5146,7 +5500,7 @@ See also the user option `org-agenda-clock-consistency-checks'." ;; There is a gap, lets see if we need to report it (unless (org-agenda-check-clock-gap tlend ts gapok) (setq issue (format "Clocking gap: %d minutes" - (/ (- ts tlend) 60)) + (/ (- ts tlend) 60)) face (or (plist-get pl :gap-face) face)))) (t nil))) (setq tlend (or te tlend) tlstart (or ts tlstart)) @@ -5206,9 +5560,9 @@ 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 org-category-pos + d2 diff dfrac wdays pos pos1 category category-pos tags suppress-prewarning ee txt head face s todo-state - show-all upcomingp donep timestr) + show-all upcomingp donep timestr warntime) (goto-char (point-min)) (while (re-search-forward regexp nil t) (setq suppress-prewarning nil) @@ -5229,7 +5583,7 @@ See also the user option `org-agenda-clock-consistency-checks'." todo-state (save-match-data (org-get-todo-state)) show-all (or (eq org-agenda-repeating-timestamp-show-all t) (member todo-state - org-agenda-repeating-timestamp-show-all)) + org-agenda-repeating-timestamp-show-all)) d2 (org-time-string-to-absolute (match-string 1) d1 'past show-all (current-buffer) pos) @@ -5254,7 +5608,8 @@ See also the user option `org-agenda-clock-consistency-checks'." (not (= diff 0)))) (setq txt nil) (setq category (org-get-category) - org-category-pos (get-text-property (point) 'org-category-position)) + warntime (org-entry-get (point) "APPT_WARNTIME") + 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)) @@ -5284,11 +5639,12 @@ See also the user option `org-agenda-clock-consistency-checks'." (setq face (org-agenda-deadline-face dfrac)) (org-add-props txt props 'org-marker (org-agenda-new-marker pos) + 'warntime warntime 'org-hd-marker (org-agenda-new-marker pos1) 'priority (+ (- diff) (org-get-priority txt)) 'org-category category - 'org-category-position org-category-pos + 'org-category-position category-pos 'todo-state todo-state 'type (if upcomingp "upcoming-deadline" "deadline") 'date (if upcomingp date d2) @@ -5321,11 +5677,12 @@ FRACTION is what fraction of the head-warning time has passed." mm (deadline-position-alist (mapcar (lambda (a) (and (setq mm (get-text-property - 0 'org-hd-marker a)) - (cons (marker-position mm) a))) + 0 'org-hd-marker a)) + (cons (marker-position mm) a))) deadline-results)) - d2 diff pos pos1 category org-category-pos tags donep - ee txt head pastschedp todo-state face timestr s habitp show-all) + d2 diff pos pos1 category category-pos tags donep + ee txt head pastschedp todo-state face timestr s habitp show-all + did-habit-check-p warntime) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -5340,14 +5697,24 @@ FRACTION is what fraction of the head-warning time has passed." d2 (org-time-string-to-absolute (match-string 1) d1 'past show-all (current-buffer) pos) - diff (- d2 d1)) + diff (- d2 d1) + warntime (org-entry-get (point) "APPT_WARNTIME")) (setq pastschedp (and todayp (< diff 0))) + (setq did-habit-check-p nil) ;; When to show a scheduled item in the calendar: ;; If it is on or past the date. (when (or (and (< diff 0) (< (abs diff) org-scheduled-past-days) (and todayp (not org-agenda-only-exact-dates))) - (= diff 0)) + (= diff 0) + ;; org-is-habit-p uses org-entry-get, which is expansive + ;; so we go extra mile to only call it once + (and todayp + (boundp 'org-habit-show-all-today) + org-habit-show-all-today + (setq did-habit-check-p t) + (setq habitp (and (functionp 'org-is-habit-p) + (org-is-habit-p))))) (save-excursion (setq donep (member todo-state org-done-keywords)) (if (and donep @@ -5356,10 +5723,11 @@ FRACTION is what fraction of the head-warning time has passed." (and (functionp 'org-is-habit-p) (org-is-habit-p)))) (setq txt nil) - (setq habitp (and (functionp 'org-is-habit-p) - (org-is-habit-p))) + (setq habitp (if did-habit-check-p habitp + (and (functionp 'org-is-habit-p) + (org-is-habit-p)))) (setq category (org-get-category) - org-category-pos (get-text-property (point) 'org-category-position)) + 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)) @@ -5367,6 +5735,7 @@ FRACTION is what fraction of the head-warning time has passed." (if habitp (if (or (not org-habit-show-habits) (and (not todayp) + (boundp 'org-habit-show-habits-only-for-today) org-habit-show-habits-only-for-today)) (throw :skip nil)) (if (and @@ -5406,11 +5775,12 @@ FRACTION is what fraction of the head-warning time has passed." 'org-hd-marker (org-agenda-new-marker pos1) 'type (if pastschedp "past-scheduled" "scheduled") 'date (if pastschedp d2 date) + 'warntime warntime 'priority (if habitp (org-habit-get-priority habitp) (+ 94 (- 5 diff) (org-get-priority txt))) 'org-category category - 'org-category-position org-category-pos + 'category-position category-pos 'org-habit-p habitp 'todo-state todo-state) (push txt ee)))))) @@ -5428,7 +5798,7 @@ 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 org-category-pos + marker hdmarker ee txt d1 d2 s1 s2 category category-pos todo-state tags pos head donep) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5451,7 +5821,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) - org-category-pos (get-text-property (point) 'org-category-position)) + 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)) @@ -5477,15 +5847,14 @@ FRACTION is what fraction of the head-warning time has passed." ((= d1 d0) (concat "<" start-time ">")) ((= d2 d0) - (concat "<" end-time ">")) - (t nil)) - remove-re)))) + (concat "<" end-time ">"))) + remove-re t)))) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date 'todo-state todo-state 'priority (org-get-priority txt) 'org-category category - 'org-category-position org-category-pos) + 'org-category-position category-pos) (push txt ee)))) (goto-char pos))) ;; Sort the entries by expiration date. @@ -5513,7 +5882,7 @@ The flag is set if the currently compiled format contains a `%e'.") (when (org-string-match-p (car entry) category) (if (listp (cadr entry)) (return (cadr entry)) - (return (apply 'create-image (cdr entry))))))) + (return (apply 'create-image (cdr entry))))))) (defun org-agenda-format-item (extra txt &optional category tags dotime remove-re habitp) @@ -5527,151 +5896,163 @@ time-of-day should be extracted from TXT for sorting of this entry, and for the `%t' specifier in the format. When DOTIME is a string, this string is searched for a time before TXT is. TAGS can be the tags of the headline. Any match of REMOVE-RE will be removed from TXT." - (save-match-data - ;; Diary entries sometimes have extra whitespace at the beginning - (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) - - ;; Fix the tags part in txt - (setq txt (org-agenda-fix-displayed-tags - txt tags - org-agenda-show-inherited-tags - org-agenda-hide-tags-regexp)) - (let* ((category (or category - (if (stringp org-category) - org-category - (and org-category (symbol-name org-category))) - (if buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ""))) - (category-icon (org-agenda-get-category-icon category)) - (category-icon (if category-icon - (propertize " " 'display category-icon) - "")) - ;; time, tag, effort are needed for the eval of the prefix format - (tag (if tags (nth (1- (length tags)) tags) "")) - time effort neffort - (ts (if dotime (concat - (if (stringp dotime) dotime "") - (and org-agenda-search-headline-for-time txt)))) - (time-of-day (and dotime (org-get-time-of-day ts))) - stamp plain s0 s1 s2 rtn srp l - duration thecategory) - (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 - (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) - (setq plain (string-match org-plain-time-of-day-regexp ts))) - (setq s0 (match-string 0 ts) - srp (and stamp (match-end 3)) - s1 (match-string (if plain 1 2) ts) - s2 (match-string (if plain 8 (if srp 4 6)) ts)) - - ;; If the times are in TXT (not in DOTIMES), and the prefix will list - ;; them, we might want to remove them there to avoid duplication. - ;; The user can turn this off with a variable. - (if (and org-prefix-has-time - org-agenda-remove-times-when-in-prefix (or stamp plain) - (string-match (concat (regexp-quote s0) " *") txt) - (not (equal ?\] (string-to-char (substring txt (match-end 0))))) - (if (eq org-agenda-remove-times-when-in-prefix 'beg) - (= (match-beginning 0) 0) - t)) - (setq txt (replace-match "" nil nil txt)))) - ;; Normalize the time(s) to 24 hour - (if s1 (setq s1 (org-get-time-of-day s1 'string t))) - (if s2 (setq s2 (org-get-time-of-day s2 'string t))) - - ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set - (when (and s1 (not s2) org-agenda-default-appointment-duration) - (setq s2 - (org-minutes-to-hh:mm-string - (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration)))) - - ;; Compute the duration - (when s2 - (setq duration (- (org-hh:mm-string-to-minutes s2) - (org-hh:mm-string-to-minutes s1))))) - - (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") - txt) - ;; Tags are in the string - (if (or (eq org-agenda-remove-tags t) - (and org-agenda-remove-tags - org-prefix-has-tag)) - (setq txt (replace-match "" t t txt)) - (setq txt (replace-match - (concat (make-string (max (- 50 (length txt)) 1) ?\ ) - (match-string 2 txt)) - t t txt)))) - (when (eq major-mode 'org-mode) - (setq effort - (condition-case nil - (org-get-effort - (or (get-text-property 0 'org-hd-marker txt) - (get-text-property 0 'org-marker txt))) - (error nil))) - (when effort - (setq neffort (org-duration-string-to-minutes effort) - effort (setq effort (concat "[" effort "]"))))) - ;; prevent erroring out with %e format when there is no effort - (or effort (setq effort "")) - - (when remove-re - (while (string-match remove-re txt) - (setq txt (replace-match "" t t txt)))) - - ;; Set org-heading property on `txt' to mark the start of the - ;; heading. - (add-text-properties 0 (length txt) '(org-heading t) txt) - - ;; Prepare the variables needed in the eval of the compiled format - (setq time (cond (s2 (concat - (org-agenda-time-of-day-to-ampm-maybe s1) - "-" (org-agenda-time-of-day-to-ampm-maybe s2) - (if org-agenda-timegrid-use-ampm " "))) - (s1 (concat - (org-agenda-time-of-day-to-ampm-maybe s1) - (if org-agenda-timegrid-use-ampm - "........ " - "......"))) - (t "")) - extra (or (and (not habitp) extra) "") - category (if (symbolp category) (symbol-name category) category) - thecategory (copy-sequence category)) - (if (string-match org-bracket-link-regexp category) - (progn - (setq l (if (match-end 3) - (- (match-end 3) (match-beginning 3)) - (- (match-end 1) (match-beginning 1)))) - (when (< l (or org-prefix-category-length 0)) - (setq category (copy-sequence category)) - (org-add-props category nil - 'extra-space (make-string - (- org-prefix-category-length l 1) ?\ )))) - (if (and org-prefix-category-max-length - (>= (length category) org-prefix-category-max-length)) - (setq category (substring category 0 (1- org-prefix-category-max-length))))) - ;; Evaluate the compiled format - (setq rtn (concat (eval org-prefix-format-compiled) txt)) - - ;; And finally add the text properties - (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) - (org-add-props rtn nil - 'org-category (if thecategory (downcase thecategory) category) - 'tags (mapcar 'org-downcase-keep-props tags) - 'org-highest-priority org-highest-priority - 'org-lowest-priority org-lowest-priority - 'time-of-day time-of-day - 'duration duration - 'effort effort - 'effort-minutes neffort - 'txt txt - 'time time - 'extra extra - 'format org-prefix-format-compiled - 'dotime dotime)))) + ;; We keep the org-prefix-* variable values along with a compiled + ;; formatter, so that multiple agendas existing at the same time, do + ;; not step on each other toes. + ;; + ;; It was inconvenient to make these variables buffer local in + ;; Agenda buffers, because this function expects to be called with + ;; the buffer where item comes from being current, and not agenda + ;; buffer + (let* ((bindings (car org-prefix-format-compiled)) + (formatter (cadr org-prefix-format-compiled))) + (loop for (var value) in bindings + do (set var value)) + (save-match-data + ;; Diary entries sometimes have extra whitespace at the beginning + (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) + + ;; Fix the tags part in txt + (setq txt (org-agenda-fix-displayed-tags + txt tags + org-agenda-show-inherited-tags + org-agenda-hide-tags-regexp)) + (let* ((category (or category + (if (stringp org-category) + org-category + (and org-category (symbol-name org-category))) + (if buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ""))) + (category-icon (org-agenda-get-category-icon category)) + (category-icon (if category-icon + (propertize " " 'display category-icon) + "")) + ;; time, tag, effort are needed for the eval of the prefix format + (tag (if tags (nth (1- (length tags)) tags) "")) + time effort neffort + (ts (if dotime (concat + (if (stringp dotime) dotime "") + (and org-agenda-search-headline-for-time txt)))) + (time-of-day (and dotime (org-get-time-of-day ts))) + stamp plain s0 s1 s2 rtn srp l + duration thecategory) + (and (derived-mode-p 'org-mode) buffer-file-name + (add-to-list 'org-agenda-contributing-files buffer-file-name)) + (when (and dotime time-of-day) + ;; Extract starting and ending time and move them to prefix + (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) + (setq plain (string-match org-plain-time-of-day-regexp ts))) + (setq s0 (match-string 0 ts) + srp (and stamp (match-end 3)) + s1 (match-string (if plain 1 2) ts) + s2 (match-string (if plain 8 (if srp 4 6)) ts)) + + ;; If the times are in TXT (not in DOTIMES), and the prefix will list + ;; them, we might want to remove them there to avoid duplication. + ;; The user can turn this off with a variable. + (if (and org-prefix-has-time + org-agenda-remove-times-when-in-prefix (or stamp plain) + (string-match (concat (regexp-quote s0) " *") txt) + (not (equal ?\] (string-to-char (substring txt (match-end 0))))) + (if (eq org-agenda-remove-times-when-in-prefix 'beg) + (= (match-beginning 0) 0) + t)) + (setq txt (replace-match "" nil nil txt)))) + ;; Normalize the time(s) to 24 hour + (if s1 (setq s1 (org-get-time-of-day s1 'string t))) + (if s2 (setq s2 (org-get-time-of-day s2 'string t))) + + ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set + (when (and s1 (not s2) org-agenda-default-appointment-duration) + (setq s2 + (org-minutes-to-hh:mm-string + (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration)))) + + ;; Compute the duration + (when s2 + (setq duration (- (org-hh:mm-string-to-minutes s2) + (org-hh:mm-string-to-minutes s1))))) + + (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + txt) + ;; Tags are in the string + (if (or (eq org-agenda-remove-tags t) + (and org-agenda-remove-tags + org-prefix-has-tag)) + (setq txt (replace-match "" t t txt)) + (setq txt (replace-match + (concat (make-string (max (- 50 (length txt)) 1) ?\ ) + (match-string 2 txt)) + t t txt)))) + (when (derived-mode-p 'org-mode) + (setq effort + (condition-case nil + (org-get-effort + (or (get-text-property 0 'org-hd-marker txt) + (get-text-property 0 'org-marker txt))) + (error nil))) + (when effort + (setq neffort (org-duration-string-to-minutes effort) + effort (setq effort (concat "[" effort "]"))))) + ;; prevent erroring out with %e format when there is no effort + (or effort (setq effort "")) + + (when remove-re + (while (string-match remove-re txt) + (setq txt (replace-match "" t t txt)))) + + ;; Set org-heading property on `txt' to mark the start of the + ;; heading. + (add-text-properties 0 (length txt) '(org-heading t) txt) + + ;; Prepare the variables needed in the eval of the compiled format + (setq time (cond (s2 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + "-" (org-agenda-time-of-day-to-ampm-maybe s2) + (if org-agenda-timegrid-use-ampm " "))) + (s1 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + (if org-agenda-timegrid-use-ampm + "........ " + "......"))) + (t "")) + extra (or (and (not habitp) extra) "") + category (if (symbolp category) (symbol-name category) category) + thecategory (copy-sequence category)) + (if (string-match org-bracket-link-regexp category) + (progn + (setq l (if (match-end 3) + (- (match-end 3) (match-beginning 3)) + (- (match-end 1) (match-beginning 1)))) + (when (< l (or org-prefix-category-length 0)) + (setq category (copy-sequence category)) + (org-add-props category nil + 'extra-space (make-string + (- org-prefix-category-length l 1) ?\ )))) + (if (and org-prefix-category-max-length + (>= (length category) org-prefix-category-max-length)) + (setq category (substring category 0 (1- org-prefix-category-max-length))))) + ;; Evaluate the compiled format + (setq rtn (concat (eval formatter) txt)) + + ;; And finally add the text properties + (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) + (org-add-props rtn nil + 'org-category (if thecategory (downcase thecategory) category) + 'tags (mapcar 'org-downcase-keep-props tags) + 'org-highest-priority org-highest-priority + 'org-lowest-priority org-lowest-priority + 'time-of-day time-of-day + 'duration duration + 'effort effort + 'effort-minutes neffort + 'txt txt + 'time time + 'extra extra + 'format org-prefix-format-compiled + 'dotime dotime))))) (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) "Remove tags string from TXT, and add a modified list of tags. @@ -5703,7 +6084,7 @@ The modified list may contain inherited tags, and tags matched by x)) tags ":") (if have-i "::" ":")))))) - txt) + txt) (defun org-downcase-keep-props (s) (let ((props (text-properties-at 0 s))) @@ -5757,8 +6138,8 @@ The modified list may contain inherited tags, and tags matched by (defun org-compile-prefix-format (key) "Compile the prefix format into a Lisp form that can be evaluated. -The resulting form is returned and stored in the variable -`org-prefix-format-compiled'." +The resulting form and associated variable bindings is returned +and stored in the variable `org-prefix-format-compiled'." (setq org-prefix-has-time nil org-prefix-has-tag nil org-prefix-category-length nil org-prefix-has-effort nil) @@ -5802,7 +6183,14 @@ The resulting form is returned and stored in the variable (setq s (replace-match "%s" t nil s)) (push varform vars)) (setq vars (nreverse vars)) - (setq org-prefix-format-compiled `(format ,s ,@vars)))) + (with-current-buffer (or org-agenda-buffer (current-buffer)) + (setq org-prefix-format-compiled + (list + `((org-prefix-has-time ,org-prefix-has-time) + (org-prefix-has-tag ,org-prefix-has-tag) + (org-prefix-category-length ,org-prefix-category-length) + (org-prefix-has-effort ,org-prefix-has-effort)) + `(format ,s ,@vars)))))) (defun org-set-sorting-strategy (key) (if (symbolp (car org-agenda-sorting-strategy)) @@ -5823,23 +6211,23 @@ HH:MM." (when (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) - (let* ((h (string-to-number (match-string 1 s))) - (m (if (match-end 3) (string-to-number (match-string 3 s)) 0)) - (ampm (if (match-end 4) (downcase (match-string 4 s)))) - (am-p (equal ampm "am")) - (h1 (cond ((not ampm) h) - ((= h 12) (if am-p 0 12)) - (t (+ h (if am-p 0 12))))) - (h2 (if (and string mod24 (not (and (= m 0) (= h1 24)))) - (mod h1 24) h1)) - (t0 (+ (* 100 h2) m)) - (t1 (concat (if (>= h1 24) "+" " ") - (if (and org-agenda-time-leading-zero - (< t0 1000)) "0" "") - (if (< t0 100) "0" "") - (if (< t0 10) "0" "") - (int-to-string t0)))) - (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) + (let* ((h (string-to-number (match-string 1 s))) + (m (if (match-end 3) (string-to-number (match-string 3 s)) 0)) + (ampm (if (match-end 4) (downcase (match-string 4 s)))) + (am-p (equal ampm "am")) + (h1 (cond ((not ampm) h) + ((= h 12) (if am-p 0 12)) + (t (+ h (if am-p 0 12))))) + (h2 (if (and string mod24 (not (and (= m 0) (= h1 24)))) + (mod h1 24) h1)) + (t0 (+ (* 100 h2) m)) + (t1 (concat (if (>= h1 24) "+" " ") + (if (and org-agenda-time-leading-zero + (< t0 1000)) "0" "") + (if (< t0 100) "0" "") + (if (< t0 10) "0" "") + (int-to-string t0)))) + (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) (defvar org-agenda-before-sorting-filter-function nil "Function to be applied to agenda items prior to sorting. @@ -5861,7 +6249,7 @@ You can also use this function as a filter, by returning nil for lines you don't want to have in the agenda at all. For this application, you could bind the variable in the options section of a custom command.") -(defun org-finalize-agenda-entries (list &optional nosort) +(defun org-agenda-finalize-entries (list &optional nosort) "Sort and concatenate the agenda items." (setq list (mapcar 'org-agenda-highlight-todo list)) (if nosort @@ -5918,8 +6306,7 @@ could bind the variable in the options section of a custom command.") (let ((pa (or (get-text-property 1 'priority a) 0)) (pb (or (get-text-property 1 'priority b) 0))) (cond ((> pa pb) +1) - ((< pa pb) -1) - (t nil)))) + ((< pa pb) -1)))) (defsubst org-cmp-effort (a b) "Compare the effort values of string A and B." @@ -5927,16 +6314,14 @@ could bind the variable in the options section of a custom command.") (ea (or (get-text-property 1 'effort-minutes a) def)) (eb (or (get-text-property 1 'effort-minutes b) def))) (cond ((> ea eb) +1) - ((< ea eb) -1) - (t nil)))) + ((< ea eb) -1)))) (defsubst org-cmp-category (a b) "Compare the string values of categories of strings A and B." (let ((ca (or (get-text-property 1 'org-category a) "")) (cb (or (get-text-property 1 'org-category b) ""))) (cond ((string-lessp ca cb) -1) - ((string-lessp cb ca) +1) - (t nil)))) + ((string-lessp cb ca) +1)))) (defsubst org-cmp-todo-state (a b) "Compare the todo states of strings A and B." @@ -5958,8 +6343,7 @@ could bind the variable in the options section of a custom command.") (cond ((and donepa (not donepb)) -1) ((and (not donepa) donepb) +1) ((< la lb) -1) - ((< lb la) +1) - (t nil)))) + ((< lb la) +1)))) (defsubst org-cmp-alpha (a b) "Compare the headlines, alphabetically." @@ -5980,8 +6364,7 @@ could bind the variable in the options section of a custom command.") (cond ((not ta) +1) ((not tb) -1) ((string-lessp ta tb) -1) - ((string-lessp tb ta) +1) - (t nil)))) + ((string-lessp tb ta) +1)))) (defsubst org-cmp-tag (a b) "Compare the string values of the first tags of A and B." @@ -5990,8 +6373,7 @@ could bind the variable in the options section of a custom command.") (cond ((not ta) +1) ((not tb) -1) ((string-lessp ta tb) -1) - ((string-lessp tb ta) +1) - (t nil)))) + ((string-lessp tb ta) +1)))) (defsubst org-cmp-time (a b) "Compare the time-of-day values of strings A and B." @@ -5999,16 +6381,14 @@ could bind the variable in the options section of a custom command.") (ta (or (get-text-property 1 'time-of-day a) def)) (tb (or (get-text-property 1 'time-of-day b) def))) (cond ((< ta tb) -1) - ((< tb ta) +1) - (t nil)))) + ((< tb ta) +1)))) (defsubst org-cmp-habit-p (a b) "Compare the todo states of strings A and B." (let ((ha (get-text-property 1 'org-habit-p a)) (hb (get-text-property 1 'org-habit-p b))) (cond ((and ha (not hb)) -1) - ((and (not ha) hb) +1) - (t nil)))) + ((and (not ha) hb) +1)))) (defsubst org-em (x y list) (or (memq x list) (memq y list))) @@ -6131,13 +6511,15 @@ in the file. Otherwise, restriction will be to the current subtree." (defun org-agenda-check-type (error &rest types) "Check if agenda buffer is of allowed type. If ERROR is non-nil, throw an error, otherwise just return nil." - (if (memq org-agenda-type types) - t - (if error - (error "Not allowed in %s-type agenda buffers" org-agenda-type) - nil))) - -(defun org-agenda-quit () + (if (not org-agenda-type) + (error "No Org agenda currently displayed") + (if (memq org-agenda-type types) + t + (if error + (error "Not allowed in %s-type agenda buffers" org-agenda-type) + nil)))) + +(defun org-agenda-Quit (&optional arg) "Exit agenda by removing the window or the buffer." (interactive) (if org-agenda-columns-active @@ -6145,23 +6527,51 @@ If ERROR is non-nil, throw an error, otherwise just return nil." (let ((buf (current-buffer))) (if (eq org-agenda-window-setup 'other-frame) (progn - (kill-buffer buf) (org-agenda-reset-markers) + (kill-buffer buf) (org-columns-remove-overlays) (setq org-agenda-archives-mode nil) (delete-frame)) (and (not (eq org-agenda-window-setup 'current-window)) (not (one-window-p)) (delete-window)) - (kill-buffer buf) (org-agenda-reset-markers) + (kill-buffer buf) (org-columns-remove-overlays) (setq org-agenda-archives-mode nil))) ;; Maybe restore the pre-agenda window configuration. (and org-agenda-restore-windows-after-quit (not (eq org-agenda-window-setup 'other-frame)) - org-pre-agenda-window-conf - (set-window-configuration org-pre-agenda-window-conf)))) + org-agenda-pre-window-conf + (set-window-configuration org-agenda-pre-window-conf) + (setq org-agenda-pre-window-conf nil)))) + +(defun org-agenda-quit () + "Exit agenda by killing agenda buffer or burying it when +`org-agenda-sticky' is non-NIL" + (interactive) + (if (and (eq org-indirect-buffer-display 'other-window) + org-last-indirect-buffer) + (delete-window (get-buffer-window org-last-indirect-buffer))) + (if org-agenda-columns-active + (org-columns-quit) + (if org-agenda-sticky + (let ((buf (current-buffer))) + (if (eq org-agenda-window-setup 'other-frame) + (progn + (delete-frame)) + (and (not (eq org-agenda-window-setup 'current-window)) + (not (one-window-p)) + (delete-window))) + (with-current-buffer buf + (bury-buffer) + ;; Maybe restore the pre-agenda window configuration. + (and org-agenda-restore-windows-after-quit + (not (eq org-agenda-window-setup 'other-frame)) + org-agenda-pre-window-conf + (set-window-configuration org-agenda-pre-window-conf) + (setq org-agenda-pre-window-conf nil)))) + (org-agenda-Quit)))) (defun org-agenda-exit () "Exit agenda by removing the window or the buffer. @@ -6170,7 +6580,18 @@ Org-mode buffers visited directly by the user will not be touched." (interactive) (org-release-buffers org-agenda-new-buffers) (setq org-agenda-new-buffers nil) - (org-agenda-quit)) + (org-agenda-Quit)) + +(defun org-agenda-kill-all-agenda-buffers () + "Kill all buffers in `org-agenda-mode'. +This is used when toggling sticky agendas. You can also explicitly invoke it +with `C-c a C-k'." + (interactive) + (let (blist) + (dolist (buf (buffer-list)) + (when (with-current-buffer buf (eq major-mode 'org-agenda-mode)) + (push buf blist))) + (mapc 'kill-buffer blist))) (defun org-agenda-execute (arg) "Execute another agenda command, keeping same window. @@ -6180,25 +6601,43 @@ in the agenda." (let ((org-agenda-window-setup 'current-window)) (org-agenda arg))) -(defun org-agenda-redo () - "Rebuild Agenda. -When this is the global TODO list, a prefix argument will be interpreted." - (interactive) - (let* ((org-agenda-keep-modes t) +(defun org-agenda-redo (&optional all) + "Rebuild possibly ALL agenda view(s) in the current buffer." + (interactive "P") + (let* ((p (or (and (looking-at "\\'") (1- (point))) (point))) + (cpa (unless (eq all t) current-prefix-arg)) + (org-agenda-doing-sticky-redo org-agenda-sticky) + (org-agenda-sticky nil) + (org-agenda-buffer-name (or org-agenda-this-buffer-name + org-agenda-buffer-name)) + (org-agenda-keep-modes t) (tag-filter org-agenda-tag-filter) (tag-preset (get 'org-agenda-tag-filter :preset-filter)) + (top-cat-filter org-agenda-top-category-filter) (cat-filter org-agenda-category-filter) (cat-preset (get 'org-agenda-category-filter :preset-filter)) (org-agenda-tag-filter-while-redo (or tag-filter tag-preset)) (cols org-agenda-columns-active) (line (org-current-line)) (window-line (- line (org-current-line (window-start)))) - (lprops (get 'org-agenda-redo-command 'org-lprops))) + (lprops (get 'org-agenda-redo-command 'org-lprops)) + (redo-cmd (get-text-property p 'org-redo-cmd)) + (last-args (get-text-property p 'org-last-args)) + (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd)) + (org-agenda-overriding-cmd-arguments + (unless (eq all t) + (cond ((listp last-args) + (cons (or cpa (car last-args)) (cdr last-args))) + ((stringp last-args) + last-args)))) + (series-redo-cmd (get-text-property p 'org-series-redo-cmd))) (put 'org-agenda-tag-filter :preset-filter nil) (put 'org-agenda-category-filter :preset-filter nil) (and cols (org-columns-quit)) (message "Rebuilding agenda buffer...") - (org-let lprops '(eval org-agenda-redo-command)) + (if series-redo-cmd + (eval series-redo-cmd) + (org-let lprops '(eval redo-cmd))) (setq org-agenda-undo-list nil org-agenda-pending-undo-list nil) (message "Rebuilding agenda buffer...done") @@ -6206,6 +6645,7 @@ When this is the global TODO list, a prefix argument will be interpreted." (put 'org-agenda-category-filter :preset-filter cat-preset) (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag)) (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category)) + (and top-cat-filter (org-agenda-filter-top-category-apply top-cat-filter)) (and cols (org-called-interactively-p 'any) (org-agenda-columns)) (org-goto-line line) (recenter window-line))) @@ -6218,13 +6658,38 @@ When this is the global TODO list, a prefix argument will be interpreted." "Keep only those lines in the agenda buffer that have a specific category. The category is that of the current line." (interactive "P") - (if org-agenda-filtered-by-category + (if (and org-agenda-filtered-by-category + org-agenda-category-filter) (org-agenda-filter-show-all-cat) (let ((cat (org-no-properties (get-text-property (point) 'org-category)))) (if cat (org-agenda-filter-apply (list (concat (if strip "-" "+") cat)) 'category) (error "No category at point"))))) +(defun org-find-top-category (&optional pos) + (save-excursion + (with-current-buffer (if pos (marker-buffer pos) (current-buffer)) + (if pos (goto-char pos)) + ;; Skip up to the topmost parent + (while (ignore-errors (outline-up-heading 1) t)) + (ignore-errors + (nth 4 (org-heading-components)))))) + +(defvar org-agenda-filtered-by-top-category nil) + +(defun org-agenda-filter-by-top-category (strip) + "Keep only those lines in the agenda buffer that have a specific category. +The category is that of the current line." + (interactive "P") + (if org-agenda-filtered-by-top-category + (progn + (setq org-agenda-filtered-by-top-category nil + org-agenda-top-category-filter nil) + (org-agenda-filter-show-all-cat)) + (let ((cat (org-find-top-category (org-get-at-bol 'org-hd-marker)))) + (if cat (org-agenda-filter-top-category-apply cat strip) + (error "No top-level category at point"))))) + (defun org-agenda-filter-by-tag (strip &optional char narrow) "Keep only those lines in the agenda buffer that have a specific tag. The tag is selected with its fast selection letter, as configured. @@ -6277,7 +6742,7 @@ to switch to narrowing." (message "Effort%s: %s " effort-op effort-prompt) (setq char (read-char-exclusive)) (when (or (< char ?0) (> char ?9)) - (error "Need 1-9,0 to select effort" )))) + (error "Need 1-9,0 to select effort")))) (when (equal char ?\t) (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) (org-set-local 'org-global-tags-completion-table @@ -6420,10 +6885,27 @@ If the line does not have an effort defined, return nil." (if (get-char-property (point) 'invisible) (ignore-errors (org-agenda-previous-line))))) +(defun org-agenda-filter-top-category-apply (category &optional negative) + "Set FILTER as the new agenda filter and apply it." + (org-agenda-set-mode-name) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let* ((pos (org-get-at-bol 'org-hd-marker)) + (topcat (and pos (org-find-top-category pos)))) + (if (and topcat (funcall (if negative 'identity 'not) + (string= category topcat))) + (org-agenda-filter-hide-line 'category))) + (beginning-of-line 2))) + (if (get-char-property (point) 'invisible) + (org-agenda-previous-line)) + (setq org-agenda-top-category-filter category + org-agenda-filtered-by-top-category t)) + (defun org-agenda-filter-hide-line (type) (let (ov) (setq ov (make-overlay (max (point-min) (1- (point-at-bol))) - (point-at-eol))) + (point-at-eol))) (overlay-put ov 'invisible t) (overlay-put ov 'type type) (if (eq type 'tag) @@ -6439,7 +6921,7 @@ If the line does not have an effort defined, return nil." (goto-char pos) (if (< (overlay-start ov) (point-at-eol)) (move-overlay ov (point-at-eol) - (overlay-end ov))))))) + (overlay-end ov))))))) (defun org-agenda-filter-show-all-tag nil (mapc 'delete-overlay org-agenda-tag-filter-overlays) @@ -6491,36 +6973,58 @@ Negative selection means regexp must not match for selection of an entry." " ")) (setq org-agenda-redo-command (list 'org-search-view - org-todo-only + (car (get-text-property (min (1- (point-max)) (point)) + 'org-last-args)) org-agenda-query-string (+ (length org-agenda-query-string) (if (member char '(?\{ ?\})) 0 1)))) (set-register org-agenda-query-register org-agenda-query-string) - (org-agenda-redo)) + (let ((org-agenda-overriding-arguments + (cdr org-agenda-redo-command))) + (org-agenda-redo))) (t (error "Cannot manipulate query for %s-type agenda buffers" org-agenda-type)))) (defun org-add-to-string (var string) (set var (concat (symbol-value var) string))) -(defun org-agenda-goto-date (date) +(defun org-agenda-goto-date (span) "Jump to DATE in agenda." - (interactive (list (let ((org-read-date-prefer-future - (eval org-agenda-jump-prefer-future))) - (org-read-date)))) - (org-agenda-list nil date)) + (interactive "P") + (let* ((org-read-date-prefer-future + (eval org-agenda-jump-prefer-future)) + (date (org-read-date)) + (org-agenda-sticky-orig org-agenda-sticky) + (org-agenda-buffer-tmp-name (buffer-name)) + (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (0-arg (or current-prefix-arg (car args))) + (2-arg (nth 2 args)) + (newcmd (list 'org-agenda-list 0-arg date + (org-agenda-span-to-ndays 2-arg))) + (newargs (cdr newcmd)) + (inhibit-read-only t) + org-agenda-sticky) + (if (not (org-agenda-check-type t 'agenda)) + (error "Not available in non-agenda blocks") + (add-text-properties (point-min) (point-max) + `(org-redo-cmd ,newcmd org-last-args ,newargs)) + (org-agenda-redo) + (setq org-agenda-sticky org-agenda-sticky-orig + org-agenda-this-buffer-is-sticky org-agenda-sticky)))) (defun org-agenda-goto-today () "Go to today." (interactive) (org-agenda-check-type t 'timeline 'agenda) - (let ((tdpos (text-property-any (point-min) (point-max) 'org-today t))) + (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (curspan (nth 2 args)) + (tdpos (text-property-any (point-min) (point-max) 'org-today t))) (cond (tdpos (goto-char tdpos)) ((eq org-agenda-type 'agenda) (let* ((sd (org-agenda-compute-starting-span - (org-today) (or org-agenda-current-span org-agenda-ndays org-agenda-span))) - (org-agenda-overriding-arguments org-agenda-last-arguments)) + (org-today) (or curspan org-agenda-ndays org-agenda-span))) + (org-agenda-overriding-arguments args)) (setf (nth 1 org-agenda-overriding-arguments) sd) (org-agenda-redo) (org-agenda-find-same-or-today-or-agenda))) @@ -6531,19 +7035,43 @@ Negative selection means regexp must not match for selection of an entry." (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) (text-property-any (point-min) (point-max) 'org-today t) (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) + (and (get-text-property (min (1- (point-max)) (point)) 'org-series) + (org-agenda-goto-block-beginning)) (point-min)))) +(defun org-agenda-goto-block-beginning () + "Go the agenda block beginning." + (interactive) + (if (not (derived-mode-p 'org-agenda-mode)) + (error "Cannot execute this command outside of org-agenda-mode buffers") + (let (dest) + (save-excursion + (unless (looking-at "\\'") + (forward-char)) + (let* ((prop 'org-agenda-structural-header) + (p (previous-single-property-change (point) prop)) + (n (next-single-property-change (or (and (looking-at "\\`") 1) + (1- (point))) prop))) + (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p)))))) + (if (not dest) + (error "Cannot find the beginning of the blog") + (goto-char dest) + (move-beginning-of-line 1))))) + (defun org-agenda-later (arg) "Go forward in time by thee current span. With prefix ARG, go forward that many times the current span." (interactive "p") (org-agenda-check-type t 'agenda) - (let* ((span org-agenda-current-span) - (sd org-starting-day) + (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (span (or (nth 2 args) org-agenda-current-span)) + (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day)) (greg (calendar-gregorian-from-absolute sd)) (cnt (org-get-at-bol 'org-day-cnt)) greg2) (cond + ((numberp span) + (setq sd (+ span sd))) ((eq span 'day) (setq sd (+ arg sd))) ((eq span 'week) @@ -6558,8 +7086,13 @@ With prefix ARG, go forward that many times the current span." (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))) (t (setq sd (+ (* span arg) sd)))) - (let ((org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) sd span t))) + (let ((org-agenda-overriding-cmd + ;; `cmd' may have been set by `org-agenda-run-series' which + ;; uses `org-agenda-overriding-cmd' to decide whether + ;; overriding is allowed for `cmd' + (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) + (org-agenda-overriding-arguments + (list (car args) sd span))) (org-agenda-redo) (org-agenda-find-same-or-today-or-agenda cnt)))) @@ -6572,10 +7105,9 @@ With prefix ARG, go backward that many times the current span." (defun org-agenda-view-mode-dispatch () "Call one of the view mode commands." (interactive) - (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort - time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck - [a]rch-trees [A]rch-files clock[R]eport include[D]iary - [E]ntryText") + (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort + time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck + [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") (let ((a (read-char-exclusive))) (case a (?\ (call-interactively 'org-agenda-reset-view)) @@ -6642,18 +7174,22 @@ written as 2-digit years." "Change the agenda view to SPAN. SPAN may be `day', `week', `month', `year'." (org-agenda-check-type t 'agenda) - (if (and (not n) (equal org-agenda-current-span span)) - (error "Viewing span is already \"%s\"" span)) - (let* ((sd (or (org-get-at-bol 'day) - org-starting-day)) - (sd (org-agenda-compute-starting-span sd span n)) - (org-agenda-overriding-arguments - (or org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) sd span t)))) - (org-agenda-redo) - (org-agenda-find-same-or-today-or-agenda)) - (org-agenda-set-mode-name) - (message "Switched to %s view" span)) + (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (curspan (nth 2 args))) + (if (and (not n) (equal curspan span)) + (error "Viewing span is already \"%s\"" span)) + (let* ((sd (or (org-get-at-bol 'day) + (nth 1 args) + org-starting-day)) + (sd (org-agenda-compute-starting-span sd span n)) + (org-agenda-overriding-cmd + (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) + (org-agenda-overriding-arguments + (list (car args) sd span))) + (org-agenda-redo) + (org-agenda-find-same-or-today-or-agenda)) + (org-agenda-set-mode-name) + (message "Switched to %s view" span))) (defun org-agenda-compute-starting-span (sd span &optional n) "Compute starting date for agenda. @@ -6732,20 +7268,21 @@ so that the date SD will be in that range." "Detach overlay INDEX." (org-detach-overlay org-hl)) -;; FIXME this is currently not used. -(defun org-highlight-until-next-command (beg end &optional buffer) - "Move the highlight overlay to BEG/END, remove it before the next command." - (org-highlight beg end buffer) - (add-hook 'pre-command-hook 'org-unhighlight-once)) (defun org-unhighlight-once () "Remove the highlight from its position, and this function from the hook." (remove-hook 'pre-command-hook 'org-unhighlight-once) (org-unhighlight)) +(defvar org-agenda-pre-follow-window-conf nil) (defun org-agenda-follow-mode () "Toggle follow mode in an agenda buffer." (interactive) + (unless org-agenda-follow-mode + (setq org-agenda-pre-follow-window-conf + (current-window-configuration))) (setq org-agenda-follow-mode (not org-agenda-follow-mode)) + (unless org-agenda-follow-mode + (set-window-configuration org-agenda-pre-follow-window-conf)) (org-agenda-set-mode-name) (org-agenda-do-context-action) (message "Follow mode is %s" @@ -6883,7 +7420,7 @@ When called with a prefix argument, include all archive files as well." 'help-echo "Category used in filtering")) "") (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter - :preset-filter)) + :preset-filter)) '(:eval (org-propertize (concat " {" (mapconcat @@ -6907,11 +7444,14 @@ When called with a prefix argument, include all archive files as well." ""))) (force-mode-line-update)) -(defun org-agenda-post-command-hook () +(define-obsolete-function-alias + 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3") + +(defun org-agenda-update-agenda-type () + "Update the agenda type after each command." (setq org-agenda-type (or (get-text-property (point) 'org-agenda-type) - (get-text-property (max (point-min) (1- (point))) - 'org-agenda-type)))) + (get-text-property (max (point-min) (1- (point))) 'org-agenda-type)))) (defun org-agenda-next-line () "Move cursor to the next line, and show if follow mode is active." @@ -6925,25 +7465,40 @@ When called with a prefix argument, include all archive files as well." (call-interactively 'previous-line) (org-agenda-do-context-action)) +(defun org-agenda-next-item (n) + "Move cursor to next agenda item." + (interactive "p") + (let ((col (current-column))) + (dotimes (c n) + (when (next-single-property-change (point-at-eol) 'org-marker) + (move-end-of-line 1) + (goto-char (next-single-property-change (point) 'org-marker)))) + (org-move-to-column col)) + (org-agenda-do-context-action)) + +(defun org-agenda-previous-item (n) + "Move cursor to next agenda item." + (interactive "p") + (dotimes (c n) + (let ((col (current-column)) + (goto (save-excursion + (move-end-of-line 0) + (previous-single-property-change (point) 'org-marker)))) + (if goto (goto-char goto)) + (org-move-to-column col))) + (org-agenda-do-context-action)) + (defun org-agenda-do-context-action () "Show outline path and, maybe, follow mode window." (let ((m (org-get-at-bol 'org-marker))) (when (and (markerp m) (marker-buffer m)) (and org-agenda-follow-mode (if org-agenda-follow-indirect - (org-agenda-tree-to-indirect-buffer) + (org-agenda-tree-to-indirect-buffer nil) (org-agenda-show))) (and org-agenda-show-outline-path (org-with-point-at m (org-display-outline-path t)))))) -(defun org-agenda-show-priority () - "Show the priority of the current item. -This priority is composed of the main priority given with the [#A] cookies, -and by additional input from the age of a schedules or deadline entry." - (interactive) - (let* ((pri (org-get-at-bol 'priority))) - (message "Priority is %d" (if pri pri -1000)))) - (defun org-agenda-show-tags () "Show the tags applicable to the current item." (interactive) @@ -6964,7 +7519,7 @@ and by additional input from the age of a schedules or deadline entry." (widen) (push-mark) (goto-char pos) - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (org-show-context 'agenda) (save-excursion (and (outline-next-heading) @@ -6983,36 +7538,38 @@ Point is in the buffer where the item originated.") "Kill the entry or subtree belonging to the current agenda entry." (interactive) (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) - (let* ((marker (or (org-get-at-bol 'org-marker) + (let* ((bufname-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker)) (type (org-get-at-bol 'type)) dbeg dend (n 0) conf) (org-with-remote-undo buffer - (with-current-buffer buffer - (save-excursion - (goto-char pos) - (if (and (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) - dend (min (point-max) (1+ (point-at-eol))))) - (goto-char dbeg) - (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) - (setq conf (or (eq t org-agenda-confirm-kill) - (and (numberp org-agenda-confirm-kill) - (> n org-agenda-confirm-kill)))) - (and conf - (not (y-or-n-p - (format "Delete entry with %d lines in buffer \"%s\"? " - n (buffer-name buffer)))) - (error "Abort")) - (org-remove-subtree-entries-from-agenda buffer dbeg dend) - (with-current-buffer buffer (delete-region dbeg dend)) - (message "Agenda item and source killed")))) - -(defvar org-archive-default-command) + (with-current-buffer buffer + (save-excursion + (goto-char pos) + (if (and (derived-mode-p 'org-mode) (not (member type '("sexp")))) + (setq dbeg (progn (org-back-to-heading t) (point)) + dend (org-end-of-subtree t t)) + (setq dbeg (point-at-bol) + dend (min (point-max) (1+ (point-at-eol))))) + (goto-char dbeg) + (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) + (setq conf (or (eq t org-agenda-confirm-kill) + (and (numberp org-agenda-confirm-kill) + (> n org-agenda-confirm-kill)))) + (and conf + (not (y-or-n-p + (format "Delete entry with %d lines in buffer \"%s\"? " + n (buffer-name buffer)))) + (error "Abort")) + (let ((org-agenda-buffer-name bufname-orig)) + (org-remove-subtree-entries-from-agenda buffer dbeg dend)) + (with-current-buffer buffer (delete-region dbeg dend)) + (message "Agenda item and source killed")))) + +(defvar org-archive-default-command) ; defined in org-archive.el (defun org-agenda-archive-default () "Archive the entry or subtree belonging to the current agenda entry." (interactive) @@ -7039,19 +7596,21 @@ Point is in the buffer where the item originated.") "Move the entry to the archive sibling." (interactive) (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) - (let* ((marker (or (org-get-at-bol 'org-marker) + (let* ((bufname-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker))) (org-with-remote-undo buffer (with-current-buffer buffer - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (if (and confirm (not (y-or-n-p "Archive this subtree or entry? "))) (error "Abort") (save-excursion (goto-char pos) - (org-remove-subtree-entries-from-agenda) + (let ((org-agenda-buffer-name bufname-orig)) + (org-remove-subtree-entries-from-agenda)) (org-back-to-heading t) (funcall cmd))) (error "Archiving works only in Org-mode files")))))) @@ -7086,7 +7645,8 @@ If this information is not given, the function uses the tree at point." (interactive "P") (if (equal goto '(16)) (org-refile-goto-last-stored) - (let* ((marker (or (org-get-at-bol 'org-hd-marker) + (let* ((buffer-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-hd-marker) (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker)) @@ -7099,7 +7659,8 @@ If this information is not given, the function uses the tree at point." (save-restriction (widen) (goto-char marker) - (org-remove-subtree-entries-from-agenda) + (let ((org-agenda-buffer-name buffer-orig)) + (org-remove-subtree-entries-from-agenda)) (org-refile goto buffer rfloc))))) (unless no-update (org-agenda-redo)))) @@ -7150,13 +7711,14 @@ at the text of the entry itself." (and delete-other-windows (delete-other-windows)) (widen) (goto-char pos) - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (org-show-context 'agenda) (save-excursion (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading (when (outline-invisible-p) - (show-entry)))))) ; display invisible text + (show-entry)) ; display invisible text + (run-hooks 'org-agenda-after-show-hook))))) (defun org-agenda-goto-mouse (ev) "Go to the Org-mode file which contains the item at the mouse click." @@ -7177,10 +7739,13 @@ if it was hidden in the outline." (select-window win))) (defvar org-agenda-show-window nil) -(defun org-agenda-show-and-scroll-up () +(defun org-agenda-show-and-scroll-up (&optional arg) "Display the Org-mode file which contains the item at point. -When called repeatedly, scroll the window that is displaying the buffer." - (interactive) +When called repeatedly, scroll the window that is displaying the buffer. +With a \\[universal-argument] prefix, use `org-show-entry' instead of +`show-subtree' to display the item, so that drawers and logbooks stay +folded." + (interactive "P") (let ((win (selected-window))) (if (and (window-live-p org-agenda-show-window) (eq this-command last-command)) @@ -7188,7 +7753,7 @@ When called repeatedly, scroll the window that is displaying the buffer." (select-window org-agenda-show-window) (ignore-errors (scroll-up))) (org-agenda-goto t) - (show-subtree) + (if arg (org-show-entry) (show-subtree)) (setq org-agenda-show-window (selected-window))) (select-window win))) @@ -7306,31 +7871,34 @@ docstring of `org-agenda-show-1'." (defun org-agenda-error () (error "Command not allowed in this line")) -(defun org-agenda-tree-to-indirect-buffer () +(defun org-agenda-tree-to-indirect-buffer (arg) "Show the subtree corresponding to the current entry in an indirect buffer. -This calls the command `org-tree-to-indirect-buffer' from the original -Org-mode buffer. -With numerical prefix arg ARG, go up to this level and then take that tree. +This calls the command `org-tree-to-indirect-buffer' from the original buffer. + +With a numerical prefix ARG, go up to this level and then take that tree. +With a negative numeric ARG, go up by this number of levels. With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't use the dedicated frame)." - (interactive) - (if (and current-prefix-arg (listp current-prefix-arg)) - (org-agenda-do-tree-to-indirect-buffer) - (let ((agenda-window (selected-window)) + (interactive "P") + (if current-prefix-arg + (org-agenda-do-tree-to-indirect-buffer arg) + (let ((agenda-buffer (buffer-name)) + (agenda-window (selected-window)) (indirect-window (and org-last-indirect-buffer (get-buffer-window org-last-indirect-buffer)))) - (save-window-excursion (org-agenda-do-tree-to-indirect-buffer)) - (unwind-protect - (progn - (unless (and indirect-window (window-live-p indirect-window)) - (setq indirect-window (split-window agenda-window))) - (select-window indirect-window) - (switch-to-buffer org-last-indirect-buffer :norecord) - (fit-window-to-buffer indirect-window)) - (select-window (get-buffer-window org-agenda-buffer-name)))))) - -(defun org-agenda-do-tree-to-indirect-buffer () + (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg)) + (unless (or (eq org-indirect-buffer-display 'new-frame) + (eq org-indirect-buffer-display 'dedicated-frame)) + (unwind-protect + (unless (and indirect-window (window-live-p indirect-window)) + (setq indirect-window (split-window agenda-window))) + (and indirect-window (select-window indirect-window)) + (switch-to-buffer org-last-indirect-buffer :norecord) + (fit-window-to-buffer indirect-window))) + (select-window (get-buffer-window agenda-buffer))))) + +(defun org-agenda-do-tree-to-indirect-buffer (arg) "Same as `org-agenda-tree-to-indirect-buffer' without saving window." (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) @@ -7340,7 +7908,7 @@ use the dedicated frame)." (with-current-buffer buffer (save-excursion (goto-char pos) - (call-interactively 'org-tree-to-indirect-buffer))))) + (funcall 'org-tree-to-indirect-buffer arg))))) (defvar org-last-heading-marker (make-marker) "Marker pointing to the headline that last changed its TODO state @@ -7429,6 +7997,7 @@ If JUST-THIS is non-nil, change just the current line, not all. If FORCE-TAGS is non nil, the car of it returns the new tags." (let* ((inhibit-read-only t) (line (org-current-line)) + (org-agenda-buffer (current-buffer)) (thetags (with-current-buffer (marker-buffer hdmarker) (save-excursion (save-restriction (widen) (goto-char hdmarker) @@ -7448,14 +8017,14 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." tags thetags new (let ((org-prefix-format-compiled - (or (get-text-property (point) 'format) - org-prefix-format-compiled))) + (or (get-text-property (min (1- (point-max)) (point)) 'format) + org-prefix-format-compiled)) + (extra (org-get-at-bol 'extra))) (with-current-buffer (marker-buffer hdmarker) (save-excursion (save-restriction (widen) - (org-agenda-format-item (org-get-at-bol 'extra) - newhead cat tags dotime))))) + (org-agenda-format-item 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) done-face (org-get-at-bol 'done-face)) @@ -7475,9 +8044,11 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." undone-face done-face)))) (org-agenda-highlight-todo 'line) (beginning-of-line 1)) - (t (error "Line update did not work")))) - (beginning-of-line 0))) - (org-finalize-agenda))) + (t (error "Line update did not work"))) + (save-restriction + (narrow-to-region (point-at-bol) (point-at-eol)) + (org-agenda-finalize))) + (beginning-of-line 0))))) (defun org-agenda-align-tags (&optional line) "Align all tags in agenda items to `org-agenda-tags-column'." @@ -7517,11 +8088,12 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (interactive) (org-agenda-priority 'down)) -(defun org-agenda-priority (&optional force-direction) +(defun org-agenda-priority (&optional force-direction show) "Set the priority of line at point, also in Org-mode file. This changes the line at point, all other lines in the agenda referring to the same tree node, and the headline of the tree node in the Org-mode file." - (interactive) + (interactive "P") + (if (equal force-direction '(4)) (setq show t)) (unless org-enable-priority-commands (error "Priority commands are disabled")) (org-agenda-check-no-diary) @@ -7540,7 +8112,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (save-excursion (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading - (funcall 'org-priority force-direction) + (funcall 'org-priority force-direction show) (end-of-line 1) (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead hdmarker) @@ -7832,73 +8404,7 @@ ARG is passed through to `org-deadline'." (goto-char pos) (setq ts (org-deadline arg time))) (org-agenda-show-new-time marker ts "D")) - (message "Deadline for this item set to %s" ts))) - -(defun org-agenda-action () - "Select entry for agenda action, or execute an agenda action. -This command prompts for another letter. Valid inputs are: - -m Mark the entry at point for an agenda action -s Schedule the marked entry to the date at the cursor -d Set the deadline of the marked entry to the date at the cursor -r Call `org-remember' with cursor date as the default date -c Call `org-capture' with cursor date as the default date -SPC Show marked entry in other window -TAB Visit marked entry in other window - -The cursor may be at a date in the calendar, or in the Org agenda." - (interactive) - (let (ans) - (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [c]apture [ ]show") - (setq ans (read-char-exclusive)) - (cond - ((equal ans ?m) - ;; Mark this entry - (if (eq major-mode 'org-agenda-mode) - (let ((m (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker)))) - (if m - (progn - (move-marker org-agenda-action-marker - (marker-position m) (marker-buffer m)) - (message "Entry marked for action; press `k' at desired date in agenda or calendar")) - (error "Don't know which entry to mark"))) - (error "This command works only in the agenda"))) - ((equal ans ?s) - (org-agenda-do-action '(org-schedule nil org-overriding-default-time))) - ((equal ans ?d) - (org-agenda-do-action '(org-deadline nil org-overriding-default-time))) - ((equal ans ?r) - (org-agenda-do-action '(org-remember) t)) - ((equal ans ?c) - (org-agenda-do-action '(org-capture) t)) - ((equal ans ?\ ) - (let ((cw (selected-window))) - (org-switch-to-buffer-other-window - (marker-buffer org-agenda-action-marker)) - (goto-char org-agenda-action-marker) - (org-show-context 'agenda) - (select-window cw))) - ((equal ans ?\C-i) - (org-switch-to-buffer-other-window - (marker-buffer org-agenda-action-marker)) - (goto-char org-agenda-action-marker) - (org-show-context 'agenda)) - (t (error "Invalid agenda action %c" ans))))) - -(defun org-agenda-do-action (form &optional current-buffer) - "Evaluate FORM at the entry pointed to by `org-agenda-action-marker'." - (let ((org-overriding-default-time (org-get-cursor-date))) - (if current-buffer - (eval form) - (if (not (marker-buffer org-agenda-action-marker)) - (error "No entry has been selected for agenda action") - (with-current-buffer (marker-buffer org-agenda-action-marker) - (save-excursion - (save-restriction - (widen) - (goto-char org-agenda-action-marker) - (eval form)))))))) + (message "Deadline for this item set to %s" ts))) (defun org-agenda-clock-in (&optional arg) "Start the clock on the currently selected item." @@ -8026,6 +8532,12 @@ top-level as top-level entries at the end of the file." :version "24.1" :type 'boolean) +(defcustom org-agenda-bulk-mark-char ">" + "A single-character string to be used as the bulk mark." + :group 'org-agenda + :version "24.1" + :type 'string) + (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) "Add a diary entry with TYPE to `org-agenda-diary-file'. If TEXT is not empty, it will become the headline of the new entry, and @@ -8039,12 +8551,12 @@ the resulting entry will not be shown. When TEXT is empty, switch to (cond ((eq type 'anniversary) (or (re-search-forward "^*[ \t]+Anniversaries" nil t) - (progn - (or (org-at-heading-p t) - (progn - (outline-next-heading) - (insert "* Anniversaries\n\n") - (beginning-of-line -1))))) + (progn + (or (org-at-heading-p t) + (progn + (outline-next-heading) + (insert "* Anniversaries\n\n") + (beginning-of-line -1))))) (outline-next-heading) (org-back-over-empty-lines) (backward-char 1) @@ -8183,12 +8695,11 @@ entries in that Org-mode file." (fset 'calendar-cursor-to-date oldf)))))) (defun org-agenda-execute-calendar-command (cmd) - "Execute a calendar command from the agenda, with the date associated to -the cursor position." + "Execute a calendar command from the agenda with date from cursor." (org-agenda-check-type t 'agenda 'timeline) (require 'diary-lib) - (unless (get-text-property (point) 'day) - (error "Don't know which date to use for calendar command")) + (unless (get-text-property (min (1- (point-max)) (point)) 'day) + (error "Don't know which date to use for the calendar command")) (let* ((oldf (symbol-function 'calendar-cursor-to-date)) (point (point)) (date (calendar-gregorian-from-absolute @@ -8196,14 +8707,14 @@ the cursor position." ;; the following 2 vars are needed in the calendar (displayed-month (car date)) (displayed-year (nth 2 date))) - (unwind-protect - (progn - (fset 'calendar-cursor-to-date - (lambda (&optional error dummy) - (calendar-gregorian-from-absolute - (get-text-property point 'day)))) - (call-interactively cmd)) - (fset 'calendar-cursor-to-date oldf)))) + (unwind-protect + (progn + (fset 'calendar-cursor-to-date + (lambda (&optional error dummy) + (calendar-gregorian-from-absolute + (get-text-property point 'day)))) + (call-interactively cmd)) + (fset 'calendar-cursor-to-date oldf)))) (defun org-agenda-phases-of-moon () "Display the phases of the moon for the 3 months around the cursor date." @@ -8215,9 +8726,9 @@ the cursor position." (interactive) (org-agenda-execute-calendar-command 'list-calendar-holidays)) -(defvar calendar-longitude) -(defvar calendar-latitude) -(defvar calendar-location-name) +(defvar calendar-longitude) ; defined in calendar.el +(defvar calendar-latitude) ; defined in calendar.el +(defvar calendar-location-name) ; defined in calendar.el (defun org-agenda-sunrise-sunset (arg) "Display sunrise and sunset for the cursor date. @@ -8236,7 +8747,7 @@ argument, latitude and longitude will be prompted for." "Open the Emacs calendar with the date at the cursor." (interactive) (org-agenda-check-type t 'agenda 'timeline) - (let* ((day (or (get-text-property (point) 'day) + (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) (error "Don't know which date to open in calendar"))) (date (calendar-gregorian-from-absolute day)) (calendar-move-hook nil) @@ -8257,7 +8768,7 @@ This is a command that has to be installed in `calendar-mode-map'." (defun org-agenda-convert-date () (interactive) (org-agenda-check-type t 'agenda 'timeline) - (let ((day (get-text-property (point) 'day)) + (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) date s) (unless day (error "Don't know which date to convert")) @@ -8284,9 +8795,6 @@ This is a command that has to be installed in `calendar-mode-map'." ;;; Bulk commands -(defvar org-agenda-bulk-marked-entries nil - "List of markers that refer to marked entries in the agenda.") - (defun org-agenda-bulk-marked-p () (eq (get-char-property (point-at-bol) 'type) 'org-marked-entry-overlay)) @@ -8302,7 +8810,7 @@ This is a command that has to be installed in `calendar-mode-map'." (unless m (error "Nothing to mark at point")) (push m org-agenda-bulk-marked-entries) (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) - (org-overlay-display ov "> " + (org-overlay-display ov (concat org-agenda-bulk-mark-char " ") (org-get-todo-face "TODO") 'evaporate) (overlay-put ov 'type 'org-marked-entry-overlay)) @@ -8312,8 +8820,13 @@ This is a command that has to be installed in `calendar-mode-map'." (message "%d entries marked for bulk action" (length org-agenda-bulk-marked-entries)))))) +(defun org-agenda-bulk-mark-all () + "Mark all entries for future agenda bulk action." + (interactive) + (org-agenda-bulk-mark-regexp ".")) + (defun org-agenda-bulk-mark-regexp (regexp) - "Mark entries match REGEXP." + "Mark entries matching REGEXP for future agenda bulk action." (interactive "sMark entries matching regexp: ") (let ((entries-marked 0)) (save-excursion @@ -8326,27 +8839,30 @@ This is a command that has to be installed in `calendar-mode-map'." (if (not entries-marked) (message "No entry matching this regexp.")))) -(defun org-agenda-bulk-unmark () +(defun org-agenda-bulk-unmark (&optional arg) "Unmark the entry at point for future bulk action." - (interactive) - (when (org-agenda-bulk-marked-p) - (org-agenda-bulk-remove-overlays - (point-at-bol) (+ 2 (point-at-bol))) - (setq org-agenda-bulk-marked-entries - (delete (org-get-at-bol 'org-hd-marker) - org-agenda-bulk-marked-entries))) - (beginning-of-line 2) - (while (and (get-char-property (point) 'invisible) (not (eobp))) - (beginning-of-line 2)) - (message "%d entries marked for bulk action" - (length org-agenda-bulk-marked-entries))) + (interactive "P") + (if arg + (org-agenda-bulk-unmark-all) + (cond ((org-agenda-bulk-marked-p) + (org-agenda-bulk-remove-overlays + (point-at-bol) (+ 2 (point-at-bol))) + (setq org-agenda-bulk-marked-entries + (delete (org-get-at-bol 'org-hd-marker) + org-agenda-bulk-marked-entries)) + (beginning-of-line 2) + (while (and (get-char-property (point) 'invisible) (not (eobp))) + (beginning-of-line 2)) + (message "%d entries left marked for bulk action" + (length org-agenda-bulk-marked-entries))) + (t (message "No entry to unmark here"))))) (defun org-agenda-bulk-toggle () - "Toggle marking the entry at point for bulk action." - (interactive) - (if (org-agenda-bulk-marked-p) - (org-agenda-bulk-unmark) - (org-agenda-bulk-mark))) + "Toggle marking the entry at point for bulk action." + (interactive) + (if (org-agenda-bulk-marked-p) + (org-agenda-bulk-unmark) + (org-agenda-bulk-mark))) (defun org-agenda-bulk-remove-overlays (&optional beg end) "Remove the mark overlays between BEG and END in the agenda buffer. @@ -8360,13 +8876,23 @@ from the list in `org-agenda-bulk-marked-entries'." (delete-overlay ov))) (overlays-in (or beg (point-min)) (or end (point-max))))) -(defun org-agenda-bulk-remove-all-marks () +(defun org-agenda-bulk-unmark-all () "Remove all marks in the agenda buffer. -This will remove the markers, and the overlays." +This will remove the markers and the overlays." (interactive) - (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries) - (setq org-agenda-bulk-marked-entries nil) - (org-agenda-bulk-remove-overlays (point-min) (point-max))) + (if (null org-agenda-bulk-marked-entries) + (message "No entry to unmark") + (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries) + (setq org-agenda-bulk-marked-entries nil) + (org-agenda-bulk-remove-overlays (point-min) (point-max)))) + +(defcustom org-agenda-persistent-marks nil + "Non-nil means marked items will stay marked after a bulk action. +You can toggle this interactively by typing `p' when prompted for a +bulk action." + :group 'org-agenda + :version "24.1" + :type 'boolean) (defun org-agenda-bulk-action (&optional arg) "Execute an remote-editing action on all marked entries. @@ -8384,148 +8910,161 @@ The prefix arg is passed through to the command if possible." org-agenda-bulk-marked-entries) ;; Prompt for the bulk command - (message (concat "Bulk: [r]efile [$]arch [A]rch->sib [t]odo" - " [+/-]tag [s]chd [S]catter [d]eadline [f]unction" - (when org-agenda-bulk-custom-functions - (concat " Custom: [" - (mapconcat (lambda(f) (char-to-string (car f))) - org-agenda-bulk-custom-functions "") - "]")))) - (let* ((action (read-char-exclusive)) - (org-log-refile (if org-log-refile 'time nil)) - (entries (reverse org-agenda-bulk-marked-entries)) - redo-at-end - cmd rfloc state e tag pos (cnt 0) (cntskip 0)) - (cond - ((equal action ?$) - (setq cmd '(org-agenda-archive))) - - ((equal action ?A) - (setq cmd '(org-agenda-archive-to-archive-sibling))) - - ((member action '(?r ?w)) - (setq rfloc (org-refile-get-location - "Refile to" - (marker-buffer (car org-agenda-bulk-marked-entries)) - org-refile-allow-creating-parent-nodes)) - (if (nth 3 rfloc) - (setcar (nthcdr 3 rfloc) - (move-marker (make-marker) (nth 3 rfloc) - (or (get-file-buffer (nth 1 rfloc)) - (find-buffer-visiting (nth 1 rfloc)) - (error "This should not happen"))))) - - (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t) - redo-at-end t)) - - ((equal action ?t) - (setq state (org-icompleting-read - "Todo state: " - (with-current-buffer (marker-buffer (car entries)) - (mapcar 'list org-todo-keywords-1)))) - (setq cmd `(let ((org-inhibit-blocking t) - (org-inhibit-logging 'note)) - (org-agenda-todo ,state)))) - - ((memq action '(?- ?+)) - (setq tag (org-icompleting-read - (format "Tag to %s: " (if (eq action ?+) "add" "remove")) - (with-current-buffer (marker-buffer (car entries)) - (delq nil - (mapcar (lambda (x) - (if (stringp (car x)) x)) org-tag-alist))))) - (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) - - ((memq action '(?s ?d)) - (let* ((date (unless arg - (org-read-date - nil nil nil - (if (eq action ?s) "(Re)Schedule to" "Set Deadline to")))) - (ans (if arg nil org-read-date-final-answer)) - (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) - (setq cmd `(let* ((bound (fboundp 'read-string)) - (old (and bound (symbol-function 'read-string)))) - (unwind-protect - (progn - (fset 'read-string (lambda (&rest ignore) ,ans)) - (eval '(,c1 arg))) - (if bound - (fset 'read-string old) - (fmakunbound 'read-string))))))) - - ((equal action ?S) - (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) - (error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type) - (let ((days (read-number - (format "Scatter tasks across how many %sdays: " - (if arg "week" "")) 7))) - (setq cmd - `(let ((distance (1+ (random ,days)))) - (if arg - (let ((dist distance) - (day-of-week - (calendar-day-of-week - (calendar-gregorian-from-absolute (org-today))))) - (dotimes (i (1+ dist)) - (while (member day-of-week org-agenda-weekend-days) - (incf distance) - (incf day-of-week) - (if (= day-of-week 7) - (setq day-of-week 0))) - (incf day-of-week) - (if (= day-of-week 7) - (setq day-of-week 0))))) - ;; silently fail when try to replan a sexp entry - (condition-case nil - (let* ((date (calendar-gregorian-from-absolute - (+ (org-today) distance))) - (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) - (nth 2 date)))) - (org-agenda-schedule nil time)) - (error nil))))))) - - ((assoc action org-agenda-bulk-custom-functions) - (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions))) - redo-at-end t)) - - ((equal action ?f) - (setq cmd (list (intern - (org-icompleting-read "Function: " - obarray 'fboundp t nil nil))))) - - (t (error "Invalid bulk action"))) - - ;; Sort the markers, to make sure that parents are handled before children - (setq entries (sort entries - (lambda (a b) - (cond - ((equal (marker-buffer a) (marker-buffer b)) - (< (marker-position a) (marker-position b))) - (t - (string< (buffer-name (marker-buffer a)) - (buffer-name (marker-buffer b)))))))) - - ;; Now loop over all markers and apply cmd - (while (setq e (pop entries)) - (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e)) - (if (not pos) - (progn (message "Skipping removed entry at %s" e) - (setq cntskip (1+ cntskip))) - (goto-char pos) - (let (org-loop-over-headlines-in-active-region) - (eval cmd)) - (setq org-agenda-bulk-marked-entries - (delete e org-agenda-bulk-marked-entries)) - (setq cnt (1+ cnt)))) - (setq org-agenda-bulk-marked-entries nil) - (org-agenda-bulk-remove-all-marks) - (when redo-at-end (org-agenda-redo)) - (message "Acted on %d entries%s" - cnt - (if (= cntskip 0) - "" - (format ", skipped %d (disappeared before their turn)" - cntskip))))) + (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: "))) + (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile " + "[S]catter [f]unction " + (when org-agenda-bulk-custom-functions + (concat " Custom: [" + (mapconcat (lambda(f) (char-to-string (car f))) + org-agenda-bulk-custom-functions "") + "]")))) + (catch 'exit + (let* ((action (read-char-exclusive)) + (org-log-refile (if org-log-refile 'time nil)) + (entries (reverse org-agenda-bulk-marked-entries)) + (org-overriding-default-time + (if (get-text-property (point) 'org-agenda-date-header) + (org-get-cursor-date))) + redo-at-end + cmd rfloc state e tag pos (cnt 0) (cntskip 0)) + (cond + ((equal action ?p) + (let ((org-agenda-persistent-marks + (not org-agenda-persistent-marks))) + (org-agenda-bulk-action) + (throw 'exit nil))) + + ((equal action ?$) + (setq cmd '(org-agenda-archive))) + + ((equal action ?A) + (setq cmd '(org-agenda-archive-to-archive-sibling))) + + ((member action '(?r ?w)) + (setq rfloc (org-refile-get-location + "Refile to" + (marker-buffer (car entries)) + org-refile-allow-creating-parent-nodes)) + (if (nth 3 rfloc) + (setcar (nthcdr 3 rfloc) + (move-marker (make-marker) (nth 3 rfloc) + (or (get-file-buffer (nth 1 rfloc)) + (find-buffer-visiting (nth 1 rfloc)) + (error "This should not happen"))))) + + (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t) + redo-at-end t)) + + ((equal action ?t) + (setq state (org-icompleting-read + "Todo state: " + (with-current-buffer (marker-buffer (car entries)) + (mapcar 'list org-todo-keywords-1)))) + (setq cmd `(let ((org-inhibit-blocking t) + (org-inhibit-logging 'note)) + (org-agenda-todo ,state)))) + + ((memq action '(?- ?+)) + (setq tag (org-icompleting-read + (format "Tag to %s: " (if (eq action ?+) "add" "remove")) + (with-current-buffer (marker-buffer (car entries)) + (delq nil + (mapcar (lambda (x) + (if (stringp (car x)) x)) org-tag-alist))))) + (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) + + ((memq action '(?s ?d)) + (let* ((time + (unless arg + (org-read-date + nil nil nil + (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to") + org-overriding-default-time))) + (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) + (setq cmd `(eval '(,c1 arg ,time))))) + + ((equal action ?S) + (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) + (error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type) + (let ((days (read-number + (format "Scatter tasks across how many %sdays: " + (if arg "week" "")) 7))) + (setq cmd + `(let ((distance (1+ (random ,days)))) + (if arg + (let ((dist distance) + (day-of-week + (calendar-day-of-week + (calendar-gregorian-from-absolute (org-today))))) + (dotimes (i (1+ dist)) + (while (member day-of-week org-agenda-weekend-days) + (incf distance) + (incf day-of-week) + (if (= day-of-week 7) + (setq day-of-week 0))) + (incf day-of-week) + (if (= day-of-week 7) + (setq day-of-week 0))))) + ;; silently fail when try to replan a sexp entry + (condition-case nil + (let* ((date (calendar-gregorian-from-absolute + (+ (org-today) distance))) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) + (nth 2 date)))) + (org-agenda-schedule nil time)) + (error nil))))))) + + ((assoc action org-agenda-bulk-custom-functions) + (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions))) + redo-at-end t)) + + ((equal action ?f) + (setq cmd (list (intern + (org-icompleting-read "Function: " + obarray 'fboundp t nil nil))))) + + (t (error "Invalid bulk action"))) + + ;; Sort the markers, to make sure that parents are handled before children + (setq entries (sort entries + (lambda (a b) + (cond + ((equal (marker-buffer a) (marker-buffer b)) + (< (marker-position a) (marker-position b))) + (t + (string< (buffer-name (marker-buffer a)) + (buffer-name (marker-buffer b)))))))) + + ;; Now loop over all markers and apply cmd + (while (setq e (pop entries)) + (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e)) + (if (not pos) + (progn (message "Skipping removed entry at %s" e) + (setq cntskip (1+ cntskip))) + (goto-char pos) + (let (org-loop-over-headlines-in-active-region) + (eval cmd)) + (setq cnt (1+ cnt)))) + (when redo-at-end (org-agenda-redo)) + (unless org-agenda-persistent-marks + (org-agenda-bulk-unmark-all)) + (message "Acted on %d entries%s%s" + cnt + (if (= cntskip 0) + "" + (format ", skipped %d (disappeared before their turn)" + cntskip)) + (if (not org-agenda-persistent-marks) + "" " (kept marked)")))))) + +(defun org-agenda-capture () + "Call `org-capture' with the date at point." + (interactive) + (if (not (eq major-mode 'org-agenda-mode)) + (error "You cannot do this outside of agenda buffers") + (let ((org-overriding-default-time + (org-get-cursor-date))) + (call-interactively 'org-capture)))) ;;; Flagging notes @@ -8576,7 +9115,7 @@ tag and (if present) the flagging note." ;;; Appointment reminders -(defvar appt-time-msg-list) +(defvar appt-time-msg-list) ; defined in appt.el ;;;###autoload (defun org-agenda-to-appt (&optional refresh filter &rest args) @@ -8606,7 +9145,10 @@ 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." +details and examples. + +If an entry as a APPT_WARNTIME property, its value will be used +to override `appt-message-warning-time'." (interactive "P") (if refresh (setq appt-time-msg-list nil)) (if (eq filter t) @@ -8621,9 +9163,10 @@ details and examples." (today (org-date-to-gregorian (time-to-days (current-time)))) (org-agenda-restrict nil) - (files (org-agenda-files 'unrestricted)) entries file) + (files (org-agenda-files 'unrestricted)) entries file + (org-agenda-buffer nil)) ;; Get all entries which may contain an appt - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (while (setq file (pop files)) (setq entries (delq nil @@ -8645,7 +9188,8 @@ details and examples." (or (and (stringp cat-filter) (string-match cat-filter cat)) (and (stringp evt-filter) - (string-match evt-filter evt)))))))) + (string-match evt-filter evt))))))) + (wrn (get-text-property 1 'warntime x))) ;; FIXME: Shall we remove text-properties for the appt text? ;; (setq evt (set-text-properties 0 (length evt) nil evt)) (when (and ok tod) @@ -8654,7 +9198,9 @@ details and examples." "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) (concat (match-string 1 tod) ":" (match-string 2 tod)))) - (appt-add tod evt) + (if (version< emacs-version "23.3") + (appt-add tod evt) + (appt-add tod evt wrn)) (setq cnt (1+ cnt))))) entries) (org-release-buffers org-agenda-new-buffers) (if (eq cnt 0) @@ -8669,7 +9215,7 @@ details and examples." (eq date today))) (defun org-agenda-todo-yesterday (&optional arg) - "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday" + "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday." (interactive "P") (let* ((hour (third (decode-time (org-current-time)))) diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index db3b8250bc0..29b883824ef 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -31,6 +31,7 @@ (require 'org) (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) (defcustom org-archive-default-command 'org-archive-subtree "The default archiving command." @@ -100,14 +101,14 @@ the archived entry, with a prefix \"ARCHIVE_\", to remember this information." :group 'org-archive :type '(set :greedy t - (const :tag "Time" time) - (const :tag "File" file) - (const :tag "Category" category) - (const :tag "TODO state" todo) - (const :tag "Priority" priority) - (const :tag "Inherited tags" itags) - (const :tag "Outline path" olpath) - (const :tag "Local tags" ltags))) + (const :tag "Time" time) + (const :tag "File" file) + (const :tag "Category" category) + (const :tag "TODO state" todo) + (const :tag "Priority" priority) + (const :tag "Inherited tags" itags) + (const :tag "Outline path" olpath) + (const :tag "Local tags" ltags))) (defun org-get-local-archive-location () "Get the archive location applicable at point." @@ -223,13 +224,14 @@ this heading." (current-time))) category todo priority ltags itags atags ;; end of variables that will be used for saving context - location afile heading buffer level newfile-p infile-p visiting) + location afile heading buffer level newfile-p infile-p visiting + datetree-date datetree-subheading-p) ;; Find the local archive location (setq location (org-get-local-archive-location) afile (org-extract-archive-file location) heading (org-extract-archive-heading location) - infile-p (equal file (abbreviate-file-name afile))) + infile-p (equal file (abbreviate-file-name (or afile "")))) (unless afile (error "Invalid `org-archive-location'")) @@ -240,6 +242,13 @@ this heading." (setq buffer (current-buffer))) (unless buffer (error "Cannot access file \"%s\"" afile)) + (when (string-match "\\`datetree/" heading) + ;; Replace with ***, to represent the 3 levels of headings the + ;; datetree has. + (setq heading (replace-regexp-in-string "\\`datetree/" "***" heading)) + (setq datetree-subheading-p (> (length heading) 3)) + (setq datetree-date (org-date-to-gregorian + (or (org-entry-get nil "CLOSED" t) time)))) (if (and (> (length heading) 0) (string-match "^\\*+" heading)) (setq level (match-end 0)) @@ -263,7 +272,7 @@ this heading." (let (this-command) (org-copy-subtree 1 nil t)) (set-buffer buffer) ;; Enforce org-mode for the archive buffer - (if (not (eq major-mode 'org-mode)) + (if (not (derived-mode-p 'org-mode)) ;; Force the mode for future visits. (let ((org-insert-mode-line-in-empty-file t) (org-inhibit-startup t)) @@ -272,6 +281,10 @@ this heading." (goto-char (point-max)) (insert (format "\nArchived entries from file %s\n\n" (buffer-file-name this-buffer)))) + (when datetree-date + (require 'org-datetree) + (org-datetree-find-date-create datetree-date) + (org-narrow-to-subtree)) ;; Force the TODO keywords of the original buffer (let ((org-todo-line-regexp tr-org-todo-line-regexp) (org-todo-keywords-1 tr-org-todo-keywords-1) @@ -285,7 +298,7 @@ this heading." tr-org-odd-levels-only))) (goto-char (point-min)) (show-all) - (if heading + (if (and heading (not (and datetree-date (not datetree-subheading-p)))) (progn (if (re-search-forward (concat "^" (regexp-quote heading) @@ -295,7 +308,8 @@ this heading." ;; Heading not found, just insert it at the end (goto-char (point-max)) (or (bolp) (insert "\n")) - (insert "\n" heading "\n") + ;; datetrees don't need too much spacing + (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) ;; Make the subtree visible (show-subtree) @@ -306,9 +320,10 @@ this heading." (org-end-of-subtree t)) (skip-chars-backward " \t\r\n") (and (looking-at "[ \t\r\n]*") - (replace-match "\n\n"))) + ;; datetree archives don't need so much spacing. + (replace-match (if datetree-date "\n" "\n\n")))) ;; No specific heading, just go to end of file. - (goto-char (point-max)) (insert "\n")) + (goto-char (point-max)) (unless datetree-date (insert "\n"))) ;; Paste (org-paste-subtree (org-get-valid-level level (and heading 1))) ;; Shall we append inherited tags? @@ -336,6 +351,7 @@ this heading." (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) (org-entry-put (point) n v))))) + (widen) ;; Save and kill the buffer, if it is not the same buffer. (when (not (eq this-buffer buffer)) (save-buffer)))) diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el index 61cbe1560a4..655b8db668d 100644 --- a/lisp/org/org-ascii.el +++ b/lisp/org/org-ascii.el @@ -36,7 +36,7 @@ :tag "Org Export ASCII" :group 'org-export) -(defcustom org-export-ascii-underline '(?\- ?\= ?\~ ?^ ?\# ?\$) +(defcustom org-export-ascii-underline '(?\= ?\- ?\~ ?\^ ?\. ?\# ?\$) "Characters for underlining headings in ASCII export. In the given sequence, these characters will be used for level 1, 2, ..." :group 'org-export-ascii @@ -144,9 +144,9 @@ command to convert it." (interactive "r") (let (reg ascii buf pop-up-frames) (save-window-excursion - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq ascii (org-export-region-as-ascii - beg end t 'string)) + beg end t 'string)) (setq reg (buffer-substring beg end) buf (get-buffer-create "*Org tmp*")) (with-current-buffer buf @@ -154,7 +154,7 @@ command to convert it." (insert reg) (org-mode) (setq ascii (org-export-region-as-ascii - (point-min) (point-max) t 'string))) + (point-min) (point-max) t 'string))) (kill-buffer buf))) (delete-region beg end) (insert ascii))) @@ -193,7 +193,7 @@ in a window. A non-interactive call will only return the buffer." ;;;###autoload (defun org-export-as-ascii (arg &optional hidden ext-plist - to-buffer body-only pub-dir) + to-buffer body-only pub-dir) "Export the outline as a pretty ASCII file. If there is an active region, export only the region. The prefix ARG specifies how many levels of the outline should become @@ -373,54 +373,54 @@ publishing directory." (push (concat (make-string (string-width (nth 3 lang-words)) ?=) "\n") thetoc) (mapc #'(lambda (line) - (if (string-match org-todo-line-regexp - line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (match-string 3 line) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) + (if (string-match org-todo-line-regexp + line) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (match-string 3 line) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (setq txt (org-html-expand-for-ascii txt)) - - (while (string-match org-bracket-link-regexp txt) - (setq txt - (replace-match - (match-string (if (match-end 2) 3 1) txt) - t t txt))) - - (if (and (memq org-export-with-tags '(not-in-toc nil)) - (string-match - (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") - txt)) - (setq txt (replace-match "" t t txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt 1))) - - (if org-export-with-section-numbers - (setq txt (concat (org-section-number level) - " " txt))) - (if (<= level umax-toc) - (progn - (push - (concat - (make-string - (* (max 0 (- level org-min-level)) 4) ?\ ) - (format (if todo "%s (*)\n" "%s\n") txt)) - thetoc) - (setq org-last-level level)) - )))) + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (setq txt (org-html-expand-for-ascii txt)) + + (while (string-match org-bracket-link-regexp txt) + (setq txt + (replace-match + (match-string (if (match-end 2) 3 1) txt) + t t txt))) + + (if (and (memq org-export-with-tags '(not-in-toc nil)) + (string-match + (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") + txt)) + (setq txt (replace-match "" t t txt))) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt 1))) + + (if org-export-with-section-numbers + (setq txt (concat (org-section-number level) + " " txt))) + (if (<= level umax-toc) + (progn + (push + (concat + (make-string + (* (max 0 (- level org-min-level)) 4) ?\ ) + (format (if todo "%s (*)\n" "%s\n") txt)) + thetoc) + (setq org-last-level level)) + )))) lines) (setq thetoc (if have-headings (nreverse thetoc) nil)))) diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index a87993f4b2e..e02d7e07a4c 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -78,12 +78,15 @@ Allowed values are: mv rename the file to move it into the attachment directory cp copy the file ln create a hard link. Note that this is not supported + on all systems, and then the result is not defined. +lns create a symbol link. Note that this is not supported on all systems, and then the result is not defined." :group 'org-attach :type '(choice (const :tag "Copy" cp) (const :tag "Move/Rename" mv) - (const :tag "Link" ln))) + (const :tag "Hard Link" ln) + (const :tag "Symbol Link" lns))) (defcustom org-attach-expert nil "Non-nil means do not show the splash buffer with the attach dispatcher." @@ -130,7 +133,7 @@ Shows a list of commands and prompts for another key to execute a command." (princ "Select an Attachment Command: a Select a file and attach it to the task, using `org-attach-method'. -c/m/l Attach a file using copy/move/link method. +c/m/l/y Attach a file using copy/move/link/symbolic-link method. n Create a new attachment, as an Emacs buffer. z Synchronize the current task with its attachment directory, in case you added attachments yourself. @@ -158,6 +161,8 @@ i Make children of the current entry inherit its attachment directory."))) (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach))) ((memq c '(?l ?\C-l)) (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) + ((memq c '(?y ?\C-y)) + (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) ((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new)) ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync)) ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open)) @@ -254,9 +259,9 @@ This checks for the existence of a \".git\" directory in that directory." (shell-command "git add .") (shell-command "git ls-files --deleted" t) (mapc #'(lambda (file) - (unless (string= file "") - (shell-command - (concat "git rm \"" file "\"")))) + (unless (string= file "") + (shell-command + (concat "git rm \"" file "\"")))) (split-string (buffer-string) "\n")) (shell-command "git commit -m 'Synchronized attachments'"))))) @@ -282,7 +287,8 @@ Only do this when `org-attach-store-link-p' is non-nil." (defun org-attach-attach (file &optional visit-dir method) "Move/copy/link FILE into the attachment directory of the current task. If VISIT-DIR is non-nil, visit the directory with dired. -METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'." +METHOD may be `cp', `mv', `ln', or `lns' default taken from +`org-attach-method'." (interactive "fFile to keep as an attachment: \nP") (setq method (or method org-attach-method)) (let ((basename (file-name-nondirectory file))) @@ -294,7 +300,8 @@ METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'." (cond ((eq method 'mv) (rename-file file fname)) ((eq method 'cp) (copy-file file fname)) - ((eq method 'ln) (add-name-to-file file fname))) + ((eq method 'ln) (add-name-to-file file fname)) + ((eq method 'lns) (make-symbolic-link file fname))) (org-attach-commit) (org-attach-tag) (cond ((eq org-attach-store-link-p 'attached) @@ -319,6 +326,13 @@ Beware that this does not work on systems that do not support hard links. On some systems, this apparently does copy the file instead." (interactive) (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) +(defun org-attach-attach-lns () + "Attach a file by creating a symbolic link to it. + +Beware that this does not work on systems that do not support symbolic links. +On some systems, this apparently does copy the file instead." + (interactive) + (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) (defun org-attach-new (file) "Create a new attachment FILE for the current task. @@ -415,7 +429,7 @@ If IN-EMACS is non-nil, force opening in Emacs." (file (if (= (length files) 1) (car files) (org-icompleting-read "Open attachment: " - (mapcar 'list files) nil t)))) + (mapcar 'list files) nil t)))) (org-open-file (expand-file-name file attach-dir) in-emacs))) (defun org-attach-open-in-emacs () diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index 04af6969de5..be395ad3927 100644 --- a/lisp/org/org-bbdb.el +++ b/lisp/org/org-bbdb.el @@ -109,17 +109,20 @@ (declare-function bbdb-record-getprop "ext:bbdb" (record property)) (declare-function bbdb-record-name "ext:bbdb" (record)) (declare-function bbdb-records "ext:bbdb" - (&optional dont-check-disk already-in-db-buffer)) + (&optional dont-check-disk already-in-db-buffer)) (declare-function bbdb-split "ext:bbdb" (string separators)) (declare-function bbdb-string-trim "ext:bbdb" (string)) (declare-function bbdb-record-get-field "ext:bbdb" (record field)) (declare-function bbdb-search-name "ext:bbdb-com" (regexp &optional layout)) (declare-function bbdb-search-organization "ext:bbdb-com" (regexp &optional layout)) +;; `bbdb-record-note' is part of BBDB v3.x +(declare-function bbdb-record-note "ext:bbdb" (record label)) + (declare-function calendar-leap-year-p "calendar" (year)) (declare-function diary-ordinal-suffix "diary-lib" (n)) -(defvar date) ;; dynamically scoped from Org +(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el ;; Customization @@ -134,30 +137,31 @@ :require 'bbdb) (defcustom org-bbdb-anniversary-format-alist - '(("birthday" lambda - (name years suffix) - (concat "Birthday: [[bbdb:" name "][" name " (" - (format "%s" years) ; handles numbers as well as strings - suffix ")]]")) - ("wedding" lambda - (name years suffix) - (concat "[[bbdb:" name "][" name "'s " - (format "%s" years) - suffix " wedding anniversary]]"))) + '(("birthday" . + (lambda (name years suffix) + (concat "Birthday: [[bbdb:" name "][" name " (" + (format "%s" years) ; handles numbers as well as strings + suffix ")]]"))) + ("wedding" . + (lambda (name years suffix) + (concat "[[bbdb:" name "][" name "'s " + (format "%s" years) + suffix " wedding anniversary]]")))) "How different types of anniversaries should be formatted. An alist of elements (STRING . FORMAT) where STRING is the name of an anniversary class and format is either: 1) A format string with the following substitutions (in order): - * the name of the record containing this anniversary - * the number of years - * an ordinal suffix (st, nd, rd, th) for the year + - the name of the record containing this anniversary + - the number of years + - an ordinal suffix (st, nd, rd, th) for the year 2) A function to be called with three arguments: NAME YEARS SUFFIX (string int string) returning a string for the diary or nil. 3) An Emacs Lisp form that should evaluate to a string (or nil) in the scope of variables NAME, YEARS and SUFFIX (among others)." - :type 'sexp + :type '(alist :key-type (string :tag "Class") + :value-type (function :tag "Function")) :group 'org-bbdb-anniversaries :require 'bbdb) @@ -203,7 +207,7 @@ date year)." (company (if (fboundp 'bbdb-record-getprop) (bbdb-record-getprop rec 'company) (car (bbdb-record-get-field rec 'organization)))) - (link (org-make-link "bbdb:" name))) + (link (concat "bbdb:" name))) (org-store-link-props :type "bbdb" :name name :company company :link link :description name) link))) @@ -217,6 +221,8 @@ italicized, in all other cases it is left unchanged." (cond ((eq format 'html) (format "<i>%s</i>" desc)) ((eq format 'latex) (format "\\textit{%s}" desc)) + ((eq format 'odt) + (format "<text:span text:style-name=\"Emphasis\">%s</text:span>" desc)) (t desc))) (defun org-bbdb-open (name) @@ -272,7 +278,7 @@ italicized, in all other cases it is left unchanged." "Convert YYYY-MM-DD to (month date year). Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted it will be considered unknown." - (multiple-value-bind (a b c) (values-list (bbdb-split time-str "-")) + (multiple-value-bind (a b c) (values-list (org-split-string time-str "-")) (if (eq c nil) (list (string-to-number a) (string-to-number b) @@ -299,13 +305,19 @@ The hash table is created on first use.") (defun org-bbdb-make-anniv-hash () "Create a hash with anniversaries extracted from BBDB, for fast access. The anniversaries are assumed to be stored `org-bbdb-anniversary-field'." - - (let (split tmp annivs) + (let ((old-bbdb (fboundp 'bbdb-record-getprop)) + split tmp annivs) (clrhash org-bbdb-anniv-hash) (dolist (rec (bbdb-records)) - (when (setq annivs (bbdb-record-getprop - rec org-bbdb-anniversary-field)) - (setq annivs (bbdb-split annivs "\n")) + (when (setq annivs (if old-bbdb + (bbdb-record-getprop + rec org-bbdb-anniversary-field) + (bbdb-record-note + rec org-bbdb-anniversary-field))) + (setq annivs (if old-bbdb + (bbdb-split annivs "\n") + ;; parameter order is reversed in new bbdb + (bbdb-split "\n" annivs))) (while annivs (setq split (org-bbdb-anniv-split (pop annivs))) (multiple-value-bind (m d y) diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el index 041a9154095..b5f3013e000 100644 --- a/lisp/org/org-beamer.el +++ b/lisp/org/org-beamer.el @@ -87,7 +87,7 @@ BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}." (defconst org-beamer-column-widths "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC" -"The column widths that should be installed as allowed property values.") + "The column widths that should be installed as allowed property values.") (defconst org-beamer-transitions "\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC" @@ -107,6 +107,7 @@ These are just a completion help.") ("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}") ("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}") ("example" "e" "\\begin{example}%a%U%x" "\\end{example}") + ("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}") ("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}") ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}") ("normal" "h" "%h" "") ; Emit the heading as normal text @@ -117,7 +118,7 @@ These are just a completion help.") These are the defaults - for user definitions, see `org-beamer-environments-extra'. \"normal\" is a special fake environment, which emit the heading as -normal text. It is needed when an environment should be surrounded +normal text. It is needed when an environment should be surrounded by normal text. Since beamer export converts nodes into environments, you need to have a node to end the environment. For example @@ -155,6 +156,12 @@ close The closing string of the environment." (string :tag "Begin") (string :tag "End")))) +(defcustom org-beamer-inherited-properties nil + "Properties that should be inherited during beamer export." + :group 'org-beamer + :type '(repeat + (string :tag "Property"))) + (defvar org-beamer-frame-level-now nil) (defvar org-beamer-header-extra nil) (defvar org-beamer-export-is-beamer-p nil) @@ -488,6 +495,12 @@ The effect is that these values will be accessible during export." (if (and (not (assoc "BEAMER_env" props)) (looking-at ".*?:B_\\(note\\(NH\\)?\\):")) (push (cons "BEAMER_env" (match-string 1)) props)) + (when (org-bound-and-true-p org-beamer-inherited-properties) + (mapc (lambda (p) + (unless (assoc p props) + (let ((v (org-entry-get nil p 'inherit))) + (and v (push (cons p v) props))))) + org-beamer-inherited-properties)) (put-text-property (point-at-bol) (point-at-eol) 'org-props props))) (setq org-export-latex-options-plist (plist-put org-export-latex-options-plist :tags nil)))))) @@ -502,7 +515,7 @@ This function will run in the final LaTeX document." (while (re-search-forward org-beamer-fragile-re nil t) (save-excursion ;; Are we inside a frame here? - (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}" + (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}\\(<[^>]*>\\)?" nil t) (equal (match-string 1) "begin")) ;; yes, inside a frame, make sure "fragile" is one of the options @@ -520,7 +533,7 @@ This function will run in the final LaTeX document." :group 'org-beamer :version "24.1" :type '(string :tag "Outline frame title") -) + ) (defcustom org-beamer-outline-frame-options nil "Outline frame options appended after \\begin{frame}. @@ -529,7 +542,7 @@ include square brackets." :group 'org-beamer :version "24.1" :type '(string :tag "Outline frame options") -) + ) (defun org-beamer-fix-toc () "Fix the table of contents by removing the vspace line." diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index 4c852fcb875..f8e07adcd8a 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -111,6 +111,7 @@ (require 'bibtex) (eval-when-compile (require 'cl)) +(require 'org-compat) (defvar org-bibtex-description nil) ; dynamically scoped from org.el (defvar org-id-locations) @@ -184,33 +185,33 @@ "Bibtex entry types with required and optional parameters.") (defvar org-bibtex-fields - '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.") - (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.") + '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.") + (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.") (:author . "The name(s) of the author(s), in the format described in the LaTeX book. Remember, all names are separated with the and keyword, and not commas.") - (:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.") + (:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.") (:chapter . "A chapter (or section or whatever) number.") (:crossref . "The database key of the entry being cross referenced.") - (:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.") - (:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.") - (:howpublished . "How something strange has been published. The first word should be capitalized.") + (:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.") + (:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.") + (:howpublished . "How something strange has been published. The first word should be capitalized.") (:institution . "The sponsoring institution of a technical report.") (:journal . "A journal name.") - (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.") - (:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,") - (:note . "Any additional information that can help the reader. The first word should be capitalized.") - (:number . "Any additional information that can help the reader. The first word should be capitalized.") + (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.") + (:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,") + (:note . "Any additional information that can help the reader. The first word should be capitalized.") + (:number . "Any additional information that can help the reader. The first word should be capitalized.") (:organization . "The organization that sponsors a conference or that publishes a manual.") (:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).") (:publisher . "The publisher’s name.") (:school . "The name of the school where a thesis was written.") - (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.") + (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.") (:title . "The work’s title, typed as explained in the LaTeX book.") (:type . "The type of a technical report for example, 'Research Note'.") (:volume . "The volume of a journal or multi-volume book.") (:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'")) "Bibtex fields with descriptions.") -(defvar *org-bibtex-entries* nil +(defvar org-bibtex-entries nil "List to hold parsed bibtex entries.") (defcustom org-bibtex-autogen-keys nil @@ -229,7 +230,7 @@ For example setting to 'BIB_' would allow interoperability with fireforg." (defcustom org-bibtex-treat-headline-as-title t "Treat headline text as title if title property is absent. If an entry is missing a title property, use the headline text as -the property. If this value is t, `org-bibtex-check' will ignore +the property. If this value is t, `org-bibtex-check' will ignore a missing title field." :group 'org-bibtex :version "24.1" @@ -247,7 +248,7 @@ not placed in the exported bibtex entry." (defcustom org-bibtex-key-property "CUSTOM_ID" "Property that holds the bibtex key. By default, this is CUSTOM_ID, which enables easy linking to -bibtex headlines from within an org file. This can be set to ID +bibtex headlines from within an org file. This can be set to ID to enable global links, but only with great caution, as global IDs must be unique." :group 'org-bibtex @@ -263,12 +264,12 @@ IDs must be unique." (defcustom org-bibtex-tags-are-keywords nil "Convert the value of the keywords field to tags and vice versa. If set to t, comma-separated entries in a bibtex entry's keywords -field will be converted to org tags. Note: spaces will be escaped +field will be converted to org tags. Note: spaces will be escaped with underscores, and characters that are not permitted in org tags will be removed. If t, local tags in an org entry will be exported as a -comma-separated string of keywords when exported to bibtex. Tags +comma-separated string of keywords when exported to bibtex. Tags defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will not be exported." :group 'org-bibtex @@ -277,7 +278,7 @@ not be exported." (defcustom org-bibtex-no-export-tags nil "List of tag(s) that should not be converted to keywords. -This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t." +This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t." :group 'org-bibtex :version "24.1" :type '(repeat :tag "Tag" (string))) @@ -309,71 +310,72 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t." (defun org-bibtex-headline () "Return a bibtex entry of the given headline as a string." - (flet ((val (key lst) (cdr (assoc key lst))) - (to (string) (intern (concat ":" string))) - (from (key) (substring (symbol-name key) 1)) - (flatten (&rest lsts) - (apply #'append (mapcar - (lambda (e) - (if (listp e) (apply #'flatten e) (list e))) - lsts)))) - (let ((notes (buffer-string)) - (id (org-bibtex-get org-bibtex-key-property)) - (type (org-bibtex-get org-bibtex-type-property-name)) - (tags (when org-bibtex-tags-are-keywords - (delq nil - (mapcar - (lambda (tag) - (unless (member tag - (append org-bibtex-tags - org-bibtex-no-export-tags)) - tag)) - (org-get-local-tags-at)))))) - (when type - (let ((entry (format - "@%s{%s,\n%s\n}\n" type id - (mapconcat - (lambda (pair) - (format " %s={%s}" (car pair) (cdr pair))) - (remove nil - (if (and org-bibtex-export-arbitrary-fields - org-bibtex-prefix) - (mapcar - (lambda (kv) - (let ((key (car kv)) (val (cdr kv))) - (when (and - (string-match org-bibtex-prefix key) - (not (string= - (downcase (concat org-bibtex-prefix - org-bibtex-type-property-name)) - (downcase key)))) - (cons (downcase (replace-regexp-in-string - org-bibtex-prefix "" key)) - val)))) - (org-entry-properties nil 'standard)) - (mapcar - (lambda (field) - (let ((value (or (org-bibtex-get (from field)) - (and (equal :title field) - (nth 4 (org-heading-components)))))) - (when value (cons (from field) value)))) - (flatten - (val :required (val (to type) org-bibtex-types)) - (val :optional (val (to type) org-bibtex-types)))))) - ",\n")))) - (with-temp-buffer - (insert entry) - (when tags - (bibtex-beginning-of-entry) - (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t) - (progn (goto-char (match-end 1)) (insert ", ")) - (bibtex-make-field "keywords" t t)) - (insert (mapconcat #'identity tags ", "))) - (buffer-string))))))) + (let* ((val (lambda (key lst) (cdr (assoc key lst)))) + (to (lambda (string) (intern (concat ":" string)))) + (from (lambda (key) (substring (symbol-name key) 1))) + flatten ; silent compiler warning + (flatten (lambda (&rest lsts) + (apply #'append (mapcar + (lambda (e) + (if (listp e) (apply flatten e) (list e))) + lsts)))) + (notes (buffer-string)) + (id (org-bibtex-get org-bibtex-key-property)) + (type (org-bibtex-get org-bibtex-type-property-name)) + (tags (when org-bibtex-tags-are-keywords + (delq nil + (mapcar + (lambda (tag) + (unless (member tag + (append org-bibtex-tags + org-bibtex-no-export-tags)) + tag)) + (org-get-local-tags-at)))))) + (when type + (let ((entry (format + "@%s{%s,\n%s\n}\n" type id + (mapconcat + (lambda (pair) + (format " %s={%s}" (car pair) (cdr pair))) + (remove nil + (if (and org-bibtex-export-arbitrary-fields + org-bibtex-prefix) + (mapcar + (lambda (kv) + (let ((key (car kv)) (val0 (cdr kv))) + (when (and + (string-match org-bibtex-prefix key) + (not (string= + (downcase (concat org-bibtex-prefix + org-bibtex-type-property-name)) + (downcase key)))) + (cons (downcase (replace-regexp-in-string + org-bibtex-prefix "" key)) + val0)))) + (org-entry-properties nil 'standard)) + (mapcar + (lambda (field) + (let ((value (or (org-bibtex-get (funcall from field)) + (and (equal :title field) + (nth 4 (org-heading-components)))))) + (when value (cons (funcall from field) value)))) + (funcall flatten + (funcall val :required (funcall val (funcall to type) org-bibtex-types)) + (funcall val :optional (funcall val (funcall to type) org-bibtex-types)))))) + ",\n")))) + (with-temp-buffer + (insert entry) + (when tags + (bibtex-beginning-of-entry) + (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t) + (progn (goto-char (match-end 1)) (insert ", ")) + (bibtex-make-field "keywords" t t)) + (insert (mapconcat #'identity tags ", "))) + (buffer-string)))))) (defun org-bibtex-ask (field) (unless (assoc field org-bibtex-fields) - (error "field:%s is not known" field)) + (error "Field:%s is not known" field)) (save-window-excursion (let* ((name (substring (symbol-name field) 1)) (buf-name (format "*Bibtex Help %s*" name))) @@ -385,7 +387,7 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t." (read-from-minibuffer (format "%s: " name)))))) (defun org-bibtex-autokey () - "Generate an autokey for the current headline" + "Generate an autokey for the current headline." (org-bibtex-put org-bibtex-key-property (if org-bibtex-autogen-keys (let* ((entry (org-bibtex-headline)) @@ -404,24 +406,26 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t." (read-from-minibuffer "id: ")))) (defun org-bibtex-fleshout (type &optional optional) - "Fleshout the current heading, ensuring that all required fields are present. + "Fleshout current heading, ensuring all required fields are present. With optional argument OPTIONAL, also prompt for optional fields." - (flet ((val (key lst) (cdr (assoc key lst))) - (keyword (name) (intern (concat ":" (downcase name)))) - (name (keyword) (substring (symbol-name keyword) 1))) + (let ((val (lambda (key lst) (cdr (assoc key lst)))) + (keyword (lambda (name) (intern (concat ":" (downcase name))))) + (name (lambda (keyword) (substring (symbol-name keyword) 1)))) (dolist (field (append (if org-bibtex-treat-headline-as-title - (remove :title (val :required (val type org-bibtex-types))) - (val :required (val type org-bibtex-types))) - (when optional (val :optional (val type org-bibtex-types))))) + (remove :title (funcall val :required (funcall val type org-bibtex-types))) + (funcall val :required (funcall val type org-bibtex-types))) + (when optional (funcall val :optional (funcall val type org-bibtex-types))))) (when (consp field) ; or'd pair of fields e.g., (:editor :author) - (let ((present (first (remove nil - (mapcar - (lambda (f) (when (org-bibtex-get (name f)) f)) - field))))) - (setf field (or present (keyword (org-icompleting-read - "Field: " (mapcar #'name field))))))) - (let ((name (name field))) + (let ((present (first (remove + nil + (mapcar + (lambda (f) (when (org-bibtex-get (funcall name f)) f)) + field))))) + (setf field (or present (funcall keyword + (org-icompleting-read + "Field: " (mapcar name field))))))) + (let ((name (funcall name field))) (unless (org-bibtex-get name) (let ((prop (org-bibtex-ask field))) (when prop (org-bibtex-put name prop))))))) @@ -546,7 +550,7 @@ Headlines are exported using `org-bibtex-export-headline'." (error (throw 'bib (point))))))))) (with-temp-file filename (insert (mapconcat #'identity bibtex-entries "\n"))) - (message "Successfully exported %d bibtex entries to %s" + (message "Successfully exported %d BibTeX entries to %s" (length bibtex-entries) filename) nil)))) (defun org-bibtex-check (&optional optional) @@ -578,7 +582,7 @@ If nonew is t, add data to the headline of the entry at point." (type (if (keywordp type) type (intern (concat ":" type)))) (org-bibtex-treat-headline-as-title (if nonew nil t))) (unless (assoc type org-bibtex-types) - (error "type:%s is not known" type)) + (error "Type:%s is not known" type)) (if nonew (org-back-to-heading) (org-insert-heading) @@ -597,57 +601,60 @@ With a prefix arg, query for optional fields." (org-bibtex-create arg t)) (defun org-bibtex-read () - "Read a bibtex entry and save to `*org-bibtex-entries*'. + "Read a bibtex entry and save to `org-bibtex-entries'. This uses `bibtex-parse-entry'." (interactive) - (flet ((keyword (str) (intern (concat ":" (downcase str)))) - (clean-space (str) (replace-regexp-in-string - "[[:space:]\n\r]+" " " str)) - (strip-delim (str) ; strip enclosing "..." and {...} - (dolist (pair '((34 . 34) (123 . 125) (123 . 125))) - (when (and (= (aref str 0) (car pair)) - (= (aref str (1- (length str))) (cdr pair))) - (setf str (substring str 1 (1- (length str)))))) str)) + (let ((keyword (lambda (str) (intern (concat ":" (downcase str))))) + (clean-space (lambda (str) (replace-regexp-in-string + "[[:space:]\n\r]+" " " str))) + (strip-delim + (lambda (str) ; strip enclosing "..." and {...} + (dolist (pair '((34 . 34) (123 . 125) (123 . 125))) + (when (and (= (aref str 0) (car pair)) + (= (aref str (1- (length str))) (cdr pair))) + (setf str (substring str 1 (1- (length str)))))) str))) (push (mapcar (lambda (pair) - (cons (let ((field (keyword (car pair)))) + (cons (let ((field (funcall keyword (car pair)))) (case field (:=type= :type) (:=key= :key) (otherwise field))) - (clean-space (strip-delim (cdr pair))))) + (funcall clean-space (funcall strip-delim (cdr pair))))) (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry))) - *org-bibtex-entries*))) + org-bibtex-entries))) (defun org-bibtex-write () - "Insert a heading built from the first element of `*org-bibtex-entries*'." + "Insert a heading built from the first element of `org-bibtex-entries'." (interactive) - (when (= (length *org-bibtex-entries*) 0) - (error "No entries in `*org-bibtex-entries*'.")) - (let ((entry (pop *org-bibtex-entries*)) - (org-special-properties nil)) ; avoids errors with `org-entry-put' - (flet ((val (field) (cdr (assoc field entry))) - (togtag (tag) (org-toggle-tag tag 'on))) - (org-insert-heading) - (insert (val :title)) - (org-bibtex-put "TITLE" (val :title)) - (org-bibtex-put org-bibtex-type-property-name (downcase (val :type))) - (dolist (pair entry) - (case (car pair) - (:title nil) - (:type nil) - (:key (org-bibtex-put org-bibtex-key-property (cdr pair))) - (:keywords (if org-bibtex-tags-are-keywords - (mapc - (lambda (kw) - (togtag - (replace-regexp-in-string - "[^[:alnum:]_@#%]" "" - (replace-regexp-in-string "[ \t]+" "_" kw)))) - (split-string (cdr pair) ", *")) - (org-bibtex-put (car pair) (cdr pair)))) - (otherwise (org-bibtex-put (car pair) (cdr pair))))) - (mapc #'togtag org-bibtex-tags)))) + (when (= (length org-bibtex-entries) 0) + (error "No entries in `org-bibtex-entries'")) + (let* ((entry (pop org-bibtex-entries)) + (org-special-properties nil) ; avoids errors with `org-entry-put' + (val (lambda (field) (cdr (assoc field entry)))) + (togtag (lambda (tag) (org-toggle-tag tag 'on)))) + (org-insert-heading) + (insert (funcall val :title)) + (org-bibtex-put "TITLE" (funcall val :title)) + (org-bibtex-put org-bibtex-type-property-name + (downcase (funcall val :type))) + (dolist (pair entry) + (case (car pair) + (:title nil) + (:type nil) + (:key (org-bibtex-put org-bibtex-key-property (cdr pair))) + (:keywords (if org-bibtex-tags-are-keywords + (mapc + (lambda (kw) + (funcall + togtag + (replace-regexp-in-string + "[^[:alnum:]_@#%]" "" + (replace-regexp-in-string "[ \t]+" "_" kw)))) + (split-string (cdr pair) ", *")) + (org-bibtex-put (car pair) (cdr pair)))) + (otherwise (org-bibtex-put (car pair) (cdr pair))))) + (mapc togtag org-bibtex-tags))) (defun org-bibtex-yank () "If kill ring holds a bibtex entry yank it as an Org-mode headline." @@ -656,7 +663,7 @@ This uses `bibtex-parse-entry'." (with-temp-buffer (yank 1) (setf entry (org-bibtex-read))) (if entry (org-bibtex-write) - (error "yanked text does not appear to contain a bibtex entry")))) + (error "Yanked text does not appear to contain a BibTeX entry")))) (defun org-bibtex-export-to-kill-ring () "Export current headline to kill ring as bibtex entry." diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 454463f7086..9d20814a2ca 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -58,6 +58,9 @@ (declare-function org-table-goto-line "org-table" (N)) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) +(declare-function org-at-encrypted-entry-p "org-crypt" ()) +(declare-function org-encrypt-entry "org-crypt" ()) +(declare-function org-decrypt-entry "org-crypt" ()) (defvar org-remember-default-headline) (defvar org-remember-templates) @@ -101,7 +104,7 @@ description A short string describing the template, will be shown during selection. type The type of entry. Valid types are: - entry an Org-mode node, with a headline. Will be + entry an Org-mode node, with a headline. Will be filed as the child of the target entry or as a top-level entry. item a plain list item, will be placed in the @@ -183,6 +186,14 @@ properties are: before and after the new item. Default 0, only common other value is 1. + :empty-lines-before Set this to the number of lines the should be inserted + before the new item. Overrides :empty-lines for the + number lines inserted before. + + :empty-lines-after Set this to the number of lines the should be inserted + after the new item. Overrides :empty-lines for the + number of lines inserted after. + :clock-in Start the clock in this item. :clock-keep Keep the clock running when filing the captured entry. @@ -211,51 +222,53 @@ will be filed as a child of the target headline. It can also be freely formatted text. Furthermore, the following %-escapes will be replaced with content and expanded in this order: - %[pathname] insert the contents of the file given by `pathname'. - %(sexp) evaluate elisp `(sexp)' and replace with the result. - %<...> the result of format-time-string on the ... format specification. - %t time stamp, date only. - %T time stamp with date and time. - %u, %U like the above, but inactive time stamps. - %a annotation, normally the link created with `org-store-link'. - %i initial content, copied from the active region. If %i is + %[pathname] Insert the contents of the file given by `pathname'. + %(sexp) Evaluate elisp `(sexp)' and replace with the result. + %<...> The result of format-time-string on the ... format specification. + %t Time stamp, date only. + %T Time stamp with date and time. + %u, %U Like the above, but inactive time stamps. + %i Initial content, copied from the active region. If %i is indented, the entire inserted text will be indented as well. - %A like %a, but prompt for the description part. - %c current kill ring head. - %x content of the X clipboard. - %k title of currently clocked task. - %K link to currently clocked task. - %n user name (taken from `user-full-name'). - %f file visited by current buffer when org-capture was called. - %F full path of the file or directory visited by current buffer. - %:keyword specific information for certain link types, see below. - %^g prompt for tags, with completion on tags in target file. - %^G prompt for tags, with completion on all tags in all agenda files. - %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. - You may define a prompt like %^{Please specify birthday. - %^C interactive selection of which kill or clip to use. - %^L like %^C, but insert as link. - %^{prop}p prompt the user for a value for property `prop'. - %^{prompt} prompt the user for a string and replace this sequence with it. + %a Annotation, normally the link created with `org-store-link'. + %A Like %a, but prompt for the description part. + %l Like %a, but only insert the literal link. + %c Current kill ring head. + %x Content of the X clipboard. + %k Title of currently clocked task. + %K Link to currently clocked task. + %n User name (taken from `user-full-name'). + %f File visited by current buffer when org-capture was called. + %F Full path of the file or directory visited by current buffer. + %:keyword Specific information for certain link types, see below. + %^g Prompt for tags, with completion on tags in target file. + %^G Prompt for tags, with completion on all tags in all agenda files. + %^t Like %t, but prompt for date. Similarly %^T, %^u, %^U. + You may define a prompt like: %^{Please specify birthday}t + %^C Interactive selection of which kill or clip to use. + %^L Like %^C, but insert as link. + %^{prop}p Prompt the user for a value for property `prop'. + %^{prompt} Prompt the user for a string and replace this sequence with it. A default value and a completion table ca be specified like this: %^{prompt|default|completion2|completion3|...}. %? After completing the template, position cursor here. + %\\n Insert the text entered at the nth %^{prompt}, where `n' is + a number, starting from 1. -Apart from these general escapes, you can access information specific to the -link type that is created. For example, calling `org-capture' in emails -or gnus will record the author and the subject of the message, which you +Apart from these general escapes, you can access information specific to +the link type that is created. For example, calling `org-capture' in emails +or in Gnus will record the author and the subject of the message, which you can access with \"%:from\" and \"%:subject\", respectively. Here is a complete list of what is recorded for each link type. Link type | Available information ------------------------+------------------------------------------------------ bbdb | %:type %:name %:company -vm, wl, mh, mew, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress +vm, wl, mh, mew, rmail, | %:type %:subject %:message-id +gnus | %:from %:fromname %:fromaddress | %:to %:toname %:toaddress | %:fromto (either \"to NAME\" or \"from NAME\") - | %:date - | %:date-timestamp (as active timestamp) + | %:date %:date-timestamp (as active timestamp) | %:date-timestamp-inactive (as inactive timestamp) gnus | %:group, for messages also all email fields w3, w3m | %:type %:url @@ -266,71 +279,71 @@ calendar | %:type %:date" :type '(repeat (choice :value ("" "" entry (file "~/org/notes.org") "") - (list :tag "Multikey description" - (string :tag "Keys ") - (string :tag "Description")) - (list :tag "Template entry" - (string :tag "Keys ") - (string :tag "Description ") - (choice :tag "Capture Type " :value entry - (const :tag "Org entry" entry) - (const :tag "Plain list item" item) - (const :tag "Checkbox item" checkitem) - (const :tag "Plain text" plain) - (const :tag "Table line" table-line)) - (choice :tag "Target location" - (list :tag "File" - (const :format "" file) - (file :tag " File")) - (list :tag "ID" - (const :format "" id) - (string :tag " ID")) - (list :tag "File & Headline" - (const :format "" file+headline) - (file :tag " File ") - (string :tag " Headline")) - (list :tag "File & Outline path" - (const :format "" file+olp) - (file :tag " File ") - (repeat :tag "Outline path" :inline t - (string :tag "Headline"))) - (list :tag "File & Regexp" - (const :format "" file+regexp) - (file :tag " File ") - (regexp :tag " Regexp")) - (list :tag "File & Date tree" - (const :format "" file+datetree) - (file :tag " File")) - (list :tag "File & Date tree, prompt for date" - (const :format "" file+datetree+prompt) - (file :tag " File")) - (list :tag "File & function" - (const :format "" file+function) - (file :tag " File ") - (sexp :tag " Function")) - (list :tag "Current clocking task" - (const :format "" clock)) - (list :tag "Function" - (const :format "" function) - (sexp :tag " Function"))) - (choice :tag "Template" - (string) - (list :tag "File" - (const :format "" file) - (file :tag "Template file")) - (list :tag "Function" - (const :format "" function) - (function :tag "Template function"))) - (plist :inline t - ;; Give the most common options as checkboxes - :options (((const :format "%v " :prepend) (const t)) - ((const :format "%v " :immediate-finish) (const t)) - ((const :format "%v " :empty-lines) (const 1)) - ((const :format "%v " :clock-in) (const t)) - ((const :format "%v " :clock-keep) (const t)) - ((const :format "%v " :clock-resume) (const t)) - ((const :format "%v " :unnarrowed) (const t)) - ((const :format "%v " :kill-buffer) (const t)))))))) + (list :tag "Multikey description" + (string :tag "Keys ") + (string :tag "Description")) + (list :tag "Template entry" + (string :tag "Keys ") + (string :tag "Description ") + (choice :tag "Capture Type " :value entry + (const :tag "Org entry" entry) + (const :tag "Plain list item" item) + (const :tag "Checkbox item" checkitem) + (const :tag "Plain text" plain) + (const :tag "Table line" table-line)) + (choice :tag "Target location" + (list :tag "File" + (const :format "" file) + (file :tag " File")) + (list :tag "ID" + (const :format "" id) + (string :tag " ID")) + (list :tag "File & Headline" + (const :format "" file+headline) + (file :tag " File ") + (string :tag " Headline")) + (list :tag "File & Outline path" + (const :format "" file+olp) + (file :tag " File ") + (repeat :tag "Outline path" :inline t + (string :tag "Headline"))) + (list :tag "File & Regexp" + (const :format "" file+regexp) + (file :tag " File ") + (regexp :tag " Regexp")) + (list :tag "File & Date tree" + (const :format "" file+datetree) + (file :tag " File")) + (list :tag "File & Date tree, prompt for date" + (const :format "" file+datetree+prompt) + (file :tag " File")) + (list :tag "File & function" + (const :format "" file+function) + (file :tag " File ") + (sexp :tag " Function")) + (list :tag "Current clocking task" + (const :format "" clock)) + (list :tag "Function" + (const :format "" function) + (sexp :tag " Function"))) + (choice :tag "Template" + (string) + (list :tag "File" + (const :format "" file) + (file :tag "Template file")) + (list :tag "Function" + (const :format "" function) + (function :tag "Template function"))) + (plist :inline t + ;; Give the most common options as checkboxes + :options (((const :format "%v " :prepend) (const t)) + ((const :format "%v " :immediate-finish) (const t)) + ((const :format "%v " :empty-lines) (const 1)) + ((const :format "%v " :clock-in) (const t)) + ((const :format "%v " :clock-keep) (const t)) + ((const :format "%v " :clock-resume) (const t)) + ((const :format "%v " :unnarrowed) (const t)) + ((const :format "%v " :kill-buffer) (const t)))))))) (defcustom org-capture-before-finalize-hook nil "Hook that is run right before a capture process is finalized. @@ -342,11 +355,25 @@ widened to the entire buffer." (defcustom org-capture-after-finalize-hook nil "Hook that is run right after a capture process is finalized. - Suitable for window cleanup" +Suitable for window cleanup." + :group 'org-capture + :version "24.1" + :type 'hook) + +(defcustom org-capture-prepare-finalize-hook nil + "Hook that is run before the finalization starts. +The capture buffer is current and still narrowed." :group 'org-capture :version "24.1" :type 'hook) +(defcustom org-capture-bookmark t + "When non-nil, add a bookmark pointing at the last stored +position when capturing." + :group 'org-capture + :version "24.3" + :type 'boolean) + ;;; The property list for keeping information about the capture process (defvar org-capture-plist nil @@ -394,12 +421,13 @@ for a capture buffer.") "Hook for the minor `org-capture-mode'.") (define-minor-mode org-capture-mode - "Minor mode for special key bindings in a capture buffer." + "Minor mode for special key bindings in a capture buffer. + +Turning on this mode runs the normal hook `org-capture-mode-hook'." nil " Rem" org-capture-mode-map (org-set-local 'header-line-format - "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.") - (run-hooks 'org-capture-mode-hook)) + "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")) (define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) (define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) (define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) @@ -407,6 +435,67 @@ for a capture buffer.") ;;; The main commands ;;;###autoload +(defvar org-capture-initial nil) +(defvar org-capture-entry nil) +(defun org-capture-string (string &optional keys) + (interactive "sInitial text: \n") + (let ((org-capture-initial string) + (org-capture-entry (org-capture-select-template keys))) + (org-capture))) + +(defcustom org-capture-templates-contexts nil + "Alist of capture templates and valid contexts. + +For example, if you have a capture template \"c\" and you want +this template to be accessible only from `message-mode' buffers, +use this: + + '((\"c\" (in-mode . \"message-mode\"))) + +Here are the available contexts definitions: + + in-file: command displayed only in matching files + in-mode: command displayed only in matching modes + not-in-file: command not displayed in matching files + not-in-mode: command not displayed in matching modes + [function]: a custom function taking no argument + +If you define several checks, the agenda command will be +accessible if there is at least one valid check. + +You can also bind a key to another agenda custom command +depending on contextual rules. + + '((\"c\" \"d\" (in-mode . \"message-mode\"))) + +Here it means: in `message-mode buffers', use \"d\" as the +key for the capture template otherwise associated with \"d\". +\(The template originally associated with \"q\" is not displayed +to avoid duplicates.)" + :version "24.3" + :group 'org-capture + :type '(repeat (list :tag "Rule" + (string :tag " Capture key") + (string :tag "Replace by template") + (repeat :tag "Available when" + (choice + (cons :tag "Condition" + (choice + (const :tag "In file" in-file) + (const :tag "Not in file" not-in-file) + (const :tag "In mode" in-mode) + (const :tag "Not in mode" not-in-mode)) + (regexp)) + (function :tag "Custom function")))))) + +(defcustom org-capture-use-agenda-date nil + "Non-nil means use the date at point when capturing from agendas. +When nil, you can still capturing using the date at point with \\[org-agenda-capture]]." + :group 'org-capture + :version "24.3" + :type 'boolean) + +;;;###autoload (defun org-capture (&optional goto keys) "Capture something. \\<org-capture-mode-map> @@ -424,10 +513,17 @@ stored. When called with a `C-0' (zero) prefix, insert a template at point. -Lisp programs can set KEYS to a string associated with a template in -`org-capture-templates'. In this case, interactive selection will be -bypassed." +Lisp programs can set KEYS to a string associated with a template +in `org-capture-templates'. In this case, interactive selection +will be bypassed. + +If `org-capture-use-agenda-date' is non-nil, capturing from the +agenda will use the date at point as the default date." (interactive "P") + (when (and org-capture-use-agenda-date + (eq major-mode 'org-agenda-mode)) + (setq org-overriding-default-time + (org-get-cursor-date))) (cond ((equal goto '(4)) (org-capture-goto-target)) ((equal goto '(16)) (org-capture-goto-last-stored)) @@ -438,9 +534,11 @@ bypassed." org-capture-link-is-already-stored) (plist-get org-store-link-plist :annotation) (ignore-errors (org-store-link nil)))) - (initial (and (org-region-active-p) - (buffer-substring (point) (mark)))) - (entry (org-capture-select-template keys))) + (entry (or org-capture-entry (org-capture-select-template keys))) + initial) + (setq initial (or org-capture-initial + (and (org-region-active-p) + (buffer-substring (point) (mark))))) (when (stringp initial) (remove-text-properties 0 (length initial) '(read-only t) initial)) (when (stringp annotation) @@ -489,7 +587,7 @@ bypassed." (error "Capture template `%s': %s" (org-capture-get :key) (nth 1 error)))) - (if (and (eq major-mode 'org-mode) + (if (and (derived-mode-p 'org-mode) (org-capture-get :clock-in)) (condition-case nil (progn @@ -530,6 +628,8 @@ captured item after finalizing." (buffer-base-buffer (current-buffer))) (error "This does not seem to be a capture buffer for Org-mode")) + (run-hooks 'org-capture-prepare-finalize-hook) + ;; Did we start the clock in this capture buffer? (when (and org-capture-clock-was-started org-clock-marker (marker-buffer org-clock-marker) @@ -577,9 +677,10 @@ captured item after finalizing." (goto-char end) (or (bolp) (newline)) (org-capture-empty-lines-after - (or (org-capture-get :empty-lines 'local) 0)))) + (or (org-capture-get :empty-lines-after 'local) + (org-capture-get :empty-lines 'local) 0)))) ;; Postprocessing: Update Statistics cookies, do the sorting - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (save-excursion (when (ignore-errors (org-back-to-heading)) (org-update-parent-todo-statistics) @@ -594,11 +695,17 @@ captured item after finalizing." ;; Store this place as the last one where we stored something ;; Do the marking in the base buffer, so that it makes sense after ;; the indirect buffer has been killed. - (org-capture-bookmark-last-stored-position) + (when org-capture-bookmark + (org-capture-bookmark-last-stored-position)) ;; Run the hook (run-hooks 'org-capture-before-finalize-hook)) + (when (org-capture-get :decrypted) + (save-excursion + (goto-char (org-capture-get :decrypted)) + (org-encrypt-entry))) + ;; Kill the indirect buffer (save-buffer) (let ((return-wconf (org-capture-get :return-to-wconf 'local)) @@ -675,8 +782,8 @@ already gone. Any prefix argument will be passed to the refile command." (defun org-capture-kill () "Abort the current capture process." (interactive) - ;; FIXME: This does not do the right thing, we need to remove the new stuff - ;; By hand it is easy: undo, then kill the buffer + ;; FIXME: This does not do the right thing, we need to remove the + ;; new stuff by hand it is easy: undo, then kill the buffer (let ((org-note-abort t) (org-capture-before-finalize-hook nil)) (org-capture-finalize))) @@ -700,9 +807,11 @@ already gone. Any prefix argument will be passed to the refile command." ;; store the current point (org-capture-put :initial-target-position (point))) +(defvar org-time-was-given) ; dynamically scoped parameter (defun org-capture-set-target-location (&optional target) - "Find target buffer and position and store then in the property list." - (let ((target-entry-p t)) + "Find TARGET buffer and position. +Store them in the capture property list." + (let ((target-entry-p t) decrypted-hl-pos) (setq target (or target (org-capture-get :target))) (save-excursion (cond @@ -727,7 +836,7 @@ already gone. Any prefix argument will be passed to the refile command." (widen) (let ((hd (nth 2 target))) (goto-char (point-min)) - (unless (eq major-mode 'org-mode) + (unless (derived-mode-p 'org-mode) (error "Target buffer \"%s\" for file+headline should be in Org mode" (current-buffer))) @@ -759,7 +868,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 (eq major-mode 'org-mode) (org-at-heading-p)))) + (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) (error "No match for target regexp in file %s" (nth 1 target)))) ((memq (car target) '(file+datetree file+datetree+prompt)) @@ -781,11 +890,22 @@ already gone. Any prefix argument will be passed to the refile command." (let ((prompt-time (org-read-date nil t nil "Date for tree entry:" (current-time)))) - (org-capture-put :prompt-time prompt-time - :default-time prompt-time) + (org-capture-put + :default-time + (cond ((and (not org-time-was-given) + (not (= (time-to-days prompt-time) (org-today)))) + ;; Use 00:00 when no time is given for another date than today? + (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time))))) + ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer) + ;; Replace any time range by its start + (apply 'encode-time + (org-read-date-analyze + (replace-match "\\1 \\2" nil nil org-read-date-final-answer) + prompt-time (decode-time prompt-time)))) + (t prompt-time))) (time-to-days prompt-time))) (t - ;; current date, possible corrected for late night workers + ;; current date, possibly corrected for late night workers (org-today)))))) ((eq (car target) 'file+function) @@ -794,12 +914,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 (eq major-mode 'org-mode) (org-at-heading-p)))) + (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) ((eq (car target) 'function) (funcall (nth 1 target)) (org-capture-put :exact-position (point)) - (setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p)))) + (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) ((eq (car target) 'clock) (if (and (markerp org-clock-hd-marker) @@ -812,8 +932,14 @@ already gone. Any prefix argument will be passed to the refile command." (t (error "Invalid capture target specification"))) + (when (and (featurep 'org-crypt) (org-at-encrypted-entry-p)) + (org-decrypt-entry) + (setq decrypted-hl-pos + (save-excursion (and (org-back-to-heading t) (point))))) + (org-capture-put :buffer (current-buffer) :pos (point) - :target-entry-p target-entry-p)))) + :target-entry-p target-entry-p + :decrypted decrypted-hl-pos)))) (defun org-capture-expand-file (file) "Expand functions and symbols for FILE. @@ -893,7 +1019,7 @@ it. When it is a variable, retrieve the value. Return whatever we get." (progn (outline-next-heading) (or (bolp) (insert "\n"))) - (org-end-of-subtree t t) + (org-end-of-subtree t nil) (or (bolp) (insert "\n"))))) (org-capture-empty-lines-before) (setq beg (point)) @@ -905,8 +1031,9 @@ it. When it is a variable, retrieve the value. Return whatever we get." (setq end (point)) (org-capture-mark-kill-region beg (1- end)) (org-capture-narrow beg (1- end)) - (goto-char beg) - (if (re-search-forward "%\\?" end t) (replace-match "")))) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))) (defun org-capture-place-item () "Place the template as a new plain list item." @@ -962,7 +1089,9 @@ it. When it is a variable, retrieve the value. Return whatever we get." (setq end (point)) (org-capture-mark-kill-region beg (1- end)) (org-capture-narrow beg (1- end)) - (if (re-search-forward "%\\?" end t) (replace-match "")))) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))) (defun org-capture-place-table-line () "Place the template as a table line." @@ -982,9 +1111,9 @@ it. When it is a variable, retrieve the value. Return whatever we get." (setq beg (1+ (point-at-eol)) end (save-excursion (outline-next-heading) (point))))) (if (re-search-forward org-table-dataline-regexp end t) - (let ((b (org-table-begin)) (e (org-table-end))) + (let ((b (org-table-begin)) (e (org-table-end)) (case-fold-search t)) (goto-char e) - (if (looking-at "[ \t]*#\\+TBLFM:") + (if (looking-at "[ \t]*#\\+tblfm:") (forward-line 1)) (narrow-to-region b (point))) (goto-char end) @@ -1040,7 +1169,9 @@ it. When it is a variable, retrieve the value. Return whatever we get." (setq end (point)))) (goto-char beg) (org-capture-position-for-last-stored 'table-line) - (if (re-search-forward "%\\?" end t) (replace-match "")) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")) (org-table-align))) (defun org-capture-place-plain-text () @@ -1075,7 +1206,9 @@ Of course, if exact position has been required, just put it there." (setq end (point)) (org-capture-mark-kill-region beg (1- end)) (org-capture-narrow beg (1- end)) - (if (re-search-forward "%\\?" end t) (replace-match "")))) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))) (defun org-capture-mark-kill-region (beg end) "Mark the region that will have to be killed when aborting capture." @@ -1128,7 +1261,8 @@ Of course, if exact position has been required, just put it there." (defun org-capture-empty-lines-before (&optional n) "Arrange for the correct number of empty lines before the insertion point. Point will be after the empty lines, so insertion can directly be done." - (setq n (or n (org-capture-get :empty-lines) 0)) + (setq n (or n (org-capture-get :empty-lines-before) + (org-capture-get :empty-lines) 0)) (let ((pos (point))) (org-back-over-empty-lines) (delete-region (point) pos) @@ -1137,7 +1271,8 @@ Point will be after the empty lines, so insertion can directly be done." (defun org-capture-empty-lines-after (&optional n) "Arrange for the correct number of empty lines after the inserted string. Point will remain at the first line after the inserted text." - (setq n (or n (org-capture-get :empty-lines) 0)) + (setq n (or n (org-capture-get :empty-lines-after) + (org-capture-get :empty-lines) 0)) (org-back-over-empty-lines) (while (looking-at "[ \t]*\n") (replace-match "")) (let ((pos (point))) @@ -1153,11 +1288,11 @@ Point will remain at the first line after the inserted text." (or (bolp) (newline)) (setq beg (point)) (cond - ((and (eq type 'entry) (eq major-mode 'org-mode)) + ((and (eq type 'entry) (derived-mode-p 'org-mode)) (org-capture-verify-tree (org-capture-get :template)) (org-paste-subtree nil template t)) ((and (memq type '(item checkitem)) - (eq major-mode 'org-mode) + (derived-mode-p 'org-mode) (save-excursion (skip-chars-backward " \t\n") (setq pp (point)) (org-in-item-p))) @@ -1225,7 +1360,7 @@ Use PREFIX as a prefix for the name of the indirect buffer." buf))))) (defun org-capture-verify-tree (tree) - "Throw error if TREE is not a valid tree" + "Throw error if TREE is not a valid tree." (unless (org-kill-is-subtree-p tree) (error "Template is not a valid Org entry or tree"))) @@ -1235,7 +1370,8 @@ Use PREFIX as a prefix for the name of the indirect buffer." "Select a capture template. Lisp programs can force the template by setting KEYS to a string." (let ((org-capture-templates - (or org-capture-templates + (or (org-contextualize-keys + org-capture-templates org-capture-templates-contexts) '(("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a"))))) (if keys @@ -1252,8 +1388,7 @@ Lisp programs can force the template by setting KEYS to a string." The template may still contain \"%?\" for cursor positioning." (setq template (or template (org-capture-get :template))) (when (stringp initial) - (setq initial (org-no-properties initial)) - (remove-text-properties 0 (length initial) '(read-only t) initial)) + (setq initial (org-no-properties initial))) (let* ((buffer (org-capture-get :buffer)) (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) (ct (org-capture-get :default-time)) @@ -1288,14 +1423,16 @@ The template may still contain \"%?\" for cursor positioning." (org-get-x-clipboard 'CLIPBOARD) (org-get-x-clipboard 'SECONDARY) v-c))) - (v-A (if (and v-a - (string-match - "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a)) - (replace-match "[\\1[%^{Link description}]]" nil nil v-a) + (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]") + (v-A (if (and v-a (string-match l-re v-a)) + (replace-match "[[\\1][%^{Link description}]]" nil nil v-a) + v-a)) + (v-l (if (and v-a (string-match l-re v-a)) + (replace-match "\\1" nil nil v-a) v-a)) (v-n user-full-name) (v-k (if (marker-buffer org-clock-marker) - (org-substring-no-properties org-clock-heading))) + (org-no-properties org-clock-heading))) (v-K (if (marker-buffer org-clock-marker) (org-make-link-string (buffer-file-name (marker-buffer org-clock-marker)) @@ -1306,7 +1443,7 @@ The template may still contain \"%?\" for cursor positioning." (org-startup-folded nil) (org-inhibit-startup t) org-time-was-given org-end-time-was-given x - prompt completions char time pos default histvar) + prompt completions char time pos default histvar strings) (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a) @@ -1339,15 +1476,7 @@ The template may still contain \"%?\" for cursor positioning." (error (insert (format "%%![Couldn't insert %s: %s]" filename error))))))) ;; %() embedded elisp - (goto-char (point-min)) - (while (re-search-forward "%\\((.+)\\)" nil t) - (unless (org-capture-escaped-%) - (goto-char (match-beginning 0)) - (let ((template-start (point))) - (forward-char 1) - (let ((result (org-eval (read (current-buffer))))) - (delete-region template-start (point)) - (insert result))))) + (org-capture-expand-embedded-elisp) ;; The current time (goto-char (point-min)) @@ -1356,7 +1485,7 @@ The template may still contain \"%?\" for cursor positioning." ;; Simple %-escapes (goto-char (point-min)) - (while (re-search-forward "%\\([tTuUaiAcxkKInfF]\\)" nil t) + (while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t) (unless (org-capture-escaped-%) (when (and initial (equal (match-string 0) "%i")) (save-match-data @@ -1366,7 +1495,8 @@ The template may still contain \"%?\" for cursor positioning." (org-split-string initial "\n") (concat "\n" lead)))))) (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") + (or (org-add-props (eval (intern (concat "v-" (match-string 1)))) + '(org-protected t)) "") t t))) ;; From the property list @@ -1383,8 +1513,8 @@ The template may still contain \"%?\" for cursor positioning." (let ((org-inhibit-startup t)) (org-mode)) ;; Interactive template entries (goto-char (point-min)) - (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" - nil t) + (while (and (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) + (not (get-text-property (1- (point)) 'org-protected))) (unless (org-capture-escaped-%) (setq char (if (match-end 3) (match-string-no-properties 3)) prompt (if (match-end 2) (match-string-no-properties 2))) @@ -1415,7 +1545,7 @@ The template may still contain \"%?\" for cursor positioning." (setq ins (mapconcat 'identity (org-split-string ins (org-re "[^[:alnum:]_@#%]+")) - ":")) + ":")) (when (string-match "\\S-" ins) (or (equal (char-before) ?:) (insert ":")) (insert ins) @@ -1436,7 +1566,7 @@ The template may still contain \"%?\" for cursor positioning." '(clipboards . 1) (car clipboards)))))) ((equal char "p") - (org-set-property (org-substring-no-properties prompt) nil)) + (org-set-property (org-no-properties prompt) nil)) (char ;; These are the date/time related ones (setq org-time-was-given (equal (upcase char) char)) @@ -1448,11 +1578,21 @@ The template may still contain \"%?\" for cursor positioning." nil nil (list org-end-time-was-given))) (t (let (org-completion-use-ido) - (insert (org-completing-read-no-i - (concat (if prompt prompt "Enter string") - (if default (concat " [" default "]")) - ": ") - completions nil nil nil histvar default))))))) + (push (org-completing-read-no-i + (concat (if prompt prompt "Enter string") + (if default (concat " [" default "]")) + ": ") + completions nil nil nil histvar default) + strings) + (insert (car strings))))))) + ;; Replace %n escapes with nth %^{...} string + (setq strings (nreverse strings)) + (goto-char (point-min)) + (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t) + (unless (org-capture-escaped-%) + (replace-match + (nth (1- (string-to-number (match-string 1))) strings) + nil t))) ;; Make sure there are no empty lines before the text, and that ;; it ends with a newline character (goto-char (point-min)) @@ -1471,6 +1611,34 @@ The template may still contain \"%?\" for cursor positioning." t) nil)) +(defun org-capture-expand-embedded-elisp () + "Evaluate embedded elisp %(sexp) and replace with the result." + (goto-char (point-min)) + (while (re-search-forward "%(" nil t) + (unless (org-capture-escaped-%) + (goto-char (match-beginning 0)) + (let ((template-start (point))) + (forward-char 1) + (let ((result (org-eval (read (current-buffer))))) + (delete-region template-start (point)) + (insert result)))))) + +(defun org-capture-inside-embedded-elisp-p () + "Return non-nil if point is inside of embedded elisp %(sexp)." + (let (beg end) + (with-syntax-table emacs-lisp-mode-syntax-table + (save-excursion + ;; `looking-at' and `search-backward' below do not match the "%(" if + ;; point is in its middle + (when (equal (char-before) ?%) + (backward-char)) + (save-match-data + (when (or (looking-at "%(") (search-backward "%(" nil t)) + (setq beg (point)) + (setq end (progn (forward-char) (forward-sexp) (1- (point))))))) + (when (and beg end) + (and (<= (point) end) (>= (point) beg)))))) + ;;;###autoload (defun org-capture-import-remember-templates () "Set org-capture-templates to be similar to `org-remember-templates'." diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index c39fb249e74..bb6f2b955b3 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -26,7 +26,6 @@ ;; This file contains the time clocking code for Org-mode -(require 'org) (require 'org-exp) ;;; Code: @@ -38,6 +37,7 @@ (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (defvar org-time-stamp-formats) (defvar org-ts-what) +(defvar org-frame-title-format-backup frame-title-format) (defgroup org-clock nil "Options concerning clocking working time in Org-mode." @@ -247,26 +247,26 @@ string as argument." :group 'org-clock) (defcustom org-clocktable-defaults - `(list - :maxlevel 2 - :lang ,org-export-default-language - :scope 'file - :block nil - :tstart nil - :tend nil - :step nil - :stepskip0 nil - :fileskip0 nil - :tags nil - :emphasize nil - :link nil - :narrow '40! - :indent t - :formula nil - :timestamp nil - :level nil - :tcolumns nil - :formatter nil) + (list + :maxlevel 2 + :lang org-export-default-language + :scope 'file + :block nil + :tstart nil + :tend nil + :step nil + :stepskip0 nil + :fileskip0 nil + :tags nil + :emphasize nil + :link nil + :narrow '40! + :indent t + :formula nil + :timestamp nil + :level nil + :tcolumns nil + :formatter nil) "Default properties for clock tables." :group 'org-clock :version "24.1" @@ -324,6 +324,53 @@ play with them." :version "24.1" :type 'boolean) +(defcustom org-clock-continuously nil + "Non-nil means to start clocking from the last clock-out time, if any." + :type 'boolean + :version "24.1" + :group 'org-clock) + +(defcustom org-clock-total-time-cell-format "*%s*" + "Format string for the total time cells." + :group 'org-clock + :version "24.1" + :type 'boolean) + +(defcustom org-clock-file-time-cell-format "*%s*" + "Format string for the file time cells." + :group 'org-clock + :version "24.1" + :type 'boolean) + +(defcustom org-clock-clocked-in-display 'mode-line + "When clocked in for a task, org-mode can display the current +task and accumulated time in the mode line and/or frame title. +Allowed values are: + +both displays in both mode line and frame title +mode-line displays only in mode line (default) +frame-title displays only in frame title +nil current clock is not displayed" + :group 'org-clock + :type '(choice + (const :tag "Mode line" mode-line) + (const :tag "Frame title" frame-title) + (const :tag "Both" both) + (const :tag "None" nil))) + +(defcustom org-clock-frame-title-format '(t org-mode-line-string) + "The value for `frame-title-format' when clocking in. + +When `org-clock-clocked-in-display' is set to 'frame-title +or 'both, clocking in will replace `frame-title-format' with +this value. Clocking out will restore `frame-title-format'. + +`org-frame-title-string' is a format string using the same +specifications than `frame-title-format', which see." + :version "24.1" + :group 'org-clock + :type 'sexp) + (defvar org-clock-in-prepare-hook nil "Hook run when preparing the clock. This hook is run before anything happens to the task that @@ -521,7 +568,7 @@ If not, show simply the clocked time like 01:50." 'org-mode-line-clock-overrun 'org-mode-line-clock))) (effort-str (format org-time-clocksum-format effort-h effort-m)) (clockstr (org-propertize - (concat "[%s/" effort-str + (concat " [%s/" effort-str "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") 'face 'org-mode-line-clock))) (format clockstr work-done-str)) @@ -545,8 +592,7 @@ If not, show simply the clocked time like 01:50." 'help-echo (concat help-text ": " org-clock-heading)) (org-propertize clock-string 'help-echo help-text))) 'local-map org-clock-mode-line-map - 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight) - )) + 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight))) (if (and org-clock-task-overrun org-clock-task-overrun-text) (setq org-mode-line-string (concat (org-propertize @@ -564,39 +610,40 @@ previous clocking intervals." (+ currently-clocked-time (or org-clock-total-time 0)))) (defun org-clock-modify-effort-estimate (&optional value) - "Add to or set the effort estimate of the item currently being clocked. + "Add to or set the effort estimate of the item currently being clocked. VALUE can be a number of minutes, or a string with format hh:mm or mm. When the string starts with a + or a - sign, the current value of the effort property will be changed by that amount. This will update the \"Effort\" property of currently clocked item, and the mode line." - (interactive) - (when (org-clock-is-active) - (let ((current org-clock-effort) sign) - (unless value - ;; Prompt user for a value or a change - (setq value - (read-string - (format "Set effort (hh:mm or mm%s): " - (if current - (format ", prefix + to add to %s" org-clock-effort) - ""))))) - (when (stringp value) - ;; A string. See if it is a delta - (setq sign (string-to-char value)) - (if (member sign '(?- ?+)) - (setq current (org-duration-string-to-minutes current) - value (substring value 1)) - (setq current 0)) - (setq value (org-duration-string-to-minutes value)) - (if (equal ?- sign) - (setq value (- current value)) - (if (equal ?+ sign) (setq value (+ current value))))) - (setq value (max 0 value) - org-clock-effort (org-minutes-to-hh:mm-string value)) - (org-entry-put org-clock-marker "Effort" org-clock-effort) - (org-clock-update-mode-line) - (message "Effort is now %s" org-clock-effort)))) + (interactive) + (if (org-clock-is-active) + (let ((current org-clock-effort) sign) + (unless value + ;; Prompt user for a value or a change + (setq value + (read-string + (format "Set effort (hh:mm or mm%s): " + (if current + (format ", prefix + to add to %s" org-clock-effort) + ""))))) + (when (stringp value) + ;; A string. See if it is a delta + (setq sign (string-to-char value)) + (if (member sign '(?- ?+)) + (setq current (org-duration-string-to-minutes current) + value (substring value 1)) + (setq current 0)) + (setq value (org-duration-string-to-minutes value)) + (if (equal ?- sign) + (setq value (- current value)) + (if (equal ?+ sign) (setq value (+ current value))))) + (setq value (max 0 value) + org-clock-effort (org-minutes-to-hh:mm-string value)) + (org-entry-put org-clock-marker "Effort" org-clock-effort) + (org-clock-update-mode-line) + (message "Effort is now %s" org-clock-effort)) + (message "Clock is not currently active"))) (defvar org-clock-notification-was-shown nil "Shows if we have shown notification already.") @@ -632,15 +679,14 @@ use libnotify if available, or fall back on a message." ((stringp org-show-notification-handler) (start-process "emacs-timer-notification" nil org-show-notification-handler notification)) - ((featurep 'notifications) - (require 'notifications) + ((fboundp 'notifications-notify) (notifications-notify :title "Org-mode message" :body notification ;; FIXME how to link to the Org icon? ;; :app-icon "~/.emacs.d/icons/mail.png" :urgency 'low)) - ((org-program-exists "notify-send") + ((executable-find "notify-send") (start-process "emacs-timer-notification" nil "notify-send" notification)) ;; Maybe the handler will send a message, so only use message as @@ -656,18 +702,13 @@ Use alsa's aplay tool if available." ((stringp org-clock-sound) (let ((file (expand-file-name org-clock-sound))) (if (file-exists-p file) - (if (org-program-exists "aplay") + (if (executable-find "aplay") (start-process "org-clock-play-notification" nil "aplay" file) (condition-case nil (play-sound-file file) (error (beep t) (beep t))))))))) -(defun org-program-exists (program-name) - "Checks whenever we can locate PROGRAM-NAME using the `which' executable." - (if (member system-type '(gnu/linux darwin)) - (= 0 (call-process "which" nil nil nil program-name)))) - (defvar org-clock-mode-line-entry nil "Information for the mode line about the running clock.") @@ -729,9 +770,9 @@ If necessary, clock-out of the currently active clock." (let ((temp (copy-marker (car clock) (marker-insertion-type (car clock))))) (if (org-is-active-clock clock) - (org-clock-out fail-quietly at-time) + (org-clock-out nil fail-quietly at-time) (org-with-clock clock - (org-clock-out fail-quietly at-time))) + (org-clock-out nil fail-quietly at-time))) (setcar clock temp))) (defsubst org-clock-clock-cancel (clock) @@ -934,18 +975,18 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (let ((dangling (or (not (org-clock-is-active)) (/= (car clock) org-clock-marker)))) (if (or (not only-dangling-p) dangling) - (org-clock-resolve - clock - (or prompt-fn - (function - (lambda (clock) - (format - "Dangling clock started %d mins ago" - (floor - (/ (- (org-float-time (current-time)) - (org-float-time (cdr clock))) 60)))))) - (or last-valid - (cdr clock))))))))))) + (org-clock-resolve + clock + (or prompt-fn + (function + (lambda (clock) + (format + "Dangling clock started %d mins ago" + (floor + (/ (- (org-float-time (current-time)) + (org-float-time (cdr clock))) 60)))))) + (or last-valid + (cdr clock))))))))))) (defun org-emacs-idle-seconds () "Return the current Emacs idle time in seconds, or nil if not idle." @@ -958,6 +999,13 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling "Return the current Mac idle time in seconds." (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'"))) +(defvar org-x11idle-exists-p + ;; Check that x11idle exists + (and (eq window-system 'x) + (eq (call-process-shell-command "command" nil nil nil "-v" "x11idle") 0) + ;; Check that x11idle can retrieve the idle time + (eq (call-process-shell-command "x11idle" nil nil nil) 0))) + (defun org-x11-idle-seconds () "Return the current X11 idle time in seconds." (/ (string-to-number (shell-command-to-string "x11idle")) 1000)) @@ -968,7 +1016,7 @@ This routine returns a floating point number." (cond ((eq system-type 'darwin) (org-mac-idle-seconds)) - ((eq window-system 'x) + ((and (eq window-system 'x) org-x11idle-exists-p) (org-x11-idle-seconds)) (t (org-emacs-idle-seconds)))) @@ -1010,15 +1058,18 @@ so long." "Reset `org-clock-current-task' to nil." (setq org-clock-current-task nil)) +(defvar org-clock-out-time nil) ; store the time of the last clock-out (defun org-clock-in (&optional select start-time) "Start the clock on the current item. If necessary, clock-out of the currently active clock. -With a prefix argument SELECT (\\[universal-argument]), offer a list of \ -recently clocked tasks to -clock into. When SELECT is \\[universal-argument] \\[universal-argument], \ -clock into the current task and mark -is as the default task, a special task that will always be offered in -the clocking selection, associated with the letter `d'." +With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked +tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task +and mark it as the default task, a special task that will always be offered +in the clocking selection, associated with the letter `d'. +When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \ +clock in by using the last clock-out +time as the start time \(see `org-clock-continuously' to +make this the default behavior.)" (interactive "P") (setq org-clock-notification-was-shown nil) (catch 'abort @@ -1026,7 +1077,7 @@ the clocking selection, associated with the letter `d'." (org-clocking-p))) ts selected-task target-pos (msg-extra "") (leftover (and (not org-clock-resolving-clocks) - org-clock-leftover-time))) + org-clock-leftover-time))) (when (and org-clock-auto-clock-resolution (or (not interrupting) @@ -1037,6 +1088,11 @@ the clocking selection, associated with the letter `d'." (let ((org-clock-clocking-in t)) (org-resolve-clocks))) ; check if any clocks are dangling + (when (equal select '(64)) + ;; Set start-time to `org-clock-out-time' + (let ((org-clock-continuously t)) + (org-clock-in nil org-clock-out-time))) + (when (equal select '(4)) (setq selected-task (org-clock-select-task "Clock-in on task: ")) (if selected-task @@ -1069,7 +1125,7 @@ the clocking selection, associated with the letter `d'." (marker-position org-clock-marker) (marker-buffer org-clock-marker)) (let ((org-clock-clocking-in t)) - (org-clock-out t))) + (org-clock-out nil t))) ;; Clock in at which position? (setq target-pos @@ -1090,7 +1146,12 @@ the clocking selection, associated with the letter `d'." (goto-char target-pos) (org-back-to-heading t) (or interrupting (move-marker org-clock-interrupted-task nil)) - (org-clock-history-push) + (save-excursion + (forward-char) ;; make sure the marker is not at the + ;; beginning of the heading, since the + ;; user is liking to insert stuff here + ;; manually + (org-clock-history-push)) (org-clock-set-current) (cond ((functionp org-clock-in-switch-to-state) (looking-at org-complex-heading-regexp) @@ -1111,7 +1172,8 @@ the clocking selection, associated with the letter `d'." (cond ((and org-clock-heading-function (functionp org-clock-heading-function)) (funcall org-clock-heading-function)) - ((looking-at org-complex-heading-regexp) + ((and (looking-at org-complex-heading-regexp) + (match-string 4)) (replace-regexp-in-string "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" (match-string 4))) @@ -1144,7 +1206,7 @@ the clocking selection, associated with the letter `d'." (t (insert-before-markers "\n") (backward-char 1) - (org-indent-line-function) + (org-indent-line) (when (and (save-excursion (end-of-line 0) (org-in-item-p))) @@ -1155,7 +1217,8 @@ the clocking selection, associated with the letter `d'." (setq org-clock-total-time (org-clock-sum-current-item (org-clock-get-sum-start))) (setq org-clock-start-time - (or (and leftover + (or (and org-clock-continuously org-clock-out-time) + (and leftover (y-or-n-p (format "You stopped another clock %d mins ago; start this one from then? " @@ -1171,18 +1234,26 @@ the clocking selection, associated with the letter `d'." (save-excursion (org-back-to-heading t) (point)) (buffer-base-buffer)) (setq org-clock-has-been-used t) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-mode-line-string)))) + ;; add to mode line + (when (or (eq org-clock-clocked-in-display 'mode-line) + (eq org-clock-clocked-in-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-mode-line-string))))) + ;; add to frame title + (when (or (eq org-clock-clocked-in-display 'frame-title) + (eq org-clock-clocked-in-display 'both)) + (setq frame-title-format org-clock-frame-title-format)) (org-clock-update-mode-line) (when org-clock-mode-line-timer (cancel-timer org-clock-mode-line-timer) (setq org-clock-mode-line-timer nil)) - (setq org-clock-mode-line-timer - (run-with-timer org-clock-update-period - org-clock-update-period - 'org-clock-update-mode-line)) + (when org-clock-clocked-in-display + (setq org-clock-mode-line-timer + (run-with-timer org-clock-update-period + org-clock-update-period + 'org-clock-update-mode-line))) (when org-clock-idle-timer (cancel-timer org-clock-idle-timer) (setq org-clock-idle-timer nil)) @@ -1191,6 +1262,41 @@ the clocking selection, associated with the letter `d'." (message "Clock starts at %s - %s" ts msg-extra) (run-hooks 'org-clock-in-hook))))))) +;;;###autoload +(defun org-clock-in-last (&optional arg) + "Clock in the last closed clocked item. +When already clocking in, send an warning. +With a universal prefix argument, select the task you want to +clock in from the last clocked in tasks. +With two universal prefix arguments, start clocking using the +last clock-out time, if any. +With three universal prefix arguments, interactively prompt +for a todo state to switch to, overriding the existing value +`org-clock-in-switch-to-state'." + (interactive "P") + (if (equal arg '(4)) + (org-clock-in (org-clock-select-task)) + (let ((start-time (if (or org-clock-continuously (equal arg '(16))) + (or org-clock-out-time (current-time)) + (current-time)))) + (if (null org-clock-history) + (message "No last clock") + (let ((org-clock-in-switch-to-state + (if (and (not org-clock-current-task) (equal arg '(64))) + (completing-read "Switch to state: " + (and org-clock-history + (with-current-buffer + (marker-buffer (car org-clock-history)) + org-todo-keywords-1))) + org-clock-in-switch-to-state)) + (already-clocking org-clock-current-task)) + (org-clock-clock-in (list (car org-clock-history)) nil start-time) + (or already-clocking + ;; Don't display a message if we are already clocking in + (message "Clocking back: %s (in %s)" + org-clock-current-task + (buffer-name (marker-buffer org-clock-marker))))))))) + (defun org-clock-mark-default-task () "Mark current task as default task." (interactive) @@ -1284,7 +1390,7 @@ line and position cursor in that line." (if (and (>= (org-get-indentation) ind-last) (org-at-item-p)) (when (and (>= (org-get-indentation) ind-last) - (org-at-item-p)) + (org-at-item-p)) (let ((struct (org-list-struct))) (goto-char (org-list-get-bottom-point struct))))) (insert ":END:\n") @@ -1293,7 +1399,7 @@ line and position cursor in that line." (goto-char first) (insert ":" drawer ":\n") (beginning-of-line 0) - (org-indent-line-function) + (org-indent-line) (org-flag-drawer t) (beginning-of-line 2) (or org-log-states-order-reversed @@ -1313,28 +1419,41 @@ line and position cursor in that line." (< org-clock-into-drawer 2))) (insert ":" drawer ":\n:END:\n") (beginning-of-line -1) - (org-indent-line-function) + (org-indent-line) (org-flag-drawer t) (beginning-of-line 2) - (org-indent-line-function) + (org-indent-line) (beginning-of-line) (or org-log-states-order-reversed (and (re-search-forward org-property-end-re nil t) (goto-char (match-beginning 0)))))))) -(defun org-clock-out (&optional fail-quietly at-time) +(defun org-clock-out (&optional switch-to-state fail-quietly at-time) "Stop the currently running clock. -If there is no running clock, throw an error, unless FAIL-QUIETLY is set." - (interactive) +Throw an error if there is no running clock and FAIL-QUIETLY is nil. +With a universal prefix, prompt for a state to switch the clocked out task +to, overriding the existing value of `org-clock-out-switch-to-state'." + (interactive "P") (catch 'exit (when (not (org-clocking-p)) (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (force-mode-line-update) (if fail-quietly (throw 'exit t) (error "No active clock"))) - (let (ts te s h m remove) + (let ((org-clock-out-switch-to-state + (if switch-to-state + (completing-read "Switch to state: " + (with-current-buffer + (marker-buffer org-clock-marker) + org-todo-keywords-1) + nil t "DONE") + org-clock-out-switch-to-state)) + (now (current-time)) + ts te s h m remove) + (setq org-clock-out-time now) (save-excursion ; Do not replace this with `with-current-buffer'. - (with-no-warnings (set-buffer (org-clocking-buffer))) + (org-no-warnings (set-buffer (org-clocking-buffer))) (save-restriction (widen) (goto-char org-clock-marker) @@ -1346,8 +1465,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (goto-char (match-end 0)) (delete-region (point) (point-at-eol)) (insert "--") - (setq te (org-insert-time-stamp (or at-time (current-time)) - 'with-hm 'inactive)) + (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te))) (org-float-time (apply 'encode-time (org-parse-time-string ts)))) h (floor (/ s 3600)) @@ -1374,6 +1492,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (setq org-clock-idle-timer nil)) (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (when org-clock-out-switch-to-state (save-excursion (org-back-to-heading t) @@ -1394,7 +1513,8 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m (if remove " => LINE REMOVED" "")) (run-hooks 'org-clock-out-hook) - (org-clock-delete-current)))))) + (unless (org-clocking-p) + (org-clock-delete-current))))))) (add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer) @@ -1407,7 +1527,8 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (when clock-drawer (save-excursion (org-back-to-heading t) - (while (search-forward clock-drawer end t) + (while (and (< (point) end) + (search-forward clock-drawer end t)) (goto-char (match-beginning 0)) (org-remove-empty-drawer-at clock-drawer (point)) (forward-line 1)))))) @@ -1471,19 +1592,23 @@ UPDOWN tells whether to change 'up or 'down." (interactive) (when (not (org-clocking-p)) (setq global-mode-string - (delq 'org-mode-line-string global-mode-string)) + (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (force-mode-line-update) (error "No active clock")) (save-excursion ; Do not replace this with `with-current-buffer'. - (with-no-warnings (set-buffer (org-clocking-buffer))) + (org-no-warnings (set-buffer (org-clocking-buffer))) (goto-char org-clock-marker) - (delete-region (1- (point-at-bol)) (point-at-eol)) - ;; Just in case, remove any empty LOGBOOK left over - (org-remove-empty-drawer-at "LOGBOOK" (point))) + (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")) + (progn (delete-region (1- (point-at-bol)) (point-at-eol)) + (org-remove-empty-drawer-at "LOGBOOK" (point))) + (message "Clock gone, cancel the timer anyway") + (sit-for 2))) (move-marker org-clock-marker nil) (move-marker org-clock-hd-marker nil) (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (force-mode-line-update) (message "Clock canceled") (run-hooks 'org-clock-cancel-hook)) @@ -1520,13 +1645,20 @@ With prefix arg SELECT, offer recently clocked tasks for selection." "Holds the file total time in minutes, after a call to `org-clock-sum'.") (make-variable-buffer-local 'org-clock-file-total-minutes) -(defun org-clock-sum (&optional tstart tend headline-filter) +(defun org-clock-sum-today (&optional headline-filter) + "Sum the times for each subtree for today." + (interactive) + (let ((range (org-clock-special-range 'today))) + (org-clock-sum (car range) (cadr range) nil :org-clock-minutes-today))) + +(defun org-clock-sum (&optional tstart tend headline-filter propname) "Sum the times for each subtree. Puts the resulting times in minutes as a text property on each headline. -TSTART and TEND can mark a time range to be considered. HEADLINE-FILTER is a -zero-arg function that, if specified, is called for each headline in the time -range with point at the headline. Headlines for which HEADLINE-FILTER returns -nil are excluded from the clock summation." +TSTART and TEND can mark a time range to be considered. +HEADLINE-FILTER is a zero-arg function that, if specified, is called for +each headline in the time range with point at the headline. Headlines for +which HEADLINE-FILTER returns nil are excluded from the clock summation. +PROPNAME lets you set a custom text property instead of :org-clock-minutes." (interactive) (let* ((bmp (buffer-modified-p)) (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" @@ -1543,7 +1675,7 @@ nil are excluded from the clock summation." (if (consp tstart) (setq tstart (org-float-time tstart))) (if (consp tend) (setq tend (org-float-time tend))) (remove-text-properties (point-min) (point-max) - '(:org-clock-minutes t + `(,(or propname :org-clock-minutes) t :org-clock-force-headline-inclusion t)) (save-excursion (goto-char (point-max)) @@ -1592,7 +1724,8 @@ nil are excluded from the clock summation." (aset ltimes l (+ (aref ltimes l) t1)))) (setq time (aref ltimes level)) (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) :org-clock-minutes time) + (put-text-property (point) (point-at-eol) + (or propname :org-clock-minutes) time) (if headline-filter (save-excursion (save-match-data @@ -1667,8 +1800,8 @@ will be easy to remove." (org-move-to-column c) (unless (eolp) (skip-chars-backward "^ \t")) (skip-chars-backward " \t") - (setq ov (make-overlay (1- (point)) (point-at-eol)) - tx (concat (buffer-substring (1- (point)) (point)) + (setq ov (make-overlay (point-at-bol) (point-at-eol)) + tx (concat (buffer-substring (point-at-bol) (point)) (make-string (+ off (max 0 (- c (current-column)))) ?.) (org-add-props (if org-time-clocksum-use-fractional (format fmt @@ -1864,13 +1997,13 @@ the returned times will be formatted strings." (setq d (nth 1 date) month (car date) y (nth 2 date) dow 1 key 'week)) - ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey) - (require 'cal-iso) - (setq y (string-to-number (match-string 1 skey))) - (setq q (string-to-number (match-string 2 skey))) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (org-quarter-to-date q y)))) - (setq d (nth 1 date) month (car date) y (nth 2 date) + ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey) + (require 'cal-iso) + (setq y (string-to-number (match-string 1 skey))) + (setq q (string-to-number (match-string 2 skey))) + (setq date (calendar-gregorian-from-absolute + (calendar-absolute-from-iso (org-quarter-to-date q y)))) + (setq d (nth 1 date) month (car date) y (nth 2 date) dow 1 key 'quarter)) ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey) @@ -1881,12 +2014,11 @@ the returned times will be formatted strings." ((string-match "\\([-+][0-9]+\\)$" skey) (setq shift (string-to-number (match-string 1 skey)) key (intern (substring skey 0 (match-beginning 1)))) - (if(and (memq key '(quarter thisq)) (> shift 0)) - (error "Looking forward with quarters isn't implemented.") - ()))) + (if (and (memq key '(quarter thisq)) (> shift 0)) + (error "Looking forward with quarters isn't implemented")))) (when (= shift 0) - (cond ((eq key 'yesterday) (setq key 'today shift -1)) + (cond ((eq key 'yesterday) (setq key 'today shift -1)) ((eq key 'lastweek) (setq key 'week shift -1)) ((eq key 'lastmonth) (setq key 'month shift -1)) ((eq key 'lastyear) (setq key 'year shift -1)) @@ -1900,27 +2032,27 @@ the returned times will be formatted strings." ((memq key '(month thismonth)) (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0)) ((memq key '(quarter thisq)) - ; compute if this shift remains in this year - ; if not, compute how many years and quarters we have to shift (via floor*) - ; and compute the shifted years, months and quarters + ; compute if this shift remains in this year + ; if not, compute how many years and quarters we have to shift (via floor*) + ; and compute the shifted years, months and quarters (cond ((< (+ (- q 1) shift) 0) ; shift not in this year - (setq interval (* -1 (+ (- q 1) shift))) - ; set tmp to ((years to shift) (quarters to shift)) - (setq tmp (org-floor* interval 4)) - ; due to the use of floor, 0 quarters actually means 4 - (if (= 0 (nth 1 tmp)) - (setq shiftedy (- y (nth 0 tmp)) - shiftedm 1 - shiftedq 1) - (setq shiftedy (- y (+ 1 (nth 0 tmp))) - shiftedm (- 13 (* 3 (nth 1 tmp))) - shiftedq (- 5 (nth 1 tmp)))) - (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy)) + (setq interval (* -1 (+ (- q 1) shift))) + ; set tmp to ((years to shift) (quarters to shift)) + (setq tmp (org-floor* interval 4)) + ; due to the use of floor, 0 quarters actually means 4 + (if (= 0 (nth 1 tmp)) + (setq shiftedy (- y (nth 0 tmp)) + shiftedm 1 + shiftedq 1) + (setq shiftedy (- y (+ 1 (nth 0 tmp))) + shiftedm (- 13 (* 3 (nth 1 tmp))) + shiftedq (- 5 (nth 1 tmp)))) + (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy)) ((> (+ q shift) 0) ; shift is within this year - (setq shiftedq (+ q shift)) - (setq shiftedy y) - (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0)))) + (setq shiftedq (+ q shift)) + (setq shiftedy y) + (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0)))) ((memq key '(year thisyear)) (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) (t (error "No such time block %s" key))) @@ -1938,7 +2070,7 @@ the returned times will be formatted strings." ((memq key '(year thisyear)) (setq txt (format-time-string "the year %Y" ts))) ((memq key '(quarter thisq)) - (setq txt (concatenate 'string (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))) + (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))) ) (if as-strings (list (format-time-string fm ts) (format-time-string fm te) txt) @@ -1976,62 +2108,62 @@ the currently selected interval size." ((equal s "lastyear") (setq s "thisyear-1")) ((equal s "lastq") (setq s "thisq-1"))) - (cond - ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s) - (setq block (match-string 1 s) - shift (if (match-end 2) - (string-to-number (match-string 2 s)) - 0)) - (setq shift (+ shift n)) - (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) - ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) - ;; 1 1 2 3 3 4 4 5 6 6 5 2 - (setq y (string-to-number (match-string 1 s)) - wp (and (match-end 3) (match-string 3 s)) - mw (and (match-end 4) (string-to-number (match-string 4 s))) - d (and (match-end 6) (string-to-number (match-string 6 s)))) - (cond - (d (setq ins (format-time-string - "%Y-%m-%d" - (encode-time 0 0 0 (+ d n) m y)))) - ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) - (require 'cal-iso) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (list (+ mw n) 1 y)))) - (setq ins (format-time-string - "%G-W%V" - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) - ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0)) - (require 'cal-iso) - ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year - (if (> (+ mw n) 4) - (setq mw 0 - y (+ 1 y)) - ()) - ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year - (if (= (+ mw n) 0) - (setq mw 5 - y (- y 1)) - ()) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y)))) - (setq ins (format-time-string - (concatenate 'string (number-to-string y) "-Q" (number-to-string (+ mw n))) - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) - (mw - (setq ins (format-time-string - "%Y-%m" - (encode-time 0 0 0 1 (+ mw n) y)))) - (y - (setq ins (number-to-string (+ y n)))))) - (t (error "Cannot shift clocktable block"))) - (when ins - (goto-char b) - (insert ins) - (delete-region (point) (+ (point) (- e b))) - (beginning-of-line 1) - (org-update-dblock) - t))))) + (cond + ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s) + (setq block (match-string 1 s) + shift (if (match-end 2) + (string-to-number (match-string 2 s)) + 0)) + (setq shift (+ shift n)) + (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) + ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) + ;; 1 1 2 3 3 4 4 5 6 6 5 2 + (setq y (string-to-number (match-string 1 s)) + wp (and (match-end 3) (match-string 3 s)) + mw (and (match-end 4) (string-to-number (match-string 4 s))) + d (and (match-end 6) (string-to-number (match-string 6 s)))) + (cond + (d (setq ins (format-time-string + "%Y-%m-%d" + (encode-time 0 0 0 (+ d n) m y)))) + ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) + (require 'cal-iso) + (setq date (calendar-gregorian-from-absolute + (calendar-absolute-from-iso (list (+ mw n) 1 y)))) + (setq ins (format-time-string + "%G-W%V" + (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) + ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0)) + (require 'cal-iso) + ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year + (if (> (+ mw n) 4) + (setq mw 0 + y (+ 1 y)) + ()) + ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year + (if (= (+ mw n) 0) + (setq mw 5 + y (- y 1)) + ()) + (setq date (calendar-gregorian-from-absolute + (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y)))) + (setq ins (format-time-string + (concat (number-to-string y) "-Q" (number-to-string (+ mw n))) + (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) + (mw + (setq ins (format-time-string + "%Y-%m" + (encode-time 0 0 0 1 (+ mw n) y)))) + (y + (setq ins (number-to-string (+ y n)))))) + (t (error "Cannot shift clocktable block"))) + (when ins + (goto-char b) + (insert ins) + (delete-region (point) (+ (point) (- e b))) + (beginning-of-line 1) + (org-update-dblock) + t))))) (defun org-dblock-write:clocktable (params) "Write the standard clocktable." @@ -2082,7 +2214,7 @@ the currently selected interval size." ;; we collect from several files (let* ((files scope) file) - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (while (setq file (pop files)) (with-current-buffer (find-buffer-visiting file) (save-excursion @@ -2091,7 +2223,7 @@ the currently selected interval size." ;; Just from the current file (save-restriction ;; get the right range into the restriction - (org-prepare-agenda-buffers (list (buffer-file-name))) + (org-agenda-prepare-buffers (list (buffer-file-name))) (cond ((not scope)) ; use the restriction as it is now ((eq scope 'file) (widen)) @@ -2150,6 +2282,7 @@ from the dynamic block definition." (ntcol (max 1 (or (plist-get params :tcolumns) 100))) (rm-file-column (plist-get params :one-file-with-archives)) (indent (plist-get params :indent)) + (case-fold-search t) range-text total-time tbl level hlc formula pcol file-time entries entry headline recalc content narrow-cut-p tcol) @@ -2159,192 +2292,196 @@ from the dynamic block definition." (setq level nil indent t narrow (or narrow '40!) ntcol 1)) ;; Some consistency test for parameters - (unless (integerp ntcol) - (setq params (plist-put params :tcolumns (setq ntcol 100)))) - - (when (and narrow (integerp narrow) link) - ;; We cannot have both integer narrow and link - (message - "Using hard narrowing in clocktable to allow for links") - (setq narrow (intern (format "%d!" narrow)))) + (unless (integerp ntcol) + (setq params (plist-put params :tcolumns (setq ntcol 100)))) - (when narrow - (cond - ((integerp narrow)) - ((and (symbolp narrow) - (string-match "\\`[0-9]+!\\'" (symbol-name narrow))) - (setq narrow-cut-p t - narrow (string-to-number (substring (symbol-name narrow) - 0 -1)))) - (t - (error "Invalid value %s of :narrow property in clock table" - narrow)))) + (when (and narrow (integerp narrow) link) + ;; We cannot have both integer narrow and link + (message + "Using hard narrowing in clocktable to allow for links") + (setq narrow (intern (format "%d!" narrow)))) - (when block - ;; Get the range text for the header - (setq range-text (nth 2 (org-clock-special-range block nil t)))) - - ;; Compute the total time - (setq total-time (apply '+ (mapcar 'cadr tables))) - - ;; Now we need to output this tsuff - (goto-char ipos) + (when narrow + (cond + ((integerp narrow)) + ((and (symbolp narrow) + (string-match "\\`[0-9]+!\\'" (symbol-name narrow))) + (setq narrow-cut-p t + narrow (string-to-number (substring (symbol-name narrow) + 0 -1)))) + (t + (error "Invalid value %s of :narrow property in clock table" + narrow)))) - ;; Insert the text *before* the actual table - (insert-before-markers - (or header - ;; Format the standard header - (concat - (nth 9 lwords) " [" - (substring - (format-time-string (cdr org-time-stamp-formats)) - 1 -1) - "]" - (if block (concat ", for " range-text ".") "") - "\n\n"))) - - ;; Insert the narrowing line - (when (and narrow (integerp narrow) (not narrow-cut-p)) - (insert-before-markers - "|" ; table line starter - (if multifile "|" "") ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (format "<%d>| |\n" narrow))) ; headline and time columns - - ;; Insert the table header line - (insert-before-markers - "|" ; table line starter - (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe - (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe - (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe - (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe - (concat (nth 4 lwords) "|" - (nth 5 lwords) "|\n")) ; headline and time columns - - ;; Insert the total time in the table + (when block + ;; Get the range text for the header + (setq range-text (nth 2 (org-clock-special-range block nil t)))) + + ;; Compute the total time + (setq total-time (apply '+ (mapcar 'cadr tables))) + + ;; Now we need to output this tsuff + (goto-char ipos) + + ;; Insert the text *before* the actual table + (insert-before-markers + (or header + ;; Format the standard header + (concat + (nth 9 lwords) " [" + (substring + (format-time-string (cdr org-time-stamp-formats)) + 1 -1) + "]" + (if block (concat ", for " range-text ".") "") + "\n\n"))) + + ;; Insert the narrowing line + (when (and narrow (integerp narrow) (not narrow-cut-p)) (insert-before-markers - "|-\n" ; a hline - "|" ; table line starter - (if multifile (concat "| " (nth 6 lwords) " ") "") - ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe + "|" ; table line starter + (if multifile "|" "") ; file column, maybe + (if level-p "|" "") ; level column, maybe + (if timestamp "|" "") ; timestamp column, maybe (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (concat "*" (nth 7 lwords) "*| ") ; instead of a headline - "*" - (org-minutes-to-hh:mm-string (or total-time 0)) ; the time - "*|\n") ; close line - - ;; Now iterate over the tables and insert the data - ;; but only if any time has been collected - (when (and total-time (> total-time 0)) - - (while (setq tbl (pop tables)) - ;; now tbl is the table resulting from one file. - (setq file-time (nth 1 tbl)) - (when (or (and file-time (> file-time 0)) - (not (plist-get params :fileskip0))) - (insert-before-markers "|-\n") ; a hline because a new file starts - ;; First the file time, if we have multiple files - (when multifile - ;; Summarize the time collected from this file - (insert-before-markers - (format (concat "| %s %s | %s%s*" (nth 8 lwords) "* | *%s*|\n") - (file-name-nondirectory (car tbl)) - (if level-p "| " "") ; level column, maybe - (if timestamp "| " "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time - - ;; Get the list of node entries and iterate over it - (setq entries (nth 2 tbl)) - (while (setq entry (pop entries)) - (setq level (car entry) - headline (nth 1 entry) - hlc (if emph (or (cdr (assoc level hlchars)) "") "")) - (when narrow-cut-p - (if (and (string-match (concat "\\`" org-bracket-link-regexp - "\\'") - headline) - (match-end 3)) - (setq headline - (format "[[%s][%s]]" - (match-string 1 headline) - (org-shorten-string (match-string 3 headline) - narrow))) - (setq headline (org-shorten-string headline narrow)))) - (insert-before-markers - "|" ; start the table line - (if multifile "|" "") ; free space for file name column? - (if level-p (format "%d|" (car entry)) "") ; level, maybe - (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe - (if properties - (concat - (mapconcat - (lambda (p) (or (cdr (assoc p (nth 4 entry))) "")) - properties "|") "|") "") ;properties columns, maybe - (if indent (org-clocktable-indent-string level) "") ; indentation - hlc headline hlc "|" ; headline - (make-string (min (1- ntcol) (or (- level 1))) ?|) + (format "<%d>| |\n" narrow))) ; headline and time columns + + ;; Insert the table header line + (insert-before-markers + "|" ; table line starter + (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe + (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe + (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe + (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe + (concat (nth 4 lwords) "|" + (nth 5 lwords) "|\n")) ; headline and time columns + + ;; Insert the total time in the table + (insert-before-markers + "|-\n" ; a hline + "|" ; table line starter + (if multifile (concat "| " (nth 6 lwords) " ") "") + ; file column, maybe + (if level-p "|" "") ; level column, maybe + (if timestamp "|" "") ; timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ; properties columns, maybe + (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline + (format org-clock-total-time-cell-format + (org-minutes-to-hh:mm-string (or total-time 0))) ; the time + "|\n") ; close line + + ;; Now iterate over the tables and insert the data + ;; but only if any time has been collected + (when (and total-time (> total-time 0)) + + (while (setq tbl (pop tables)) + ;; now tbl is the table resulting from one file. + (setq file-time (nth 1 tbl)) + (when (or (and file-time (> file-time 0)) + (not (plist-get params :fileskip0))) + (insert-before-markers "|-\n") ; a hline because a new file starts + ;; First the file time, if we have multiple files + (when multifile + ;; Summarize the time collected from this file + (insert-before-markers + (format (concat "| %s %s | %s%s" + (format org-clock-file-time-cell-format (nth 8 lwords)) + " | *%s*|\n") + (file-name-nondirectory (car tbl)) + (if level-p "| " "") ; level column, maybe + (if timestamp "| " "") ; timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ;properties columns, maybe + (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time + + ;; Get the list of node entries and iterate over it + (setq entries (nth 2 tbl)) + (while (setq entry (pop entries)) + (setq level (car entry) + headline (nth 1 entry) + hlc (if emph (or (cdr (assoc level hlchars)) "") "")) + (when narrow-cut-p + (if (and (string-match (concat "\\`" org-bracket-link-regexp + "\\'") + headline) + (match-end 3)) + (setq headline + (format "[[%s][%s]]" + (match-string 1 headline) + (org-shorten-string (match-string 3 headline) + narrow))) + (setq headline (org-shorten-string headline narrow)))) + (insert-before-markers + "|" ; start the table line + (if multifile "|" "") ; free space for file name column? + (if level-p (format "%d|" (car entry)) "") ; level, maybe + (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe + (if properties + (concat + (mapconcat + (lambda (p) (or (cdr (assoc p (nth 4 entry))) "")) + properties "|") "|") "") ;properties columns, maybe + (if indent (org-clocktable-indent-string level) "") ; indentation + hlc headline hlc "|" ; headline + (make-string (min (1- ntcol) (or (- level 1))) ?|) ; empty fields for higher levels - hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time - "|\n" ; close line - ))))) - (backward-delete-char 1) - (if (setq formula (plist-get params :formula)) - (cond - ((eq formula '%) - ;; compute the column where the % numbers need to go - (setq pcol (+ 2 - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0) - (min maxlevel (or ntcol 100)))) - ;; compute the column where the total time is - (setq tcol (+ 2 - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0))) - (insert - (format - "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" - pcol ; the column where the % numbers should go - (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time - tcol ; column of the total time - tcol (1- pcol) ; range of columns where times can be found - )) - (setq recalc t)) - ((stringp formula) - (insert "\n#+TBLFM: " formula) - (setq recalc t)) - (t (error "invalid formula in clocktable"))) - ;; Should we rescue an old formula? - (when (stringp (setq content (plist-get params :content))) - (when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content) - (setq recalc t) - (insert "\n" (match-string 1 (plist-get params :content))) - (beginning-of-line 0)))) - ;; Back to beginning, align the table, recalculate if necessary - (goto-char ipos) - (skip-chars-forward "^|") - (org-table-align) - (when org-hide-emphasis-markers - ;; we need to align a second time - (org-table-align)) - (when recalc - (if (eq formula '%) - (save-excursion - (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) - (org-table-goto-column pcol nil 'force) - (insert "%"))) - (org-table-recalculate 'all)) - (when rm-file-column - ;; The file column is actually not wanted - (forward-char 1) - (org-table-delete-column)) - total-time)) + hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time + "|\n" ; close line + ))))) + ;; When exporting subtrees or regions the region might be + ;; activated, so let's disable Ì€delete-active-region' + (let ((delete-active-region nil)) (backward-delete-char 1)) + (if (setq formula (plist-get params :formula)) + (cond + ((eq formula '%) + ;; compute the column where the % numbers need to go + (setq pcol (+ 2 + (if multifile 1 0) + (if level-p 1 0) + (if timestamp 1 0) + (min maxlevel (or ntcol 100)))) + ;; compute the column where the total time is + (setq tcol (+ 2 + (if multifile 1 0) + (if level-p 1 0) + (if timestamp 1 0))) + (insert + (format + "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" + pcol ; the column where the % numbers should go + (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time + tcol ; column of the total time + tcol (1- pcol) ; range of columns where times can be found + )) + (setq recalc t)) + ((stringp formula) + (insert "\n#+TBLFM: " formula) + (setq recalc t)) + (t (error "Invalid formula in clocktable"))) + ;; Should we rescue an old formula? + (when (stringp (setq content (plist-get params :content))) + (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content) + (setq recalc t) + (insert "\n" (match-string 1 (plist-get params :content))) + (beginning-of-line 0)))) + ;; Back to beginning, align the table, recalculate if necessary + (goto-char ipos) + (skip-chars-forward "^|") + (org-table-align) + (when org-hide-emphasis-markers + ;; we need to align a second time + (org-table-align)) + (when recalc + (if (eq formula '%) + (save-excursion + (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) + (org-table-goto-column pcol nil 'force) + (insert "%"))) + (org-table-recalculate 'all)) + (when rm-file-column + ;; The file column is actually not wanted + (forward-char 1) + (org-table-delete-column)) + total-time)) (defun org-clocktable-indent-string (level) (if (= level 1) @@ -2464,7 +2601,9 @@ TIME: The sum of all time spend in this tree, in minutes. This time (org-clock-sum ts te (unless (null matcher) (lambda () - (let ((tags-list (org-get-tags-at))) + (let* ((tags-list (org-get-tags-at)) + (org-scanner-tags tags-list) + (org-trust-scanner-tags t)) (eval matcher))))) (goto-char (point-min)) (setq st t) @@ -2496,13 +2635,13 @@ TIME: The sum of all time spend in this tree, in minutes. This time (cdr (assoc "DEADLINE" props)) (cdr (assoc "TIMESTAMP" props)) (cdr (assoc "TIMESTAMP_IA" props)))) - props (when properties - (remove nil - (mapcar - (lambda (p) - (when (org-entry-get (point) p inherit-property-p) - (cons p (org-entry-get (point) p inherit-property-p)))) - properties)))) + props (when properties + (remove nil + (mapcar + (lambda (p) + (when (org-entry-get (point) p inherit-property-p) + (cons p (org-entry-get (point) p inherit-property-p)))) + properties)))) (when (> time 0) (push (list level hdl tsp time props) tbl)))))) (setq tbl (nreverse tbl)) (list file org-clock-file-total-minutes tbl)))) @@ -2566,7 +2705,7 @@ The details of what will be saved are regulated by the variable (buffer-file-name (org-clocking-buffer)) "\" . " (int-to-string (marker-position org-clock-marker)) "))\n")) - ;; Store clocked task history. Tasks are stored reversed to make + ;; Store clocked task history. Tasks are stored reversed to make ;; reading simpler (when (and (memq org-clock-persist '(t history)) org-clock-history) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index 5cec355d738..e17210b7ff5 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -33,9 +33,10 @@ (declare-function org-agenda-redo "org-agenda" ()) (declare-function org-agenda-do-context-action "org-agenda" ()) +(declare-function org-clock-sum-today "org-clock" (&optional headline-filter)) (when (featurep 'xemacs) - (error "Do not load this file into XEmacs, use 'org-colview-xemacs.el'.")) + (error "Do not load this file into XEmacs, use `org-colview-xemacs.el'")) ;;; Column View @@ -149,6 +150,7 @@ This is the compiled version of the format.") "Create a new column overlay and add it to the list." (let ((ov (make-overlay beg end))) (overlay-put ov 'face (or face 'secondary-selection)) + (remove-text-properties 0 (length string) '(face nil) string) (org-overlay-display ov string face) (push ov org-columns-overlays) ov)) @@ -186,17 +188,15 @@ This is the compiled version of the format.") (cons "ITEM" ;; When in a buffer, get the whole line, ;; we'll clean it later… - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (save-match-data - (org-no-properties - (org-remove-tabs - (buffer-substring-no-properties - (point-at-bol) (point-at-eol))))) + (org-remove-tabs + (buffer-substring-no-properties + (point-at-bol) (point-at-eol)))) ;; In agenda, just get the `txt' property - (org-no-properties - (or (org-get-at-bol 'txt) - (buffer-substring - (point) (progn (end-of-line) (point))))))) + (or (org-get-at-bol 'txt) + (buffer-substring-no-properties + (point) (progn (end-of-line) (point)))))) (assoc property props)) width (or (cdr (assoc property org-columns-current-maxwidths)) (nth 2 column) @@ -240,20 +240,20 @@ This is the compiled version of the format.") (save-excursion (goto-char beg) (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later? - ;; Make the rest of the line disappear. - (org-unmodified - (setq ov (org-columns-new-overlay beg (point-at-eol))) - (overlay-put ov 'invisible t) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'intangible t) - (overlay-put ov 'line-prefix "") - (overlay-put ov 'wrap-prefix "") - (push ov org-columns-overlays) - (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) - (overlay-put ov 'keymap org-columns-map) - (push ov org-columns-overlays) - (let ((inhibit-read-only t)) - (put-text-property (max (point-min) (1- (point-at-bol))) + ;; Make the rest of the line disappear. + (org-unmodified + (setq ov (org-columns-new-overlay beg (point-at-eol))) + (overlay-put ov 'invisible t) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'intangible t) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "") + (push ov org-columns-overlays) + (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) + (overlay-put ov 'keymap org-columns-map) + (push ov org-columns-overlays) + (let ((inhibit-read-only t)) + (put-text-property (max (point-min) (1- (point-at-bol))) (min (point-max) (1+ (point-at-eol))) 'read-only "Type `e' to edit property"))))) @@ -304,7 +304,7 @@ for the duration of the command.") (org-set-local 'org-columns-current-widths (nreverse widths)) (setq org-columns-full-header-line-format title) (setq org-columns-previous-hscroll -1) -; (org-columns-hscoll-title) + ; (org-columns-hscoll-title) (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))) (defun org-columns-hscoll-title () @@ -442,8 +442,8 @@ Where possible, use the standard interface for changing this line." (org-edit-headline)))) ((equal key "TODO") (setq eval '(org-with-point-at - pom - (call-interactively 'org-todo)))) + pom + (call-interactively 'org-todo)))) ((equal key "PRIORITY") (setq eval '(org-with-point-at pom (call-interactively 'org-priority)))) @@ -499,7 +499,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 (eq major-mode 'org-mode) + (if (and (derived-mode-p 'org-mode) (nth 3 (assoc key org-columns-current-fmt-compiled))) (org-columns-update key))))))) @@ -665,27 +665,38 @@ around it." (org-open-link-from-string value arg))) (defun org-columns-get-format-and-top-level () - (let (fmt) + (let ((fmt (org-columns-get-format))) + (org-columns-goto-top-level) + fmt)) + +(defun org-columns-get-format (&optional fmt-string) + (interactive) + (let (fmt-as-property fmt) (when (condition-case nil (org-back-to-heading) (error nil)) - (setq fmt (org-entry-get nil "COLUMNS" t))) - (setq fmt (or fmt org-columns-default-format)) + (setq fmt-as-property (org-entry-get nil "COLUMNS" t))) + (setq fmt (or fmt-string fmt-as-property org-columns-default-format)) (org-set-local 'org-columns-current-fmt fmt) (org-columns-compile-format fmt) - (if (marker-position org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker - org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker (point))) fmt)) -(defun org-columns () - "Turn on column view on an org-mode file." +(defun org-columns-goto-top-level () + (when (condition-case nil (org-back-to-heading) (error nil)) + (org-entry-get nil "COLUMNS" t)) + (if (marker-position org-entry-property-inherited-from) + (move-marker org-columns-top-level-marker org-entry-property-inherited-from) + (move-marker org-columns-top-level-marker (point)))) + +(defun org-columns (&optional columns-fmt-string) + "Turn on column view on an org-mode file. +When COLUMNS-FMT-STRING is non-nil, use it as the column format." (interactive) (org-verify-version 'columns) (org-columns-remove-overlays) (move-marker org-columns-begin-marker (point)) (let ((org-columns-time (time-to-number-of-days (current-time))) beg end fmt cache maxwidths) - (setq fmt (org-columns-get-format-and-top-level)) + (org-columns-goto-top-level) + (setq fmt (org-columns-get-format columns-fmt-string)) (save-excursion (goto-char org-columns-top-level-marker) (setq beg (point)) @@ -700,6 +711,11 @@ around it." (save-restriction (narrow-to-region beg end) (org-clock-sum)))) + (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (org-clock-sum-today)))) (while (re-search-forward org-outline-regexp-bol end t) (if (and org-columns-skip-archived-trees (looking-at (concat ".*:" org-archive-tag ":"))) @@ -1014,7 +1030,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 (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (call-interactively 'org-columns) (org-agenda-redo) (call-interactively 'org-agenda-columns))) @@ -1083,6 +1099,14 @@ Don't set this, this is meant for dynamic scoping.") (while l (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) sum)) + ((string-match (concat "\\([0-9.]+\\) *\\(" + (regexp-opt (mapcar 'car org-effort-durations)) + "\\)") s) + (setq s (concat "0:" (org-duration-string-to-minutes s t))) + (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) + (while l + (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) + sum)) ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) (if (equal s "[X]") 1. 0.000001)) ((memq fmt '(estimate)) (org-string-to-estimate s)) @@ -1215,13 +1239,16 @@ PARAMS is a property list of parameters: :vlines When t, make each column a colgroup to enforce vertical lines. :maxlevel When set to a number, don't capture headlines below this level. :skip-empty-rows - When t, skip rows where all specifiers other than ITEM are empty." + When t, skip rows where all specifiers other than ITEM are empty. +:format When non-nil, specify the column view format to use." (let ((pos (move-marker (make-marker) (point))) (hlines (plist-get params :hlines)) (vlines (plist-get params :vlines)) (maxlevel (plist-get params :maxlevel)) (content-lines (org-split-string (plist-get params :content) "\n")) (skip-empty-rows (plist-get params :skip-empty-rows)) + (columns-fmt (plist-get params :format)) + (case-fold-search t) tbl id idpos nfields tmp recalc line id-as-string view-file view-pos) (when (setq id (plist-get params :id)) @@ -1250,7 +1277,7 @@ PARAMS is a property list of parameters: (save-restriction (widen) (goto-char (or view-pos (point))) - (org-columns) + (org-columns columns-fmt) (setq tbl (org-columns-capture-view maxlevel skip-empty-rows)) (setq nfields (length (car tbl))) (org-columns-quit)))) @@ -1287,7 +1314,7 @@ PARAMS is a property list of parameters: (while (setq line (pop content-lines)) (when (string-match "^#" line) (insert "\n" line) - (when (string-match "^[ \t]*#\\+TBLFM" line) + (when (string-match "^[ \t]*#\\+tblfm" line) (setq recalc t)))) (if recalc (progn (goto-char pos) (org-table-recalculate 'all)) @@ -1337,12 +1364,11 @@ and tailing newline characters." (org-columns-remove-overlays) (move-marker org-columns-begin-marker (point)) (let ((org-columns-time (time-to-number-of-days (current-time))) - cache maxwidths m p a d fmt) + cache maxwidths m p a d fmt) (cond ((and (boundp 'org-agenda-overriding-columns-format) org-agenda-overriding-columns-format) - (setq fmt org-agenda-overriding-columns-format) - (org-set-local 'org-agenda-overriding-columns-format fmt)) + (setq fmt org-agenda-overriding-columns-format)) ((setq m (org-get-at-bol 'org-hd-marker)) (setq fmt (or (org-entry-get m "COLUMNS" t) (with-current-buffer (marker-buffer m) @@ -1370,7 +1396,7 @@ and tailing newline characters." (setq p (org-entry-properties m)) (when (or (not (setq a (assoc org-effort-property p))) - (not (string-match "\\S-" (or (cdr a) "")))) + (not (string-match "\\S-" (or (cdr a) "")))) ;; OK, the property is not defined. Use appointment duration? (when (and org-agenda-columns-add-appointments-to-effort-sum (setq d (get-text-property (point) 'duration))) @@ -1397,8 +1423,9 @@ and tailing newline characters." "Summarize the summarizable columns in column view in the agenda. This will add overlays to the date lines, to show the summary for each day." (let* ((fmt (mapcar (lambda (x) - (if (equal (car x) "CLOCKSUM") - (list "CLOCKSUM" (nth 1 x) (nth 2 x) ":" 'add_times + (if (string-match "CLOCKSUM.*" (car x)) + (list (match-string 0 (car x)) + (nth 1 x) (nth 2 x) ":" 'add_times nil '+ nil) x)) org-columns-current-fmt-compiled)) @@ -1485,23 +1512,25 @@ This will add overlays to the date lines, to show the summary for each day." (goto-char (point-min)) (org-columns-get-format-and-top-level) (while (setq fm (pop fmt)) - (if (equal (car fm) "CLOCKSUM") - (org-clock-sum) - (when (and (nth 4 fm) - (setq a (assoc (car fm) - org-columns-current-fmt-compiled)) - (equal (nth 4 a) (nth 4 fm))) - (org-columns-compute (car fm))))))))))) + (cond ((equal (car fm) "CLOCKSUM") + (org-clock-sum)) + ((equal (car fm) "CLOCKSUM_T") + (org-clock-sum-today)) + ((and (nth 4 fm) + (setq a (assoc (car fm) + org-columns-current-fmt-compiled)) + (equal (nth 4 a) (nth 4 fm))) + (org-columns-compute (car fm))))))))))) (defun org-format-time-period (interval) "Convert time in fractional days to days/hours/minutes/seconds." (if (numberp interval) - (let* ((days (floor interval)) - (frac-hours (* 24 (- interval days))) - (hours (floor frac-hours)) - (minutes (floor (* 60 (- frac-hours hours)))) - (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes))))) - (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) + (let* ((days (floor interval)) + (frac-hours (* 24 (- interval days))) + (hours (floor frac-hours)) + (minutes (floor (* 60 (- frac-hours hours)))) + (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes))))) + (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) "")) (defun org-estimate-mean-and-var (v) @@ -1519,10 +1548,10 @@ and variances (respectively) of the individual estimates." (let ((mean 0) (var 0)) (mapc (lambda (e) - (let ((stats (org-estimate-mean-and-var e))) - (setq mean (+ mean (car stats))) - (setq var (+ var (cadr stats))))) - el) + (let ((stats (org-estimate-mean-and-var e))) + (setq mean (+ mean (car stats))) + (setq var (+ var (cadr stats))))) + el) (let ((stdev (sqrt var))) (list (- mean stdev) (+ mean stdev))))) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index ce72e25d991..76042849663 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -34,7 +34,6 @@ (require 'org-macs) -(declare-function find-library-name "find-func" (library)) (declare-function w32-focus-frame "term/w32-win" (frame)) ;; The following constant is for backward compatibility. We do not use @@ -111,6 +110,7 @@ any other entries, and any resulting duplicates will be removed entirely." t)) t))) + ;;;; Emacs/XEmacs compatibility ;; Keys @@ -326,20 +326,8 @@ Works on both Emacs and XEmacs." string) (apply 'propertize string properties))) -(defun org-substring-no-properties (string &optional from to) - (if (featurep 'xemacs) - (org-no-properties (substring string (or from 0) to)) - (substring-no-properties string from to))) - -(defun org-find-library-name (library) - (if (fboundp 'find-library-name) - (file-name-directory (find-library-name library)) - ; XEmacs does not have `find-library-name' - (flet ((find-library-name-helper (filename ignored-codesys) - filename) - (find-library-name (library) - (find-library library nil 'find-library-name-helper))) - (file-name-directory (find-library-name library))))) +(defmacro org-find-library-dir (library) + `(file-name-directory (locate-library ,library))) (defun org-count-lines (s) "How many lines in string S?" @@ -396,7 +384,7 @@ TIME defaults to the current time." (save-match-data (apply 'looking-at args)))) -; XEmacs does not have `looking-back'. + ; XEmacs does not have `looking-back'. (if (fboundp 'looking-back) (defalias 'org-looking-back 'looking-back) (defun org-looking-back (regexp &optional limit greedy) @@ -436,7 +424,7 @@ With two arguments, return floor and remainder of their quotient." (let ((q (floor x y))) (list q (- x (if y (* y q) q))))) -;; `pop-to-buffer-same-window' has been introduced with Emacs 24.1. +;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1. (defun org-pop-to-buffer-same-window (&optional buffer-or-name norecord label) "Pop to buffer specified by BUFFER-OR-NAME in the selected window." @@ -445,6 +433,33 @@ With two arguments, return floor and remainder of their quotient." 'pop-to-buffer-same-window buffer-or-name norecord) (funcall 'switch-to-buffer buffer-or-name norecord))) +;; `condition-case-unless-debug' has been introduced in Emacs 24.1 +;; `condition-case-no-debug' has been introduced in Emacs 23.1 +(defalias 'org-condition-case-unless-debug + (or (and (fboundp 'condition-case-unless-debug) + 'condition-case-unless-debug) + (and (fboundp 'condition-case-no-debug) + 'condition-case-no-debug) + 'condition-case)) + +;;;###autoload +(defmacro org-check-version () + "Try very hard to provide sensible version strings." + (let* ((org-dir (org-find-library-dir "org")) + (org-version.el (concat org-dir "org-version.el")) + (org-fixup.el (concat org-dir "../mk/org-fixup.el"))) + (if (require 'org-version org-version.el 'noerror) + '(progn + (autoload 'org-release "org-version.el") + (autoload 'org-git-version "org-version.el")) + (if (require 'org-fixup org-fixup.el 'noerror) + '(org-fixup) + ;; provide fallback definitions and complain + (warn "Could not define org version correctly. Check installation!") + '(progn + (defun org-release () "N/A") + (defun org-git-version () "N/A !!check installation!!")))))) + (provide 'org-compat) ;;; org-compat.el ends here diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index c613ba20e48..a187d2facfe 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -75,7 +75,7 @@ (context plain recipients &optional sign always-trust)) (defgroup org-crypt nil - "Org Crypt" + "Org Crypt." :tag "Org Crypt" :group 'org) @@ -111,6 +111,7 @@ nil : Leave auto-save-mode enabled. NOTE: This only works for entries which have a tag that matches `org-crypt-tag-matcher'." :group 'org-crypt + :version "24.1" :type '(choice (const :tag "Always" t) (const :tag "Never" nil) (const :tag "Ask" ask) @@ -129,13 +130,13 @@ See `org-crypt-disable-auto-save'." (eq org-crypt-disable-auto-save t) (and (eq org-crypt-disable-auto-save 'ask) - (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? "))) + (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? "))) (message (concat "org-decrypt: Disabling auto-save-mode for " (or (buffer-file-name) (current-buffer)))) - ; The argument to auto-save-mode has to be "-1", since - ; giving a "nil" argument toggles instead of disabling. + ; The argument to auto-save-mode has to be "-1", since + ; giving a "nil" argument toggles instead of disabling. (auto-save-mode -1)) ((eq org-crypt-disable-auto-save nil) - (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage.")) + (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage.")) ((eq org-crypt-disable-auto-save 'encrypt) (message "org-decrypt: Enabling re-encryption on auto-save.") (add-hook 'auto-save-hook @@ -221,7 +222,7 @@ See `org-crypt-disable-auto-save'." ;; outline property starts at the \n of the heading. (delete-region (1- (point)) end) ;; Store a checksum of the decrypted and the encrypted - ;; text value. This allow to reuse the same encrypted text + ;; text value. This allow to reuse the same encrypted text ;; if the text does not change, and therefore avoid a ;; re-encryption process. (insert "\n" (propertize decrypted-text @@ -251,6 +252,14 @@ See `org-crypt-disable-auto-save'." (cdr (org-make-tags-matcher org-crypt-tag-matcher)) todo-only))) +(defun org-at-encrypted-entry-p () + "Is the current entry encrypted?" + (unless (org-before-first-heading-p) + (save-excursion + (org-back-to-heading t) + (search-forward "-----BEGIN PGP MESSAGE-----" + (save-excursion (org-end-of-subtree t)) t)))) + (defun org-crypt-use-before-save-magic () "Add a hook to automatically encrypt entries before a file is saved to disk." (add-hook diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 48656190a0c..a951cf99648 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -26,18 +26,18 @@ ;; Synopsis ;; ======== ;; -;; Allows org-mode to make use of the Emacs `etags' system. Defines tag +;; Allows org-mode to make use of the Emacs `etags' system. Defines tag ;; destinations in org-mode files as any text between <<double angled ;; brackets>>. This allows the tags-generation program `exuberant ctags' to ;; parse these files and create tag tables that record where these -;; destinations are found. Plain [[links]] in org mode files which do not have +;; destinations are found. Plain [[links]] in org mode files which do not have ;; <<matching destinations>> within the same file will then be interpreted as ;; links to these 'tagged' destinations, allowing seamless navigation between -;; multiple org-mode files. Topics can be created in any org mode file and -;; will always be found by plain links from other files. Other file types +;; multiple org-mode files. Topics can be created in any org mode file and +;; will always be found by plain links from other files. Other file types ;; recognized by ctags (source code files, latex files, etc) will also be ;; available as destinations for plain links, and similarly, org-mode links -;; will be available as tags from source files. Finally, the function +;; will be available as tags from source files. Finally, the function ;; `org-ctags-find-tag-interactive' lets you choose any known tag, using ;; autocompletion, and quickly jump to it. ;; @@ -82,25 +82,25 @@ ;; ===== ;; ;; When you click on a link "[[foo]]" and org cannot find a matching "<<foo>>" -;; in the current buffer, the tags facility will take over. The file TAGS in +;; in the current buffer, the tags facility will take over. The file TAGS in ;; the active directory is examined to see if the tags facility knows about -;; "<<foo>>" in any other files. If it does, the matching file will be opened +;; "<<foo>>" in any other files. If it does, the matching file will be opened ;; and the cursor will jump to the position of "<<foo>>" in that file. ;; ;; User-visible functions: ;; - `org-ctags-find-tag-interactive': type a tag (plain link) name and visit -;; it. With autocompletion. Bound to ctrl-O in the above setup. -;; - All the etags functions should work. These include: +;; it. With autocompletion. Bound to ctrl-O in the above setup. +;; - All the etags functions should work. These include: ;; ;; M-. `find-tag' -- finds the tag at point ;; ;; C-M-. find-tag based on regular expression ;; ;; M-x tags-search RET -- like C-M-. but searches through ENTIRE TEXT -;; of ALL the files referenced in the TAGS file. A quick way to +;; of ALL the files referenced in the TAGS file. A quick way to ;; search through an entire 'project'. ;; -;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'. +;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'. ;; You may need to bind this key yourself with (eg) ;; (global-set-key (kbd "<M-kp-multiply>") 'pop-tag-mark) ;; @@ -116,8 +116,8 @@ ;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file. ;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in ;; your `org-open-link-functions' list, as is done in the setup -;; above. This will cause the TAGS file to be rebuilt whenever a link -;; cannot be found. This may be slow with large file collections however. +;; above. This will cause the TAGS file to be rebuilt whenever a link +;; cannot be found. This may be slow with large file collections however. ;; 3. You run the following from the command line (all 1 line): ;; ;; ctags --langdef=orgmode --langmap=orgmode:.org @@ -126,7 +126,7 @@ ;; ;; If you are paranoid, you might want to run (org-ctags-create-tags ;; "/path/to/org/files") at startup, by including the following toplevel form -;; in .emacs. However this can cause a pause of several seconds if ctags has +;; in .emacs. However this can cause a pause of several seconds if ctags has ;; to scan lots of files. ;; ;; (progn @@ -193,6 +193,7 @@ Created as a local variable in each buffer.") The following patterns are replaced in the string: `%t' - replaced with the capitalized title of the hyperlink" :group 'org-ctags + :version "24.1" :type 'string) @@ -247,7 +248,7 @@ buffer position where the tag is found." ((re-search-backward " \n\\(.*\\),[0-9]+\n") (list (match-string 1) line pos)) (t ; can't find a file name preceding the matched - ; tag?? + ; tag?? (error "Malformed TAGS file: %s" (buffer-name)))))) (t ; tag not found nil)))))) @@ -308,7 +309,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 (eq major-mode 'org-mode) org-ctags-enabled-p) + (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p) (org-mark-ring-push)))) @@ -411,7 +412,7 @@ asked before creating a new file." (defun org-ctags-append-topic (name &optional narrowp) "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Append a new toplevel heading to the end of the current buffer. The +Append a new toplevel heading to the end of the current buffer. The heading contains NAME surrounded by <<angular brackets>>, thus making the heading a destination for the tag `NAME'." (interactive "sTopic: ") @@ -456,12 +457,12 @@ to rebuild (update) the TAGS file." "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. Wrapper for org-ctags-rebuild-tags-file-then-find-tag." (if (and (buffer-file-name) - (y-or-n-p - (format - "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?" - name - (file-name-directory (buffer-file-name))))) - (org-ctags-rebuild-tags-file-then-find-tag name) + (y-or-n-p + (format + "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?" + name + (file-name-directory (buffer-file-name))))) + (org-ctags-rebuild-tags-file-then-find-tag name) nil)) @@ -533,7 +534,7 @@ a new topic." (t ;; New tag (run-hook-with-args-until-success - 'org-open-link-functions tag)))))) + 'org-open-link-functions tag)))))) (org-ctags-enable) diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index 192d1d6e6df..4ff8e7d00d0 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -38,6 +38,15 @@ This is normally one, but if the buffer has an entry with a DATE_TREE property (any value), the date tree will become a subtree under that entry, so the base level will be properly adjusted.") +(defcustom org-datetree-add-timestamp nil + "When non-nil, add a time stamp when create a datetree entry." + :group 'org-capture + :version "24.3" + :type '(choice + (const :tag "Do not add a time stamp" nil) + (const :tag "Add an inactive time stamp" inactive) + (const :tag "Add an active time stamp" active))) + ;;;###autoload (defun org-datetree-find-date-create (date &optional keep-restriction) "Find or create an entry for DATE. @@ -63,7 +72,7 @@ tree can be found." (goto-char (prog1 (point) (widen)))))) (defun org-datetree-find-year-create (year) - (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)$") + (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)\\s-*$") match) (goto-char (point-min)) (while (and (setq match (re-search-forward re nil t)) @@ -119,7 +128,7 @@ tree can be found." (org-datetree-insert-line year month day))))) (defun org-datetree-insert-line (year &optional month day) - (let ((pos (point))) + (let ((pos (point)) ts-type) (skip-chars-backward " \t\n") (delete-region (point) pos) (insert "\n" (make-string org-datetree-base-level ?*) " \n") @@ -136,6 +145,10 @@ tree can be found." (insert (format " %s" (format-time-string "%B" (encode-time 0 0 0 1 month year)))))) + (when (and day (setq ts-type org-datetree-add-timestamp)) + (insert "\n") + (org-indent-line) + (org-insert-time-stamp (encode-time 0 0 0 day month year) nil ts-type)) (beginning-of-line 1))) (defun org-datetree-file-entry-under (txt date) @@ -155,42 +168,42 @@ before running this command, even though the command tries to be smart." (let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'")) (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'")) dct ts tmp date year month day pos hdl-pos) - (while (re-search-forward org-ts-regexp nil t) - (catch 'next - (setq ts (match-string 0)) - (setq tmp (buffer-substring - (max (point-at-bol) (- (match-beginning 0) - org-ds-keyword-length)) - (match-beginning 0))) - (if (or (string-match "-\\'" tmp) - (string-match dre tmp) - (string-match sre tmp)) + (while (re-search-forward org-ts-regexp nil t) + (catch 'next + (setq ts (match-string 0)) + (setq tmp (buffer-substring + (max (point-at-bol) (- (match-beginning 0) + org-ds-keyword-length)) + (match-beginning 0))) + (if (or (string-match "-\\'" tmp) + (string-match dre tmp) + (string-match sre tmp)) + (throw 'next nil)) + (setq dct (decode-time (org-time-string-to-time (match-string 0))) + date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)) + year (nth 2 date) + month (car date) + day (nth 1 date) + pos (point)) + (org-back-to-heading t) + (setq hdl-pos (point)) + (unless (org-up-heading-safe) + ;; No parent, we are not in a date tree + (goto-char pos) + (throw 'next nil)) + (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") + ;; Parent looks wrong, we are not in a date tree + (goto-char pos) (throw 'next nil)) - (setq dct (decode-time (org-time-string-to-time (match-string 0))) - date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)) - year (nth 2 date) - month (car date) - day (nth 1 date) - pos (point)) - (org-back-to-heading t) - (setq hdl-pos (point)) - (unless (org-up-heading-safe) - ;; No parent, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") - ;; Parent looks wrong, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) - ;; At correct date already, do nothing + (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) + ;; At correct date already, do nothing (progn (goto-char pos) (throw 'next nil))) - ;; OK, we need to refile this entry - (goto-char hdl-pos) - (org-cut-subtree) - (save-excursion - (save-restriction - (org-datetree-file-entry-under (current-kill 0) date))))))) + ;; OK, we need to refile this entry + (goto-char hdl-pos) + (org-cut-subtree) + (save-excursion + (save-restriction + (org-datetree-file-entry-under (current-kill 0) date))))))) (provide 'org-datetree) diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el index c3fd62c1fe2..22cc5a7cdac 100644 --- a/lisp/org/org-docbook.el +++ b/lisp/org/org-docbook.el @@ -163,7 +163,7 @@ avoid same set of footnote IDs being used multiple times." "A list of DocBook expressions to convert emphasis fontifiers. Each element of the list is a list of three elements. The first element is the character used as a marker for fontification. -The second element is a formatting string to wrap fontified text with. +The second element is a format string to wrap fontified text with. The third element decides whether to protect converted text from other conversions." :group 'org-export-docbook @@ -295,7 +295,7 @@ then use this command to convert it." (interactive "r") (let (reg docbook buf) (save-window-excursion - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq docbook (org-export-region-as-docbook beg end t 'string)) (setq reg (buffer-substring beg end) @@ -629,7 +629,7 @@ publishing directory." (insert org-export-docbook-doctype)) (insert "<!-- Date: " date " -->\n") (insert (format "<!-- DocBook XML file generated by Org-mode %s Emacs %s -->\n" - org-version emacs-major-version)) + (org-version) emacs-major-version)) (insert org-export-docbook-article-header) (insert (format "\n <title>%s</title> @@ -1018,11 +1018,11 @@ publishing directory." (t ;; This line either is list item or end a list. (when (when (get-text-property 0 'list-item line) - (setq line (org-export-docbook-list-line - line - (get-text-property 0 'list-item line) - (get-text-property 0 'list-struct line) - (get-text-property 0 'list-prevs line))))) + (setq line (org-export-docbook-list-line + line + (get-text-property 0 'list-item line) + (get-text-property 0 'list-struct line) + (get-text-property 0 'list-prevs line))))) ;; Empty lines start a new paragraph. If hand-formatted lists ;; are not fully interpreted, lines starting with "-", "+", "*" @@ -1066,7 +1066,7 @@ publishing directory." (if (eq major-mode (default-value 'major-mode)) (nxml-mode))) - ;; Remove empty paragraphs. Replace them with a newline. + ;; Remove empty paragraphs. Replace them with a newline. (goto-char (point-min)) (while (re-search-forward "[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t) @@ -1355,10 +1355,10 @@ that need to be preserved in later phase of DocBook exporting." (concat replaced line))) (defun org-export-docbook-list-line (line pos struct prevs) - "Insert list syntax in export buffer. Return LINE, maybe modified. + "Insert list syntax in export buffer. Return LINE, maybe modified. POS is the item position or line position the line had before -modifications to buffer. STRUCT is the list structure. PREVS is +modifications to buffer. STRUCT is the list structure. PREVS is the alist of previous items." (let* ((get-type (function diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el new file mode 100644 index 00000000000..8b44d4936f5 --- /dev/null +++ b/lisp/org/org-element.el @@ -0,0 +1,4356 @@ +;;; org-element.el --- Parser And Applications for Org syntax + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> +;; Keywords: outlines, hypermedia, calendar, wp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Org syntax can be divided into three categories: "Greater +;; elements", "Elements" and "Objects". +;; +;; Elements are related to the structure of the document. Indeed, all +;; elements are a cover for the document: each position within belongs +;; to at least one element. +;; +;; An element always starts and ends at the beginning of a line. With +;; a few exceptions (namely `babel-call', `clock', `headline', `item', +;; `keyword', `planning', `property-drawer' and `section' types), it +;; can also accept a fixed set of keywords as attributes. Those are +;; called "affiliated keywords" to distinguish them from other +;; keywords, which are full-fledged elements. Almost all affiliated +;; keywords are referenced in `org-element-affiliated-keywords'; the +;; others are export attributes and start with "ATTR_" prefix. +;; +;; Element containing other elements (and only elements) are called +;; greater elements. Concerned types are: `center-block', `drawer', +;; `dynamic-block', `footnote-definition', `headline', `inlinetask', +;; `item', `plain-list', `quote-block', `section' and `special-block'. +;; +;; Other element types are: `babel-call', `clock', `comment', +;; `comment-block', `example-block', `export-block', `fixed-width', +;; `horizontal-rule', `keyword', `latex-environment', `paragraph', +;; `planning', `property-drawer', `quote-section', `src-block', +;; `table', `table-row' and `verse-block'. Among them, `paragraph' +;; and `verse-block' types can contain Org objects and plain text. +;; +;; Objects are related to document's contents. Some of them are +;; recursive. Associated types are of the following: `bold', `code', +;; `entity', `export-snippet', `footnote-reference', +;; `inline-babel-call', `inline-src-block', `italic', +;; `latex-fragment', `line-break', `link', `macro', `radio-target', +;; `statistics-cookie', `strike-through', `subscript', `superscript', +;; `table-cell', `target', `timestamp', `underline' and `verbatim'. +;; +;; Some elements also have special properties whose value can hold +;; objects themselves (i.e. an item tag or an headline name). Such +;; values are called "secondary strings". Any object belongs to +;; either an element or a secondary string. +;; +;; Notwithstanding affiliated keywords, each greater element, element +;; and object has a fixed set of properties attached to it. Among +;; them, four are shared by all types: `:begin' and `:end', which +;; refer to the beginning and ending buffer positions of the +;; considered element or object, `:post-blank', which holds the number +;; of blank lines, or white spaces, at its end and `:parent' which +;; refers to the element or object containing it. Greater elements +;; and elements containing objects will also have `:contents-begin' +;; and `:contents-end' properties to delimit contents. +;; +;; Lisp-wise, an element or an object can be represented as a list. +;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: +;; TYPE is a symbol describing the Org element or object. +;; PROPERTIES is the property list attached to it. See docstring of +;; appropriate parsing function to get an exhaustive +;; list. +;; CONTENTS is a list of elements, objects or raw strings contained +;; in the current element or object, when applicable. +;; +;; An Org buffer is a nested list of such elements and objects, whose +;; type is `org-data' and properties is nil. +;; +;; The first part of this file defines Org syntax, while the second +;; one provide accessors and setters functions. +;; +;; The next part implements a parser and an interpreter for each +;; element and object type in Org syntax. +;; +;; The following part creates a fully recursive buffer parser. It +;; also provides a tool to map a function to elements or objects +;; matching some criteria in the parse tree. Functions of interest +;; are `org-element-parse-buffer', `org-element-map' and, to a lesser +;; extent, `org-element-parse-secondary-string'. +;; +;; The penultimate part is the cradle of an interpreter for the +;; obtained parse tree: `org-element-interpret-data'. +;; +;; The library ends by furnishing `org-element-at-point' function, and +;; a way to give information about document structure around point +;; with `org-element-context'. + + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'org) + + +;;; Definitions And Rules +;; +;; Define elements, greater elements and specify recursive objects, +;; along with the affiliated keywords recognized. Also set up +;; restrictions on recursive objects combinations. +;; +;; These variables really act as a control center for the parsing +;; process. + +(defconst org-element-paragraph-separate + (concat "^\\(?:" + ;; Headlines, inlinetasks. + org-outline-regexp "\\|" + ;; Footnote definitions. + "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|" + "[ \t]*\\(?:" + ;; Empty lines. + "$" "\\|" + ;; Tables (any type). + "\\(?:|\\|\\+-[-+]\\)" "\\|" + ;; Blocks (any type), Babel calls, drawers (any type), + ;; fixed-width areas and keywords. Note: this is only an + ;; indication and need some thorough check. + "[#:]" "\\|" + ;; Horizontal rules. + "-\\{5,\\}[ \t]*$" "\\|" + ;; LaTeX environments. + "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|" + ;; Planning and Clock lines. + (regexp-opt (list org-scheduled-string + org-deadline-string + org-closed-string + org-clock-string)) + "\\|" + ;; Lists. + (let ((term (case org-plain-list-ordered-item-terminator + (?\) ")") (?. "\\.") (otherwise "[.)]"))) + (alpha (and org-alphabetical-lists "\\|[A-Za-z]"))) + (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" + "\\(?:[ \t]\\|$\\)")) + "\\)\\)") + "Regexp to separate paragraphs in an Org buffer. +In the case of lines starting with \"#\" and \":\", this regexp +is not sufficient to know if point is at a paragraph ending. See +`org-element-paragraph-parser' for more information.") + +(defconst org-element-all-elements + '(center-block clock comment comment-block drawer dynamic-block example-block + export-block fixed-width footnote-definition headline + horizontal-rule inlinetask item keyword latex-environment + babel-call paragraph plain-list planning property-drawer + quote-block quote-section section special-block src-block table + table-row verse-block) + "Complete list of element types.") + +(defconst org-element-greater-elements + '(center-block drawer dynamic-block footnote-definition headline inlinetask + item plain-list quote-block section special-block table) + "List of recursive element types aka Greater Elements.") + +(defconst org-element-all-successors + '(export-snippet footnote-reference inline-babel-call inline-src-block + latex-or-entity line-break link macro radio-target + statistics-cookie sub/superscript table-cell target + text-markup timestamp) + "Complete list of successors.") + +(defconst org-element-object-successor-alist + '((subscript . sub/superscript) (superscript . sub/superscript) + (bold . text-markup) (code . text-markup) (italic . text-markup) + (strike-through . text-markup) (underline . text-markup) + (verbatim . text-markup) (entity . latex-or-entity) + (latex-fragment . latex-or-entity)) + "Alist of translations between object type and successor name. + +Sharing the same successor comes handy when, for example, the +regexp matching one object can also match the other object.") + +(defconst org-element-all-objects + '(bold code entity export-snippet footnote-reference inline-babel-call + inline-src-block italic line-break latex-fragment link macro + radio-target statistics-cookie strike-through subscript superscript + table-cell target timestamp underline verbatim) + "Complete list of object types.") + +(defconst org-element-recursive-objects + '(bold italic link macro subscript radio-target strike-through superscript + table-cell underline) + "List of recursive object types.") + +(defconst org-element-block-name-alist + '(("CENTER" . org-element-center-block-parser) + ("COMMENT" . org-element-comment-block-parser) + ("EXAMPLE" . org-element-example-block-parser) + ("QUOTE" . org-element-quote-block-parser) + ("SRC" . org-element-src-block-parser) + ("VERSE" . org-element-verse-block-parser)) + "Alist between block names and the associated parsing function. +Names must be uppercase. Any block whose name has no association +is parsed with `org-element-special-block-parser'.") + +(defconst org-element-affiliated-keywords + '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" + "RESULTS" "SOURCE" "SRCNAME" "TBLNAME") + "List of affiliated keywords as strings. +By default, all keywords setting attributes (i.e. \"ATTR_LATEX\") +are affiliated keywords and need not to be in this list.") + +(defconst org-element--affiliated-re + (format "[ \t]*#\\+%s:" + ;; Regular affiliated keywords. + (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?" + (regexp-opt org-element-affiliated-keywords))) + "Regexp matching any affiliated keyword. + +Keyword name is put in match group 1. Moreover, if keyword +belongs to `org-element-dual-keywords', put the dual value in +match group 2. + +Don't modify it, set `org-element-affiliated-keywords' instead.") + +(defconst org-element-keyword-translation-alist + '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME") + ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME") + ("RESULT" . "RESULTS") ("HEADERS" . "HEADER")) + "Alist of usual translations for keywords. +The key is the old name and the value the new one. The property +holding their value will be named after the translated name.") + +(defconst org-element-multiple-keywords '("HEADER") + "List of affiliated keywords that can occur more that once in an element. + +Their value will be consed into a list of strings, which will be +returned as the value of the property. + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'. + +By default, all keywords setting attributes (i.e. \"ATTR_LATEX\") +allow multiple occurrences and need not to be in this list.") + +(defconst org-element-parsed-keywords '("AUTHOR" "CAPTION" "DATE" "TITLE") + "List of keywords whose value can be parsed. + +Their value will be stored as a secondary string: a list of +strings and objects. + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'.") + +(defconst org-element-dual-keywords '("CAPTION" "RESULTS") + "List of keywords which can have a secondary value. + +In Org syntax, they can be written with optional square brackets +before the colons. For example, results keyword can be +associated to a hash value with the following: + + #+RESULTS[hash-string]: some-source + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'.") + +(defconst org-element-object-restrictions + '((bold export-snippet inline-babel-call inline-src-block latex-or-entity link + radio-target sub/superscript target text-markup timestamp) + (footnote-reference export-snippet footnote-reference inline-babel-call + inline-src-block latex-or-entity line-break link macro + radio-target sub/superscript target text-markup + timestamp) + (headline inline-babel-call inline-src-block latex-or-entity link macro + radio-target statistics-cookie sub/superscript target text-markup + timestamp) + (inlinetask inline-babel-call inline-src-block latex-or-entity link macro + radio-target sub/superscript target text-markup timestamp) + (italic export-snippet inline-babel-call inline-src-block latex-or-entity + link radio-target sub/superscript target text-markup timestamp) + (item export-snippet footnote-reference inline-babel-call latex-or-entity + link macro radio-target sub/superscript target text-markup) + (keyword latex-or-entity macro sub/superscript text-markup) + (link export-snippet inline-babel-call inline-src-block latex-or-entity link + sub/superscript text-markup) + (macro macro) + (paragraph export-snippet footnote-reference inline-babel-call + inline-src-block latex-or-entity line-break link macro + radio-target statistics-cookie sub/superscript target text-markup + timestamp) + (radio-target export-snippet latex-or-entity sub/superscript) + (strike-through export-snippet inline-babel-call inline-src-block + latex-or-entity link radio-target sub/superscript target + text-markup timestamp) + (subscript export-snippet inline-babel-call inline-src-block latex-or-entity + sub/superscript target text-markup) + (superscript export-snippet inline-babel-call inline-src-block + latex-or-entity sub/superscript target text-markup) + (table-cell export-snippet latex-or-entity link macro radio-target + sub/superscript target text-markup timestamp) + (table-row table-cell) + (underline export-snippet inline-babel-call inline-src-block latex-or-entity + link radio-target sub/superscript target text-markup timestamp) + (verse-block footnote-reference inline-babel-call inline-src-block + latex-or-entity line-break link macro radio-target + sub/superscript target text-markup timestamp)) + "Alist of objects restrictions. + +CAR is an element or object type containing objects and CDR is +a list of successors that will be called within an element or +object of such type. + +For example, in a `radio-target' object, one can only find +entities, export snippets, latex-fragments, subscript and +superscript. + +This alist also applies to secondary string. For example, an +`headline' type element doesn't directly contain objects, but +still has an entry since one of its properties (`:title') does.") + +(defconst org-element-secondary-value-alist + '((headline . :title) + (inlinetask . :title) + (item . :tag) + (footnote-reference . :inline-definition)) + "Alist between element types and location of secondary value.") + + + +;;; Accessors and Setters +;; +;; Provide four accessors: `org-element-type', `org-element-property' +;; `org-element-contents' and `org-element-restriction'. +;; +;; Setter functions allow to modify elements by side effect. There is +;; `org-element-put-property', `org-element-set-contents', +;; `org-element-set-element' and `org-element-adopt-element'. Note +;; that `org-element-set-element' and `org-element-adopt-elements' are +;; higher level functions since also update `:parent' property. + +(defsubst org-element-type (element) + "Return type of ELEMENT. + +The function returns the type of the element or object provided. +It can also return the following special value: + `plain-text' for a string + `org-data' for a complete document + nil in any other case." + (cond + ((not (consp element)) (and (stringp element) 'plain-text)) + ((symbolp (car element)) (car element)))) + +(defsubst org-element-property (property element) + "Extract the value from the PROPERTY of an ELEMENT." + (plist-get (nth 1 element) property)) + +(defsubst org-element-contents (element) + "Extract contents from an ELEMENT." + (and (consp element) (nthcdr 2 element))) + +(defsubst org-element-restriction (element) + "Return restriction associated to ELEMENT. +ELEMENT can be an element, an object or a symbol representing an +element or object type." + (cdr (assq (if (symbolp element) element (org-element-type element)) + org-element-object-restrictions))) + +(defsubst org-element-put-property (element property value) + "In ELEMENT set PROPERTY to VALUE. +Return modified element." + (when (consp element) + (setcar (cdr element) (plist-put (nth 1 element) property value))) + element) + +(defsubst org-element-set-contents (element &rest contents) + "Set ELEMENT contents to CONTENTS. +Return modified element." + (cond ((not element) (list contents)) + ((cdr element) (setcdr (cdr element) contents)) + (t (nconc element contents)))) + +(defsubst org-element-set-element (old new) + "Replace element or object OLD with element or object NEW. +The function takes care of setting `:parent' property for NEW." + ;; Since OLD is going to be changed into NEW by side-effect, first + ;; make sure that every element or object within NEW has OLD as + ;; parent. + (mapc (lambda (blob) (org-element-put-property blob :parent old)) + (org-element-contents new)) + ;; Transfer contents. + (apply 'org-element-set-contents old (org-element-contents new)) + ;; Ensure NEW has same parent as OLD, then overwrite OLD properties + ;; with NEW's. + (org-element-put-property new :parent (org-element-property :parent old)) + (setcar (cdr old) (nth 1 new)) + ;; Transfer type. + (setcar old (car new))) + +(defsubst org-element-adopt-elements (parent &rest children) + "Append elements to the contents of another element. + +PARENT is an element or object. CHILDREN can be elements, +objects, or a strings. + +The function takes care of setting `:parent' property for CHILD. +Return parent element." + (if (not parent) children + ;; Link every child to PARENT. + (mapc (lambda (child) + (unless (stringp child) + (org-element-put-property child :parent parent))) + children) + ;; Add CHILDREN at the end of PARENT contents. + (apply 'org-element-set-contents + parent + (nconc (org-element-contents parent) children)) + ;; Return modified PARENT element. + parent)) + + + +;;; Greater elements +;; +;; For each greater element type, we define a parser and an +;; interpreter. +;; +;; A parser returns the element or object as the list described above. +;; Most of them accepts no argument. Though, exceptions exist. Hence +;; every element containing a secondary string (see +;; `org-element-secondary-value-alist') will accept an optional +;; argument to toggle parsing of that secondary string. Moreover, +;; `item' parser requires current list's structure as its first +;; element. +;; +;; An interpreter accepts two arguments: the list representation of +;; the element or object, and its contents. The latter may be nil, +;; depending on the element or object considered. It returns the +;; appropriate Org syntax, as a string. +;; +;; Parsing functions must follow the naming convention: +;; org-element-TYPE-parser, where TYPE is greater element's type, as +;; defined in `org-element-greater-elements'. +;; +;; Similarly, interpreting functions must follow the naming +;; convention: org-element-TYPE-interpreter. +;; +;; With the exception of `headline' and `item' types, greater elements +;; cannot contain other greater elements of their own type. +;; +;; Beside implementing a parser and an interpreter, adding a new +;; greater element requires to tweak `org-element--current-element'. +;; Moreover, the newly defined type must be added to both +;; `org-element-all-elements' and `org-element-greater-elements'. + + +;;;; Center Block + +(defun org-element-center-block-parser (limit) + "Parse a center block. + +LIMIT bounds the search. + +Return a list whose CAR is `center-block' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end' and `:post-blank' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_CENTER" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((block-end-line (match-beginning 0))) + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (save-excursion (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'center-block + (nconc + (list :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords)))))))) + +(defun org-element-center-block-interpreter (center-block contents) + "Interpret CENTER-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents)) + + +;;;; Drawer + +(defun org-element-drawer-parser (limit) + "Parse a drawer. + +LIMIT bounds the search. + +Return a list whose CAR is `drawer' and CDR is a plist containing +`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end' and `:post-blank' keywords. + +Assume point is at beginning of drawer." + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward "^[ \t]*:END:" limit t))) + ;; Incomplete drawer: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((drawer-end-line (match-beginning 0))) + (save-excursion + (let* ((case-fold-search t) + (name (progn (looking-at org-drawer-regexp) + (org-match-string-no-properties 1))) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty drawers have no contents. + (contents-begin (progn (forward-line) + (and (< (point) drawer-end-line) + (point)))) + (contents-end (and contents-begin drawer-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char drawer-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'drawer + (nconc + (list :begin begin + :end end + :drawer-name name + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-drawer-interpreter (drawer contents) + "Interpret DRAWER element as Org syntax. +CONTENTS is the contents of the element." + (format ":%s:\n%s:END:" + (org-element-property :drawer-name drawer) + contents)) + + +;;;; Dynamic Block + +(defun org-element-dynamic-block-parser (limit) + "Parse a dynamic block. + +LIMIT bounds the search. + +Return a list whose CAR is `dynamic-block' and CDR is a plist +containing `:block-name', `:begin', `:end', `:hiddenp', +`:contents-begin', `:contents-end', `:arguments' and +`:post-blank' keywords. + +Assume point is at beginning of dynamic block." + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward org-dblock-end-re limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((name (progn (looking-at org-dblock-start-re) + (org-match-string-no-properties 1))) + (arguments (org-match-string-no-properties 3)) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'dynamic-block + (nconc + (list :begin begin + :end end + :block-name name + :arguments arguments + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-dynamic-block-interpreter (dynamic-block contents) + "Interpret DYNAMIC-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (format "#+BEGIN: %s%s\n%s#+END:" + (org-element-property :block-name dynamic-block) + (let ((args (org-element-property :arguments dynamic-block))) + (and args (concat " " args))) + contents)) + + +;;;; Footnote Definition + +(defun org-element-footnote-definition-parser (limit) + "Parse a footnote definition. + +LIMIT bounds the search. + +Return a list whose CAR is `footnote-definition' and CDR is +a plist containing `:label', `:begin' `:end', `:contents-begin', +`:contents-end' and `:post-blank' keywords. + +Assume point is at the beginning of the footnote definition." + (save-excursion + (let* ((label (progn (looking-at org-footnote-definition-re) + (org-match-string-no-properties 1))) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (ending (save-excursion + (if (progn + (end-of-line) + (re-search-forward + (concat org-outline-regexp-bol "\\|" + org-footnote-definition-re "\\|" + "^[ \t]*$") limit 'move)) + (match-beginning 0) + (point)))) + (contents-begin (progn (search-forward "]") + (skip-chars-forward " \r\t\n" ending) + (and (/= (point) ending) (point)))) + (contents-end (and contents-begin ending)) + (end (progn (goto-char ending) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'footnote-definition + (nconc + (list :label label + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines ending end)) + (cadr keywords)))))) + +(defun org-element-footnote-definition-interpreter (footnote-definition contents) + "Interpret FOOTNOTE-DEFINITION element as Org syntax. +CONTENTS is the contents of the footnote-definition." + (concat (format "[%s]" (org-element-property :label footnote-definition)) + " " + contents)) + + +;;;; Headline + +(defun org-element-headline-parser (limit &optional raw-secondary-p) + "Parse an headline. + +Return a list whose CAR is `headline' and CDR is a plist +containing `:raw-value', `:title', `:begin', `:end', +`:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end', +`:level', `:priority', `:tags', `:todo-keyword',`:todo-type', +`:scheduled', `:deadline', `:timestamp', `:clock', `:category', +`:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p' +keywords. + +The plist also contains any property set in the property drawer, +with its name in lowercase, the underscores replaced with hyphens +and colons at the beginning (i.e. `:custom-id'). + +When RAW-SECONDARY-P is non-nil, headline's title will not be +parsed as a secondary string, but as a plain string instead. + +Assume point is at beginning of the headline." + (save-excursion + (let* ((components (org-heading-components)) + (level (nth 1 components)) + (todo (nth 2 components)) + (todo-type + (and todo (if (member todo org-done-keywords) 'done 'todo))) + (tags (let ((raw-tags (nth 5 components))) + (and raw-tags (org-split-string raw-tags ":")))) + (raw-value (or (nth 4 components) "")) + (quotedp + (let ((case-fold-search nil)) + (string-match (format "^%s\\( \\|$\\)" org-quote-string) + raw-value))) + (commentedp + (let ((case-fold-search nil)) + (string-match (format "^%s\\( \\|$\\)" org-comment-string) + raw-value))) + (archivedp (member org-archive-tag tags)) + (footnote-section-p (and org-footnote-section + (string= org-footnote-section raw-value))) + ;; Normalize property names: ":SOME_PROP:" becomes + ;; ":some-prop". + (standard-props (let (plist) + (mapc + (lambda (p) + (let ((p-name (downcase (car p)))) + (while (string-match "_" p-name) + (setq p-name + (replace-match "-" nil nil p-name))) + (setq p-name (intern (concat ":" p-name))) + (setq plist + (plist-put plist p-name (cdr p))))) + (org-entry-properties nil 'standard)) + plist)) + (time-props (org-entry-properties nil 'special "CLOCK")) + (scheduled (cdr (assoc "SCHEDULED" time-props))) + (deadline (cdr (assoc "DEADLINE" time-props))) + (clock (cdr (assoc "CLOCK" time-props))) + (timestamp (cdr (assoc "TIMESTAMP" time-props))) + (begin (point)) + (end (save-excursion (goto-char (org-end-of-subtree t t)))) + (pos-after-head (progn (forward-line) (point))) + (contents-begin (save-excursion + (skip-chars-forward " \r\t\n" end) + (and (/= (point) end) (line-beginning-position)))) + (hidden (org-invisible-p2)) + (contents-end (and contents-begin + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))))) + ;; Clean RAW-VALUE from any quote or comment string. + (when (or quotedp commentedp) + (let ((case-fold-search nil)) + (setq raw-value + (replace-regexp-in-string + (concat + (regexp-opt (list org-quote-string org-comment-string)) + "\\(?: \\|$\\)") + "" + raw-value)))) + ;; Clean TAGS from archive tag, if any. + (when archivedp (setq tags (delete org-archive-tag tags))) + (let ((headline + (list 'headline + (nconc + (list :raw-value raw-value + :begin begin + :end end + :pre-blank + (if (not contents-begin) 0 + (count-lines pos-after-head contents-begin)) + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :level level + :priority (nth 3 components) + :tags tags + :todo-keyword todo + :todo-type todo-type + :scheduled scheduled + :deadline deadline + :timestamp timestamp + :clock clock + :post-blank (count-lines + (if (not contents-end) pos-after-head + (goto-char contents-end) + (forward-line) + (point)) + end) + :footnote-section-p footnote-section-p + :archivedp archivedp + :commentedp commentedp + :quotedp quotedp) + standard-props)))) + (org-element-put-property + headline :title + (if raw-secondary-p raw-value + (org-element-parse-secondary-string + raw-value (org-element-restriction 'headline) headline))))))) + +(defun org-element-headline-interpreter (headline contents) + "Interpret HEADLINE element as Org syntax. +CONTENTS is the contents of the element." + (let* ((level (org-element-property :level headline)) + (todo (org-element-property :todo-keyword headline)) + (priority (org-element-property :priority headline)) + (title (org-element-interpret-data + (org-element-property :title headline))) + (tags (let ((tag-list (if (org-element-property :archivedp headline) + (cons org-archive-tag + (org-element-property :tags headline)) + (org-element-property :tags headline)))) + (and tag-list + (format ":%s:" (mapconcat 'identity tag-list ":"))))) + (commentedp (org-element-property :commentedp headline)) + (quotedp (org-element-property :quotedp headline)) + (pre-blank (or (org-element-property :pre-blank headline) 0)) + (heading (concat (make-string level ?*) + (and todo (concat " " todo)) + (and quotedp (concat " " org-quote-string)) + (and commentedp (concat " " org-comment-string)) + (and priority + (format " [#%s]" (char-to-string priority))) + (cond ((and org-footnote-section + (org-element-property + :footnote-section-p headline)) + (concat " " org-footnote-section)) + (title (concat " " title)))))) + (concat heading + ;; Align tags. + (when tags + (cond + ((zerop org-tags-column) (format " %s" tags)) + ((< org-tags-column 0) + (concat + (make-string + (max (- (+ org-tags-column (length heading) (length tags))) 1) + ? ) + tags)) + (t + (concat + (make-string (max (- org-tags-column (length heading)) 1) ? ) + tags)))) + (make-string (1+ pre-blank) 10) + contents))) + + +;;;; Inlinetask + +(defun org-element-inlinetask-parser (limit &optional raw-secondary-p) + "Parse an inline task. + +Return a list whose CAR is `inlinetask' and CDR is a plist +containing `:title', `:begin', `:end', `:hiddenp', +`:contents-begin' and `:contents-end', `:level', `:priority', +`:raw-value', `:tags', `:todo-keyword', `:todo-type', +`:scheduled', `:deadline', `:timestamp', `:clock' and +`:post-blank' keywords. + +The plist also contains any property set in the property drawer, +with its name in lowercase, the underscores replaced with hyphens +and colons at the beginning (i.e. `:custom-id'). + +When optional argument RAW-SECONDARY-P is non-nil, inline-task's +title will not be parsed as a secondary string, but as a plain +string instead. + +Assume point is at beginning of the inline task." + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (components (org-heading-components)) + (todo (nth 2 components)) + (todo-type (and todo + (if (member todo org-done-keywords) 'done 'todo))) + (tags (let ((raw-tags (nth 5 components))) + (and raw-tags (org-split-string raw-tags ":")))) + (raw-value (or (nth 4 components) "")) + ;; Normalize property names: ":SOME_PROP:" becomes + ;; ":some-prop". + (standard-props (let (plist) + (mapc + (lambda (p) + (let ((p-name (downcase (car p)))) + (while (string-match "_" p-name) + (setq p-name + (replace-match "-" nil nil p-name))) + (setq p-name (intern (concat ":" p-name))) + (setq plist + (plist-put plist p-name (cdr p))))) + (org-entry-properties nil 'standard)) + plist)) + (time-props (org-entry-properties nil 'special "CLOCK")) + (scheduled (cdr (assoc "SCHEDULED" time-props))) + (deadline (cdr (assoc "DEADLINE" time-props))) + (clock (cdr (assoc "CLOCK" time-props))) + (timestamp (cdr (assoc "TIMESTAMP" time-props))) + (task-end (save-excursion + (end-of-line) + (and (re-search-forward "^\\*+ END" limit t) + (match-beginning 0)))) + (contents-begin (progn (forward-line) + (and task-end (< (point) task-end) (point)))) + (hidden (and contents-begin (org-invisible-p2))) + (contents-end (and contents-begin task-end)) + (before-blank (if (not task-end) (point) + (goto-char task-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol)))) + (inlinetask + (list 'inlinetask + (nconc + (list :raw-value raw-value + :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :level (nth 1 components) + :priority (nth 3 components) + :tags tags + :todo-keyword todo + :todo-type todo-type + :scheduled scheduled + :deadline deadline + :timestamp timestamp + :clock clock + :post-blank (count-lines before-blank end)) + standard-props + (cadr keywords))))) + (org-element-put-property + inlinetask :title + (if raw-secondary-p raw-value + (org-element-parse-secondary-string + raw-value + (org-element-restriction 'inlinetask) + inlinetask)))))) + +(defun org-element-inlinetask-interpreter (inlinetask contents) + "Interpret INLINETASK element as Org syntax. +CONTENTS is the contents of inlinetask." + (let* ((level (org-element-property :level inlinetask)) + (todo (org-element-property :todo-keyword inlinetask)) + (priority (org-element-property :priority inlinetask)) + (title (org-element-interpret-data + (org-element-property :title inlinetask))) + (tags (let ((tag-list (org-element-property :tags inlinetask))) + (and tag-list + (format ":%s:" (mapconcat 'identity tag-list ":"))))) + (task (concat (make-string level ?*) + (and todo (concat " " todo)) + (and priority + (format " [#%s]" (char-to-string priority))) + (and title (concat " " title))))) + (concat task + ;; Align tags. + (when tags + (cond + ((zerop org-tags-column) (format " %s" tags)) + ((< org-tags-column 0) + (concat + (make-string + (max (- (+ org-tags-column (length task) (length tags))) 1) + ? ) + tags)) + (t + (concat + (make-string (max (- org-tags-column (length task)) 1) ? ) + tags)))) + ;; Prefer degenerate inlinetasks when there are no + ;; contents. + (when contents + (concat "\n" + contents + (make-string level ?*) " END"))))) + + +;;;; Item + +(defun org-element-item-parser (limit struct &optional raw-secondary-p) + "Parse an item. + +STRUCT is the structure of the plain list. + +Return a list whose CAR is `item' and CDR is a plist containing +`:bullet', `:begin', `:end', `:contents-begin', `:contents-end', +`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and +`:post-blank' keywords. + +When optional argument RAW-SECONDARY-P is non-nil, item's tag, if +any, will not be parsed as a secondary string, but as a plain +string instead. + +Assume point is at the beginning of the item." + (save-excursion + (beginning-of-line) + (looking-at org-list-full-item-re) + (let* ((begin (point)) + (bullet (org-match-string-no-properties 1)) + (checkbox (let ((box (org-match-string-no-properties 3))) + (cond ((equal "[ ]" box) 'off) + ((equal "[X]" box) 'on) + ((equal "[-]" box) 'trans)))) + (counter (let ((c (org-match-string-no-properties 2))) + (save-match-data + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string 0 c))))))) + (end (save-excursion (goto-char (org-list-get-item-end begin struct)) + (unless (bolp) (forward-line)) + (point))) + (contents-begin + (progn (goto-char + ;; Ignore tags in un-ordered lists: they are just + ;; a part of item's body. + (if (and (match-beginning 4) + (save-match-data (string-match "[.)]" bullet))) + (match-beginning 4) + (match-end 0))) + (skip-chars-forward " \r\t\n" limit) + ;; If first line isn't empty, contents really start + ;; at the text after item's meta-data. + (if (= (point-at-bol) begin) (point) (point-at-bol)))) + (hidden (progn (forward-line) + (and (not (= (point) end)) (org-invisible-p2)))) + (contents-end (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + (item + (list 'item + (list :bullet bullet + :begin begin + :end end + ;; CONTENTS-BEGIN and CONTENTS-END may be + ;; mixed up in the case of an empty item + ;; separated from the next by a blank line. + ;; Thus ensure the former is always the + ;; smallest. + :contents-begin (min contents-begin contents-end) + :contents-end (max contents-begin contents-end) + :checkbox checkbox + :counter counter + :hiddenp hidden + :structure struct + :post-blank (count-lines contents-end end))))) + (org-element-put-property + item :tag + (let ((raw-tag (org-list-get-tag begin struct))) + (and raw-tag + (if raw-secondary-p raw-tag + (org-element-parse-secondary-string + raw-tag (org-element-restriction 'item) item)))))))) + +(defun org-element-item-interpreter (item contents) + "Interpret ITEM element as Org syntax. +CONTENTS is the contents of the element." + (let* ((bullet (org-list-bullet-string (org-element-property :bullet item))) + (checkbox (org-element-property :checkbox item)) + (counter (org-element-property :counter item)) + (tag (let ((tag (org-element-property :tag item))) + (and tag (org-element-interpret-data tag)))) + ;; Compute indentation. + (ind (make-string (length bullet) 32)) + (item-starts-with-par-p + (eq (org-element-type (car (org-element-contents item))) + 'paragraph))) + ;; Indent contents. + (concat + bullet + (and counter (format "[@%d] " counter)) + (case checkbox + (on "[X] ") + (off "[ ] ") + (trans "[-] ")) + (and tag (format "%s :: " tag)) + (let ((contents (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))) + (if item-starts-with-par-p (org-trim contents) + (concat "\n" contents)))))) + + +;;;; Plain List + +(defun org-element-plain-list-parser (limit &optional structure) + "Parse a plain list. + +Optional argument STRUCTURE, when non-nil, is the structure of +the plain list being parsed. + +Return a list whose CAR is `plain-list' and CDR is a plist +containing `:type', `:begin', `:end', `:contents-begin' and +`:contents-end', `:structure' and `:post-blank' keywords. + +Assume point is at the beginning of the list." + (save-excursion + (let* ((struct (or structure (org-list-struct))) + (prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct)) + (type (org-list-get-list-type (point) struct prevs)) + (contents-begin (point)) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (contents-end + (progn (goto-char (org-list-get-list-end (point) struct prevs)) + (unless (bolp) (forward-line)) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + ;; Return value. + (list 'plain-list + (nconc + (list :type type + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :structure struct + :post-blank (count-lines contents-end end)) + (cadr keywords)))))) + +(defun org-element-plain-list-interpreter (plain-list contents) + "Interpret PLAIN-LIST element as Org syntax. +CONTENTS is the contents of the element." + (with-temp-buffer + (insert contents) + (goto-char (point-min)) + (org-list-repair) + (buffer-string))) + + +;;;; Quote Block + +(defun org-element-quote-block-parser (limit) + "Parse a quote block. + +LIMIT bounds the search. + +Return a list whose CAR is `quote-block' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end' and `:post-blank' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_QUOTE" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'quote-block + (nconc + (list :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-quote-block-interpreter (quote-block contents) + "Interpret QUOTE-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents)) + + +;;;; Section + +(defun org-element-section-parser (limit) + "Parse a section. + +LIMIT bounds the search. + +Return a list whose CAR is `section' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `contents-end' +and `:post-blank' keywords." + (save-excursion + ;; Beginning of section is the beginning of the first non-blank + ;; line after previous headline. + (let ((begin (point)) + (end (progn (org-with-limited-levels (outline-next-heading)) + (point))) + (pos-before-blank (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point)))) + (list 'section + (list :begin begin + :end end + :contents-begin begin + :contents-end pos-before-blank + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-section-interpreter (section contents) + "Interpret SECTION element as Org syntax. +CONTENTS is the contents of the element." + contents) + + +;;;; Special Block + +(defun org-element-special-block-parser (limit) + "Parse a special block. + +LIMIT bounds the search. + +Return a list whose CAR is `special-block' and CDR is a plist +containing `:type', `:begin', `:end', `:hiddenp', +`:contents-begin', `:contents-end' and `:post-blank' keywords. + +Assume point is at the beginning of the block." + (let* ((case-fold-search t) + (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(S-+\\)") + (upcase (match-string-no-properties 1))))) + (if (not (save-excursion + (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) + (list 'special-block + (nconc + (list :type type + :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-special-block-interpreter (special-block contents) + "Interpret SPECIAL-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (let ((block-type (org-element-property :type special-block))) + (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type))) + + + +;;; Elements +;; +;; For each element, a parser and an interpreter are also defined. +;; Both follow the same naming convention used for greater elements. +;; +;; Also, as for greater elements, adding a new element type is done +;; through the following steps: implement a parser and an interpreter, +;; tweak `org-element--current-element' so that it recognizes the new +;; type and add that new type to `org-element-all-elements'. +;; +;; As a special case, when the newly defined type is a block type, +;; `org-element-block-name-alist' has to be modified accordingly. + + +;;;; Babel Call + +(defun org-element-babel-call-parser (limit) + "Parse a babel call. + +LIMIT bounds the search. + +Return a list whose CAR is `babel-call' and CDR is a plist +containing `:begin', `:end', `:info' and `:post-blank' as +keywords." + (save-excursion + (let ((case-fold-search t) + (info (progn (looking-at org-babel-block-lob-one-liner-regexp) + (org-babel-lob-get-info))) + (begin (point-at-bol)) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'babel-call + (list :begin begin + :end end + :info info + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-babel-call-interpreter (babel-call contents) + "Interpret BABEL-CALL element as Org syntax. +CONTENTS is nil." + (let* ((babel-info (org-element-property :info babel-call)) + (main (car babel-info)) + (post-options (nth 1 babel-info))) + (concat "#+CALL: " + (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main + ;; Remove redundant square brackets. + (replace-match (match-string 1 main) nil nil main)) + (and post-options (format "[%s]" post-options))))) + + +;;;; Clock + +(defun org-element-clock-parser (limit) + "Parse a clock. + +LIMIT bounds the search. + +Return a list whose CAR is `clock' and CDR is a plist containing +`:status', `:value', `:time', `:begin', `:end' and `:post-blank' +as keywords." + (save-excursion + (let* ((case-fold-search nil) + (begin (point)) + (value (progn (search-forward org-clock-string (line-end-position) t) + (org-skip-whitespace) + (looking-at "\\[.*\\]") + (org-match-string-no-properties 0))) + (time (and (progn (goto-char (match-end 0)) + (looking-at " +=> +\\(\\S-+\\)[ \t]*$")) + (org-match-string-no-properties 1))) + (status (if time 'closed 'running)) + (post-blank (let ((before-blank (progn (forward-line) (point)))) + (skip-chars-forward " \r\t\n" limit) + (unless (eobp) (beginning-of-line)) + (count-lines before-blank (point)))) + (end (point))) + (list 'clock + (list :status status + :value value + :time time + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-clock-interpreter (clock contents) + "Interpret CLOCK element as Org syntax. +CONTENTS is nil." + (concat org-clock-string " " + (org-element-property :value clock) + (let ((time (org-element-property :time clock))) + (and time + (concat " => " + (apply 'format + "%2s:%02s" + (org-split-string time ":"))))))) + + +;;;; Comment + +(defun org-element-comment-parser (limit) + "Parse a comment. + +LIMIT bounds the search. + +Return a list whose CAR is `comment' and CDR is a plist +containing `:begin', `:end', `:value' and `:post-blank' +keywords. + +Assume point is at comment beginning." + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (value (prog2 (looking-at "[ \t]*# ?") + (buffer-substring-no-properties + (match-end 0) (line-end-position)) + (forward-line))) + (com-end + ;; Get comments ending. + (progn + (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)")) + ;; Accumulate lines without leading hash and first + ;; whitespace. + (setq value + (concat value + "\n" + (buffer-substring-no-properties + (match-end 0) (line-end-position)))) + (forward-line)) + (point))) + (end (progn (goto-char com-end) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'comment + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines com-end end)) + (cadr keywords)))))) + +(defun org-element-comment-interpreter (comment contents) + "Interpret COMMENT element as Org syntax. +CONTENTS is nil." + (replace-regexp-in-string "^" "# " (org-element-property :value comment))) + + +;;;; Comment Block + +(defun org-element-comment-block-parser (limit) + "Parse an export block. + +LIMIT bounds the search. + +Return a list whose CAR is `comment-block' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:value' and +`:post-blank' keywords. + +Assume point is at comment block beginning." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_COMMENT" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol)))) + (value (buffer-substring-no-properties + contents-begin contents-end))) + (list 'comment-block + (nconc + (list :begin begin + :end end + :value value + :hiddenp hidden + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-comment-block-interpreter (comment-block contents) + "Interpret COMMENT-BLOCK element as Org syntax. +CONTENTS is nil." + (format "#+BEGIN_COMMENT\n%s#+END_COMMENT" + (org-remove-indentation (org-element-property :value comment-block)))) + + +;;;; Example Block + +(defun org-element-example-block-parser (limit) + "Parse an example block. + +LIMIT bounds the search. + +Return a list whose CAR is `example-block' and CDR is a plist +containing `:begin', `:end', `:number-lines', `:preserve-indent', +`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp', +`:switches', `:value' and `:post-blank' keywords." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_EXAMPLE" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((switches + (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") + (org-match-string-no-properties 1))) + ;; Switches analysis + (number-lines (cond ((not switches) nil) + ((string-match "-n\\>" switches) 'new) + ((string-match "+n\\>" switches) 'continued))) + (preserve-indent (and switches (string-match "-i\\>" switches))) + ;; Should labels be retained in (or stripped from) example + ;; blocks? + (retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches)))) + ;; What should code-references use - labels or + ;; line-numbers? + (use-labels + (or (not switches) + (and retain-labels (not (string-match "-k\\>" switches))))) + (label-fmt (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches))) + ;; Standard block parsing. + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (value (buffer-substring-no-properties contents-begin contents-end)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'example-block + (nconc + (list :begin begin + :end end + :value value + :switches switches + :number-lines number-lines + :preserve-indent preserve-indent + :retain-labels retain-labels + :use-labels use-labels + :label-fmt label-fmt + :hiddenp hidden + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-example-block-interpreter (example-block contents) + "Interpret EXAMPLE-BLOCK element as Org syntax. +CONTENTS is nil." + (let ((switches (org-element-property :switches example-block))) + (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n" + (org-remove-indentation + (org-element-property :value example-block)) + "#+END_EXAMPLE"))) + + +;;;; Export Block + +(defun org-element-export-block-parser (limit) + "Parse an export block. + +LIMIT bounds the search. + +Return a list whose CAR is `export-block' and CDR is a plist +containing `:begin', `:end', `:type', `:hiddenp', `:value' and +`:post-blank' keywords. + +Assume point is at export-block beginning." + (let* ((case-fold-search t) + (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") + (upcase (org-match-string-no-properties 1))))) + (if (not (save-excursion + (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol)))) + (value (buffer-substring-no-properties contents-begin + contents-end))) + (list 'export-block + (nconc + (list :begin begin + :end end + :type type + :value value + :hiddenp hidden + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-export-block-interpreter (export-block contents) + "Interpret EXPORT-BLOCK element as Org syntax. +CONTENTS is nil." + (let ((type (org-element-property :type export-block))) + (concat (format "#+BEGIN_%s\n" type) + (org-element-property :value export-block) + (format "#+END_%s" type)))) + + +;;;; Fixed-width + +(defun org-element-fixed-width-parser (limit) + "Parse a fixed-width section. + +LIMIT bounds the search. + +Return a list whose CAR is `fixed-width' and CDR is a plist +containing `:begin', `:end', `:value' and `:post-blank' keywords. + +Assume point is at the beginning of the fixed-width area." + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + value + (end-area + (progn + (while (and (< (point) limit) + (looking-at "[ \t]*:\\( \\|$\\)")) + ;; Accumulate text without starting colons. + (setq value + (concat value + (buffer-substring-no-properties + (match-end 0) (point-at-eol)) + "\n")) + (forward-line)) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'fixed-width + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines end-area end)) + (cadr keywords)))))) + +(defun org-element-fixed-width-interpreter (fixed-width contents) + "Interpret FIXED-WIDTH element as Org syntax. +CONTENTS is nil." + (replace-regexp-in-string + "^" ": " (substring (org-element-property :value fixed-width) 0 -1))) + + +;;;; Horizontal Rule + +(defun org-element-horizontal-rule-parser (limit) + "Parse an horizontal rule. + +LIMIT bounds the search. + +Return a list whose CAR is `horizontal-rule' and CDR is a plist +containing `:begin', `:end' and `:post-blank' keywords." + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (post-hr (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'horizontal-rule + (nconc + (list :begin begin + :end end + :post-blank (count-lines post-hr end)) + (cadr keywords)))))) + +(defun org-element-horizontal-rule-interpreter (horizontal-rule contents) + "Interpret HORIZONTAL-RULE element as Org syntax. +CONTENTS is nil." + "-----") + + +;;;; Keyword + +(defun org-element-keyword-parser (limit) + "Parse a keyword at point. + +LIMIT bounds the search. + +Return a list whose CAR is `keyword' and CDR is a plist +containing `:key', `:value', `:begin', `:end' and `:post-blank' +keywords." + (save-excursion + (let* ((case-fold-search t) + (begin (point)) + (key (progn (looking-at "[ \t]*#\\+\\(\\S-+\\):") + (upcase (org-match-string-no-properties 1)))) + (value (org-trim (buffer-substring-no-properties + (match-end 0) (point-at-eol)))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'keyword + (list :key key + :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-keyword-interpreter (keyword contents) + "Interpret KEYWORD element as Org syntax. +CONTENTS is nil." + (format "#+%s: %s" + (org-element-property :key keyword) + (org-element-property :value keyword))) + + +;;;; Latex Environment + +(defun org-element-latex-environment-parser (limit) + "Parse a LaTeX environment. + +LIMIT bounds the search. + +Return a list whose CAR is `latex-environment' and CDR is a plist +containing `:begin', `:end', `:value' and `:post-blank' +keywords. + +Assume point is at the beginning of the latex environment." + (save-excursion + (let* ((case-fold-search t) + (code-begin (point)) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (env (progn (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") + (regexp-quote (match-string 1)))) + (code-end + (progn (re-search-forward (format "^[ \t]*\\\\end{%s}" env) limit t) + (forward-line) + (point))) + (value (buffer-substring-no-properties code-begin code-end)) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'latex-environment + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines code-end end)) + (cadr keywords)))))) + +(defun org-element-latex-environment-interpreter (latex-environment contents) + "Interpret LATEX-ENVIRONMENT element as Org syntax. +CONTENTS is nil." + (org-element-property :value latex-environment)) + + +;;;; Paragraph + +(defun org-element-paragraph-parser (limit) + "Parse a paragraph. + +LIMIT bounds the search. + +Return a list whose CAR is `paragraph' and CDR is a plist +containing `:begin', `:end', `:contents-begin' and +`:contents-end' and `:post-blank' keywords. + +Assume point is at the beginning of the paragraph." + (save-excursion + (let* (;; INNER-PAR-P is non-nil when paragraph is at the + ;; beginning of an item or a footnote reference. In that + ;; case, we mustn't look for affiliated keywords since they + ;; belong to the container. + (inner-par-p (not (bolp))) + (contents-begin (point)) + (keywords (unless inner-par-p + (org-element--collect-affiliated-keywords))) + (begin (if inner-par-p contents-begin (car keywords))) + (before-blank + (let ((case-fold-search t)) + (end-of-line) + (re-search-forward org-element-paragraph-separate limit 'm) + (while (and (/= (point) limit) + (cond + ;; Skip non-existent or incomplete drawer. + ((save-excursion + (beginning-of-line) + (and (looking-at "[ \t]*:\\S-") + (or (not (looking-at org-drawer-regexp)) + (not (save-excursion + (re-search-forward + "^[ \t]*:END:" limit t))))))) + ;; Stop at comments. + ((save-excursion + (beginning-of-line) + (not (looking-at "[ \t]*#\\S-"))) nil) + ;; Skip incomplete dynamic blocks. + ((save-excursion + (beginning-of-line) + (looking-at "[ \t]*#\\+BEGIN: ")) + (not (save-excursion + (re-search-forward + "^[ \t]*\\+END:" limit t)))) + ;; Skip incomplete blocks. + ((save-excursion + (beginning-of-line) + (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")) + (not (save-excursion + (re-search-forward + (concat "^[ \t]*#\\+END_" + (match-string 1)) + limit t)))) + ;; Skip incomplete latex environments. + ((save-excursion + (beginning-of-line) + (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")) + (not (save-excursion + (re-search-forward + (format "^[ \t]*\\\\end{%s}" + (match-string 1)) + limit t)))) + ;; Skip ill-formed keywords. + ((not (save-excursion + (beginning-of-line) + (looking-at "[ \t]*#\\+\\S-+:")))))) + (re-search-forward org-element-paragraph-separate limit 'm)) + (if (eobp) (point) (goto-char (line-beginning-position))))) + (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'paragraph + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines before-blank end)) + (cadr keywords)))))) + +(defun org-element-paragraph-interpreter (paragraph contents) + "Interpret PARAGRAPH element as Org syntax. +CONTENTS is the contents of the element." + contents) + + +;;;; Planning + +(defun org-element-planning-parser (limit) + "Parse a planning. + +LIMIT bounds the search. + +Return a list whose CAR is `planning' and CDR is a plist +containing `:closed', `:deadline', `:scheduled', `:begin', `:end' +and `:post-blank' keywords." + (save-excursion + (let* ((case-fold-search nil) + (begin (point)) + (post-blank (let ((before-blank (progn (forward-line) (point)))) + (skip-chars-forward " \r\t\n" limit) + (unless (eobp) (beginning-of-line)) + (count-lines before-blank (point)))) + (end (point)) + closed deadline scheduled) + (goto-char begin) + (while (re-search-forward org-keyword-time-not-clock-regexp + (line-end-position) t) + (goto-char (match-end 1)) + (org-skip-whitespace) + (let ((time (buffer-substring-no-properties + (1+ (point)) (1- (match-end 0)))) + (keyword (match-string 1))) + (cond ((equal keyword org-closed-string) (setq closed time)) + ((equal keyword org-deadline-string) (setq deadline time)) + (t (setq scheduled time))))) + (list 'planning + (list :closed closed + :deadline deadline + :scheduled scheduled + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-planning-interpreter (planning contents) + "Interpret PLANNING element as Org syntax. +CONTENTS is nil." + (mapconcat + 'identity + (delq nil + (list (let ((closed (org-element-property :closed planning))) + (when closed (concat org-closed-string " [" closed "]"))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline (concat org-deadline-string " <" deadline ">"))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat org-scheduled-string " <" scheduled ">"))))) + " ")) + + +;;;; Property Drawer + +(defun org-element-property-drawer-parser (limit) + "Parse a property drawer. + +LIMIT bounds the search. + +Return a list whose CAR is `property-drawer' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end', `:properties' and `:post-blank' keywords. + +Assume point is at the beginning of the property drawer." + (save-excursion + (let ((case-fold-search t) + (begin (point)) + (prop-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (properties + (let (val) + (while (not (looking-at "^[ \t]*:END:")) + (when (looking-at "[ \t]*:\\([A-Za-z][-_A-Za-z0-9]*\\):") + (push (cons (org-match-string-no-properties 1) + (org-trim + (buffer-substring-no-properties + (match-end 0) (point-at-eol)))) + val)) + (forward-line)) + val)) + (prop-end (progn (re-search-forward "^[ \t]*:END:" limit t) + (point-at-bol))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'property-drawer + (list :begin begin + :end end + :hiddenp hidden + :properties properties + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-property-drawer-interpreter (property-drawer contents) + "Interpret PROPERTY-DRAWER element as Org syntax. +CONTENTS is nil." + (let ((props (org-element-property :properties property-drawer))) + (concat + ":PROPERTIES:\n" + (mapconcat (lambda (p) + (format org-property-format (format ":%s:" (car p)) (cdr p))) + (nreverse props) "\n") + "\n:END:"))) + + +;;;; Quote Section + +(defun org-element-quote-section-parser (limit) + "Parse a quote section. + +LIMIT bounds the search. + +Return a list whose CAR is `quote-section' and CDR is a plist +containing `:begin', `:end', `:value' and `:post-blank' keywords. + +Assume point is at beginning of the section." + (save-excursion + (let* ((begin (point)) + (end (progn (org-with-limited-levels (outline-next-heading)) + (point))) + (pos-before-blank (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + (value (buffer-substring-no-properties begin pos-before-blank))) + (list 'quote-section + (list :begin begin + :end end + :value value + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-quote-section-interpreter (quote-section contents) + "Interpret QUOTE-SECTION element as Org syntax. +CONTENTS is nil." + (org-element-property :value quote-section)) + + +;;;; Src Block + +(defun org-element-src-block-parser (limit) + "Parse a src block. + +LIMIT bounds the search. + +Return a list whose CAR is `src-block' and CDR is a plist +containing `:language', `:switches', `:parameters', `:begin', +`:end', `:hiddenp', `:number-lines', `:retain-labels', +`:use-labels', `:label-fmt', `:preserve-indent', `:value' and +`:post-blank' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + ;; Get beginning position. + (begin (car keywords)) + ;; Get language as a string. + (language + (progn + (looking-at + (concat "^[ \t]*#\\+BEGIN_SRC" + "\\(?: +\\(\\S-+\\)\\)?" + "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?" + "\\(.*\\)[ \t]*$")) + (org-match-string-no-properties 1))) + ;; Get switches. + (switches (org-match-string-no-properties 2)) + ;; Get parameters. + (parameters (org-match-string-no-properties 3)) + ;; Switches analysis + (number-lines (cond ((not switches) nil) + ((string-match "-n\\>" switches) 'new) + ((string-match "+n\\>" switches) 'continued))) + (preserve-indent (and switches (string-match "-i\\>" switches))) + (label-fmt (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches))) + ;; Should labels be retained in (or stripped from) + ;; src blocks? + (retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches)))) + ;; What should code-references use - labels or + ;; line-numbers? + (use-labels + (or (not switches) + (and retain-labels (not (string-match "-k\\>" switches))))) + ;; Get visibility status. + (hidden (progn (forward-line) (org-invisible-p2))) + ;; Retrieve code. + (value (buffer-substring-no-properties (point) contents-end)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + ;; Get position after ending blank lines. + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'src-block + (nconc + (list :language language + :switches (and (org-string-nw-p switches) + (org-trim switches)) + :parameters (and (org-string-nw-p parameters) + (org-trim parameters)) + :begin begin + :end end + :number-lines number-lines + :preserve-indent preserve-indent + :retain-labels retain-labels + :use-labels use-labels + :label-fmt label-fmt + :hiddenp hidden + :value value + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-src-block-interpreter (src-block contents) + "Interpret SRC-BLOCK element as Org syntax. +CONTENTS is nil." + (let ((lang (org-element-property :language src-block)) + (switches (org-element-property :switches src-block)) + (params (org-element-property :parameters src-block)) + (value (let ((val (org-element-property :value src-block))) + (cond + + (org-src-preserve-indentation val) + ((zerop org-edit-src-content-indentation) + (org-remove-indentation val)) + (t + (let ((ind (make-string + org-edit-src-content-indentation 32))) + (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" ind + (org-remove-indentation val) nil nil 1))))))) + (concat (format "#+BEGIN_SRC%s\n" + (concat (and lang (concat " " lang)) + (and switches (concat " " switches)) + (and params (concat " " params)))) + value + "#+END_SRC"))) + + +;;;; Table + +(defun org-element-table-parser (limit) + "Parse a table at point. + +LIMIT bounds the search. + +Return a list whose CAR is `table' and CDR is a plist containing +`:begin', `:end', `:tblfm', `:type', `:contents-begin', +`:contents-end', `:value' and `:post-blank' keywords. + +Assume point is at the beginning of the table." + (save-excursion + (let* ((case-fold-search t) + (table-begin (point)) + (type (if (org-at-table.el-p) 'table.el 'org)) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (table-end (goto-char (marker-position (org-table-end t)))) + (tblfm (let (acc) + (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") + (push (org-match-string-no-properties 1) acc) + (forward-line)) + acc)) + (pos-before-blank (point)) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'table + (nconc + (list :begin begin + :end end + :type type + :tblfm tblfm + ;; Only `org' tables have contents. `table.el' tables + ;; use a `:value' property to store raw table as + ;; a string. + :contents-begin (and (eq type 'org) table-begin) + :contents-end (and (eq type 'org) table-end) + :value (and (eq type 'table.el) + (buffer-substring-no-properties + table-begin table-end)) + :post-blank (count-lines pos-before-blank end)) + (cadr keywords)))))) + +(defun org-element-table-interpreter (table contents) + "Interpret TABLE element as Org syntax. +CONTENTS is nil." + (if (eq (org-element-property :type table) 'table.el) + (org-remove-indentation (org-element-property :value table)) + (concat (with-temp-buffer (insert contents) + (org-table-align) + (buffer-string)) + (mapconcat (lambda (fm) (concat "#+TBLFM: " fm)) + (reverse (org-element-property :tblfm table)) + "\n")))) + + +;;;; Table Row + +(defun org-element-table-row-parser (limit) + "Parse table row at point. + +LIMIT bounds the search. + +Return a list whose CAR is `table-row' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:type' and `:post-blank' keywords." + (save-excursion + (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard)) + (begin (point)) + ;; A table rule has no contents. In that case, ensure + ;; CONTENTS-BEGIN matches CONTENTS-END. + (contents-begin (and (eq type 'standard) + (search-forward "|") + (point))) + (contents-end (and (eq type 'standard) + (progn + (end-of-line) + (skip-chars-backward " \t") + (point)))) + (end (progn (forward-line) (point)))) + (list 'table-row + (list :type type + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank 0))))) + +(defun org-element-table-row-interpreter (table-row contents) + "Interpret TABLE-ROW element as Org syntax. +CONTENTS is the contents of the table row." + (if (eq (org-element-property :type table-row) 'rule) "|-" + (concat "| " contents))) + + +;;;; Verse Block + +(defun org-element-verse-block-parser (limit) + "Parse a verse block. + +LIMIT bounds the search. + +Return a list whose CAR is `verse-block' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:hiddenp' and `:post-blank' keywords. + +Assume point is at beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_VERSE" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (hidden (progn (forward-line) (org-invisible-p2))) + (contents-begin (point)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'verse-block + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :hiddenp hidden + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-verse-block-interpreter (verse-block contents) + "Interpret VERSE-BLOCK element as Org syntax. +CONTENTS is verse block contents." + (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents)) + + + +;;; Objects +;; +;; Unlike to elements, interstices can be found between objects. +;; That's why, along with the parser, successor functions are provided +;; for each object. Some objects share the same successor (i.e. `code' +;; and `verbatim' objects). +;; +;; A successor must accept a single argument bounding the search. It +;; will return either a cons cell whose CAR is the object's type, as +;; a symbol, and CDR the position of its next occurrence, or nil. +;; +;; Successors follow the naming convention: +;; org-element-NAME-successor, where NAME is the name of the +;; successor, as defined in `org-element-all-successors'. +;; +;; Some object types (i.e. `italic') are recursive. Restrictions on +;; object types they can contain will be specified in +;; `org-element-object-restrictions'. +;; +;; Adding a new type of object is simple. Implement a successor, +;; a parser, and an interpreter for it, all following the naming +;; convention. Register type in `org-element-all-objects' and +;; successor in `org-element-all-successors'. Maybe tweak +;; restrictions about it, and that's it. + + +;;;; Bold + +(defun org-element-bold-parser () + "Parse bold object at point. + +Return a list whose CAR is `bold' and CDR is a plist with +`:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first star marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'bold + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-bold-interpreter (bold contents) + "Interpret BOLD object as Org syntax. +CONTENTS is the contents of the object." + (format "*%s*" contents)) + +(defun org-element-text-markup-successor (limit) + "Search for the next text-markup object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is a symbol among `bold', +`italic', `underline', `strike-through', `code' and `verbatim' +and CDR is beginning position." + (save-excursion + (unless (bolp) (backward-char)) + (when (re-search-forward org-emph-re limit t) + (let ((marker (match-string 3))) + (cons (cond + ((equal marker "*") 'bold) + ((equal marker "/") 'italic) + ((equal marker "_") 'underline) + ((equal marker "+") 'strike-through) + ((equal marker "~") 'code) + ((equal marker "=") 'verbatim) + (t (error "Unknown marker at %d" (match-beginning 3)))) + (match-beginning 2)))))) + + +;;;; Code + +(defun org-element-code-parser () + "Parse code object at point. + +Return a list whose CAR is `code' and CDR is a plist with +`:value', `:begin', `:end' and `:post-blank' keywords. + +Assume point is at the first tilde marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (value (org-match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'code + (list :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-code-interpreter (code contents) + "Interpret CODE object as Org syntax. +CONTENTS is nil." + (format "~%s~" (org-element-property :value code))) + + +;;;; Entity + +(defun org-element-entity-parser () + "Parse entity at point. + +Return a list whose CAR is `entity' and CDR a plist with +`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1', +`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as +keywords. + +Assume point is at the beginning of the entity." + (save-excursion + (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)") + (let* ((value (org-entity-get (match-string 1))) + (begin (match-beginning 0)) + (bracketsp (string= (match-string 2) "{}")) + (post-blank (progn (goto-char (match-end 1)) + (when bracketsp (forward-char 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'entity + (list :name (car value) + :latex (nth 1 value) + :latex-math-p (nth 2 value) + :html (nth 3 value) + :ascii (nth 4 value) + :latin1 (nth 5 value) + :utf-8 (nth 6 value) + :begin begin + :end end + :use-brackets-p bracketsp + :post-blank post-blank))))) + +(defun org-element-entity-interpreter (entity contents) + "Interpret ENTITY object as Org syntax. +CONTENTS is nil." + (concat "\\" + (org-element-property :name entity) + (when (org-element-property :use-brackets-p entity) "{}"))) + +(defun org-element-latex-or-entity-successor (limit) + "Search for the next latex-fragment or entity object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `entity' or +`latex-fragment' and CDR is beginning position." + (save-excursion + (let ((matchers + (remove "begin" (plist-get org-format-latex-options :matchers))) + ;; ENTITY-RE matches both LaTeX commands and Org entities. + (entity-re + "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")) + (when (re-search-forward + (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps))) + matchers "\\|") + "\\|" entity-re) + limit t) + (goto-char (match-beginning 0)) + (if (looking-at entity-re) + ;; Determine if it's a real entity or a LaTeX command. + (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment) + (match-beginning 0)) + ;; No entity nor command: point is at a LaTeX fragment. + ;; Determine its type to get the correct beginning position. + (cons 'latex-fragment + (catch 'return + (mapc (lambda (e) + (when (looking-at (nth 1 (assoc e org-latex-regexps))) + (throw 'return + (match-beginning + (nth 2 (assoc e org-latex-regexps)))))) + matchers) + (point)))))))) + + +;;;; Export Snippet + +(defun org-element-export-snippet-parser () + "Parse export snippet at point. + +Return a list whose CAR is `export-snippet' and CDR a plist with +`:begin', `:end', `:back-end', `:value' and `:post-blank' as +keywords. + +Assume point is at the beginning of the snippet." + (save-excursion + (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t) + (let* ((begin (match-beginning 0)) + (back-end (org-match-string-no-properties 1)) + (value (buffer-substring-no-properties + (point) + (progn (re-search-forward "@@" nil t) (match-beginning 0)))) + (post-blank (skip-chars-forward " \t")) + (end (point))) + (list 'export-snippet + (list :back-end back-end + :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-export-snippet-interpreter (export-snippet contents) + "Interpret EXPORT-SNIPPET object as Org syntax. +CONTENTS is nil." + (format "@@%s:%s@@" + (org-element-property :back-end export-snippet) + (org-element-property :value export-snippet))) + +(defun org-element-export-snippet-successor (limit) + "Search for the next export-snippet object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `export-snippet' and CDR +its beginning position." + (save-excursion + (let (beg) + (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t) + (setq beg (match-beginning 0)) + (search-forward "@@" limit t)) + (cons 'export-snippet beg))))) + + +;;;; Footnote Reference + +(defun org-element-footnote-reference-parser () + "Parse footnote reference at point. + +Return a list whose CAR is `footnote-reference' and CDR a plist +with `:label', `:type', `:inline-definition', `:begin', `:end' +and `:post-blank' as keywords." + (save-excursion + (looking-at org-footnote-re) + (let* ((begin (point)) + (label (or (org-match-string-no-properties 2) + (org-match-string-no-properties 3) + (and (match-string 1) + (concat "fn:" (org-match-string-no-properties 1))))) + (type (if (or (not label) (match-string 1)) 'inline 'standard)) + (inner-begin (match-end 0)) + (inner-end + (let ((count 1)) + (forward-char) + (while (and (> count 0) (re-search-forward "[][]" nil t)) + (if (equal (match-string 0) "[") (incf count) (decf count))) + (1- (point)))) + (post-blank (progn (goto-char (1+ inner-end)) + (skip-chars-forward " \t"))) + (end (point)) + (footnote-reference + (list 'footnote-reference + (list :label label + :type type + :begin begin + :end end + :post-blank post-blank)))) + (org-element-put-property + footnote-reference :inline-definition + (and (eq type 'inline) + (org-element-parse-secondary-string + (buffer-substring inner-begin inner-end) + (org-element-restriction 'footnote-reference) + footnote-reference)))))) + +(defun org-element-footnote-reference-interpreter (footnote-reference contents) + "Interpret FOOTNOTE-REFERENCE object as Org syntax. +CONTENTS is nil." + (let ((label (or (org-element-property :label footnote-reference) "fn:")) + (def + (let ((inline-def + (org-element-property :inline-definition footnote-reference))) + (if (not inline-def) "" + (concat ":" (org-element-interpret-data inline-def)))))) + (format "[%s]" (concat label def)))) + +(defun org-element-footnote-reference-successor (limit) + "Search for the next footnote-reference object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `footnote-reference' and +CDR is beginning position." + (save-excursion + (catch 'exit + (while (re-search-forward org-footnote-re limit t) + (save-excursion + (let ((beg (match-beginning 0)) + (count 1)) + (backward-char) + (while (re-search-forward "[][]" limit t) + (if (equal (match-string 0) "[") (incf count) (decf count)) + (when (zerop count) + (throw 'exit (cons 'footnote-reference beg)))))))))) + + +;;;; Inline Babel Call + +(defun org-element-inline-babel-call-parser () + "Parse inline babel call at point. + +Return a list whose CAR is `inline-babel-call' and CDR a plist +with `:begin', `:end', `:info' and `:post-blank' as keywords. + +Assume point is at the beginning of the babel call." + (save-excursion + (unless (bolp) (backward-char)) + (looking-at org-babel-inline-lob-one-liner-regexp) + (let ((info (save-match-data (org-babel-lob-get-info))) + (begin (match-end 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'inline-babel-call + (list :begin begin + :end end + :info info + :post-blank post-blank))))) + +(defun org-element-inline-babel-call-interpreter (inline-babel-call contents) + "Interpret INLINE-BABEL-CALL object as Org syntax. +CONTENTS is nil." + (let* ((babel-info (org-element-property :info inline-babel-call)) + (main-source (car babel-info)) + (post-options (nth 1 babel-info))) + (concat "call_" + (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source) + ;; Remove redundant square brackets. + (replace-match + (match-string 1 main-source) nil nil main-source) + main-source) + (and post-options (format "[%s]" post-options))))) + +(defun org-element-inline-babel-call-successor (limit) + "Search for the next inline-babel-call object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `inline-babel-call' and +CDR is beginning position." + (save-excursion + ;; Use a simplified version of + ;; `org-babel-inline-lob-one-liner-regexp'. + (when (re-search-forward + "call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?" + limit t) + (cons 'inline-babel-call (match-beginning 0))))) + + +;;;; Inline Src Block + +(defun org-element-inline-src-block-parser () + "Parse inline source block at point. + +LIMIT bounds the search. + +Return a list whose CAR is `inline-src-block' and CDR a plist +with `:begin', `:end', `:language', `:value', `:parameters' and +`:post-blank' as keywords. + +Assume point is at the beginning of the inline src block." + (save-excursion + (unless (bolp) (backward-char)) + (looking-at org-babel-inline-src-block-regexp) + (let ((begin (match-beginning 1)) + (language (org-match-string-no-properties 2)) + (parameters (org-match-string-no-properties 4)) + (value (org-match-string-no-properties 5)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'inline-src-block + (list :language language + :value value + :parameters parameters + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-inline-src-block-interpreter (inline-src-block contents) + "Interpret INLINE-SRC-BLOCK object as Org syntax. +CONTENTS is nil." + (let ((language (org-element-property :language inline-src-block)) + (arguments (org-element-property :parameters inline-src-block)) + (body (org-element-property :value inline-src-block))) + (format "src_%s%s{%s}" + language + (if arguments (format "[%s]" arguments) "") + body))) + +(defun org-element-inline-src-block-successor (limit) + "Search for the next inline-babel-call element. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `inline-babel-call' and +CDR is beginning position." + (save-excursion + (unless (bolp) (backward-char)) + (when (re-search-forward org-babel-inline-src-block-regexp limit t) + (cons 'inline-src-block (match-beginning 1))))) + +;;;; Italic + +(defun org-element-italic-parser () + "Parse italic object at point. + +Return a list whose CAR is `italic' and CDR is a plist with +`:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first slash marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'italic + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-italic-interpreter (italic contents) + "Interpret ITALIC object as Org syntax. +CONTENTS is the contents of the object." + (format "/%s/" contents)) + + +;;;; Latex Fragment + +(defun org-element-latex-fragment-parser () + "Parse latex fragment at point. + +Return a list whose CAR is `latex-fragment' and CDR a plist with +`:value', `:begin', `:end', and `:post-blank' as keywords. + +Assume point is at the beginning of the latex fragment." + (save-excursion + (let* ((begin (point)) + (substring-match + (catch 'exit + (mapc (lambda (e) + (let ((latex-regexp (nth 1 (assoc e org-latex-regexps)))) + (when (or (looking-at latex-regexp) + (and (not (bobp)) + (save-excursion + (backward-char) + (looking-at latex-regexp)))) + (throw 'exit (nth 2 (assoc e org-latex-regexps)))))) + (plist-get org-format-latex-options :matchers)) + ;; None found: it's a macro. + (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*") + 0)) + (value (match-string-no-properties substring-match)) + (post-blank (progn (goto-char (match-end substring-match)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'latex-fragment + (list :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-latex-fragment-interpreter (latex-fragment contents) + "Interpret LATEX-FRAGMENT object as Org syntax. +CONTENTS is nil." + (org-element-property :value latex-fragment)) + +;;;; Line Break + +(defun org-element-line-break-parser () + "Parse line break at point. + +Return a list whose CAR is `line-break', and CDR a plist with +`:begin', `:end' and `:post-blank' keywords. + +Assume point is at the beginning of the line break." + (list 'line-break (list :begin (point) :end (point-at-eol) :post-blank 0))) + +(defun org-element-line-break-interpreter (line-break contents) + "Interpret LINE-BREAK object as Org syntax. +CONTENTS is nil." + "\\\\") + +(defun org-element-line-break-successor (limit) + "Search for the next line-break object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `line-break' and CDR is +beginning position." + (save-excursion + (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t) + (goto-char (match-beginning 1))))) + ;; A line break can only happen on a non-empty line. + (when (and beg (re-search-backward "\\S-" (point-at-bol) t)) + (cons 'line-break beg))))) + + +;;;; Link + +(defun org-element-link-parser () + "Parse link at point. + +Return a list whose CAR is `link' and CDR a plist with `:type', +`:path', `:raw-link', `:begin', `:end', `:contents-begin', +`:contents-end' and `:post-blank' as keywords. + +Assume point is at the beginning of the link." + (save-excursion + (let ((begin (point)) + end contents-begin contents-end link-end post-blank path type + raw-link link) + (cond + ;; Type 1: Text targeted from a radio target. + ((and org-target-link-regexp (looking-at org-target-link-regexp)) + (setq type "radio" + link-end (match-end 0) + path (org-match-string-no-properties 0))) + ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]] + ((looking-at org-bracket-link-regexp) + (setq contents-begin (match-beginning 3) + contents-end (match-end 3) + link-end (match-end 0) + ;; RAW-LINK is the original link. + raw-link (org-match-string-no-properties 1) + link (org-translate-link + (org-link-expand-abbrev + (org-link-unescape raw-link)))) + ;; Determine TYPE of link and set PATH accordingly. + (cond + ;; File type. + ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link)) + (setq type "file" path link)) + ;; Explicit type (http, irc, bbdb...). See `org-link-types'. + ((string-match org-link-re-with-space3 link) + (setq type (match-string 1 link) path (match-string 2 link))) + ;; Id type: PATH is the id. + ((string-match "^id:\\([-a-f0-9]+\\)" link) + (setq type "id" path (match-string 1 link))) + ;; Code-ref type: PATH is the name of the reference. + ((string-match "^(\\(.*\\))$" link) + (setq type "coderef" path (match-string 1 link))) + ;; Custom-id type: PATH is the name of the custom id. + ((= (aref link 0) ?#) + (setq type "custom-id" path (substring link 1))) + ;; Fuzzy type: Internal link either matches a target, an + ;; headline name or nothing. PATH is the target or + ;; headline's name. + (t (setq type "fuzzy" path link)))) + ;; Type 3: Plain link, i.e. http://orgmode.org + ((looking-at org-plain-link-re) + (setq raw-link (org-match-string-no-properties 0) + type (org-match-string-no-properties 1) + path (org-match-string-no-properties 2) + link-end (match-end 0))) + ;; Type 4: Angular link, i.e. <http://orgmode.org> + ((looking-at org-angle-link-re) + (setq raw-link (buffer-substring-no-properties + (match-beginning 1) (match-end 2)) + type (org-match-string-no-properties 1) + path (org-match-string-no-properties 2) + link-end (match-end 0)))) + ;; In any case, deduce end point after trailing white space from + ;; LINK-END variable. + (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t")) + end (point)) + (list 'link + (list :type type + :path path + :raw-link (or raw-link path) + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-link-interpreter (link contents) + "Interpret LINK object as Org syntax. +CONTENTS is the contents of the object, or nil." + (let ((type (org-element-property :type link)) + (raw-link (org-element-property :raw-link link))) + (if (string= type "radio") raw-link + (format "[[%s]%s]" + raw-link + (if contents (format "[%s]" contents) ""))))) + +(defun org-element-link-successor (limit) + "Search for the next link object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `link' and CDR is +beginning position." + (save-excursion + (let ((link-regexp + (if (not org-target-link-regexp) org-any-link-re + (concat org-any-link-re "\\|" org-target-link-regexp)))) + (when (re-search-forward link-regexp limit t) + (cons 'link (match-beginning 0)))))) + + +;;;; Macro + +(defun org-element-macro-parser () + "Parse macro at point. + +Return a list whose CAR is `macro' and CDR a plist with `:key', +`:args', `:begin', `:end', `:value' and `:post-blank' as +keywords. + +Assume point is at the macro." + (save-excursion + (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}") + (let ((begin (point)) + (key (downcase (org-match-string-no-properties 1))) + (value (org-match-string-no-properties 0)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point)) + (args (let ((args (org-match-string-no-properties 3)) args2) + (when args + (setq args (org-split-string args ",")) + (while args + (while (string-match "\\\\\\'" (car args)) + ;; Repair bad splits. + (setcar (cdr args) (concat (substring (car args) 0 -1) + "," (nth 1 args))) + (pop args)) + (push (pop args) args2)) + (mapcar 'org-trim (nreverse args2)))))) + (list 'macro + (list :key key + :value value + :args args + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-macro-interpreter (macro contents) + "Interpret MACRO object as Org syntax. +CONTENTS is nil." + (org-element-property :value macro)) + +(defun org-element-macro-successor (limit) + "Search for the next macro object. + +LIMIT bounds the search. + +Return value is cons cell whose CAR is `macro' and CDR is +beginning position." + (save-excursion + (when (re-search-forward + "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" + limit t) + (cons 'macro (match-beginning 0))))) + + +;;;; Radio-target + +(defun org-element-radio-target-parser () + "Parse radio target at point. + +Return a list whose CAR is `radio-target' and CDR a plist with +`:begin', `:end', `:contents-begin', `:contents-end', `:value' +and `:post-blank' as keywords. + +Assume point is at the radio target." + (save-excursion + (looking-at org-radio-target-regexp) + (let ((begin (point)) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1)) + (value (org-match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'radio-target + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank + :value value))))) + +(defun org-element-radio-target-interpreter (target contents) + "Interpret TARGET object as Org syntax. +CONTENTS is the contents of the object." + (concat "<<<" contents ">>>")) + +(defun org-element-radio-target-successor (limit) + "Search for the next radio-target object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `radio-target' and CDR +is beginning position." + (save-excursion + (when (re-search-forward org-radio-target-regexp limit t) + (cons 'radio-target (match-beginning 0))))) + + +;;;; Statistics Cookie + +(defun org-element-statistics-cookie-parser () + "Parse statistics cookie at point. + +Return a list whose CAR is `statistics-cookie', and CDR a plist +with `:begin', `:end', `:value' and `:post-blank' keywords. + +Assume point is at the beginning of the statistics-cookie." + (save-excursion + (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") + (let* ((begin (point)) + (value (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'statistics-cookie + (list :begin begin + :end end + :value value + :post-blank post-blank))))) + +(defun org-element-statistics-cookie-interpreter (statistics-cookie contents) + "Interpret STATISTICS-COOKIE object as Org syntax. +CONTENTS is nil." + (org-element-property :value statistics-cookie)) + +(defun org-element-statistics-cookie-successor (limit) + "Search for the next statistics cookie object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `statistics-cookie' and +CDR is beginning position." + (save-excursion + (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t) + (cons 'statistics-cookie (match-beginning 0))))) + + +;;;; Strike-Through + +(defun org-element-strike-through-parser () + "Parse strike-through object at point. + +Return a list whose CAR is `strike-through' and CDR is a plist +with `:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first plus sign marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'strike-through + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-strike-through-interpreter (strike-through contents) + "Interpret STRIKE-THROUGH object as Org syntax. +CONTENTS is the contents of the object." + (format "+%s+" contents)) + + +;;;; Subscript + +(defun org-element-subscript-parser () + "Parse subscript at point. + +Return a list whose CAR is `subscript' and CDR a plist with +`:begin', `:end', `:contents-begin', `:contents-end', +`:use-brackets-p' and `:post-blank' as keywords. + +Assume point is at the underscore." + (save-excursion + (unless (bolp) (backward-char)) + (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) + t + (not (looking-at org-match-substring-regexp)))) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 5) + (match-beginning 3))) + (contents-end (or (match-end 5) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'subscript + (list :begin begin + :end end + :use-brackets-p bracketsp + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-subscript-interpreter (subscript contents) + "Interpret SUBSCRIPT object as Org syntax. +CONTENTS is the contents of the object." + (format + (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") + contents)) + +(defun org-element-sub/superscript-successor (limit) + "Search for the next sub/superscript object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is either `subscript' or +`superscript' and CDR is beginning position." + (save-excursion + (when (re-search-forward org-match-substring-regexp limit t) + (cons (if (string= (match-string 2) "_") 'subscript 'superscript) + (match-beginning 2))))) + + +;;;; Superscript + +(defun org-element-superscript-parser () + "Parse superscript at point. + +Return a list whose CAR is `superscript' and CDR a plist with +`:begin', `:end', `:contents-begin', `:contents-end', +`:use-brackets-p' and `:post-blank' as keywords. + +Assume point is at the caret." + (save-excursion + (unless (bolp) (backward-char)) + (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t + (not (looking-at org-match-substring-regexp)))) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 5) + (match-beginning 3))) + (contents-end (or (match-end 5) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'superscript + (list :begin begin + :end end + :use-brackets-p bracketsp + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-superscript-interpreter (superscript contents) + "Interpret SUPERSCRIPT object as Org syntax. +CONTENTS is the contents of the object." + (format + (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s") + contents)) + + +;;;; Table Cell + +(defun org-element-table-cell-parser () + "Parse table cell at point. + +Return a list whose CAR is `table-cell' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end' +and `:post-blank' keywords." + (looking-at "[ \t]*\\(.*?\\)[ \t]*|") + (let* ((begin (match-beginning 0)) + (end (match-end 0)) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1))) + (list 'table-cell + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank 0)))) + +(defun org-element-table-cell-interpreter (table-cell contents) + "Interpret TABLE-CELL element as Org syntax. +CONTENTS is the contents of the cell, or nil." + (concat " " contents " |")) + +(defun org-element-table-cell-successor (limit) + "Search for the next table-cell object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `table-cell' and CDR is +beginning position." + (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point)))) + + +;;;; Target + +(defun org-element-target-parser () + "Parse target at point. + +Return a list whose CAR is `target' and CDR a plist with +`:begin', `:end', `:value' and `:post-blank' as keywords. + +Assume point is at the target." + (save-excursion + (looking-at org-target-regexp) + (let ((begin (point)) + (value (org-match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'target + (list :begin begin + :end end + :value value + :post-blank post-blank))))) + +(defun org-element-target-interpreter (target contents) + "Interpret TARGET object as Org syntax. +CONTENTS is nil." + (format "<<%s>>" (org-element-property :value target))) + +(defun org-element-target-successor (limit) + "Search for the next target object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `target' and CDR is +beginning position." + (save-excursion + (when (re-search-forward org-target-regexp limit t) + (cons 'target (match-beginning 0))))) + + +;;;; Timestamp + +(defun org-element-timestamp-parser () + "Parse time stamp at point. + +Return a list whose CAR is `timestamp', and CDR a plist with +`:type', `:begin', `:end', `:value' and `:post-blank' keywords. + +Assume point is at the beginning of the timestamp." + (save-excursion + (let* ((begin (point)) + (activep (eq (char-after) ?<)) + (main-value + (progn + (looking-at "[<[]\\(\\(%%\\)?.*?\\)[]>]\\(?:--[<[]\\(.*?\\)[]>]\\)?") + (match-string-no-properties 1))) + (range-end (match-string-no-properties 3)) + (type (cond ((match-string 2) 'diary) + ((and activep range-end) 'active-range) + (activep 'active) + (range-end 'inactive-range) + (t 'inactive))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'timestamp + (list :type type + :value main-value + :range-end range-end + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-timestamp-interpreter (timestamp contents) + "Interpret TIMESTAMP object as Org syntax. +CONTENTS is nil." + (let ((type (org-element-property :type timestamp) )) + (concat + (format (if (memq type '(inactive inactive-range)) "[%s]" "<%s>") + (org-element-property :value timestamp)) + (let ((range-end (org-element-property :range-end timestamp))) + (when range-end + (concat "--" + (format (if (eq type 'inactive-range) "[%s]" "<%s>") + range-end))))))) + +(defun org-element-timestamp-successor (limit) + "Search for the next timestamp object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `timestamp' and CDR is +beginning position." + (save-excursion + (when (re-search-forward + (concat org-ts-regexp-both + "\\|" + "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" + "\\|" + "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") + limit t) + (cons 'timestamp (match-beginning 0))))) + + +;;;; Underline + +(defun org-element-underline-parser () + "Parse underline object at point. + +Return a list whose CAR is `underline' and CDR is a plist with +`:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first underscore marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'underline + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-underline-interpreter (underline contents) + "Interpret UNDERLINE object as Org syntax. +CONTENTS is the contents of the object." + (format "_%s_" contents)) + + +;;;; Verbatim + +(defun org-element-verbatim-parser () + "Parse verbatim object at point. + +Return a list whose CAR is `verbatim' and CDR is a plist with +`:value', `:begin', `:end' and `:post-blank' keywords. + +Assume point is at the first equal sign marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (value (org-match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'verbatim + (list :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-verbatim-interpreter (verbatim contents) + "Interpret VERBATIM object as Org syntax. +CONTENTS is nil." + (format "=%s=" (org-element-property :value verbatim))) + + + +;;; Parsing Element Starting At Point +;; +;; `org-element--current-element' is the core function of this section. +;; It returns the Lisp representation of the element starting at +;; point. +;; +;; `org-element--current-element' makes use of special modes. They +;; are activated for fixed element chaining (i.e. `plain-list' > +;; `item') or fixed conditional element chaining (i.e. `headline' > +;; `section'). Special modes are: `first-section', `section', +;; `quote-section', `item' and `table-row'. + +(defun org-element--current-element + (limit &optional granularity special structure) + "Parse the element starting at point. + +LIMIT bounds the search. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. + +Possible types are defined in `org-element-all-elements'. + +Optional argument GRANULARITY determines the depth of the +recursion. Allowed values are `headline', `greater-element', +`element', `object' or nil. When it is broader than `object' (or +nil), secondary values will not be parsed, since they only +contain objects. + +Optional argument SPECIAL, when non-nil, can be either +`first-section', `section', `quote-section', `table-row' and +`item'. + +If STRUCTURE isn't provided but SPECIAL is set to `item', it will +be computed. + +This function assumes point is always at the beginning of the +element it has to parse." + (save-excursion + ;; If point is at an affiliated keyword, try moving to the + ;; beginning of the associated element. If none is found, the + ;; keyword is orphaned and will be treated as plain text. + (when (looking-at org-element--affiliated-re) + (let ((opoint (point))) + (while (looking-at org-element--affiliated-re) (forward-line)) + (when (looking-at "[ \t]*$") (goto-char opoint)))) + (let ((case-fold-search t) + ;; Determine if parsing depth allows for secondary strings + ;; parsing. It only applies to elements referenced in + ;; `org-element-secondary-value-alist'. + (raw-secondary-p (and granularity (not (eq granularity 'object))))) + (cond + ;; Item. + ((eq special 'item) + (org-element-item-parser limit structure raw-secondary-p)) + ;; Table Row. + ((eq special 'table-row) (org-element-table-row-parser limit)) + ;; Headline. + ((org-with-limited-levels (org-at-heading-p)) + (org-element-headline-parser limit raw-secondary-p)) + ;; Sections (must be checked after headline). + ((eq special 'section) (org-element-section-parser limit)) + ((eq special 'quote-section) (org-element-quote-section-parser limit)) + ((eq special 'first-section) + (org-element-section-parser + (or (save-excursion (org-with-limited-levels (outline-next-heading))) + limit))) + ;; When not at bol, point is at the beginning of an item or + ;; a footnote definition: next item is always a paragraph. + ((not (bolp)) (org-element-paragraph-parser limit)) + ;; Planning and Clock. + ((and (looking-at org-planning-or-clock-line-re)) + (if (equal (match-string 1) org-clock-string) + (org-element-clock-parser limit) + (org-element-planning-parser limit))) + ;; Inlinetask. + ((org-at-heading-p) + (org-element-inlinetask-parser limit raw-secondary-p)) + ;; LaTeX Environment. + ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}") + (if (save-excursion + (re-search-forward + (format "[ \t]*\\\\end{%s}[ \t]*" + (regexp-quote (match-string 1))) + nil t)) + (org-element-latex-environment-parser limit) + (org-element-paragraph-parser limit))) + ;; Drawer and Property Drawer. + ((looking-at org-drawer-regexp) + (let ((name (match-string 1))) + (cond + ((not (save-excursion + (re-search-forward "^[ \t]*:END:[ \t]*$" nil t))) + (org-element-paragraph-parser limit)) + ((equal "PROPERTIES" name) + (org-element-property-drawer-parser limit)) + (t (org-element-drawer-parser limit))))) + ;; Fixed Width + ((looking-at "[ \t]*:\\( \\|$\\)") + (org-element-fixed-width-parser limit)) + ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and + ;; Keywords. + ((looking-at "[ \t]*#") + (goto-char (match-end 0)) + (cond ((looking-at "\\(?: \\|$\\)") + (beginning-of-line) + (org-element-comment-parser limit)) + ((looking-at "\\+BEGIN_\\(\\S-+\\)") + (beginning-of-line) + (let ((parser (assoc (upcase (match-string 1)) + org-element-block-name-alist))) + (if parser (funcall (cdr parser) limit) + (org-element-special-block-parser limit)))) + ((looking-at "\\+CALL:") + (beginning-of-line) + (org-element-babel-call-parser limit)) + ((looking-at "\\+BEGIN:? ") + (beginning-of-line) + (org-element-dynamic-block-parser limit)) + ((looking-at "\\+\\S-+:") + (beginning-of-line) + (org-element-keyword-parser limit)) + (t + (beginning-of-line) + (org-element-paragraph-parser limit)))) + ;; Footnote Definition. + ((looking-at org-footnote-definition-re) + (org-element-footnote-definition-parser limit)) + ;; Horizontal Rule. + ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") + (org-element-horizontal-rule-parser limit)) + ;; Table. + ((org-at-table-p t) (org-element-table-parser limit)) + ;; List. + ((looking-at (org-item-re)) + (org-element-plain-list-parser limit (or structure (org-list-struct)))) + ;; Default element: Paragraph. + (t (org-element-paragraph-parser limit)))))) + + +;; Most elements can have affiliated keywords. When looking for an +;; element beginning, we want to move before them, as they belong to +;; that element, and, in the meantime, collect information they give +;; into appropriate properties. Hence the following function. +;; +;; Usage of optional arguments may not be obvious at first glance: +;; +;; - TRANS-LIST is used to polish keywords names that have evolved +;; during Org history. In example, even though =result= and +;; =results= coexist, we want to have them under the same =result= +;; property. It's also true for "srcname" and "name", where the +;; latter seems to be preferred nowadays (thus the "name" property). +;; +;; - CONSED allows to regroup multi-lines keywords under the same +;; property, while preserving their own identity. This is mostly +;; used for "attr_latex" and al. +;; +;; - PARSED prepares a keyword value for export. This is useful for +;; "caption". Objects restrictions for such keywords are defined in +;; `org-element-object-restrictions'. +;; +;; - DUALS is used to take care of keywords accepting a main and an +;; optional secondary values. For example "results" has its +;; source's name as the main value, and may have an hash string in +;; optional square brackets as the secondary one. +;; +;; A keyword may belong to more than one category. + +(defun org-element--collect-affiliated-keywords + (&optional key-re trans-list consed parsed duals) + "Collect affiliated keywords before point. + +Optional argument KEY-RE is a regexp matching keywords, which +puts matched keyword in group 1. It defaults to +`org-element--affiliated-re'. + +TRANS-LIST is an alist where key is the keyword and value the +property name it should be translated to, without the colons. It +defaults to `org-element-keyword-translation-alist'. + +CONSED is a list of strings. Any keyword belonging to that list +will have its value consed. The check is done after keyword +translation. It defaults to `org-element-multiple-keywords'. + +PARSED is a list of strings. Any keyword member of this list +will have its value parsed. The check is done after keyword +translation. If a keyword is a member of both CONSED and PARSED, +it's value will be a list of parsed strings. It defaults to +`org-element-parsed-keywords'. + +DUALS is a list of strings. Any keyword member of this list can +have two parts: one mandatory and one optional. Its value is +a cons cell whose CAR is the former, and the CDR the latter. If +a keyword is a member of both PARSED and DUALS, both values will +be parsed. It defaults to `org-element-dual-keywords'. + +Return a list whose CAR is the position at the first of them and +CDR a plist of keywords and values." + (save-excursion + (let ((case-fold-search t) + (key-re (or key-re org-element--affiliated-re)) + (trans-list (or trans-list org-element-keyword-translation-alist)) + (consed (or consed org-element-multiple-keywords)) + (parsed (or parsed org-element-parsed-keywords)) + (duals (or duals org-element-dual-keywords)) + ;; RESTRICT is the list of objects allowed in parsed + ;; keywords value. + (restrict (org-element-restriction 'keyword)) + output) + (unless (bobp) + (while (and (not (bobp)) (progn (forward-line -1) (looking-at key-re))) + (let* ((raw-kwd (upcase (match-string 1))) + ;; Apply translation to RAW-KWD. From there, KWD is + ;; the official keyword. + (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd)) + ;; Find main value for any keyword. + (value + (save-match-data + (org-trim + (buffer-substring-no-properties + (match-end 0) (point-at-eol))))) + ;; If KWD is a dual keyword, find its secondary + ;; value. Maybe parse it. + (dual-value + (and (member kwd duals) + (let ((sec (org-match-string-no-properties 2))) + (if (or (not sec) (not (member kwd parsed))) sec + (org-element-parse-secondary-string sec restrict))))) + ;; Attribute a property name to KWD. + (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) + ;; Now set final shape for VALUE. + (when (member kwd parsed) + (setq value (org-element-parse-secondary-string value restrict))) + (when (member kwd duals) + ;; VALUE is mandatory. Set it to nil if there is none. + (setq value (and value (cons value dual-value)))) + ;; Attributes are always consed. + (when (or (member kwd consed) (string-match "^ATTR_" kwd)) + (setq value (cons value (plist-get output kwd-sym)))) + ;; Eventually store the new value in OUTPUT. + (setq output (plist-put output kwd-sym value)))) + (unless (looking-at key-re) (forward-line 1))) + (list (point) output)))) + + + +;;; The Org Parser +;; +;; The two major functions here are `org-element-parse-buffer', which +;; parses Org syntax inside the current buffer, taking into account +;; region, narrowing, or even visibility if specified, and +;; `org-element-parse-secondary-string', which parses objects within +;; a given string. +;; +;; The (almost) almighty `org-element-map' allows to apply a function +;; on elements or objects matching some type, and accumulate the +;; resulting values. In an export situation, it also skips unneeded +;; parts of the parse tree. + +(defun org-element-parse-buffer (&optional granularity visible-only) + "Recursively parse the buffer and return structure. +If narrowing is in effect, only parse the visible part of the +buffer. + +Optional argument GRANULARITY determines the depth of the +recursion. It can be set to the following symbols: + +`headline' Only parse headlines. +`greater-element' Don't recurse into greater elements excepted + headlines and sections. Thus, elements + parsed are the top-level ones. +`element' Parse everything but objects and plain text. +`object' Parse the complete buffer (default). + +When VISIBLE-ONLY is non-nil, don't parse contents of hidden +elements. + +Assume buffer is in Org mode." + (save-excursion + (goto-char (point-min)) + (org-skip-whitespace) + (org-element--parse-elements + (point-at-bol) (point-max) + ;; Start in `first-section' mode so text before the first + ;; headline belongs to a section. + 'first-section nil granularity visible-only (list 'org-data nil)))) + +(defun org-element-parse-secondary-string (string restriction &optional parent) + "Recursively parse objects in STRING and return structure. + +RESTRICTION is a symbol limiting the object types that will be +looked after. + +Optional argument PARENT, when non-nil, is the element or object +containing the secondary string. It is used to set correctly +`:parent' property within the string." + (with-temp-buffer + (insert string) + (let ((secondary (org-element--parse-objects + (point-min) (point-max) nil restriction))) + (mapc (lambda (obj) (org-element-put-property obj :parent parent)) + secondary)))) + +(defun org-element-map (data types fun &optional info first-match no-recursion) + "Map a function on selected elements or objects. + +DATA is the parsed tree, as returned by, i.e, +`org-element-parse-buffer'. TYPES is a symbol or list of symbols +of elements or objects types. FUN is the function called on the +matching element or object. It must accept one arguments: the +element or object itself. + +When optional argument INFO is non-nil, it should be a plist +holding export options. In that case, parts of the parse tree +not exportable according to that property list will be skipped. + +When optional argument FIRST-MATCH is non-nil, stop at the first +match for which FUN doesn't return nil, and return that value. + +Optional argument NO-RECURSION is a symbol or a list of symbols +representing elements or objects types. `org-element-map' won't +enter any recursive element or object whose type belongs to that +list. Though, FUN can still be applied on them. + +Nil values returned from FUN do not appear in the results." + ;; Ensure TYPES and NO-RECURSION are a list, even of one element. + (unless (listp types) (setq types (list types))) + (unless (listp no-recursion) (setq no-recursion (list no-recursion))) + ;; Recursion depth is determined by --CATEGORY. + (let* ((--category + (catch 'found + (let ((category 'greater-elements)) + (mapc (lambda (type) + (cond ((or (memq type org-element-all-objects) + (eq type 'plain-text)) + ;; If one object is found, the function + ;; has to recurse into every object. + (throw 'found 'objects)) + ((not (memq type org-element-greater-elements)) + ;; If one regular element is found, the + ;; function has to recurse, at least, + ;; into every element it encounters. + (and (not (eq category 'elements)) + (setq category 'elements))))) + types) + category))) + --acc + --walk-tree + (--walk-tree + (function + (lambda (--data) + ;; Recursively walk DATA. INFO, if non-nil, is a plist + ;; holding contextual information. + (let ((--type (org-element-type --data))) + (cond + ((not --data)) + ;; Ignored element in an export context. + ((and info (memq --data (plist-get info :ignore-list)))) + ;; Secondary string: only objects can be found there. + ((not --type) + (when (eq --category 'objects) (mapc --walk-tree --data))) + ;; Unconditionally enter parse trees. + ((eq --type 'org-data) + (mapc --walk-tree (org-element-contents --data))) + (t + ;; Check if TYPE is matching among TYPES. If so, + ;; apply FUN to --DATA and accumulate return value + ;; into --ACC (or exit if FIRST-MATCH is non-nil). + (when (memq --type types) + (let ((result (funcall fun --data))) + (cond ((not result)) + (first-match (throw '--map-first-match result)) + (t (push result --acc))))) + ;; If --DATA has a secondary string that can contain + ;; objects with their type among TYPES, look into it. + (when (eq --category 'objects) + (let ((sec-prop + (assq --type org-element-secondary-value-alist))) + (when sec-prop + (funcall --walk-tree + (org-element-property (cdr sec-prop) --data))))) + ;; Determine if a recursion into --DATA is possible. + (cond + ;; --TYPE is explicitly removed from recursion. + ((memq --type no-recursion)) + ;; --DATA has no contents. + ((not (org-element-contents --data))) + ;; Looking for greater elements but --DATA is simply + ;; an element or an object. + ((and (eq --category 'greater-elements) + (not (memq --type org-element-greater-elements)))) + ;; Looking for elements but --DATA is an object. + ((and (eq --category 'elements) + (memq --type org-element-all-objects))) + ;; In any other case, map contents. + (t (mapc --walk-tree (org-element-contents --data))))))))))) + (catch '--map-first-match + (funcall --walk-tree data) + ;; Return value in a proper order. + (nreverse --acc)))) + +;; The following functions are internal parts of the parser. +;; +;; The first one, `org-element--parse-elements' acts at the element's +;; level. +;; +;; The second one, `org-element--parse-objects' applies on all objects +;; of a paragraph or a secondary string. It uses +;; `org-element--get-next-object-candidates' to optimize the search of +;; the next object in the buffer. +;; +;; More precisely, that function looks for every allowed object type +;; first. Then, it discards failed searches, keeps further matches, +;; and searches again types matched behind point, for subsequent +;; calls. Thus, searching for a given type fails only once, and every +;; object is searched only once at top level (but sometimes more for +;; nested types). + +(defun org-element--parse-elements + (beg end special structure granularity visible-only acc) + "Parse elements between BEG and END positions. + +SPECIAL prioritize some elements over the others. It can be set +to `first-section', `quote-section', `section' `item' or +`table-row'. + +When value is `item', STRUCTURE will be used as the current list +structure. + +GRANULARITY determines the depth of the recursion. See +`org-element-parse-buffer' for more information. + +When VISIBLE-ONLY is non-nil, don't parse contents of hidden +elements. + +Elements are accumulated into ACC." + (save-excursion + (goto-char beg) + ;; When parsing only headlines, skip any text before first one. + (when (and (eq granularity 'headline) (not (org-at-heading-p))) + (org-with-limited-levels (outline-next-heading))) + ;; Main loop start. + (while (< (point) end) + ;; Find current element's type and parse it accordingly to + ;; its category. + (let* ((element (org-element--current-element + end granularity special structure)) + (type (org-element-type element)) + (cbeg (org-element-property :contents-begin element))) + (goto-char (org-element-property :end element)) + ;; Fill ELEMENT contents by side-effect. + (cond + ;; If VISIBLE-ONLY is true and element is hidden or if it has + ;; no contents, don't modify it. + ((or (and visible-only (org-element-property :hiddenp element)) + (not cbeg))) + ;; Greater element: parse it between `contents-begin' and + ;; `contents-end'. Make sure GRANULARITY allows the + ;; recursion, or ELEMENT is an headline, in which case going + ;; inside is mandatory, in order to get sub-level headings. + ((and (memq type org-element-greater-elements) + (or (memq granularity '(element object nil)) + (and (eq granularity 'greater-element) + (eq type 'section)) + (eq type 'headline))) + (org-element--parse-elements + cbeg (org-element-property :contents-end element) + ;; Possibly switch to a special mode. + (case type + (headline + (if (org-element-property :quotedp element) 'quote-section + 'section)) + (plain-list 'item) + (table 'table-row)) + (org-element-property :structure element) + granularity visible-only element)) + ;; ELEMENT has contents. Parse objects inside, if + ;; GRANULARITY allows it. + ((memq granularity '(object nil)) + (org-element--parse-objects + cbeg (org-element-property :contents-end element) element + (org-element-restriction type)))) + (org-element-adopt-elements acc element))) + ;; Return result. + acc)) + +(defun org-element--parse-objects (beg end acc restriction) + "Parse objects between BEG and END and return recursive structure. + +Objects are accumulated in ACC. + +RESTRICTION is a list of object types which are allowed in the +current object." + (let (candidates) + (save-excursion + (goto-char beg) + (while (and (< (point) end) + (setq candidates (org-element--get-next-object-candidates + end restriction candidates))) + (let ((next-object + (let ((pos (apply 'min (mapcar 'cdr candidates)))) + (save-excursion + (goto-char pos) + (funcall (intern (format "org-element-%s-parser" + (car (rassq pos candidates))))))))) + ;; 1. Text before any object. Untabify it. + (let ((obj-beg (org-element-property :begin next-object))) + (unless (= (point) obj-beg) + (setq acc + (org-element-adopt-elements + acc + (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) obj-beg)))))) + ;; 2. Object... + (let ((obj-end (org-element-property :end next-object)) + (cont-beg (org-element-property :contents-begin next-object))) + ;; Fill contents of NEXT-OBJECT by side-effect, if it has + ;; a recursive type. + (when (and cont-beg + (memq (car next-object) org-element-recursive-objects)) + (save-restriction + (narrow-to-region + cont-beg + (org-element-property :contents-end next-object)) + (org-element--parse-objects + (point-min) (point-max) next-object + (org-element-restriction next-object)))) + (setq acc (org-element-adopt-elements acc next-object)) + (goto-char obj-end)))) + ;; 3. Text after last object. Untabify it. + (unless (= (point) end) + (setq acc + (org-element-adopt-elements + acc + (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) end))))) + ;; Result. + acc))) + +(defun org-element--get-next-object-candidates (limit restriction objects) + "Return an alist of candidates for the next object. + +LIMIT bounds the search, and RESTRICTION narrows candidates to +some object types. + +Return value is an alist whose CAR is position and CDR the object +type, as a symbol. + +OBJECTS is the previous candidates alist." + (let (next-candidates types-to-search) + ;; If no previous result, search every object type in RESTRICTION. + ;; Otherwise, keep potential candidates (old objects located after + ;; point) and ask to search again those which had matched before. + (if (not objects) (setq types-to-search restriction) + (mapc (lambda (obj) + (if (< (cdr obj) (point)) (push (car obj) types-to-search) + (push obj next-candidates))) + objects)) + ;; Call the appropriate successor function for each type to search + ;; and accumulate matches. + (mapc + (lambda (type) + (let* ((successor-fun + (intern + (format "org-element-%s-successor" + (or (cdr (assq type org-element-object-successor-alist)) + type)))) + (obj (funcall successor-fun limit))) + (and obj (push obj next-candidates)))) + types-to-search) + ;; Return alist. + next-candidates)) + + + +;;; Towards A Bijective Process +;; +;; The parse tree obtained with `org-element-parse-buffer' is really +;; a snapshot of the corresponding Org buffer. Therefore, it can be +;; interpreted and expanded into a string with canonical Org syntax. +;; Hence `org-element-interpret-data'. +;; +;; The function relies internally on +;; `org-element--interpret-affiliated-keywords'. + +;;;###autoload +(defun org-element-interpret-data (data &optional parent) + "Interpret DATA as Org syntax. + +DATA is a parse tree, an element, an object or a secondary string +to interpret. + +Optional argument PARENT is used for recursive calls. It contains +the element or object containing data, or nil. + +Return Org syntax as a string." + (let* ((type (org-element-type data)) + (results + (cond + ;; Secondary string. + ((not type) + (mapconcat + (lambda (obj) (org-element-interpret-data obj parent)) + data "")) + ;; Full Org document. + ((eq type 'org-data) + (mapconcat + (lambda (obj) (org-element-interpret-data obj parent)) + (org-element-contents data) "")) + ;; Plain text. + ((stringp data) data) + ;; Element/Object without contents. + ((not (org-element-contents data)) + (funcall (intern (format "org-element-%s-interpreter" type)) + data nil)) + ;; Element/Object with contents. + (t + (let* ((greaterp (memq type org-element-greater-elements)) + (objectp (and (not greaterp) + (memq type org-element-recursive-objects))) + (contents + (mapconcat + (lambda (obj) (org-element-interpret-data obj data)) + (org-element-contents + (if (or greaterp objectp) data + ;; Elements directly containing objects must + ;; have their indentation normalized first. + (org-element-normalize-contents + data + ;; When normalizing first paragraph of an + ;; item or a footnote-definition, ignore + ;; first line's indentation. + (and (eq type 'paragraph) + (equal data (car (org-element-contents parent))) + (memq (org-element-type parent) + '(footnote-definition item)))))) + ""))) + (funcall (intern (format "org-element-%s-interpreter" type)) + data + (if greaterp (org-element-normalize-contents contents) + contents))))))) + (if (memq type '(org-data plain-text nil)) results + ;; Build white spaces. If no `:post-blank' property is + ;; specified, assume its value is 0. + (let ((post-blank (or (org-element-property :post-blank data) 0))) + (if (memq type org-element-all-objects) + (concat results (make-string post-blank 32)) + (concat + (org-element--interpret-affiliated-keywords data) + (org-element-normalize-string results) + (make-string post-blank 10))))))) + +(defun org-element--interpret-affiliated-keywords (element) + "Return ELEMENT's affiliated keywords as Org syntax. +If there is no affiliated keyword, return the empty string." + (let ((keyword-to-org + (function + (lambda (key value) + (let (dual) + (when (member key org-element-dual-keywords) + (setq dual (cdr value) value (car value))) + (concat "#+" key + (and dual + (format "[%s]" (org-element-interpret-data dual))) + ": " + (if (member key org-element-parsed-keywords) + (org-element-interpret-data value) + value) + "\n")))))) + (mapconcat + (lambda (prop) + (let ((value (org-element-property prop element)) + (keyword (upcase (substring (symbol-name prop) 1)))) + (when value + (if (or (member keyword org-element-multiple-keywords) + ;; All attribute keywords can have multiple lines. + (string-match "^ATTR_" keyword)) + (mapconcat (lambda (line) (funcall keyword-to-org keyword line)) + value + "") + (funcall keyword-to-org keyword value))))) + ;; List all ELEMENT's properties matching an attribute line or an + ;; affiliated keyword, but ignore translated keywords since they + ;; cannot belong to the property list. + (loop for prop in (nth 1 element) by 'cddr + when (let ((keyword (upcase (substring (symbol-name prop) 1)))) + (or (string-match "^ATTR_" keyword) + (and + (member keyword org-element-affiliated-keywords) + (not (assoc keyword + org-element-keyword-translation-alist))))) + collect prop) + ""))) + +;; Because interpretation of the parse tree must return the same +;; number of blank lines between elements and the same number of white +;; space after objects, some special care must be given to white +;; spaces. +;; +;; The first function, `org-element-normalize-string', ensures any +;; string different from the empty string will end with a single +;; newline character. +;; +;; The second function, `org-element-normalize-contents', removes +;; global indentation from the contents of the current element. + +(defun org-element-normalize-string (s) + "Ensure string S ends with a single newline character. + +If S isn't a string return it unchanged. If S is the empty +string, return it. Otherwise, return a new string with a single +newline character at its end." + (cond + ((not (stringp s)) s) + ((string= "" s) "") + (t (and (string-match "\\(\n[ \t]*\\)*\\'" s) + (replace-match "\n" nil nil s))))) + +(defun org-element-normalize-contents (element &optional ignore-first) + "Normalize plain text in ELEMENT's contents. + +ELEMENT must only contain plain text and objects. + +If optional argument IGNORE-FIRST is non-nil, ignore first line's +indentation to compute maximal common indentation. + +Return the normalized element that is element with global +indentation removed from its contents. The function assumes that +indentation is not done with TAB characters." + (let* (ind-list ; for byte-compiler + collect-inds ; for byte-compiler + (collect-inds + (function + ;; Return list of indentations within BLOB. This is done by + ;; walking recursively BLOB and updating IND-LIST along the + ;; way. FIRST-FLAG is non-nil when the first string hasn't + ;; been seen yet. It is required as this string is the only + ;; one whose indentation doesn't happen after a newline + ;; character. + (lambda (blob first-flag) + (mapc + (lambda (object) + (when (and first-flag (stringp object)) + (setq first-flag nil) + (string-match "\\`\\( *\\)" object) + (let ((len (length (match-string 1 object)))) + ;; An indentation of zero means no string will be + ;; modified. Quit the process. + (if (zerop len) (throw 'zero (setq ind-list nil)) + (push len ind-list)))) + (cond + ((stringp object) + (let ((start 0)) + ;; Avoid matching blank or empty lines. + (while (and (string-match "\n\\( *\\)\\(.\\)" object start) + (not (equal (match-string 2 object) " "))) + (setq start (match-end 0)) + (push (length (match-string 1 object)) ind-list)))) + ((memq (org-element-type object) org-element-recursive-objects) + (funcall collect-inds object first-flag)))) + (org-element-contents blob)))))) + ;; Collect indentation list in ELEMENT. Possibly remove first + ;; value if IGNORE-FIRST is non-nil. + (catch 'zero (funcall collect-inds element (not ignore-first))) + (if (not ind-list) element + ;; Build ELEMENT back, replacing each string with the same + ;; string minus common indentation. + (let* (build ; For byte compiler. + (build + (function + (lambda (blob mci first-flag) + ;; Return BLOB with all its strings indentation + ;; shortened from MCI white spaces. FIRST-FLAG is + ;; non-nil when the first string hasn't been seen + ;; yet. + (setcdr (cdr blob) + (mapcar + (lambda (object) + (when (and first-flag (stringp object)) + (setq first-flag nil) + (setq object + (replace-regexp-in-string + (format "\\` \\{%d\\}" mci) "" object))) + (cond + ((stringp object) + (replace-regexp-in-string + (format "\n \\{%d\\}" mci) "\n" object)) + ((memq (org-element-type object) + org-element-recursive-objects) + (funcall build object mci first-flag)) + (t object))) + (org-element-contents blob))) + blob)))) + (funcall build element (apply 'min ind-list) (not ignore-first)))))) + + + +;;; The Toolbox +;; +;; The first move is to implement a way to obtain the smallest element +;; containing point. This is the job of `org-element-at-point'. It +;; basically jumps back to the beginning of section containing point +;; and moves, element after element, with +;; `org-element--current-element' until the container is found. Note: +;; When using `org-element-at-point', secondary values are never +;; parsed since the function focuses on elements, not on objects. +;; +;; At a deeper level, `org-element-context' lists all elements and +;; objects containing point. +;; +;; `org-element-nested-p' and `org-element-swap-A-B' may be used +;; internally by navigation and manipulation tools. + +;;;###autoload +(defun org-element-at-point (&optional keep-trail) + "Determine closest element around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. + +Possible types are defined in `org-element-all-elements'. +Properties depend on element or object type, but always +include :begin, :end, :parent and :post-blank properties. + +As a special case, if point is at the very beginning of a list or +sub-list, returned element will be that list instead of the first +item. In the same way, if point is at the beginning of the first +row of a table, returned element will be the table instead of the +first row. + +If optional argument KEEP-TRAIL is non-nil, the function returns +a list of of elements leading to element at point. The list's +CAR is always the element at point. Following positions contain +element's siblings, then parents, siblings of parents, until the +first element of current section." + (org-with-wide-buffer + ;; If at an headline, parse it. It is the sole element that + ;; doesn't require to know about context. Be sure to disallow + ;; secondary string parsing, though. + (if (org-with-limited-levels (org-at-heading-p)) + (progn + (beginning-of-line) + (if (not keep-trail) (org-element-headline-parser (point-max) t) + (list (org-element-headline-parser (point-max) t)))) + ;; Otherwise move at the beginning of the section containing + ;; point. + (let ((origin (point)) + (end (save-excursion + (org-with-limited-levels (outline-next-heading)) (point))) + element type special-flag trail struct prevs parent) + (org-with-limited-levels + (if (org-with-limited-levels (org-before-first-heading-p)) + (goto-char (point-min)) + (org-back-to-heading) + (forward-line))) + (org-skip-whitespace) + (beginning-of-line) + ;; Parse successively each element, skipping those ending + ;; before original position. + (catch 'exit + (while t + (setq element + (org-element--current-element end 'element special-flag struct) + type (car element)) + (org-element-put-property element :parent parent) + (when keep-trail (push element trail)) + (cond + ;; 1. Skip any element ending before point. Also skip + ;; element ending at point when we're sure that another + ;; element has started. + ((let ((elem-end (org-element-property :end element))) + (when (or (< elem-end origin) + (and (= elem-end origin) (/= elem-end end))) + (goto-char elem-end)))) + ;; 2. An element containing point is always the element at + ;; point. + ((not (memq type org-element-greater-elements)) + (throw 'exit (if keep-trail trail element))) + ;; 3. At any other greater element type, if point is + ;; within contents, move into it. + (t + (let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin) + ;; Create an anchor for tables and plain lists: + ;; when point is at the very beginning of these + ;; elements, ignoring affiliated keywords, + ;; target them instead of their contents. + (and (= cbeg origin) (memq type '(plain-list table))) + ;; When point is at contents end, do not move + ;; into elements with an explicit ending, but + ;; return that element instead. + (and (= cend origin) + (memq type + '(center-block + drawer dynamic-block inlinetask item + plain-list quote-block special-block)))) + (throw 'exit (if keep-trail trail element)) + (setq parent element) + (case type + (plain-list + (setq special-flag 'item + struct (org-element-property :structure element))) + (table (setq special-flag 'table-row)) + (otherwise (setq special-flag nil))) + (setq end cend) + (goto-char cbeg))))))))))) + +;;;###autoload +(defun org-element-context () + "Return closest element or object around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element or object and PROPS a plist of properties +associated to it. + +Possible types are defined in `org-element-all-elements' and +`org-element-all-objects'. Properties depend on element or +object type, but always include :begin, :end, :parent +and :post-blank properties." + (org-with-wide-buffer + (let* ((origin (point)) + (element (org-element-at-point)) + (type (car element)) + end) + ;; Check if point is inside an element containing objects or at + ;; a secondary string. In that case, move to beginning of the + ;; element or secondary string and set END to the other side. + (if (not (or (and (eq type 'item) + (let ((tag (org-element-property :tag element))) + (and tag + (progn + (beginning-of-line) + (search-forward tag (point-at-eol)) + (goto-char (match-beginning 0)) + (and (>= origin (point)) + (<= origin + ;; `1+' is required so some + ;; successors can match + ;; properly their object. + (setq end (1+ (match-end 0))))))))) + (and (memq type '(headline inlinetask)) + (progn (beginning-of-line) + (skip-chars-forward "* ") + (setq end (point-at-eol)))) + (and (memq type '(paragraph table-cell verse-block)) + (let ((cbeg (org-element-property + :contents-begin element)) + (cend (org-element-property + :contents-end element))) + (and (>= origin cbeg) + (<= origin cend) + (progn (goto-char cbeg) (setq end cend))))))) + element + (let ((restriction (org-element-restriction element)) + (parent element) + candidates) + (catch 'exit + (while (setq candidates (org-element--get-next-object-candidates + end restriction candidates)) + (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates)) + candidates))) + ;; If ORIGIN is before next object in element, there's + ;; no point in looking further. + (if (> (cdr closest-cand) origin) (throw 'exit element) + (let* ((object + (progn (goto-char (cdr closest-cand)) + (funcall (intern (format "org-element-%s-parser" + (car closest-cand)))))) + (cbeg (org-element-property :contents-begin object)) + (cend (org-element-property :contents-end object))) + (cond + ;; ORIGIN is after OBJECT, so skip it. + ((< (org-element-property :end object) origin) + (goto-char (org-element-property :end object))) + ;; ORIGIN is within a non-recursive object or at an + ;; object boundaries: Return that object. + ((or (not cbeg) (> cbeg origin) (< cend origin)) + (throw 'exit + (org-element-put-property object :parent parent))) + ;; Otherwise, move within current object and restrict + ;; search to the end of its contents. + (t (goto-char cbeg) + (org-element-put-property object :parent parent) + (setq parent object end cend))))))) + parent)))))) + +(defsubst org-element-nested-p (elem-A elem-B) + "Non-nil when elements ELEM-A and ELEM-B are nested." + (let ((beg-A (org-element-property :begin elem-A)) + (beg-B (org-element-property :begin elem-B)) + (end-A (org-element-property :end elem-A)) + (end-B (org-element-property :end elem-B))) + (or (and (>= beg-A beg-B) (<= end-A end-B)) + (and (>= beg-B beg-A) (<= end-B end-A))))) + +(defun org-element-swap-A-B (elem-A elem-B) + "Swap elements ELEM-A and ELEM-B. +Assume ELEM-B is after ELEM-A in the buffer. Leave point at the +end of ELEM-A." + (goto-char (org-element-property :begin elem-A)) + ;; There are two special cases when an element doesn't start at bol: + ;; the first paragraph in an item or in a footnote definition. + (let ((specialp (not (bolp)))) + ;; Only a paragraph without any affiliated keyword can be moved at + ;; ELEM-A position in such a situation. Note that the case of + ;; a footnote definition is impossible: it cannot contain two + ;; paragraphs in a row because it cannot contain a blank line. + (if (and specialp + (or (not (eq (org-element-type elem-B) 'paragraph)) + (/= (org-element-property :begin elem-B) + (org-element-property :contents-begin elem-B)))) + (error "Cannot swap elements")) + ;; In a special situation, ELEM-A will have no indentation. We'll + ;; give it ELEM-B's (which will in, in turn, have no indentation). + (let* ((ind-B (when specialp + (goto-char (org-element-property :begin elem-B)) + (org-get-indentation))) + (beg-A (org-element-property :begin elem-A)) + (end-A (save-excursion + (goto-char (org-element-property :end elem-A)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + (beg-B (org-element-property :begin elem-B)) + (end-B (save-excursion + (goto-char (org-element-property :end elem-B)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + ;; Store overlays responsible for visibility status. We + ;; also need to store their boundaries as they will be + ;; removed from buffer. + (overlays + (cons + (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov))) + (overlays-in beg-A end-A)) + (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov))) + (overlays-in beg-B end-B)))) + ;; Get contents. + (body-A (buffer-substring beg-A end-A)) + (body-B (delete-and-extract-region beg-B end-B))) + (goto-char beg-B) + (when specialp + (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) + (org-indent-to-column ind-B)) + (insert body-A) + ;; Restore ex ELEM-A overlays. + (let ((offset (- beg-B beg-A))) + (mapc (lambda (ov) + (move-overlay + (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset))) + (car overlays)) + (goto-char beg-A) + (delete-region beg-A end-A) + (insert body-B) + ;; Restore ex ELEM-B overlays. + (mapc (lambda (ov) + (move-overlay + (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset))) + (cdr overlays))) + (goto-char (org-element-property :end elem-B))))) + + +(provide 'org-element) +;;; org-element.el ends here diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 8b5b3f312e4..bd675c376bb 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -252,7 +252,7 @@ loaded, add these packages to `org-export-latex-packages-alist'." "* Other" "** Misc. (often used)" - ("circ" "\\circ" t "ˆ" "^" "^" "ˆ") + ("circ" "\\^{}" nil "ˆ" "^" "^" "ˆ") ("vert" "\\vert{}" t "|" "|" "|" "|") ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") ("sect" "\\S" nil "§" "paragraph" "§" "§") @@ -260,6 +260,11 @@ loaded, add these packages to `org-export-latex-packages-alist'." ("lt" "\\textless{}" nil "<" "<" "<" "<") ("gt" "\\textgreater{}" nil ">" ">" ">" ">") ("tilde" "\\~{}" nil "˜" "~" "~" "~") + ("slash" "/" nil "/" "/" "/" "/") + ("plus" "+" nil "+" "+" "+" "+") + ("under" "\\_" nil "_" "_" "_" "_") + ("equal" "=" nil "=" "=" "=" "=") + ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^") ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") @@ -492,34 +497,31 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." ;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org (defun org-entities-create-table () - "Create an org-mode table with all entities." + "Create an Org mode table with all entities." (interactive) - (let ((ll org-entities) - (pos (point)) - e latex mathp html latin utf8 name ascii) + (let ((pos (point)) e latex mathp html latin utf8 name ascii) (insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n") - (while ll - (when (listp e) - (setq e (pop ll)) - (setq name (car e) - latex (nth 1 e) - mathp (nth 2 e) - html (nth 3 e) - ascii (nth 4 e) - latin (nth 5 e) - utf8 (nth 6 e)) - (if (equal ascii "|") (setq ascii "\\vert")) - (if (equal latin "|") (setq latin "\\vert")) - (if (equal utf8 "|") (setq utf8 "\\vert")) - (if (equal ascii "=>") (setq ascii "= >")) - (if (equal latin "=>") (setq latin "= >")) - (insert "|" name - "|" (format "=%s=" latex) - "|" (format (if mathp "$%s$" "$\\mbox{%s}$") - latex) - "|" (format "=%s=" html) "|" html - "|" ascii "|" latin "|" utf8 - "|\n"))) + (mapc (lambda (e) (when (listp e) + (setq name (car e) + latex (nth 1 e) + mathp (nth 2 e) + html (nth 3 e) + ascii (nth 4 e) + latin (nth 5 e) + utf8 (nth 6 e)) + (if (equal ascii "|") (setq ascii "\\vert")) + (if (equal latin "|") (setq latin "\\vert")) + (if (equal utf8 "|") (setq utf8 "\\vert")) + (if (equal ascii "=>") (setq ascii "= >")) + (if (equal latin "=>") (setq latin "= >")) + (insert "|" name + "|" (format "=%s=" latex) + "|" (format (if mathp "$%s$" "$\\mbox{%s}$") + latex) + "|" (format "=%s=" html) "|" html + "|" ascii "|" latin "|" utf8 + "|\n"))) + org-entities) (goto-char pos) (org-table-align))) diff --git a/lisp/org/org-eshell.el b/lisp/org/org-eshell.el index f572095d818..4335fce578c 100644 --- a/lisp/org/org-eshell.el +++ b/lisp/org/org-eshell.el @@ -37,18 +37,18 @@ followed by a colon." (let* ((buffer-and-command (if (string-match "\\([A-Za-z0-9-+*]+\\):\\(.*\\)" link) - (list (match-string 1 link) - (match-string 2 link)) + (list (match-string 1 link) + (match-string 2 link)) (list eshell-buffer-name link))) (eshell-buffer-name (car buffer-and-command)) (command (cadr buffer-and-command))) - (if (get-buffer eshell-buffer-name) - (org-pop-to-buffer-same-window eshell-buffer-name) - (eshell)) - (goto-char (point-max)) - (eshell-kill-input) - (insert command) - (eshell-send-input))) + (if (get-buffer eshell-buffer-name) + (org-pop-to-buffer-same-window eshell-buffer-name) + (eshell)) + (goto-char (point-max)) + (eshell-kill-input) + (insert command) + (eshell-send-input))) (defun org-eshell-store-link () "Store a link that, when opened, switches back to the current eshell buffer @@ -57,7 +57,7 @@ (let* ((command (concat "cd " dired-directory)) (link (concat (buffer-name) ":" command))) (org-store-link-props - :link (org-make-link "eshell:" link) + :link (concat "eshell:" link) :description command)))) (provide 'org-eshell) diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el index fbac6592090..89a0e5e5503 100644 --- a/lisp/org/org-exp-blocks.el +++ b/lisp/org/org-exp-blocks.el @@ -72,8 +72,13 @@ (eval-when-compile (require 'cl)) -(require 'org) (require 'find-func) +(require 'org-compat) + +(declare-function org-split-string "org" (string &optional separators)) +(declare-function org-remove-indentation "org" (code &optional n)) + +(defvar org-protecting-blocks nil) ; From org.el (defun org-export-blocks-set (var value) "Set the value of `org-export-blocks' and install fontification." @@ -142,7 +147,6 @@ export function should accept three arguments." (defun org-export-blocks-html-quote (body &optional open close) "Protect BODY from org html export. The optional OPEN and CLOSE tags will be inserted around BODY." - (concat "\n#+BEGIN_HTML\n" (or open "") @@ -160,6 +164,7 @@ The optional OPEN and CLOSE tags will be inserted around BODY." (or close "") "#+END_LaTeX\n")) +(defvar org-src-preserve-indentation) ; From org-src.el (defun org-export-blocks-preprocess () "Export all blocks according to the `org-export-blocks' block export alist. Does not export block types specified in specified in BLOCKS @@ -167,65 +172,70 @@ which defaults to the value of `org-export-blocks-witheld'." (interactive) (save-window-excursion (let ((case-fold-search t) - (types '()) - matched indentation type func + (interblock (lambda (start end) + (mapcar (lambda (pair) (funcall (second pair) start end)) + org-export-interblocks))) + matched indentation type types func start end body headers preserve-indent progress-marker) - (flet ((interblock (start end) - (mapcar (lambda (pair) (funcall (second pair) start end)) - org-export-interblocks))) - (goto-char (point-min)) - (setq start (point)) - (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]")) - (while (re-search-forward beg-re nil t) - (let* ((match-start (copy-marker (match-beginning 0))) - (body-start (copy-marker (match-end 0))) - (indentation (length (match-string 1))) - (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s" - (regexp-quote (downcase (match-string 2))))) - (type (intern (downcase (match-string 2)))) - (headers (save-match-data - (org-split-string (match-string 3) "[ \t]+"))) - (balanced 1) - (preserve-indent (or org-src-preserve-indentation - (member "-i" headers))) - match-end) - (while (and (not (zerop balanced)) - (re-search-forward inner-re nil t)) - (if (string= (downcase (match-string 1)) "end") - (decf balanced) - (incf balanced))) - (when (not (zerop balanced)) - (error "unbalanced begin/end_%s blocks with %S" - type (buffer-substring match-start (point)))) - (setq match-end (copy-marker (match-end 0))) - (unless preserve-indent - (setq body (save-match-data (org-remove-indentation - (buffer-substring - body-start (match-beginning 0)))))) - (unless (memq type types) (setq types (cons type types))) - (save-match-data (interblock start match-start)) - (when (setq func (cadr (assoc type org-export-blocks))) - (let ((replacement (save-match-data - (if (memq type org-export-blocks-witheld) "" - (apply func body headers))))) - (when replacement - (delete-region match-start match-end) - (goto-char match-start) (insert replacement) - (if preserve-indent - ;; indent only the code block markers - (save-excursion - (indent-line-to indentation) ; indent end_block - (goto-char match-start) - (indent-line-to indentation)) ; indent begin_block - ;; indent everything - (indent-code-rigidly match-start (point) indentation))))) - ;; cleanup markers - (set-marker match-start nil) - (set-marker body-start nil) - (set-marker match-end nil)) - (setq start (point)))) - (interblock start (point-max)) - (run-hooks 'org-export-blocks-postblock-hook))))) + (goto-char (point-min)) + (setq start (point)) + (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]")) + (while (re-search-forward beg-re nil t) + (let* ((match-start (copy-marker (match-beginning 0))) + (body-start (copy-marker (match-end 0))) + (indentation (length (match-string 1))) + (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s" + (regexp-quote (downcase (match-string 2))))) + (type (intern (downcase (match-string 2)))) + (headers (save-match-data + (org-split-string (match-string 3) "[ \t]+"))) + (balanced 1) + (preserve-indent (or org-src-preserve-indentation + (member "-i" headers))) + match-end) + (while (and (not (zerop balanced)) + (re-search-forward inner-re nil t)) + (if (string= (downcase (match-string 1)) "end") + (decf balanced) + (incf balanced))) + (when (not (zerop balanced)) + (error "Unbalanced begin/end_%s blocks with %S" + type (buffer-substring match-start (point)))) + (setq match-end (copy-marker (match-end 0))) + (unless preserve-indent + (setq body (save-match-data (org-remove-indentation + (buffer-substring + body-start (match-beginning 0)))))) + (unless (memq type types) (setq types (cons type types))) + (save-match-data (funcall interblock start match-start)) + (when (setq func (cadr (assoc type org-export-blocks))) + (let ((replacement (save-match-data + (if (memq type org-export-blocks-witheld) "" + (apply func body headers))))) + ;; ;; un-comment this code after the org-element merge + ;; (save-match-data + ;; (when (and replacement (string= replacement "")) + ;; (delete-region + ;; (car (org-element-collect-affiliated-keyword)) + ;; match-start))) + (when replacement + (delete-region match-start match-end) + (goto-char match-start) (insert replacement) + (if preserve-indent + ;; indent only the code block markers + (save-excursion + (indent-line-to indentation) ; indent end_block + (goto-char match-start) + (indent-line-to indentation)) ; indent begin_block + ;; indent everything + (indent-code-rigidly match-start (point) indentation))))) + ;; cleanup markers + (set-marker match-start nil) + (set-marker body-start nil) + (set-marker match-end nil)) + (setq start (point)))) + (funcall interblock start (point-max)) + (run-hooks 'org-export-blocks-postblock-hook)))) ;;================================================================================ ;; type specific functions @@ -233,14 +243,14 @@ which defaults to the value of `org-export-blocks-witheld'." ;;-------------------------------------------------------------------------------- ;; ditaa: create images from ASCII art using the ditaa utility (defcustom org-ditaa-jar-path (expand-file-name - "ditaa.jar" - (file-name-as-directory - (expand-file-name - "scripts" - (file-name-as-directory - (expand-file-name - "../contrib" - (file-name-directory (find-library-name "org"))))))) + "ditaa.jar" + (file-name-as-directory + (expand-file-name + "scripts" + (file-name-as-directory + (expand-file-name + "../contrib" + (file-name-directory (org-find-library-dir "org"))))))) "Path to the ditaa jar executable." :group 'org-babel :type 'string) @@ -273,29 +283,29 @@ passed to the ditaa utility as command line arguments." (org-split-string body "\n") "\n"))) (prog1 - (cond - ((member org-export-current-backend '(html latex docbook)) - (unless (file-exists-p out-file) - (mapc ;; remove old hashed versions of this file - (lambda (file) - (when (and (string-match (concat (regexp-quote (car out-file-parts)) - "_\\([[:alnum:]]+\\)\\." - (regexp-quote (cdr out-file-parts))) - file) - (= (length (match-string 1 out-file)) 40)) - (delete-file (expand-file-name file - (file-name-directory out-file))))) - (directory-files (or (file-name-directory out-file) - default-directory))) - (with-temp-file data-file (insert body)) - (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) - (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))) - (format "\n[[file:%s]]\n" out-file)) - (t (concat - "\n#+BEGIN_EXAMPLE\n" - body (if (string-match "\n$" body) "" "\n") - "#+END_EXAMPLE\n"))) - (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")))) + (cond + ((member org-export-current-backend '(html latex docbook)) + (unless (file-exists-p out-file) + (mapc ;; remove old hashed versions of this file + (lambda (file) + (when (and (string-match (concat (regexp-quote (car out-file-parts)) + "_\\([[:alnum:]]+\\)\\." + (regexp-quote (cdr out-file-parts))) + file) + (= (length (match-string 1 out-file)) 40)) + (delete-file (expand-file-name file + (file-name-directory out-file))))) + (directory-files (or (file-name-directory out-file) + default-directory))) + (with-temp-file data-file (insert body)) + (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) + (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))) + (format "\n[[file:%s]]\n" out-file)) + (t (concat + "\n#+BEGIN_EXAMPLE\n" + body (if (string-match "\n$" body) "" "\n") + "#+END_EXAMPLE\n"))) + (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")))) ;;-------------------------------------------------------------------------------- ;; dot: create graphs using the dot graphing language @@ -332,29 +342,29 @@ digraph data_relationships { (cons raw-out-file "png"))) (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) (prog1 - (cond - ((member org-export-current-backend '(html latex docbook)) - (unless (file-exists-p out-file) - (mapc ;; remove old hashed versions of this file - (lambda (file) - (when (and (string-match (concat (regexp-quote (car out-file-parts)) - "_\\([[:alnum:]]+\\)\\." - (regexp-quote (cdr out-file-parts))) - file) - (= (length (match-string 1 out-file)) 40)) - (delete-file (expand-file-name file - (file-name-directory out-file))))) - (directory-files (or (file-name-directory out-file) - default-directory))) - (with-temp-file data-file (insert body)) - (message (concat "dot " data-file " " args " -o " out-file)) - (shell-command (concat "dot " data-file " " args " -o " out-file))) - (format "\n[[file:%s]]\n" out-file)) - (t (concat - "\n#+BEGIN_EXAMPLE\n" - body (if (string-match "\n$" body) "" "\n") - "#+END_EXAMPLE\n"))) - (message "begin_dot blocks are DEPRECATED, use begin_src blocks")))) + (cond + ((member org-export-current-backend '(html latex docbook)) + (unless (file-exists-p out-file) + (mapc ;; remove old hashed versions of this file + (lambda (file) + (when (and (string-match (concat (regexp-quote (car out-file-parts)) + "_\\([[:alnum:]]+\\)\\." + (regexp-quote (cdr out-file-parts))) + file) + (= (length (match-string 1 out-file)) 40)) + (delete-file (expand-file-name file + (file-name-directory out-file))))) + (directory-files (or (file-name-directory out-file) + default-directory))) + (with-temp-file data-file (insert body)) + (message (concat "dot " data-file " " args " -o " out-file)) + (shell-command (concat "dot " data-file " " args " -o " out-file))) + (format "\n[[file:%s]]\n" out-file)) + (t (concat + "\n#+BEGIN_EXAMPLE\n" + body (if (string-match "\n$" body) "" "\n") + "#+END_EXAMPLE\n"))) + (message "begin_dot blocks are DEPRECATED, use begin_src blocks")))) ;;-------------------------------------------------------------------------------- ;; comment: export comments in author-specific css-stylable divs diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el index 174619a3b8f..6b506cd1275 100644 --- a/lisp/org/org-exp.el +++ b/lisp/org/org-exp.el @@ -1,4 +1,4 @@ -;;; org-exp.el --- ASCII, HTML, XOXO and iCalendar export for Org-mode +;;; org-exp.el --- Export internals for Org-mode ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. @@ -190,16 +190,31 @@ This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." ("eo" "Aŭtoro" "Dato" "Enhavo" "Piednotoj") ("es" "Autor" "Fecha" "Índice" "Pies de página") ("fi" "Tekijä" "Päivämäärä" "Sisällysluettelo" "Alaviitteet") - ("fr" "Auteur" "Date" "Table des matières" "Notes de bas de page") + ("fr" "Auteur" "Date" "Sommaire" "Notes de bas de page") ("hu" "Szerzõ" "Dátum" "Tartalomjegyzék" "Lábjegyzet") ("is" "Höfundur" "Dagsetning" "Efnisyfirlit" "Aftanmálsgreinar") ("it" "Autore" "Data" "Indice" "Note a piè di pagina") + ;; Use numeric character entities for proper rendering of non-UTF8 documents + ;; ("ja" "著者" "日付" "目次" "脚注") + ("ja" "著者" "日付" "目次" "脚注") ("nl" "Auteur" "Datum" "Inhoudsopgave" "Voetnoten") ("no" "Forfatter" "Dato" "Innhold" "Fotnoter") ("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l) ("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk) ("pl" "Autor" "Data" "Spis treści" "Przypis") - ("sv" "Författare" "Datum" "Innehåll" "Fotnoter")) + ;; Use numeric character entities for proper rendering of non-UTF8 documents + ;; ("ru" "Ðвтор" "Дата" "Содержание" "СноÑки") + ("ru" "Автор" "Дата" "Содержание" "Сноски") + ("sv" "Författare" "Datum" "Innehåll" "Fotnoter") + ;; Use numeric character entities for proper rendering of non-UTF8 documents + ;; ("uk" "Ðвтор" "Дата" "ЗміÑÑ‚" "Примітки") + ("uk" "Автор" "Дата" "Зміст" "Примітки") + ;; Use numeric character entities for proper rendering of non-UTF8 documents + ;; ("zh-CN" "作者" "日期" "目录" "脚注") + ("zh-CN" "作者" "日期" "目录" "脚注") + ;; Use numeric character entities for proper rendering of non-UTF8 documents + ;; ("zh-TW" "作者" "日期" "目錄" "腳註") + ("zh-TW" "作者" "日期" "目錄" "腳註")) "Terms used in export text, translated to different languages. Use the variable `org-export-default-language' to set the language, or use the +OPTION lines for a per-file setting." @@ -525,12 +540,14 @@ This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\". Allowed values are: -nil Don't do anything. -verbatim Keep everything in verbatim -dvipng Process the LaTeX fragments to images. - This will also include processing of non-math environments. -t Do MathJax preprocessing if there is at least on math snippet, - and arrange for MathJax.js to be loaded. +nil Don't do anything. +verbatim Keep everything in verbatim +dvipng Process the LaTeX fragments to images. + This will also include processing of non-math environments. +imagemagick Convert the LaTeX fragments to pdf files and use imagemagick + to convert pdf files to png files. +t Do MathJax preprocessing if there is at least on math snippet, + and arrange for MathJax.js to be loaded. The default is nil, because this option needs the `dvipng' program which is not available on all systems." @@ -540,6 +557,7 @@ is not available on all systems." (const :tag "Do not process math in any way" nil) (const :tag "Obsolete, use dvipng setting" t) (const :tag "Use dvipng to make images" dvipng) + (const :tag "Use imagemagick to make images" imagemagick) (const :tag "Use MathJax to display math" mathjax) (const :tag "Leave math verbatim" verbatim))) @@ -623,7 +641,7 @@ table.el tables." (defvar org-export-current-backend nil "During export, this will be bound to a symbol such as 'html, 'latex, 'docbook, 'ascii, etc, indicating which of the export - backends is in use. Otherwise it has the value nil. Users + backends is in use. Otherwise it has the value nil. Users should not attempt to change the value of this variable directly, but it can be used in code to test whether export is in progress, and if so, what the backend is.") @@ -702,7 +720,7 @@ Each element is a list of 3 items: 2. The string that can be used in the OPTION lines to set this option, or nil if this option cannot be changed in this way 3. The customization variable that sets the default for this option." -) + ) (defun org-default-export-plist () "Return the property list with default settings for the export variables." @@ -713,8 +731,7 @@ Each element is a list of 3 items: (setq s (nth 2 e) v (cond ((assq s letbind) (nth 1 (assq s letbind))) - ((boundp s) (symbol-value s)) - (t nil)) + ((boundp s) (symbol-value s))) rtn (cons (car e) (cons v rtn)))) rtn)) @@ -957,6 +974,8 @@ Pressing `1' will switch between these two options." (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background)) (subtree-p (or (org-region-active-p) (eq org-export-initial-scope 'subtree))) + (regb (and (org-region-active-p) (region-beginning))) + (rege (and (org-region-active-p) (region-end))) (help "[t] insert the export option template \[v] limit export to visible part of outline tree \[1] switch buffer/subtree export @@ -1037,6 +1056,10 @@ Pressing `1' will switch between these two options." ((not subtree-p) (setq subtree-p t) (setq bpos (point)) + (org-mark-subtree) + (org-activate-mark) + (setq regb (and (org-region-active-p) (region-beginning))) + (setq rege (and (org-region-active-p) (region-end))) (message "Export subtree: ")))) (when (eq r1 ?\ ) (let ((case-fold-search t) @@ -1074,8 +1097,9 @@ Pressing `1' will switch between these two options." "-f" (symbol-name (nth 1 ass))))) (set-process-sentinel p 'org-export-process-sentinel) (message "Background process \"%s\": started" p)) - ;; background processing not requested, or not possible - (if subtree-p (progn (org-mark-subtree) (org-activate-mark))) + ;; set the mark correctly when exporting a subtree + (if subtree-p (let (deactivate-mark) (push-mark rege t t) (goto-char regb))) + (call-interactively (nth 1 ass)) (when (and bpos (get-buffer-window cbuf)) (let ((cw (selected-window))) @@ -1184,7 +1208,7 @@ on this string to produce the exported version." (when (plist-get parameters :footnotes) (org-footnote-normalize nil parameters)) - ;; Change lists ending. Other parts of export may insert blank + ;; Change lists ending. Other parts of export may insert blank ;; lines and lists' structure could be altered. (org-export-mark-list-end) @@ -1300,11 +1324,8 @@ on this string to produce the exported version." ;; Remove or replace comments (org-export-handle-comments (plist-get parameters :comments)) - ;; Remove #+TBLFM and #+TBLNAME lines - (org-export-handle-table-metalines) - - ;; Remove #+results and #+name lines - (org-export-res/src-name-cleanup) + ;; Remove #+TBLFM #+TBLNAME #+NAME #+RESULTS lines + (org-export-handle-metalines) ;; Run the final hook (run-hooks 'org-export-preprocess-final-hook) @@ -1406,53 +1427,53 @@ the current file." (goto-char (point-min)) (while (re-search-forward org-bracket-link-regexp nil t) (org-if-unprotected-at (1+ (match-beginning 0)) - (let* ((org-link-search-must-match-exact-headline t) - (md (match-data)) - (desc (match-end 2)) - (link (org-link-unescape (match-string 1))) - (slink (org-solidify-link-text link)) - found props pos cref - (target - (cond - ((= (string-to-char link) ?#) - ;; user wants exactly this link - link) - ((cdr (assoc slink target-alist)) - (or (cdr (assoc (assoc slink target-alist) - org-export-preferred-target-alist)) - (cdr (assoc slink target-alist)))) - ((and (string-match "^id:" link) - (cdr (assoc (substring link 3) target-alist)))) - ((string-match "^(\\(.*\\))$" link) - (setq cref (match-string 1 link)) - (concat "coderef:" cref)) - ((string-match org-link-types-re link) nil) - ((or (file-name-absolute-p link) - (string-match "^\\." link)) - nil) - (t - (let ((org-link-search-inhibit-query t)) - (save-excursion - (setq found (condition-case nil (org-link-search link) - (error nil))) - (when (and found - (or (org-at-heading-p) - (not (eq found 'dedicated)))) - (or (get-text-property (point) 'target) - (get-text-property - (max (point-min) - (1- (or (previous-single-property-change - (point) 'target) 0))) - 'target))))))))) - (when target - (set-match-data md) - (goto-char (match-beginning 1)) - (setq props (text-properties-at (point))) - (delete-region (match-beginning 1) (match-end 1)) - (setq pos (point)) - (insert target) - (unless desc (insert "][" link)) - (add-text-properties pos (point) props)))))) + (let* ((org-link-search-must-match-exact-headline t) + (md (match-data)) + (desc (match-end 2)) + (link (org-link-unescape (match-string 1))) + (slink (org-solidify-link-text link)) + found props pos cref + (target + (cond + ((= (string-to-char link) ?#) + ;; user wants exactly this link + link) + ((cdr (assoc slink target-alist)) + (or (cdr (assoc (assoc slink target-alist) + org-export-preferred-target-alist)) + (cdr (assoc slink target-alist)))) + ((and (string-match "^id:" link) + (cdr (assoc (substring link 3) target-alist)))) + ((string-match "^(\\(.*\\))$" link) + (setq cref (match-string 1 link)) + (concat "coderef:" cref)) + ((string-match org-link-types-re link) nil) + ((or (file-name-absolute-p link) + (string-match "^\\." link)) + nil) + (t + (let ((org-link-search-inhibit-query t)) + (save-excursion + (setq found (condition-case nil (org-link-search link) + (error nil))) + (when (and found + (or (org-at-heading-p) + (not (eq found 'dedicated)))) + (or (get-text-property (point) 'target) + (get-text-property + (max (point-min) + (1- (or (previous-single-property-change + (point) 'target) 0))) + 'target))))))))) + (when target + (set-match-data md) + (goto-char (match-beginning 1)) + (setq props (text-properties-at (point))) + (delete-region (match-beginning 1) (match-end 1)) + (setq pos (point)) + (insert target) + (unless desc (insert "][" link)) + (add-text-properties pos (point) props)))))) (defun org-export-remember-html-container-classes () "Store the HTML_CONTAINER_CLASS properties in a text property." @@ -1462,8 +1483,10 @@ the current file." "^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t) (setq class (match-string 1)) (save-excursion - (org-back-to-heading t) - (put-text-property (point-at-bol) (point-at-eol) 'html-container-class class))))) + (when (re-search-backward "^\\*" (point-min) t) + (org-back-to-heading t) + (put-text-property (point-at-bol) (point-at-eol) + 'html-container-class class)))))) (defvar org-export-format-drawer-function nil "Function to be called to format the contents of a drawer. @@ -1532,8 +1555,8 @@ removed as well." select-tags "\\|") "\\):")) (re-excl (concat ":\\(" (mapconcat 'regexp-quote - exclude-tags "\\|") - "\\):")) + exclude-tags "\\|") + "\\):")) beg end cont) (goto-char (point-min)) (when (and select-tags @@ -1594,8 +1617,8 @@ When it is a list of strings, keep only tasks with these TODO keywords." org-todo-keywords-1)))) "\\|") "\\)\\($\\|[ \t]\\)")) - (case-fold-search nil) - beg) + (case-fold-search nil) + beg) (goto-char (point-min)) (while (re-search-forward re nil t) (org-if-unprotected @@ -1741,7 +1764,7 @@ from the buffer." (add-text-properties (point-at-bol) (min (1+ (point-at-eol)) (point-max)) `(org-protected t original-indentation ,ind org-native-text t))))) - ;; Delete #+ATTR_BACKEND: stuff of another backend. Those + ;; Delete #+ATTR_BACKEND: stuff of another backend. Those ;; matching the current backend will be taken care of by ;; `org-export-attach-captions-and-attributes' (goto-char (point-min)) @@ -1819,9 +1842,9 @@ These special cookies will later be interpreted by the backend." (replace-match "")) (unless (bolp) (insert "\n")) ;; As org-list-end is inserted at column 0, it would end - ;; by indentation any list. It can be problematic when + ;; by indentation any list. It can be problematic when ;; there are lists within lists: the inner list end would - ;; also become the outer list end. To avoid this, text + ;; also become the outer list end. To avoid this, text ;; property `original-indentation' is added, as ;; `org-list-struct' pays attention to it when reading a ;; list. @@ -1838,7 +1861,7 @@ These special properties will later be interpreted by the backend." ;; Mark a list with 3 properties: `list-item' which is ;; position at beginning of line, `list-struct' which is ;; list structure, and `list-prevs' which is the alist of - ;; item and its predecessor. Leave point at list ending. + ;; item and its predecessor. Leave point at list ending. (lambda (ctxt) (let* ((struct (org-list-struct)) (top (org-list-get-top-point struct)) @@ -1866,9 +1889,9 @@ These special properties will later be interpreted by the backend." 'list-struct struct 'list-prevs prevs))) poi) - ;; Take care of bottom point. As babel may have inserted + ;; Take care of bottom point. As babel may have inserted ;; a new list in buffer, list ending isn't always - ;; marked. Now mark every list ending and add properties + ;; marked. Now mark every list ending and add properties ;; useful to line processing exporters. (goto-char bottom) (when (or (looking-at "^ORG-LIST-END-MARKER\n") @@ -1878,8 +1901,8 @@ These special properties will later be interpreted by the backend." (unless (bolp) (insert "\n")) (insert (org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom - 'list-struct struct - 'list-prevs prevs))) + 'list-struct struct + 'list-prevs prevs))) ;; Following property is used by LaTeX exporter. (add-text-properties top (point) (list 'list-context ctxt))))))) ;; Mark lists except for backends not interpreting them. @@ -1971,29 +1994,33 @@ table line. If it is a link, add it to the line containing the link." "Remove comments, or convert to backend-specific format. ORG-COMMENTSP can be a format string for publishing comments. When it is nil, all comments will be removed." - (let ((re "^\\(#\\|[ \t]*#\\+ \\)\\(.*\n?\\)") - pos) + (let ((re "^[ \t]*#\\( \\|$\\)")) (goto-char (point-min)) - (while (or (looking-at re) - (re-search-forward re nil t)) - (setq pos (match-beginning 0)) - (if (get-text-property pos 'org-protected) - (goto-char (1+ pos)) - (if (and org-commentsp - (not (equal (char-before (match-end 1)) ?+))) - (progn (add-text-properties - (match-beginning 0) (match-end 0) '(org-protected t)) - (replace-match (org-add-props - (format org-commentsp (match-string 2)) - nil 'org-protected t) - t t)) - (goto-char (1+ pos)) - (replace-match "") - (goto-char (max (point-min) (1- pos)))))))) + (while (re-search-forward re nil t) + (let ((pos (match-beginning 0)) + (end (progn (forward-line) (point)))) + (if (get-text-property pos 'org-protected) + (forward-line) + (if (not org-commentsp) (delete-region pos end) + (add-text-properties pos end '(org-protected t)) + (replace-match + (org-add-props + (format org-commentsp (buffer-substring (match-end 0) end)) + nil 'org-protected t) + t t))))) + ;; Hack attack: previous implementation also removed keywords at + ;; column 0. Brainlessly do it again. + (goto-char (point-min)) + (while (re-search-forward "^#\\+" nil t) + (unless (get-text-property (point-at-bol) 'org-protected) + (delete-region (point-at-bol) (progn (forward-line) (point))))))) -(defun org-export-handle-table-metalines () - "Remove table specific metalines #+TBLNAME: and #+TBLFM:." - (let ((re "^[ \t]*#\\+TBL\\(NAME\\|FM\\):\\(.*\n?\\)") +(defun org-export-handle-metalines () + "Remove tables and source blocks metalines. +This function should only be called after all block processing +has taken place." + (let ((re "^[ \t]*#\\+\\(tbl\\(?:name\\|fm\\)\\|results\\(?:\\[[a-z0-9]+\\]\\)?\\|name\\):\\(.*\n?\\)") + (case-fold-search t) pos) (goto-char (point-min)) (while (or (looking-at re) @@ -2005,18 +2032,6 @@ When it is nil, all comments will be removed." (replace-match "") (goto-char (max (point-min) (1- pos))))))) -(defun org-export-res/src-name-cleanup () - "Clean up #+results and #+name lines for export. -This function should only be called after all block processing -has taken place." - (interactive) - (save-excursion - (goto-char (point-min)) - (let ((case-fold-search t)) - (while (org-re-search-forward-unprotected - "#\\+\\(name\\|results\\(\\[[a-z0-9]+\\]\\)?\\):" nil t) - (delete-region (match-beginning 0) (progn (forward-line) (point))))))) - (defun org-export-mark-radio-links () "Find all matches for radio targets and turn them into internal links." (let ((re-radio (and org-target-link-regexp @@ -2146,8 +2161,8 @@ can work correctly." (goto-char (point-min)) (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t) (org-if-unprotected-at (match-beginning 1) - (replace-match "\\1 \\3") - (goto-char (match-beginning 0))))) + (replace-match "\\1 \\3") + (goto-char (match-beginning 0))))) (defun org-export-concatenate-multiline-emphasis () "Find multi-line emphasis and put it all into a single line. @@ -2372,7 +2387,7 @@ TYPE must be a string, any of: (if (stringp val) val (format "%s" val)) "\n") (concat "\n" ind-str))))) - ;; Eventually do the replacement, if VAL isn't nil. Move + ;; Eventually do the replacement, if VAL isn't nil. Move ;; point at beginning of macro for recursive expansions. (when val (replace-match val t t) @@ -2391,13 +2406,14 @@ TYPE must be a string, any of: (defun org-export-handle-include-files () "Include the contents of include files, with proper formatting." (let ((case-fold-search t) - params file markup lang start end prefix prefix1 switches all minlevel lines) + params file markup lang start end prefix prefix1 switches all minlevel currentlevel addlevel lines) (goto-char (point-min)) - (while (re-search-forward "^#\\+INCLUDE:?[ \t]+\\(.*\\)" nil t) + (while (re-search-forward "^#\\+include:[ \t]+\\(.*\\)" nil t) (setq params (read (concat "(" (match-string 1) ")")) prefix (org-get-and-remove-property 'params :prefix) prefix1 (org-get-and-remove-property 'params :prefix1) minlevel (org-get-and-remove-property 'params :minlevel) + addlevel (org-get-and-remove-property 'params :addlevel) lines (org-get-and-remove-property 'params :lines) file (org-symname-or-string (pop params)) markup (org-symname-or-string (pop params)) @@ -2406,6 +2422,7 @@ TYPE must be a string, any of: switches (mapconcat #'(lambda (x) (format "%s" x)) params " ") start nil end nil) (delete-region (match-beginning 0) (match-end 0)) + (setq currentlevel (or (org-current-level) 0)) (if (or (not file) (not (file-exists-p file)) (not (file-readable-p file))) @@ -2421,7 +2438,7 @@ TYPE must be a string, any of: end (format "#+end_%s" markup)))) (insert (or start "")) (insert (org-get-file-contents (expand-file-name file) - prefix prefix1 markup minlevel lines)) + prefix prefix1 markup currentlevel minlevel addlevel lines)) (or (bolp) (newline)) (insert (or end "")))) all)) @@ -2438,13 +2455,15 @@ TYPE must be a string, any of: (when intersection (error "Recursive #+INCLUDE: %S" intersection)))))) -(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel lines) +(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel parentlevel addlevel lines) "Get the contents of FILE and return them as a string. If PREFIX is a string, prepend it to each line. If PREFIX1 is a string, prepend it to the first line instead of PREFIX. If MARKUP, don't protect org-like lines, the exporter will -take care of the block they are in. If LINES is a string -specifying a range of lines, include only those lines ." +take care of the block they are in. If ADDLEVEL is a number, +demote included file to current heading level+ADDLEVEL. +If LINES is a string specifying a range of lines, +include only those lines." (if (stringp markup) (setq markup (downcase markup))) (with-temp-buffer (insert-file-contents file) @@ -2477,6 +2496,14 @@ specifying a range of lines, include only those lines ." (when minlevel (dotimes (lvl minlevel) (org-map-region 'org-demote (point-min) (point-max)))) + (when addlevel + (let ((inclevel (or (if (org-before-first-heading-p) + (1- (and (outline-next-heading) + (org-current-level))) + (1- (org-current-level))) + 0))) + (dotimes (level (- (+ parentlevel addlevel) inclevel)) + (org-map-region 'org-demote (point-min) (point-max))))) (buffer-string))) (defun org-get-and-remove-property (listvar prop) @@ -2548,7 +2575,7 @@ in the list) and remove property and value from the list in LISTVAR." (defvar org-export-latex-minted-options) ;; defined in org-latex.el (defun org-remove-formatting-on-newlines-in-region (beg end) - "Remove formatting on newline characters" + "Remove formatting on newline characters." (interactive "r") (save-excursion (goto-char beg) @@ -2562,10 +2589,10 @@ in the list) and remove property and value from the list in LISTVAR." The CODE is marked up in `org-export-current-backend' format. Check if a function by name -\"org-<backend>-format-source-code-or-example\" is bound. If yes, -use it as the custom formatter. Otherwise, use the default -formatter. Default formatters are provided for docbook, html, -latex and ascii backends. For example, use +\"org-<backend>-format-source-code-or-example\" is bound. If yes, +use it as the custom formatter. Otherwise, use the default +formatter. Default formatters are provided for docbook, html, +latex and ascii backends. For example, use `org-html-format-source-code-or-example' to provide a custom formatter for export to \"html\". @@ -2703,65 +2730,64 @@ INDENT was the original indentation of the block." (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) (cond ((and lang org-export-latex-listings) - (flet ((make-option-string - (pair) - (concat (first pair) - (if (> (length (second pair)) 0) - (concat "=" (second pair)))))) - (let* ((lang-sym (intern lang)) - (minted-p (eq org-export-latex-listings 'minted)) - (listings-p (not minted-p)) - (backend-lang - (or (cadr - (assq - lang-sym - (cond - (minted-p org-export-latex-minted-langs) - (listings-p org-export-latex-listings-langs)))) - lang)) - (custom-environment - (cadr - (assq - lang-sym - org-export-latex-custom-lang-environments)))) - (concat - (when (and listings-p (not custom-environment)) - (format - "\\lstset{%s}\n" - (mapconcat - #'make-option-string - (append org-export-latex-listings-options - `(("language" ,backend-lang))) ","))) - (when (and caption org-export-latex-listings-w-names) - (format - "\n%s $\\equiv$ \n" - (replace-regexp-in-string "_" "\\\\_" caption))) - (cond - (custom-environment - (format "\\begin{%s}\n%s\\end{%s}\n" - custom-environment rtn custom-environment)) - (listings-p - (format "\\begin{%s}\n%s\\end{%s}" - "lstlisting" rtn "lstlisting")) - (minted-p - (format - "\\begin{minted}[%s]{%s}\n%s\\end{minted}" - (mapconcat #'make-option-string - org-export-latex-minted-options ",") - backend-lang rtn))))))) + (let* ((make-option-string + (lambda (pair) + (concat (first pair) + (if (> (length (second pair)) 0) + (concat "=" (second pair)))))) + (lang-sym (intern lang)) + (minted-p (eq org-export-latex-listings 'minted)) + (listings-p (not minted-p)) + (backend-lang + (or (cadr + (assq + lang-sym + (cond + (minted-p org-export-latex-minted-langs) + (listings-p org-export-latex-listings-langs)))) + lang)) + (custom-environment + (cadr + (assq + lang-sym + org-export-latex-custom-lang-environments)))) + (concat + (when (and listings-p (not custom-environment)) + (format + "\\lstset{%s}\n" + (mapconcat + make-option-string + (append org-export-latex-listings-options + `(("language" ,backend-lang))) ","))) + (when (and caption org-export-latex-listings-w-names) + (format + "\n%s $\\equiv$ \n" + (replace-regexp-in-string "_" "\\\\_" caption))) + (cond + (custom-environment + (format "\\begin{%s}\n%s\\end{%s}\n" + custom-environment rtn custom-environment)) + (listings-p + (format "\\begin{%s}\n%s\\end{%s}" + "lstlisting" rtn "lstlisting")) + (minted-p + (format + "\\begin{minted}[%s]{%s}\n%s\\end{minted}" + (mapconcat make-option-string + org-export-latex-minted-options ",") + backend-lang rtn)))))) (t (concat (car org-export-latex-verbatim-wrap) rtn (cdr org-export-latex-verbatim-wrap))))) - ((eq org-export-current-backend 'ascii) - ;; This is not HTML or LaTeX, so just make it an example. - (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) - (concat caption "\n" + ((eq org-export-current-backend 'ascii) + ;; This is not HTML or LaTeX, so just make it an example. + (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) + (concat caption "\n" (concat (mapconcat (lambda (l) (concat " " l)) (org-split-string rtn "\n") "\n") - "\n") - )) + "\n"))) (t (error "Don't know how to markup source or example block in %s" (upcase backend-name))))) @@ -2787,7 +2813,7 @@ backend-specific lines pre-pended or appended to the original source block. NUMBER is non-nil if the literal example specifies \"+n\" or -\"-n\" switch. If NUMBER is non-nil add line numbers. +\"-n\" switch. If NUMBER is non-nil add line numbers. CONT is non-nil if the literal example specifies \"+n\" switch. If CONT is nil, start numbering this block from 1. Otherwise @@ -2837,7 +2863,7 @@ block numbering. When non-nil do the following: (fm (cond ((eq org-export-current-backend 'html) (format "<span class=\"linenr\">%s</span>" - fmt)) + fmt)) ((eq org-export-current-backend 'ascii) fmt) ((eq org-export-current-backend 'latex) fmt) ((eq org-export-current-backend 'docbook) fmt) @@ -2915,7 +2941,7 @@ block numbering. When non-nil do the following: (setq lv (- (match-end 1) (match-beginning 1)) todo (and (match-beginning 2) (not (member (match-string 2 line) - org-done-keywords)))) + org-done-keywords)))) ; TODO, not DONE (if (<= lv level) (throw 'exit nil)) (if todo (throw 'exit t)))))))) @@ -3202,8 +3228,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." (or org-tag-alist (org-get-buffer-tags)) " ") "") (mapconcat 'identity org-file-tags " ") org-archive-location - "org file:~/org/%s.org" - )) + "org file:~/org/%s.org")) ;;;###autoload (defun org-insert-export-options-template () @@ -3244,8 +3269,7 @@ If yes remove the column and the special lines." (mapcar (lambda (x) (cond ((member x '("<" "<")) :start) ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend) - (t nil))) + ((member x '("<>" "<>")) :startend))) (org-split-string x "[ \t]*|[ \t]*"))) nil) ((org-table-cookie-line-p x) @@ -3266,8 +3290,7 @@ If yes remove the column and the special lines." (mapcar (lambda (x) (cond ((member x '("<" "<")) :start) ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend) - (t nil))) + ((member x '("<>" "<>")) :startend))) (cdr (org-split-string x "[ \t]*|[ \t]*")))) nil) ((org-table-cookie-line-p x) @@ -3284,18 +3307,20 @@ If yes remove the column and the special lines." (defun org-export-cleanup-toc-line (s) "Remove tags and timestamps from lines going into the toc." - (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) + (if (not s) + "" ; Return a string when argument is nil + (when (memq org-export-with-tags '(not-in-toc nil)) + (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) + (setq s (replace-match "" t t s)))) + (when org-export-remove-timestamps-from-toc + (while (string-match org-maybe-keyword-time-regexp s) (setq s (replace-match "" t t s)))) - (when org-export-remove-timestamps-from-toc - (while (string-match org-maybe-keyword-time-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (match-string (if (match-end 3) 3 1) s) - t t s))) - (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s) - (setq s (replace-match "" t t s))) - s) + (while (string-match org-bracket-link-regexp s) + (setq s (replace-match (match-string (if (match-end 3) 3 1) s) + t t s))) + (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s) + (setq s (replace-match "" t t s))) + s)) (defun org-get-text-property-any (pos prop &optional object) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index 58f879dd51a..51aead1b8bb 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -287,12 +287,14 @@ column view defines special faces for each outline level. See the file (defface org-date-selected (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold nil)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold nil)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold nil)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold nil)) + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t)) (t (:inverse-video t)))) - "Face for highlighting the calendar day when using `org-read-date'." + "Face for highlighting the calendar day when using `org-read-date'. +Using a bold face here might cause discrepancies while displaying the +calendar." :group 'org-faces) (defface org-sexp-date @@ -309,6 +311,11 @@ Note that the variable `org-tag-faces' can be used to overrule this face for specific tags." :group 'org-faces) +(defface org-list-dt + '((t (:bold t))) + "Default face for definition terms in lists." + :group 'org-faces) + (defface org-todo ; font-lock-warning-face (org-compatible-face nil '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) @@ -381,8 +388,8 @@ determines if it is a foreground or a background color." (cons (string :tag "Keyword") (choice :tag "Face " - (string :tag "Color") - (sexp :tag "Face"))))) + (string :tag "Color") + (sexp :tag "Face"))))) (defcustom org-priority-faces nil "Faces for specific Priorities. @@ -398,8 +405,8 @@ determines if it is a foreground or a background color." (cons (character :tag "Priority") (choice :tag "Face " - (string :tag "Color") - (sexp :tag "Face"))))) + (string :tag "Color") + (sexp :tag "Face"))))) (defvar org-tags-special-faces-re nil) (defun org-set-tag-faces (var value) @@ -412,7 +419,7 @@ determines if it is a foreground or a background color." (defface org-checkbox (org-compatible-face 'bold '((t (:bold t)))) - "Face for checkboxes" + "Face for checkboxes." :group 'org-faces) @@ -439,8 +446,8 @@ changes." (cons (string :tag "Tag ") (choice :tag "Face" - (string :tag "Foreground color") - (sexp :tag "Face"))))) + (string :tag "Foreground color") + (sexp :tag "Face"))))) (defface org-table ;; originally copied from font-lock-function-name-face (org-compatible-face nil @@ -484,9 +491,9 @@ changes." :version "22.1") (defface org-document-title - '((((class color) (background light)) (:foreground "midnight blue" :weight bold :height 1.44)) - (((class color) (background dark)) (:foreground "pale turquoise" :weight bold :height 1.44)) - (t (:weight bold :height 1.44))) + '((((class color) (background light)) (:foreground "midnight blue" :weight bold)) + (((class color) (background dark)) (:foreground "pale turquoise" :weight bold)) + (t (:weight bold))) "Face for document title, i.e. that which follows the #+TITLE: keyword." :group 'org-faces) @@ -549,9 +556,9 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword." :version "22.1") (org-copy-face 'org-block 'org-quote - "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.") + "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.") (org-copy-face 'org-block 'org-verse - "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.") + "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.") (defcustom org-fontify-quote-and-verse-blocks nil "Non-nil means, add a special face to #+begin_quote and #+begin_verse block. @@ -574,8 +581,8 @@ content of these blocks will still be treated as Org syntax." (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) (t (:inverse-video t)))) - "Basic face for displaying the secondary selection." - :group 'org-faces) + "Basic face for displaying the secondary selection." + :group 'org-faces) (defface org-agenda-structure ;; originally copied from font-lock-function-name-face (org-compatible-face nil @@ -602,7 +609,7 @@ content of these blocks will still be treated as Org syntax." "Face used in agenda for weekend days. See the variable `org-agenda-weekend-days' for a definition of which days belong to the weekend." - :weight 'bold) + :weight 'bold) (defface org-scheduled (org-compatible-face nil @@ -727,8 +734,8 @@ month and 365.24 days for a year)." (defconst org-level-faces '(org-level-1 org-level-2 org-level-3 org-level-4 - org-level-5 org-level-6 org-level-7 org-level-8 - )) + org-level-5 org-level-6 org-level-7 org-level-8 + )) (defcustom org-n-level-faces (length org-level-faces) "The number of different faces to be used for headlines. @@ -738,14 +745,14 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." :group 'org-faces) (defcustom org-cycle-level-faces t - "Non-nil means level styles cycle after level `org-n-level-faces'. + "Non-nil means level styles cycle after level `org-n-level-faces'. Then so level org-n-level-faces+1 is styled like level 1. If nil, then all levels >=org-n-level-faces are styled like level org-n-level-faces" - :group 'org-appearance - :group 'org-faces - :version "24.1" - :type 'boolean) + :group 'org-appearance + :group 'org-faces + :version "24.1" + :type 'boolean) (defface org-latex-and-export-specials (let ((font (cond ((assq :inherit custom-face-attributes) diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index f5186aaacf3..91bf3347953 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -80,7 +80,7 @@ ;; that received the input of the feed. You should add FEEDSTATUS ;; to your list of drawers in the files that receive feed input: ;; -;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS +;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS ;; ;; Acknowledgments ;; --------------- @@ -100,6 +100,10 @@ (declare-function xml-get-attribute-or-nil "xml" (node attribute)) (declare-function xml-substitute-special "xml" (string)) +(declare-function org-capture-escaped-% "org-capture" ()) +(declare-function org-capture-inside-embedded-elisp-p "org-capture" ()) +(declare-function org-capture-expand-embedded-elisp "org-capture" ()) + (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." :tag "Org Feed" @@ -179,34 +183,34 @@ Here are the keyword-value pair allows in `org-feed-alist'. :group 'org-feed :type '(repeat (list :value ("" "http://" "" "") - (string :tag "Name") - (string :tag "Feed URL") - (file :tag "File for inbox") - (string :tag "Headline for inbox") - (repeat :inline t - (choice - (list :inline t :tag "Filter" - (const :filter) - (symbol :tag "Filter Function")) - (list :inline t :tag "Template" - (const :template) - (string :tag "Template")) - (list :inline t :tag "Formatter" - (const :formatter) - (symbol :tag "Formatter Function")) - (list :inline t :tag "New items handler" - (const :new-handler) - (symbol :tag "Handler Function")) - (list :inline t :tag "Changed items" - (const :changed-handler) - (symbol :tag "Handler Function")) - (list :inline t :tag "Parse Feed" - (const :parse-feed) - (symbol :tag "Parse Feed Function")) - (list :inline t :tag "Parse Entry" - (const :parse-entry) - (symbol :tag "Parse Entry Function")) - ))))) + (string :tag "Name") + (string :tag "Feed URL") + (file :tag "File for inbox") + (string :tag "Headline for inbox") + (repeat :inline t + (choice + (list :inline t :tag "Filter" + (const :filter) + (symbol :tag "Filter Function")) + (list :inline t :tag "Template" + (const :template) + (string :tag "Template")) + (list :inline t :tag "Formatter" + (const :formatter) + (symbol :tag "Formatter Function")) + (list :inline t :tag "New items handler" + (const :new-handler) + (symbol :tag "Handler Function")) + (list :inline t :tag "Changed items" + (const :changed-handler) + (symbol :tag "Handler Function")) + (list :inline t :tag "Parse Feed" + (const :parse-feed) + (symbol :tag "Parse Feed Function")) + (list :inline t :tag "Parse Entry" + (const :parse-entry) + (symbol :tag "Parse Entry Function")) + ))))) (defcustom org-feed-drawer "FEEDSTATUS" "The name of the drawer for feed status information. @@ -225,12 +229,14 @@ Any fields from the feed item can be interpolated into the template with %name, for example %title, %description, %pubDate etc. In addition, the following special escapes are valid as well: -%h the title, or the first line of the description -%t the date as a stamp, either from <pubDate> (if present), or - the current date. -%T date and time -%u,%U like %t,%T, but inactive time stamps -%a A link, from <guid> if that is a permalink, else from <link>" +%h The title, or the first line of the description +%t The date as a stamp, either from <pubDate> (if present), or + the current date +%T Date and time +%u,%U Like %t,%T, but inactive time stamps +%a A link, from <guid> if that is a permalink, else from <link> +%(sexp) Evaluate elisp `(sexp)' and replace with the result, the simple + %-escapes above can be used as arguments, e.g. %(capitalize \\\"%h\\\")" :group 'org-feed :type '(string :tag "Template")) @@ -251,7 +257,7 @@ of the file pointed to by the URL." (const :tag "Externally with wget" wget) (function :tag "Function"))) - (defcustom org-feed-before-adding-hook nil +(defcustom org-feed-before-adding-hook nil "Hook that is run before adding new feed items to a file. You might want to commit the file in its current state to version control, for example." @@ -450,8 +456,8 @@ Switch to that buffer, and return the position of that headline." nil t) (goto-char (match-beginning 0)) (goto-char (point-max)) - (insert "\n\n* " heading "\n\n") - (org-back-to-heading t)) + (insert "\n\n* " heading "\n\n") + (org-back-to-heading t)) (point)) (defun org-feed-read-previous-status (pos drawer) @@ -506,9 +512,10 @@ This will find DRAWER and extract the alist." ENTRY is a property list. This function adds a `:formatted-for-org' property and returns the full property list. If that property is already present, nothing changes." + (require 'org-capture) (if formatter (funcall formatter entry) - (let (dlines fmt tmp indent time name + (let (dlines time escape name tmp v-h v-t v-T v-u v-U v-a) (setq dlines (org-split-string (or (plist-get entry :description) "???") "\n") @@ -527,20 +534,35 @@ If that property is already present, nothing changes." "")) (with-temp-buffer (insert template) + + ;; Simple %-escapes + ;; before embedded elisp to support simple %-escapes as + ;; arguments for embedded elisp (goto-char (point-min)) (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t) - (setq name (match-string 1)) - (cond - ((member name '("h" "t" "T" "u" "U" "a")) - (replace-match (symbol-value (intern (concat "v-" name))) t t)) - ((setq tmp (plist-get entry (intern (concat ":" name)))) - (save-excursion - (save-match-data - (beginning-of-line 1) - (when (looking-at (concat "^\\([ \t]*\\)%" name "[ \t]*$")) - (setq tmp (org-feed-make-indented-block - tmp (org-get-indentation)))))) - (replace-match tmp t t)))) + (unless (org-capture-escaped-%) + (setq name (match-string 1) + escape (org-capture-inside-embedded-elisp-p)) + (cond + ((member name '("h" "t" "T" "u" "U" "a")) + (setq tmp (symbol-value (intern (concat "v-" name))))) + ((setq tmp (plist-get entry (intern (concat ":" name)))) + (save-excursion + (save-match-data + (beginning-of-line 1) + (when (looking-at + (concat "^\\([ \t]*\\)%" name "[ \t]*$")) + (setq tmp (org-feed-make-indented-block + tmp (org-get-indentation)))))))) + (when tmp + ;; escape string delimiters `"' when inside %() embedded lisp + (when escape + (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp))) + (replace-match tmp t t)))) + + ;; %() embedded elisp + (org-capture-expand-embedded-elisp) + (decode-coding-string (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index a9ba8d7510b..3aaa44b7ac3 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -57,6 +57,7 @@ (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function org-show-context "org" (&optional key)) (declare-function org-trim "org" (s)) +(declare-function org-skip-whitespace "org" ()) (declare-function outline-next-heading "outline") (declare-function org-skip-whitespace "org" ()) @@ -277,9 +278,7 @@ otherwise." (concat org-outline-regexp-bol "\\|" org-footnote-definition-re "\\|" "^[ \t]*$") bound 'move)) - (progn (goto-char (match-beginning 0)) - (org-skip-whitespace) - (point-at-bol)) + (match-beginning 0) (point))))) (list label beg end (org-trim (buffer-substring-no-properties beg-def end))))))))) @@ -362,7 +361,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 (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")) t))) @@ -451,7 +450,8 @@ or new, let the user edit the definition of the footnote." (error "Cannot insert a footnote here")) (let* ((lbls (and (not (equal org-footnote-auto-label 'random)) (org-footnote-all-labels))) - (propose (org-footnote-unique-label lbls)) + (propose (and (not (equal org-footnote-auto-label 'random)) + (org-footnote-unique-label lbls))) (label (org-footnote-normalize-label (cond @@ -489,7 +489,7 @@ or new, let the user edit the definition of the footnote." (let ((label (org-footnote-normalize-label label))) (cond ;; In an Org file. - ((eq major-mode 'org-mode) + ((derived-mode-p 'org-mode) ;; If `org-footnote-section' is defined, find it, or create it ;; at the end of the buffer. (when org-footnote-section @@ -553,7 +553,7 @@ or new, let the user edit the definition of the footnote." (backward-char) ;; Only notify user about next possible action when in an Org ;; buffer, as the bindings may have different meanings otherwise. - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))) @@ -713,7 +713,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; 2. Find and remove the footnote section, if any. Also ;; determine where footnotes shall be inserted (INS-POINT). (cond - ((and org-footnote-section (eq major-mode 'org-mode)) + ((and org-footnote-section (derived-mode-p 'org-mode)) (goto-char (point-min)) (if (re-search-forward (concat "^\\*[ \t]+" (regexp-quote org-footnote-section) @@ -729,7 +729,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; of the section containing their first reference. ;; Nevertheless, in an export situation, set insertion point to ;; `point-max' by default. - ((eq major-mode 'org-mode) + ((derived-mode-p 'org-mode) (when export-props (goto-char (point-max)) (skip-chars-backward " \r\t\n") @@ -790,7 +790,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 (eq major-mode 'org-mode)) + ((or (not (derived-mode-p 'org-mode)) org-footnote-section export-props) ;; Insert again the section title, if any. Ensure that title, @@ -799,7 +799,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 (eq major-mode 'org-mode)) + ((not (derived-mode-p 'org-mode)) (skip-chars-backward " \t\n\r") (delete-region (point) ins-point) (unless (bolp) (newline)) @@ -845,7 +845,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': (beginning-of-line 0) (while (and (not (bobp)) (= (char-after) ?#)) (beginning-of-line 0)) - (if (looking-at "[ \t]*#\\+TBLFM:") (beginning-of-line 2)) + (if (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) (beginning-of-line 2)) (end-of-line 1) (skip-chars-backward "\n\r\t ") (forward-line)) @@ -872,7 +872,11 @@ Return the number of footnotes removed." (while (re-search-forward def-re nil t) (let ((full-def (org-footnote-at-definition-p))) (when full-def - (delete-region (nth 1 full-def) (nth 2 full-def)) + ;; Remove the footnote, and all blank lines before it. + (goto-char (nth 1 full-def)) + (skip-chars-backward " \r\t\n") + (unless (bolp) (forward-line)) + (delete-region (point) (nth 2 full-def)) (incf ndef)))) ndef))) @@ -888,7 +892,7 @@ If LABEL is non-nil, delete that footnote instead." (label (cond ;; LABEL is provided as argument. (label) - ;; Footnote reference at point. If the footnote is + ;; Footnote reference at point. If the footnote is ;; anonymous, delete it and exit instead. ((setq x (org-footnote-at-reference-p)) (or (car x) diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el index 3b94d928945..a05cb554d4b 100644 --- a/lisp/org/org-freemind.el +++ b/lisp/org/org-freemind.el @@ -60,7 +60,7 @@ (require 'xml) (require 'org) -;(require 'rx) + ;(require 'rx) (require 'org-exp) (eval-when-compile (require 'cl)) @@ -139,7 +139,7 @@ NOT READY YET." ;;;###autoload (defun org-export-as-freemind (&optional hidden ext-plist - to-buffer body-only pub-dir) + to-buffer body-only pub-dir) "Export the current buffer as a Freemind file. If there is an active region, export only the region. HIDDEN is obsolete and does nothing. EXT-PLIST is a property list with @@ -258,22 +258,22 @@ The characters \"&<> will be escaped." ;;(org-freemind-unescape-str-to-org "mA≌B<C<=") ;;(org-freemind-unescape-str-to-org "<<") (defun org-freemind-unescape-str-to-org (fm-str) - "Do some html-unescaping of FM-STR and return the result. + "Do some html-unescaping of FM-STR and return the result. This is the opposite of `org-freemind-escape-str-from-org' but it will also unescape &#nn;." - (let ((org-str fm-str)) - (setq org-str (replace-regexp-in-string """ "\"" org-str)) - (setq org-str (replace-regexp-in-string "&" "&" org-str)) - (setq org-str (replace-regexp-in-string "<" "<" org-str)) - (setq org-str (replace-regexp-in-string ">" ">" org-str)) - (setq org-str (replace-regexp-in-string - "&#x\\([a-f0-9]\\{2,4\\}\\);" - (lambda (m) - (char-to-string - (+ (string-to-number (match-string 1 m) 16) - 0 ;?\x800 ;; What is this for? Encoding? - ))) - org-str)))) + (let ((org-str fm-str)) + (setq org-str (replace-regexp-in-string """ "\"" org-str)) + (setq org-str (replace-regexp-in-string "&" "&" org-str)) + (setq org-str (replace-regexp-in-string "<" "<" org-str)) + (setq org-str (replace-regexp-in-string ">" ">" org-str)) + (setq org-str (replace-regexp-in-string + "&#x\\([a-f0-9]\\{2,4\\}\\);" + (lambda (m) + (char-to-string + (+ (string-to-number (match-string 1 m) 16) + 0 ;?\x800 ;; What is this for? Encoding? + ))) + org-str)))) ;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ") ;; (str2 (org-freemind-escape-str-from-org str1)) @@ -291,7 +291,7 @@ MATCHED is the link just matched." (is-img (and (image-type-from-file-name link) (let ((url-type (substring link 0 col-pos))) (member url-type '("file" "http" "https"))))) - ) + ) (if is-img ;; Fix-me: I can't find a way to get the border to "shrink ;; wrap" around the image using <div>. @@ -334,7 +334,7 @@ MATCHED is the link just matched." "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]" ;;"<a href=\"\\1\">\\2</a>" 'org-freemind-convert-links-helper - fm-str))) + fm-str t t))) ;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>") (defun org-freemind-convert-links-to-org (fm-str) @@ -380,7 +380,7 @@ MATCHED is the link just matched." (dolist (cc (append matched nil)) (if (= 32 cc) ;;(setq res (concat res " ")) - ;; We need to use the numerical version. Otherwise Freemind + ;; We need to use the numerical version. Otherwise Freemind ;; ver 0.9.0 RC9 can not export to html/javascript. (progn (if (< 0 bi) @@ -410,7 +410,7 @@ MATCHED is the link just matched." (defcustom org-freemind-node-css-style "p { margin-top: 3px; margin-bottom: 3px; }" "CSS style for Freemind nodes." - ;; Fix-me: I do not understand this. It worked to export from Freemind + ;; Fix-me: I do not understand this. It worked to export from Freemind ;; with this setting now, but not before??? Was this perhaps a java ;; bug or is it a windows xp bug (some resource gets exhausted if you ;; use sticky keys which I do). @@ -455,8 +455,7 @@ DRAWERS-REGEXP are converted to freemind notes." note-res "</body>\n" "</html>\n" - "</richcontent>\n")) - ) + "</richcontent>\n"))) ;; There is always an LF char: (when (> (length text) 1) @@ -467,10 +466,10 @@ DRAWERS-REGEXP are converted to freemind notes." (if (= 0 (length org-freemind-node-css-style)) "" (concat - "<style type=\"text/css\">\n" - "<!--\n" + "<style type=\"text/css\">\n" + "<!--\n" org-freemind-node-css-style - "-->\n" + "-->\n" "</style>\n")) "</head>\n" "<body>\n")) @@ -520,14 +519,15 @@ DRAWERS-REGEXP are converted to freemind notes." (list node-res note-res)))) (defun org-freemind-write-node (mm-buffer drawers-regexp - num-left-nodes base-level - current-level next-level this-m2 - this-node-end - this-children-visible - next-node-start - next-has-some-visible-child) + num-left-nodes base-level + current-level next-level this-m2 + this-node-end + this-children-visible + next-node-start + next-has-some-visible-child) (let* (this-icons this-bg-color + this-m2-link this-m2-escaped this-rich-node this-rich-note @@ -560,6 +560,10 @@ DRAWERS-REGEXP are converted to freemind notes." (add-to-list 'this-icons "full-7")) )))) (setq this-m2 (org-trim this-m2)) + (when (string-match org-bracket-link-analytic-regexp this-m2) + (setq this-m2-link (concat "link=\"" (match-string 1 this-m2) + (match-string 3 this-m2) "\" ") + this-m2 (replace-match "\\5" nil nil this-m2 0))) (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2)) (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note this-m2-escaped @@ -569,7 +573,8 @@ DRAWERS-REGEXP are converted to freemind notes." (setq this-rich-node (nth 0 node-notes)) (setq this-rich-note (nth 1 node-notes))) (with-current-buffer mm-buffer - (insert "<node text=\"" this-m2-escaped "\"") + (insert "<node " (if this-m2-link this-m2-link "") + "text=\"" this-m2-escaped "\"") (org-freemind-get-node-style this-m2) (when (> next-level current-level) (unless (or this-children-visible @@ -784,15 +789,15 @@ Otherwise give an error say the file exists." ;;; (unless (if node-at-line-last ;;; (>= (point) node-at-line-last) ;;; nil) - ;; Write last node: - (setq this-m2 next-m2) - (setq current-level next-level) - (setq next-node-start (if node-at-line-last - (1+ node-at-line-last) - (point-max))) - (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)) - (with-current-buffer mm-buffer (insert "</node>\n")) - ;) + ;; Write last node: + (setq this-m2 next-m2) + (setq current-level next-level) + (setq next-node-start (if node-at-line-last + (1+ node-at-line-last) + (point-max))) + (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)) + (with-current-buffer mm-buffer (insert "</node>\n")) + ;) ) (with-current-buffer mm-buffer (while (> current-level base-level) @@ -1032,7 +1037,7 @@ PATH should be a list of steps, where each step has the form (let* ((child-attr-list (cadr child)) (step-attr-copy (copy-sequence step-attr-list))) (dolist (child-attr child-attr-list) - ;; Compare attr names: + ;; Compare attr names: (when (org-freemind-symbols= (caar step-attr-copy) (car child-attr)) ;; Compare values: (let ((step-val (cdar step-attr-copy)) @@ -1066,12 +1071,12 @@ PATH should be a list of steps, where each step has the form (defun org-freemind-test-get-tree-text () (let ((node '(p nil "\n" - (a - ((href . "link")) - "text") - "\n" - (b nil "hej") - "\n"))) + (a + ((href . "link")) + "text") + "\n" + (b nil "hej") + "\n"))) (org-freemind-get-tree-text node))) ;; (org-freemind-test-get-tree-text) @@ -1085,11 +1090,9 @@ PATH should be a list of steps, where each step has the form ;;(a (setq is-link t) ) ((h1 h2 h3 h4 h5 h6 p) ;;(setq ntxt (concat "\n" ntxt)) - (setq lf-after 2) - ) + (setq lf-after 2)) (br - (setq lf-after 1) - ) + (setq lf-after 1)) (t (cond ((stringp n) @@ -1106,8 +1109,7 @@ PATH should be a list of steps, where each step has the form (let ((att (car att-val)) (val (cdr att-val))) (when (eq att 'href) - (setq link val))))) - ))))) + (setq link val)))))))))) (if lf-after (setq ntxt (concat ntxt (make-string lf-after ?\n))) (setq ntxt (concat ntxt " "))) @@ -1184,7 +1186,7 @@ PATH should be a list of steps, where each step has the form (org-freemind-node-to-org child (1+ level) skip-levels))))) ;; Fix-me: put back special things, like drawers that are stored in -;; the notes. Should maybe all notes contents be put in drawers? +;; the notes. Should maybe all notes contents be put in drawers? ;;;###autoload (defun org-freemind-to-org-mode (mm-file org-file) "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE." diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index 5b855c291f0..77f9c0b8a7f 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -32,6 +32,7 @@ ;;; Code: (require 'org) +(require 'gnus-util) (eval-when-compile (require 'gnus-sum)) ;; Declare external functions and variables @@ -100,11 +101,11 @@ If `org-store-link' was called with a prefix arg the meaning of (if (and (string-match "^nntp" group) ;; Only for nntp groups (org-xor current-prefix-arg org-gnus-prefer-web-links)) - (org-make-link (if (string-match "gmane" unprefixed-group) - "http://news.gmane.org/" - "http://groups.google.com/group/") - unprefixed-group) - (org-make-link "gnus:" group)))) + (concat (if (string-match "gmane" unprefixed-group) + "http://news.gmane.org/" + "http://groups.google.com/group/") + unprefixed-group) + (concat "gnus:" group)))) (defun org-gnus-article-link (group newsgroups message-id x-no-archive) "Create a link to a Gnus article. @@ -125,7 +126,7 @@ If `org-store-link' was called with a prefix arg the meaning of "http://mid.gmane.org/%s" "http://groups.google.com/groups/search?as_umsgid=%s") (org-fixup-message-id-for-http message-id)) - (org-make-link "gnus:" group "#" message-id))) + (concat "gnus:" group "#" message-id))) (defun org-gnus-store-link () "Store a link to a Gnus folder or message." @@ -206,7 +207,7 @@ If `org-store-link' was called with a prefix arg the meaning of desc link newsgroup xarchive) ; those are always nil for gcc (and (not gcc) - (error "Can not create link: No Gcc header found.")) + (error "Can not create link: No Gcc header found")) (org-store-link-props :type "gnus" :from from :subject subject :message-id id :group gcc :to to) (setq desc (org-email-link-description) @@ -233,9 +234,9 @@ If `org-store-link' was called with a prefix arg the meaning of (setq group (match-string 1 path) article (match-string 3 path)) (when group - (setq group (org-substring-no-properties group))) + (setq group (org-no-properties group))) (when article - (setq article (org-substring-no-properties article))) + (setq article (org-no-properties article))) (org-gnus-follow-link group article))) (defun org-gnus-follow-link (&optional group article) @@ -244,9 +245,9 @@ If `org-store-link' was called with a prefix arg the meaning of (funcall (cdr (assq 'gnus org-link-frame-setup))) (if gnus-other-frame-object (select-frame gnus-other-frame-object)) (when group - (setq group (org-substring-no-properties group))) + (setq group (org-no-properties group))) (when article - (setq article (org-substring-no-properties article))) + (setq article (org-no-properties article))) (cond ((and group article) (gnus-activate-group group) (condition-case nil @@ -272,7 +273,7 @@ If `org-store-link' was called with a prefix arg the meaning of ;; stop on integer overflows (> articles 0)) (setq group-opened (gnus-group-read-group - articles nil group) + articles t group) articles (if (< articles 16) (1+ articles) (* articles 2)))) diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 6b4776662e2..5b68ac32265 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -67,6 +67,12 @@ relative to the current effective date." :group 'org-habit :type 'boolean) +(defcustom org-habit-show-all-today nil + "If non-nil, will show the consistency graph of all habits on +today's agenda, even if they are not scheduled." + :group 'org-habit + :type 'boolean) + (defcustom org-habit-today-glyph ?! "Glyph character used to identify today." :group 'org-habit diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el index 5cecc44a2df..79b028638a1 100644 --- a/lisp/org/org-html.el +++ b/lisp/org/org-html.el @@ -98,8 +98,32 @@ not be modified." :group 'org-export-html :type 'boolean) -(defconst org-export-html-scripts -"<script type=\"text/javascript\"> +(defvar org-export-html-scripts + "<script type=\"text/javascript\"> +/* +@licstart The following is the entire license notice for the +JavaScript code in this tag. + +Copyright (C) 2012 Free Software Foundation, Inc. + +The JavaScript code in this tag is free software: you can +redistribute it and/or modify it under the terms of the GNU +General Public License (GNU GPL) as published by the Free Software +Foundation, either version 3 of the License, or (at your option) +any later version. The code is distributed WITHOUT ANY WARRANTY; +without even the implied warranty of MERCHANTABILITY or FITNESS +FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + +As additional permission under GNU GPL version 3 section 7, you +may distribute non-source (e.g., minimized or compacted) forms of +that code without the copy of the GNU GPL normally required by +section 4, provided you include this license notice and a URL +through which recipients can access the Corresponding Source. + + +@licend The above is the entire license notice +for the JavaScript code in this tag. +*/ <!--/*--><![CDATA[/*><!--*/ function CodeHighlightOn(elem, id) { @@ -121,10 +145,10 @@ not be modified." } /*]]>*///--> </script>" -"Basic JavaScript that is needed by HTML files produced by Org-mode.") + "Basic JavaScript that is needed by HTML files produced by Org-mode.") (defconst org-export-html-style-default -"<style type=\"text/css\"> + "<style type=\"text/css\"> <!--/*--><![CDATA[/*><!--*/ html { font-family: Times, serif; font-size: 12pt; } .title { text-align: center; } @@ -255,16 +279,16 @@ You can also customize this for each buffer, using something like :group 'org-export-html :version "24.1" :type '(list :greedy t - (list :tag "path (the path from where to load MathJax.js)" - (const :format " " path) (string)) - (list :tag "scale (scaling for the displayed math)" - (const :format " " scale) (string)) - (list :tag "align (alignment of displayed equations)" - (const :format " " align) (string)) - (list :tag "indent (indentation with left or right alignment)" - (const :format " " indent) (string)) - (list :tag "mathml (should MathML display be used is possible)" - (const :format " " mathml) (boolean)))) + (list :tag "path (the path from where to load MathJax.js)" + (const :format " " path) (string)) + (list :tag "scale (scaling for the displayed math)" + (const :format " " scale) (string)) + (list :tag "align (alignment of displayed equations)" + (const :format " " align) (string)) + (list :tag "indent (indentation with left or right alignment)" + (const :format " " indent) (string)) + (list :tag "mathml (should MathML display be used is possible)" + (const :format " " mathml) (boolean)))) (defun org-export-html-mathjax-config (template options in-buffer) "Insert the user setup into the matchjax template." @@ -276,8 +300,9 @@ You can also customize this for each buffer, using something like (setq val (car (read-from-string (substring in-buffer (match-end 0)))))) (if (not (stringp val)) (setq val (format "%s" val))) - (if (string-match (concat "%" (upcase (symbol-name name))) template) - (setq template (replace-match val t t template)))) + (setq template + (replace-regexp-in-string + (concat "%" (upcase (symbol-name name))) val template t t))) options) (setq val (nth 1 (assq 'mathml options))) (if (string-match (concat "\\<mathml:") in-buffer) @@ -295,6 +320,56 @@ You can also customize this for each buffer, using something like (defcustom org-export-html-mathjax-template "<script type=\"text/javascript\" src=\"%PATH\"> +/** + * + * @source: %PATH + * + * @licstart The following is the entire license notice for the + * JavaScript code in %PATH. + * + * Copyright (C) 2012 MathJax + * + * Licensed under the Apache License, Version 2.0 (the \"License\"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an \"AS IS\" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * @licend The above is the entire license notice + * for the JavaScript code in %PATH. + * + */ + +/* +@licstart The following is the entire license notice for the +JavaScript code below. + +Copyright (C) 2012 Free Software Foundation, Inc. + +The JavaScript code below is free software: you can +redistribute it and/or modify it under the terms of the GNU +General Public License (GNU GPL) as published by the Free Software +Foundation, either version 3 of the License, or (at your option) +any later version. The code is distributed WITHOUT ANY WARRANTY; +without even the implied warranty of MERCHANTABILITY or FITNESS +FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + +As additional permission under GNU GPL version 3 section 7, you +may distribute non-source (e.g., minimized or compacted) forms of +that code without the copy of the GNU GPL normally required by +section 4, provided you include this license notice and a URL +through which recipients can access the Corresponding Source. + + +@licend The above is the entire license notice +for the JavaScript code below. +*/ <!--/*--><![CDATA[/*><!--*/ MathJax.Hub.Config({ // Only one of the two following lines, depending on user settings @@ -382,11 +457,17 @@ precedence over this variable." :group 'org-export-html :type '(choice (const :tag "No preamble" nil) (const :tag "Default preamble" t) - (string :tag "Custom formatting string") + (string :tag "Custom format string") (function :tag "Function (must return a string)"))) (defcustom org-export-html-preamble-format '(("en" "")) - "The format for the HTML preamble. + "Alist of languages and format strings for the HTML preamble. + +The first element of each list is the language code, as used for +the #+LANGUAGE keyword. + +The second element of each list is a format string to format the +preamble itself. This format string can contain these elements: %t stands for the title. %a stands for the author's name. @@ -402,7 +483,7 @@ like that: \"%%\"." (defcustom org-export-html-postamble 'auto "Non-nil means insert a postamble in HTML export. -When `t', insert a string as defined by the formatting string in +When `t', insert a string as defined by the format string in `org-export-html-postamble-format'. When set to a string, this string overrides `org-export-html-postamble-format'. When set to 'auto, discard `org-export-html-postamble-format' and honor @@ -416,8 +497,8 @@ precedence over this variable." :group 'org-export-html :type '(choice (const :tag "No postamble" nil) (const :tag "Auto preamble" 'auto) - (const :tag "Default formatting string" t) - (string :tag "Custom formatting string") + (const :tag "Default format string" t) + (string :tag "Custom format string") (function :tag "Function (must return a string)"))) (defcustom org-export-html-postamble-format @@ -426,7 +507,13 @@ precedence over this variable." <p class=\"creator\">Generated by %c</p> <p class=\"xhtml-validation\">%v</p> ")) - "The format for the HTML postamble. + "Alist of languages and format strings for the HTML postamble. + +The first element of each list is the language code, as used for +the #+LANGUAGE keyword. + +The second element of each list is a format string to format the +postamble itself. This format string can contain these elements: %a stands for the author's name. %e stands for the author's email. @@ -653,6 +740,14 @@ postamble DIV." (string :tag " Div for the content:") (string :tag "Div for the postamble:"))) +(defcustom org-export-html-date-format-string "%Y-%m-%dT%R%z" + "Format string to format the date and time. + +The default is an extended format of the ISO 8601 specification." + :group 'org-export-html + :version "24.1" + :type 'string) + ;;; Hooks (defvar org-export-html-after-blockquotes-hook nil @@ -668,7 +763,7 @@ postamble DIV." (when (and org-current-export-file (plist-get parameters :LaTeX-fragments)) (org-format-latex - (concat "ltxpng/" (file-name-sans-extension + (concat org-latex-preview-ltxpng-directory (file-name-sans-extension (file-name-nondirectory org-current-export-file))) org-current-export-dir nil "Creating LaTeX image %s" @@ -677,8 +772,8 @@ postamble DIV." ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim) ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax) ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax) - ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng) - (t nil)))) + ((eq (plist-get parameters :LaTeX-fragments) 'imagemagick) 'imagemagick) + ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng)))) (goto-char (point-min)) (let (label l1) (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) @@ -730,7 +825,7 @@ command to convert it." (interactive "r") (let (reg html buf pop-up-frames) (save-window-excursion - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq html (org-export-region-as-html beg end t 'string)) (setq reg (buffer-substring beg end) @@ -782,51 +877,51 @@ in a window. A non-interactive call will only return the buffer." ;;; org-html-cvt-link-fn (defconst org-html-cvt-link-fn - nil - "Function to convert link URLs to exportable URLs. + nil + "Function to convert link URLs to exportable URLs. Takes two arguments, TYPE and PATH. Returns exportable url as (TYPE PATH), or nil to signal that it didn't handle this case. Intended to be locally bound around a call to `org-export-as-html'." ) (defun org-html-cvt-org-as-html (opt-plist type path) - "Convert an org filename to an equivalent html filename. + "Convert an org filename to an equivalent html filename. If TYPE is not file, just return `nil'. See variable `org-export-html-link-org-files-as-html'" - (save-match-data - (and - org-export-html-link-org-files-as-html - (string= type "file") - (string-match "\\.org$" path) - (progn - (list - "file" - (concat - (substring path 0 (match-beginning 0)) - "." - (plist-get opt-plist :html-extension))))))) + (save-match-data + (and + org-export-html-link-org-files-as-html + (string= type "file") + (string-match "\\.org$" path) + (progn + (list + "file" + (concat + (substring path 0 (match-beginning 0)) + "." + (plist-get opt-plist :html-extension))))))) ;;; org-html-should-inline-p (defun org-html-should-inline-p (filename descp) - "Return non-nil if link FILENAME should be inlined. + "Return non-nil if link FILENAME should be inlined. The decision to inline the FILENAME link is based on the current settings. DESCP is the boolean of whether there was a link description. See variables `org-export-html-inline-images' and `org-export-html-inline-image-extensions'." - (declare (special - org-export-html-inline-images - org-export-html-inline-image-extensions)) - (and (or (eq t org-export-html-inline-images) - (and org-export-html-inline-images (not descp))) - (org-file-image-p - filename org-export-html-inline-image-extensions))) + (declare (special + org-export-html-inline-images + org-export-html-inline-image-extensions)) + (and (or (eq t org-export-html-inline-images) + (and org-export-html-inline-images (not descp))) + (org-file-image-p + filename org-export-html-inline-image-extensions))) ;;; org-html-make-link (defun org-html-make-link (opt-plist type path fragment desc attr - may-inline-p) - "Make an HTML link. + may-inline-p) + "Make an HTML link. OPT-PLIST is an options list. TYPE is the device-type of the link (THIS://foo.html). PATH is the path of the link (http://THIS#location). @@ -835,89 +930,89 @@ DESC is the link description, if any. ATTR is a string of other attributes of the \"a\" element. MAY-INLINE-P allows inlining it as an image." - (declare (special org-par-open)) - (save-match-data - (let* ((filename path) - ;;First pass. Just sanity stuff. - (components-1 - (cond - ((string= type "file") - (list - type - ;;Substitute just if original path was absolute. - ;;(Otherwise path must remain relative) - (if (file-name-absolute-p path) - (concat "file://" (expand-file-name path)) - path))) - ((string= type "") - (list nil path)) - (t (list type path)))) - - ;;Second pass. Components converted so they can refer - ;;to a remote site. - (components-2 - (or - (and org-html-cvt-link-fn - (apply org-html-cvt-link-fn - opt-plist components-1)) - (apply #'org-html-cvt-org-as-html - opt-plist components-1) - components-1)) - (type (first components-2)) - (thefile (second components-2))) - - - ;;Third pass. Build final link except for leading type - ;;spec. - (cond - ((or - (not type) - (string= type "http") - (string= type "https") - (string= type "file") - (string= type "coderef")) - (if fragment - (setq thefile (concat thefile "#" fragment)))) - - (t)) - - ;;Final URL-build, for all types. - (setq thefile + (declare (special org-par-open)) + (save-match-data + (let* ((filename path) + ;;First pass. Just sanity stuff. + (components-1 + (cond + ((string= type "file") + (list + type + ;;Substitute just if original path was absolute. + ;;(Otherwise path must remain relative) + (if (file-name-absolute-p path) + (concat "file://" (expand-file-name path)) + path))) + ((string= type "") + (list nil path)) + (t (list type path)))) + + ;;Second pass. Components converted so they can refer + ;;to a remote site. + (components-2 + (or + (and org-html-cvt-link-fn + (apply org-html-cvt-link-fn + opt-plist components-1)) + (apply #'org-html-cvt-org-as-html + opt-plist components-1) + components-1)) + (type (first components-2)) + (thefile (second components-2))) + + + ;;Third pass. Build final link except for leading type + ;;spec. + (cond + ((or + (not type) + (string= type "http") + (string= type "https") + (string= type "file") + (string= type "coderef")) + (if fragment + (setq thefile (concat thefile "#" fragment)))) + + (t)) + + ;;Final URL-build, for all types. + (setq thefile (let - ((str (org-export-html-format-href thefile))) + ((str (org-export-html-format-href thefile))) (if (and type (not (or (string= "file" type) (string= "coderef" type)))) (concat type ":" str) - str))) + str))) - (if (and - may-inline-p - ;;Can't inline a URL with a fragment. - (not fragment)) - (progn - (message "image %s %s" thefile org-par-open) - (org-export-html-format-image thefile org-par-open)) - (concat - "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">" - (org-export-html-format-desc desc) - "</a>"))))) - -(defun org-html-handle-links (line opt-plist) - "Return LINE with markup of Org mode links. + (if (and + may-inline-p + ;;Can't inline a URL with a fragment. + (not fragment)) + (progn + (message "image %s %s" thefile org-par-open) + (org-export-html-format-image thefile org-par-open)) + (concat + "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">" + (org-export-html-format-desc desc) + "</a>"))))) + +(defun org-html-handle-links (org-line opt-plist) + "Return ORG-LINE with markup of Org mode links. OPT-PLIST is the export options list." (let ((start 0) (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) + (file-name-directory buffer-file-name) + default-directory)) (link-validate (plist-get opt-plist :link-validation-function)) type id-file fnc rpl path attr desc descp desc1 desc2 link) - (while (string-match org-bracket-link-analytic-regexp++ line start) + (while (string-match org-bracket-link-analytic-regexp++ org-line start) (setq start (match-beginning 0)) (setq path (save-match-data (org-link-unescape - (match-string 3 line)))) + (match-string 3 org-line)))) (setq type (cond - ((match-end 2) (match-string 2 line)) + ((match-end 2) (match-string 2 org-line)) ((save-match-data (or (file-name-absolute-p path) (string-match "^\\.\\.?/" path))) @@ -925,7 +1020,7 @@ OPT-PLIST is the export options list." (t "internal"))) (setq path (org-extract-attributes path)) (setq attr (get-text-property 0 'org-attributes path)) - (setq desc1 (if (match-end 5) (match-string 5 line)) + (setq desc1 (if (match-end 5) (match-string 5 org-line)) desc2 (if (match-end 2) (concat type ":" path) path) descp (and desc1 (not (equal desc1 desc2))) desc (or desc1 desc2)) @@ -1066,9 +1161,9 @@ OPT-PLIST is the export options list." (setq rpl (concat "<i><" type ":" (save-match-data (org-link-unescape path)) "></i>")))) - (setq line (replace-match rpl t t line) + (setq org-line (replace-match rpl t t org-line) start (+ start (length rpl)))) - line)) + org-line)) ;;; org-export-as-html @@ -1150,7 +1245,7 @@ PUB-DIR is set, use this as the publishing directory." (org-current-export-dir (or pub-dir (org-export-directory :html opt-plist))) (org-current-export-file buffer-file-name) - (level 0) (line "") (origline "") txt todo + (level 0) (org-line "") (origline "") txt todo (umax nil) (umax-toc nil) (filename (if to-buffer nil @@ -1227,6 +1322,9 @@ PUB-DIR is set, use this as the publishing directory." (org-export-have-math nil) (org-export-footnotes-seen nil) (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) + (custom-id (or (org-entry-get nil "CUSTOM_ID" t) "")) + (footnote-def-prefix (format "fn-%s" custom-id)) + (footnote-ref-prefix (format "fnr-%s" custom-id)) (lines (org-split-string (org-export-preprocess-string @@ -1267,8 +1365,7 @@ PUB-DIR is set, use this as the publishing directory." rpl path attr desc descp desc1 desc2 link snumber fnc footnotes footref-seen - href - ) + href) (let ((inhibit-read-only t)) (org-unmodified @@ -1285,7 +1382,7 @@ PUB-DIR is set, use this as the publishing directory." ((and date (string-match "%" date)) (setq date (format-time-string date))) (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) + (t (setq date (format-time-string org-export-html-date-format-string)))) ;; Get the language-dependent settings (setq lang-words (or (assoc language org-export-language-setup) @@ -1371,12 +1468,12 @@ PUB-DIR is set, use this as the publishing directory." (insert "\n</div>\n")) (t (setq html-pre-real-contents - (format-spec - (or (cadr (assoc (nth 0 lang-words) - org-export-html-preamble-format)) - (cadr (assoc "en" org-export-html-preamble-format))) - `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email)))))) + (format-spec + (or (cadr (assoc (nth 0 lang-words) + org-export-html-preamble-format)) + (cadr (assoc "en" org-export-html-preamble-format))) + `((?t . ,title) (?a . ,author) + (?d . ,date) (?e . ,email)))))) ;; don't output an empty preamble DIV (unless (and (functionp html-pre) (equal html-pre-real-contents "")) @@ -1394,7 +1491,7 @@ PUB-DIR is set, use this as the publishing directory." "\n<h1 class=\"title\">" title "</h1>\n")) ;; insert body - (if (and org-export-with-toc (not body-only)) + (if org-export-with-toc (progn (push (format "<h%d>%s</h%d>\n" org-export-html-toplevel-hlevel @@ -1405,9 +1502,9 @@ PUB-DIR is set, use this as the publishing directory." (push "<ul>\n<li>" thetoc) (setq lines (mapcar - #'(lambda (line) - (if (and (string-match org-todo-line-regexp line) - (not (get-text-property 0 'org-protected line))) + #'(lambda (org-line) + (if (and (string-match org-todo-line-regexp org-line) + (not (get-text-property 0 'org-protected org-line))) ;; This is a headline (progn (setq have-headings t) @@ -1417,17 +1514,17 @@ PUB-DIR is set, use this as the publishing directory." txt (save-match-data (org-html-expand (org-export-cleanup-toc-line - (match-string 3 line)))) + (match-string 3 org-line)))) todo (or (and org-export-mark-todo-in-toc (match-beginning 2) - (not (member (match-string 2 line) + (not (member (match-string 2 org-line) org-done-keywords))) ; TODO, not DONE (and org-export-mark-todo-in-toc (= level umax-toc) (org-search-todo-below - line lines level)))) + org-line lines level)))) (if (string-match (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) (setq txt (replace-match @@ -1456,11 +1553,11 @@ PUB-DIR is set, use this as the publishing directory." (push "</li>\n</ul>" thetoc)) (push "\n" thetoc))) ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line (replace-match - (concat "@<span class=\"target\">" - (match-string 1 line) "@</span> ") - t t line))) + (while (string-match org-any-target-regexp org-line) + (setq org-line (replace-match + (concat "@<span class=\"target\">" + (match-string 1 org-line) "@</span> ") + t t org-line))) (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) (setq txt (replace-match "" t t txt))) (setq href @@ -1477,7 +1574,7 @@ PUB-DIR is set, use this as the publishing directory." href txt) thetoc) (setq org-last-level level))))) - line) + org-line) lines)) (while (> org-last-level (1- org-min-level)) (setq org-last-level (1- org-last-level)) @@ -1490,28 +1587,28 @@ PUB-DIR is set, use this as the publishing directory." (org-open-par) - (while (setq line (pop lines) origline line) + (while (setq org-line (pop lines) origline org-line) (catch 'nextline ;; end of quote section? - (when (and inquote (string-match org-outline-regexp-bol line)) + (when (and inquote (string-match org-outline-regexp-bol org-line)) (insert "</pre>\n") (org-open-par) (setq inquote nil)) ;; inside a quote section? (when inquote - (insert (org-html-protect line) "\n") + (insert (org-html-protect org-line) "\n") (throw 'nextline nil)) ;; Fixed-width, verbatim lines (examples) (when (and org-export-with-fixed-width - (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line)) + (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" org-line)) (when (not infixed) (setq infixed t) (org-close-par-maybe) (insert "<pre class=\"example\">\n")) - (insert (org-html-protect (match-string 3 line)) "\n") + (insert (org-html-protect (match-string 3 org-line)) "\n") (when (or (not lines) (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" (car lines)))) @@ -1521,17 +1618,17 @@ PUB-DIR is set, use this as the publishing directory." (throw 'nextline nil)) ;; Protected HTML - (when (and (get-text-property 0 'org-protected line) + (when (and (get-text-property 0 'org-protected org-line) ;; Make sure it is the entire line that is protected (not (< (or (next-single-property-change - 0 'org-protected line) 10000) - (length line)))) - (let (par (ind (get-text-property 0 'original-indentation line))) + 0 'org-protected org-line) 10000) + (length org-line)))) + (let (par (ind (get-text-property 0 'original-indentation org-line))) (when (re-search-backward "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) (setq par (match-string 1)) (replace-match "\\2\n")) - (insert line "\n") + (insert org-line "\n") (while (and lines (or (= (length (car lines)) 0) (not ind) @@ -1543,144 +1640,144 @@ PUB-DIR is set, use this as the publishing directory." (throw 'nextline nil)) ;; Blockquotes, verse, and center - (when (equal "ORG-BLOCKQUOTE-START" line) + (when (equal "ORG-BLOCKQUOTE-START" org-line) (org-close-par-maybe) (insert "<blockquote>\n") (org-open-par) (throw 'nextline nil)) - (when (equal "ORG-BLOCKQUOTE-END" line) + (when (equal "ORG-BLOCKQUOTE-END" org-line) (org-close-par-maybe) (insert "\n</blockquote>\n") (org-open-par) (throw 'nextline nil)) - (when (equal "ORG-VERSE-START" line) + (when (equal "ORG-VERSE-START" org-line) (org-close-par-maybe) (insert "\n<p class=\"verse\">\n") (setq org-par-open t) (setq inverse t) (throw 'nextline nil)) - (when (equal "ORG-VERSE-END" line) + (when (equal "ORG-VERSE-END" org-line) (insert "</p>\n") (setq org-par-open nil) (org-open-par) (setq inverse nil) (throw 'nextline nil)) - (when (equal "ORG-CENTER-START" line) + (when (equal "ORG-CENTER-START" org-line) (org-close-par-maybe) (insert "\n<div style=\"text-align: center\">") (org-open-par) (throw 'nextline nil)) - (when (equal "ORG-CENTER-END" line) + (when (equal "ORG-CENTER-END" org-line) (org-close-par-maybe) (insert "\n</div>") (org-open-par) (throw 'nextline nil)) (run-hooks 'org-export-html-after-blockquotes-hook) (when inverse - (let ((i (org-get-string-indentation line))) + (let ((i (org-get-string-indentation org-line))) (if (> i 0) - (setq line (concat (mapconcat 'identity - (make-list (* 2 i) "\\nbsp") "") - " " (org-trim line)))) - (unless (string-match "\\\\\\\\[ \t]*$" line) - (setq line (concat line "\\\\"))))) + (setq org-line (concat (mapconcat 'identity + (make-list (* 2 i) "\\nbsp") "") + " " (org-trim org-line)))) + (unless (string-match "\\\\\\\\[ \t]*$" org-line) + (setq org-line (concat org-line "\\\\"))))) ;; make targets to anchors (setq start 0) (while (string-match - "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start) + "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" org-line start) (cond - ((get-text-property (match-beginning 1) 'org-protected line) + ((get-text-property (match-beginning 1) 'org-protected org-line) (setq start (match-end 1))) ((match-end 2) - (setq line (replace-match - (format - "@<a name=\"%s\" id=\"%s\">@</a>" - (org-solidify-link-text (match-string 1 line)) - (org-solidify-link-text (match-string 1 line))) - t t line))) - ((and org-export-with-toc (equal (string-to-char line) ?*)) + (setq org-line (replace-match + (format + "@<a name=\"%s\" id=\"%s\">@</a>" + (org-solidify-link-text (match-string 1 org-line)) + (org-solidify-link-text (match-string 1 org-line))) + t t org-line))) + ((and org-export-with-toc (equal (string-to-char org-line) ?*)) ;; FIXME: NOT DEPENDENT on TOC????????????????????? - (setq line (replace-match - (concat "@<span class=\"target\">" - (match-string 1 line) "@</span> ") - ;; (concat "@<i>" (match-string 1 line) "@</i> ") - t t line))) + (setq org-line (replace-match + (concat "@<span class=\"target\">" + (match-string 1 org-line) "@</span> ") + ;; (concat "@<i>" (match-string 1 org-line) "@</i> ") + t t org-line))) (t - (setq line (replace-match - (concat "@<a name=\"" - (org-solidify-link-text (match-string 1 line)) - "\" class=\"target\">" (match-string 1 line) - "@</a> ") - t t line))))) + (setq org-line (replace-match + (concat "@<a name=\"" + (org-solidify-link-text (match-string 1 org-line)) + "\" class=\"target\">" (match-string 1 org-line) + "@</a> ") + t t org-line))))) - (setq line (org-html-handle-time-stamps line)) + (setq org-line (org-html-handle-time-stamps org-line)) ;; replace "&" by "&", "<" and ">" by "<" and ">" ;; handle @<..> HTML tags (replace "@>..<" by "<..>") ;; Also handle sub_superscripts and checkboxes - (or (string-match org-table-hline-regexp line) - (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line) - (setq line (org-html-expand line))) + (or (string-match org-table-hline-regexp org-line) + (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" org-line) + (setq org-line (org-html-expand org-line))) ;; Format the links - (setq line (org-html-handle-links line opt-plist)) + (setq org-line (org-html-handle-links org-line opt-plist)) ;; TODO items (if (and org-todo-line-regexp - (string-match org-todo-line-regexp line) + (string-match org-todo-line-regexp org-line) (match-beginning 2)) - (setq line - (concat (substring line 0 (match-beginning 2)) + (setq org-line + (concat (substring org-line 0 (match-beginning 2)) "<span class=\"" - (if (member (match-string 2 line) + (if (member (match-string 2 org-line) org-done-keywords) "done" "todo") " " (org-export-html-get-todo-kwd-class-name - (match-string 2 line)) - "\">" (match-string 2 line) - "</span>" (substring line (match-end 2))))) + (match-string 2 org-line)) + "\">" (match-string 2 org-line) + "</span>" (substring org-line (match-end 2))))) ;; Does this contain a reference to a footnote? (when org-export-with-footnotes (setq start 0) - (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start) + (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" org-line start) ;; Discard protected matches not clearly identified as ;; footnote markers. - (if (or (get-text-property (match-beginning 2) 'org-protected line) - (not (get-text-property (match-beginning 2) 'org-footnote line))) + (if (or (get-text-property (match-beginning 2) 'org-protected org-line) + (not (get-text-property (match-beginning 2) 'org-footnote org-line))) (setq start (match-end 2)) - (let ((n (match-string 2 line)) extra a) + (let ((n (match-string 2 org-line)) extra a) (if (setq a (assoc n footref-seen)) (progn (setcdr a (1+ (cdr a))) (setq extra (format ".%d" (cdr a)))) (setq extra "") (push (cons n 1) footref-seen)) - (setq line + (setq org-line (replace-match (concat (format (concat "%s" (format org-export-html-footnote-format - (concat "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>"))) - (or (match-string 1 line) "") n extra n n) + (concat "<a class=\"footref\" name=\"" footnote-ref-prefix ".%s%s\" href=\"#" footnote-def-prefix ".%s\">%s</a>"))) + (or (match-string 1 org-line) "") n extra n n) ;; If another footnote is following the ;; current one, add a separator. (if (save-match-data (string-match "\\`\\[[0-9]+\\]" - (substring line (match-end 0)))) + (substring org-line (match-end 0)))) org-export-html-footnote-separator "")) - t t line)))))) + t t org-line)))))) (cond - ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line) + ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" org-line) ;; This is a headline (setq level (org-tr-level (- (match-end 1) (match-beginning 1) level-offset)) - txt (match-string 2 line)) + txt (or (match-string 2 org-line) "")) (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt))) (if (<= level (max umax umax-toc)) @@ -1691,19 +1788,19 @@ PUB-DIR is set, use this as the publishing directory." head-count opt-plist) ;; QUOTES - (when (string-match quote-re line) + (when (string-match quote-re org-line) (org-close-par-maybe) (insert "<pre>") (setq inquote t))) ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) + (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" org-line)) (when (not table-open) ;; New table starts (setq table-open t table-buffer nil table-orig-buffer nil)) ;; Accumulate lines - (setq table-buffer (cons line table-buffer) + (setq table-buffer (cons org-line table-buffer) table-orig-buffer (cons origline table-orig-buffer)) (when (or (not lines) (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" @@ -1718,15 +1815,15 @@ PUB-DIR is set, use this as the publishing directory." (t ;; This line either is list item or end a list. - (when (get-text-property 0 'list-item line) - (setq line (org-html-export-list-line - line - (get-text-property 0 'list-item line) - (get-text-property 0 'list-struct line) - (get-text-property 0 'list-prevs line)))) + (when (get-text-property 0 'list-item org-line) + (setq org-line (org-html-export-list-line + org-line + (get-text-property 0 'list-item org-line) + (get-text-property 0 'list-struct org-line) + (get-text-property 0 'list-prevs org-line)))) ;; Horizontal line - (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) + (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line) (if org-par-open (insert "\n</p>\n<hr/>\n<p>\n") (insert "\n<hr/>\n")) @@ -1735,44 +1832,45 @@ PUB-DIR is set, use this as the publishing directory." ;; Empty lines start a new paragraph. If hand-formatted lists ;; are not fully interpreted, lines starting with "-", "+", "*" ;; also start a new paragraph. - (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par)) + (if (string-match "^ [-+*]-\\|^[ \t]*$" org-line) (org-open-par)) ;; Is this the start of a footnote? (when org-export-with-footnotes (when (and (boundp 'footnote-section-tag-regexp) (string-match (concat "^" footnote-section-tag-regexp) - line)) + org-line)) ;; ignore this line (throw 'nextline nil)) - (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) + (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" org-line) (org-close-par-maybe) - (let ((n (match-string 1 line))) + (let ((n (match-string 1 org-line))) (setq org-par-open t - line (replace-match - (format - (concat "<p class=\"footnote\">" - (format org-export-html-footnote-format - "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>")) - n n n) t t line))))) + org-line (replace-match + (format + (concat "<p class=\"footnote\">" + (format org-export-html-footnote-format + (concat + "<a class=\"footnum\" name=\"" footnote-def-prefix ".%s\" href=\"#" footnote-ref-prefix ".%s\">%s</a>"))) + n n n) t t org-line))))) ;; Check if the line break needs to be conserved (cond - ((string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match "<br/>" t t line))) + ((string-match "\\\\\\\\[ \t]*$" org-line) + (setq org-line (replace-match "<br/>" t t org-line))) (org-export-preserve-breaks - (setq line (concat line "<br/>")))) + (setq org-line (concat org-line "<br/>")))) ;; Check if a paragraph should be started (let ((start 0)) (while (and org-par-open - (string-match "\\\\par\\>" line start)) + (string-match "\\\\par\\>" org-line start)) ;; Leave a space in the </p> so that the footnote matcher ;; does not see this. (if (not (get-text-property (match-beginning 0) - 'org-protected line)) - (setq line (replace-match "</p ><p >" t t line))) + 'org-protected org-line)) + (setq org-line (replace-match "</p ><p >" t t org-line))) (setq start (match-end 0)))) - (insert line "\n"))))) + (insert org-line "\n"))))) ;; Properly close all local lists and other lists (when inquote @@ -1814,7 +1912,8 @@ PUB-DIR is set, use this as the publishing directory." (split-string email ",+ *") ", ")) (creator-info - (concat "Org version " org-version " with Emacs version " + (concat "<a href=\"http://orgmode.org\">Org</a> version " + (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version " (number-to-string emacs-major-version)))) (when (plist-get opt-plist :html-postamble) @@ -1831,12 +1930,13 @@ PUB-DIR is set, use this as the publishing directory." (when (plist-get opt-plist :time-stamp-file) (insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n")) (when (and (plist-get opt-plist :author-info) author) - (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n")) + (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n")) (when (and (plist-get opt-plist :email-info) email) (insert "<p class=\"email\">" email "</p>\n")) (when (plist-get opt-plist :creator-info) (insert "<p class=\"creator\">" - (concat "Org version " org-version " with Emacs version " + (concat "<a href=\"http://orgmode.org\">Org</a> version " + (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version " (number-to-string emacs-major-version) "</p>\n"))) (insert html-validation-link "\n")) (t @@ -1931,7 +2031,7 @@ PUB-DIR is set, use this as the publishing directory." (defun org-export-html-format-image (src par-open) "Create image tag with source and attributes." (save-match-data - (if (string-match "^ltxpng/" src) + (if (string-match (regexp-quote org-latex-preview-ltxpng-directory) src) (format "<img src=\"%s\" alt=\"%s\"/>" src (org-find-text-property-in-string 'org-latex-src src)) (let* ((caption (org-find-text-property-in-string 'org-caption src)) @@ -1939,21 +2039,21 @@ PUB-DIR is set, use this as the publishing directory." (label (org-find-text-property-in-string 'org-label src))) (setq caption (and caption (org-html-do-expand caption))) (concat - (if caption - (format "%s<div %sclass=\"figure\"> + (if caption + (format "%s<div %sclass=\"figure\"> <p>" - (if org-par-open "</p>\n" "") - (if label (format "id=\"%s\" " (org-solidify-link-text label)) ""))) - (format "<img src=\"%s\"%s />" - src - (if (string-match "\\<alt=" (or attr "")) - (concat " " attr ) - (concat " " attr " alt=\"" src "\""))) - (if caption - (format "</p>%s + (if org-par-open "</p>\n" "") + (if label (format "id=\"%s\" " (org-solidify-link-text label)) ""))) + (format "<img src=\"%s\"%s />" + src + (if (string-match "\\<alt=" (or attr "")) + (concat " " attr ) + (concat " " attr " alt=\"" src "\""))) + (if caption + (format "</p>%s </div>%s" - (concat "\n<p>" caption "</p>") - (if org-par-open "\n<p>" "")))))))) + (concat "\n<p>" caption "</p>") + (if org-par-open "\n<p>" "")))))))) (defun org-export-html-get-bibliography () "Find bibliography, cut it out and return it." @@ -1969,7 +2069,7 @@ PUB-DIR is set, use this as the publishing directory." (and (looking-at ">") (forward-char 1)) (setq bib (buffer-substring beg (point))) (delete-region beg (point)) - (throw 'exit bib)))) + (throw 'exit bib)))) nil)))) (defvar org-table-number-regexp) ; defined in org-table.el @@ -2020,7 +2120,7 @@ for formatting. This is required for the DocBook exporter." (lambda (x) (string-match "^[ \t]*|-" x)) (cdr lines))))) (nline 0) fnum nfields i (cnt 0) - tbopen line fields html gr colgropen rowstart rowend + tbopen org-line fields html gr colgropen rowstart rowend ali align aligns n) (setq caption (and caption (org-html-do-expand caption))) (when (and col-cookies org-table-clean-did-remove-column) @@ -2029,9 +2129,9 @@ for formatting. This is required for the DocBook exporter." (if splice (setq head nil)) (unless splice (push (if head "<thead>" "<tbody>") html)) (setq tbopen t) - (while (setq line (pop lines)) + (while (setq org-line (pop lines)) (catch 'next-line - (if (string-match "^[ \t]*|-" line) + (if (string-match "^[ \t]*|-" org-line) (progn (unless splice (push (if head "</thead>" "</tbody>") html) @@ -2040,7 +2140,7 @@ for formatting. This is required for the DocBook exporter." ;; ignore this line (throw 'next-line t))) ;; Break the line into fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) + (setq fields (org-split-string org-line "[ \t]*|[ \t]*")) (unless fnum (setq fnum (make-vector (length fields) 0) nfields (length fnum))) (setq nline (1+ nline) i -1 @@ -2114,11 +2214,12 @@ for formatting. This is required for the DocBook exporter." (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) ;; Since the output of HTML table formatter can also be used in - ;; DocBook document, we want to always include the caption to make - ;; DocBook XML file valid. - (push (format "<caption>%s</caption>" (or caption "")) html) + ;; DocBook document, include empty captions for the DocBook + ;; export only so that it produces valid XML. + (when (or caption (eq org-export-current-backend 'docbook)) + (push (format "<caption>%s</caption>" (or caption "")) html)) (when label - (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label))))) + (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label))))) (push html-table-tag html)) (setq html (mapcar (lambda (x) @@ -2155,14 +2256,14 @@ for formatting. This is required for the DocBook exporter." This conversion does *not* use `table-generate-source' from table.el. This has the advantage that Org-mode's HTML conversions can be used. But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (line field-buffer - (head org-export-highlight-first-table-line) - fields html empty i) + (let (org-line field-buffer + (head org-export-highlight-first-table-line) + fields html empty i) (setq html (concat html-table-tag "\n")) - (while (setq line (pop lines)) + (while (setq org-line (pop lines)) (setq empty " ") (catch 'next-line - (if (string-match "^[ \t]*\\+-" line) + (if (string-match "^[ \t]*\\+-" org-line) (progn (if field-buffer (progn @@ -2188,7 +2289,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." ;; Ignore this line (throw 'next-line t))) ;; Break the line into fields and store the fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) + (setq fields (org-split-string org-line "[ \t]*|[ \t]*")) (if field-buffer (setq field-buffer (mapcar (lambda (x) @@ -2338,7 +2439,7 @@ is nil, return nil." l (match-string 0 string) string (substring string (match-end 0))) (push (org-html-do-expand s) res) - (push l res)) + (push l res)) (push (org-html-do-expand string) res) (apply 'concat (nreverse res))))) @@ -2469,22 +2570,22 @@ When TITLE is nil, just close all open levels." (when title ;; If title is nil, this means this function is called to close ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq title (replace-match - (if org-export-with-tags - (save-match-data - (concat - " <span class=\"tag\">" - (mapconcat - (lambda (x) - (format "<span class=\"%s\">%s</span>" - (org-export-html-get-tag-class-name x) - x)) - (org-split-string (match-string 1 title) ":") - " ") - "</span>")) - "") - t t title))) + (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) + (setq title (replace-match + (if org-export-with-tags + (save-match-data + (concat + " <span class=\"tag\">" + (mapconcat + (lambda (x) + (format "<span class=\"%s\">%s</span>" + (org-export-html-get-tag-class-name x) + x)) + (org-split-string (match-string 1 title) ":") + " ") + "</span>")) + "") + t t title))) (if (> level umax) (progn (if (aref org-levels-open (1- level)) @@ -2553,11 +2654,11 @@ Replaces invalid characters with \"_\" and then prepends a prefix." (org-close-li) (insert "</ul>\n"))) -(defun org-html-export-list-line (line pos struct prevs) - "Insert list syntax in export buffer. Return LINE, maybe modified. +(defun org-html-export-list-line (org-line pos struct prevs) + "Insert list syntax in export buffer. Return ORG-LINE, maybe modified. -POS is the item position or line position the line had before -modifications to buffer. STRUCT is the list structure. PREVS is +POS is the item position or org-line position the org-line had before +modifications to buffer. STRUCT is the list structure. PREVS is the alist of previous items." (let* ((get-type (function @@ -2605,10 +2706,10 @@ the alist of previous items." "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" - "\\(.*\\)") line) - (let* ((checkbox (match-string 3 line)) - (desc-tag (or (match-string 4 line) "???")) - (body (or (match-string 5 line) "")) + "\\(.*\\)") org-line) + (let* ((checkbox (match-string 3 org-line)) + (desc-tag (or (match-string 4 org-line) "???")) + (body (or (match-string 5 org-line) "")) (list-beg (org-list-get-list-begin pos struct prevs)) (firstp (= list-beg pos)) ;; Always refer to first item to determine list type, in @@ -2642,9 +2743,9 @@ the alist of previous items." ;; Return modified line body)) ;; At a list ender: go to next line (side-effects only). - ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil)) + ((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil)) ;; Not at an item: return line unchanged (side-effects only). - (t line)))) + (t org-line)))) (provide 'org-html) diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el index d73a6195b32..8523b442583 100644 --- a/lisp/org/org-icalendar.el +++ b/lisp/org/org-icalendar.el @@ -28,8 +28,7 @@ (require 'org-exp) -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl)) (declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) @@ -194,7 +193,7 @@ or if they are only using it locally." (defcustom org-icalendar-timezone (getenv "TZ") "The time zone string for iCalendar export. -When nil of the empty string, use the abbreviation retrieved from Emacs." +When nil or the empty string, use output from \(current-time-zone\)." :group 'org-export-icalendar :type '(choice (const :tag "Unspecified" nil) @@ -257,7 +256,7 @@ The file is stored under the name `org-combined-agenda-icalendar-file'." If COMBINE is non-nil, combine all calendar entries into a single large file and store it under the name `org-combined-agenda-icalendar-file'." (save-excursion - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (let* ((dir (org-export-directory :ical (list :publishing-directory org-export-publishing-directory))) @@ -288,20 +287,19 @@ file and store it under the name `org-combined-agenda-icalendar-file'." (let ((standard-output ical-buffer)) (if combine (and (not started) (setq started t) - (org-start-icalendar-file org-icalendar-combined-name)) - (org-start-icalendar-file category)) - (org-print-icalendar-entries combine) + (org-icalendar-start-file org-icalendar-combined-name)) + (org-icalendar-start-file category)) + (org-icalendar-print-entries combine) (when (or (and combine (not files)) (not combine)) (when (and combine org-icalendar-include-bbdb-anniversaries) (require 'org-bbdb) (org-bbdb-anniv-export-ical)) - (org-finish-icalendar-file) + (org-icalendar-finish-file) (set-buffer ical-buffer) (run-hooks 'org-before-save-iCalendar-file-hook) (save-buffer) (run-hooks 'org-after-save-iCalendar-file-hook) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) - )))) + (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))))) (org-release-buffers org-agenda-new-buffers)))) (defvar org-before-save-iCalendar-file-hook nil @@ -315,18 +313,18 @@ A good way to use this is to tell a desktop calendar application to re-read the iCalendar file.") (defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el -(defun org-print-icalendar-entries (&optional combine) +(defun org-icalendar-print-entries (&optional combine) "Print iCalendar entries for the current Org-mode file to `standard-output'. When COMBINE is non nil, add the category to each line." (require 'org-agenda) (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) - (dts (org-ical-ts-to-string + (dts (org-icalendar-ts-to-string (format-time-string (cdr org-time-stamp-formats) (current-time)) "DTSTART")) hd ts ts2 state status (inc t) pos b sexp rrule scheduledp deadlinep todo prefix due start tags - tmp pri categories location summary desc uid alarm + tmp pri categories location summary desc uid alarm alarm-time (sexp-buffer (get-buffer-create "*ical-tmp*"))) (org-refresh-category-properties) (save-excursion @@ -359,26 +357,25 @@ When COMBINE is non nil, add the category to each line." (org-id-get-create) (or (org-id-get) (org-id-new))) categories (org-export-get-categories) + alarm-time (org-entry-get nil "APPT_WARNTIME") + alarm-time (if alarm-time (string-to-number alarm-time) 0) alarm "" deadlinep nil scheduledp nil) + (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos) + deadlinep (string-match org-deadline-regexp tmp) + scheduledp (string-match org-scheduled-regexp tmp) + todo (org-get-todo-state)) + ;; donep (org-entry-is-done-p) (if (looking-at re2) (progn (goto-char (match-end 0)) (setq ts2 (match-string 1) inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) - (setq tmp (buffer-substring (max (point-min) - (- pos org-ds-keyword-length)) - pos) - ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) + (setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) (progn (setq inc nil) (replace-match "\\1" t nil ts)) - ts) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - todo (org-get-todo-state) - ;; donep (org-entry-is-done-p) - )) + ts))) (when (and (not org-icalendar-use-plain-timestamp) (not deadlinep) (not scheduledp)) (throw :skip t)) @@ -403,12 +400,12 @@ When COMBINE is non nil, add the category to each line." (if (or (string-match org-tr-regexp hd) (string-match org-ts-regexp hd)) (setq hd (replace-match "" t t hd))) - (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) + (if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts) (setq rrule (concat "\nRRULE:FREQ=" (cdr (assoc (match-string 2 ts) - '(("d" . "DAILY")("w" . "WEEKLY") + '(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY") ("m" . "MONTHLY")("y" . "YEARLY")))) ";INTERVAL=" (match-string 1 ts))) (setq rrule "")) @@ -419,11 +416,11 @@ When COMBINE is non nil, add the category to each line." ;; (c) only a DISPLAY action is defined. ;; [ESF] (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault)))) - (if (and (> org-icalendar-alarm-time 0) + (if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0)) (car t1) (nth 1 t1) (nth 2 t1)) - (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time)) - (setq alarm "")) - ) + (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM" + summary (or alarm-time org-icalendar-alarm-time))) + (setq alarm ""))) (if (string-match org-bracket-link-regexp summary) (setq summary (replace-match (if (match-end 3) @@ -446,8 +443,8 @@ SUMMARY:%s%s%s CATEGORIES:%s%s END:VEVENT\n" (concat prefix uid) - (org-ical-ts-to-string ts "DTSTART") - (org-ical-ts-to-string ts2 "DTEND" inc) + (org-icalendar-ts-to-string ts "DTSTART") + (org-icalendar-ts-to-string ts2 "DTEND" inc) rrule summary (if (and desc (string-match "\\S-" desc)) (concat "\nDESCRIPTION: " desc) "") @@ -525,13 +522,13 @@ END:VEVENT\n" due (and (member 'todo-due org-icalendar-use-deadline) (org-entry-get nil "DEADLINE")) start (and (member 'todo-start org-icalendar-use-scheduled) - (org-entry-get nil "SCHEDULED")) + (org-entry-get nil "SCHEDULED")) categories (org-export-get-categories) uid (if org-icalendar-store-UID (org-id-get-create) (or (org-id-get) (org-id-new)))) - (and due (setq due (org-ical-ts-to-string due "DUE"))) - (and start (setq start (org-ical-ts-to-string start "DTSTART"))) + (and due (setq due (org-icalendar-ts-to-string due "DUE"))) + (and start (setq start (org-icalendar-ts-to-string start "DTSTART"))) (if (string-match org-bracket-link-regexp hd) (setq hd (replace-match (if (match-end 3) (match-string 3 hd) @@ -588,10 +585,10 @@ characters." (if (not s) nil (if is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s)))) + (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) + (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) + (while (string-match re s) (setq s (replace-match "" t t s))) + (while (string-match re2 s) (setq s (replace-match "" t t s)))) (setq s (replace-regexp-in-string "[[:space:]]+" " " s))) (let ((start 0)) (while (string-match "\\([,;]\\)" s start) @@ -634,7 +631,7 @@ not used right now." (when (string-match "[;,:]" s) (setq s (concat "\"" s "\""))) s)) -(defun org-start-icalendar-file (name) +(defun org-icalendar-start-file (name) "Start an iCalendar file by inserting the header." (let ((user user-full-name) (name (or name "unknown")) @@ -651,11 +648,11 @@ X-WR-TIMEZONE:%s X-WR-CALDESC:%s CALSCALE:GREGORIAN\n" name user timezone description)))) -(defun org-finish-icalendar-file () +(defun org-icalendar-finish-file () "Finish an iCalendar file by inserting the END statement." (princ "END:VCALENDAR\n")) -(defun org-ical-ts-to-string (s keyword &optional inc) +(defun org-icalendar-ts-to-string (s keyword &optional inc) "Take a time string S and convert it to iCalendar format. KEYWORD is added in front, to make a complete line like DTSTART.... When INC is non-nil, increase the hour by two (if time string contains @@ -680,7 +677,7 @@ a time), or the day by one (if it does not contain a time)." (replace-regexp-in-string "%Z" org-icalendar-timezone org-icalendar-date-time-format) - ";VALUE=DATE:%Y%m%d")) + ";VALUE=DATE:%Y%m%d")) (concat keyword (format-time-string fmt time (and (org-icalendar-use-UTC-date-timep) have-time)))))) diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index a93f804946f..c156e240dbf 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -83,6 +83,47 @@ :tag "Org ID" :group 'org) +(define-obsolete-variable-alias + 'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3") +(defcustom org-id-link-to-org-use-id nil + "Non-nil means storing a link to an Org file will use entry IDs. + +The variable can have the following values: + +t Create an ID if needed to make a link to the current entry. + +create-if-interactive + If `org-store-link' is called directly (interactively, as a user + command), do create an ID to support the link. But when doing the + job for capture, only use the ID if it already exists. The + purpose of this setting is to avoid proliferation of unwanted + IDs, just because you happen to be in an Org file when you + call `org-capture' that automatically and preemptively creates a + link. If you do want to get an ID link in a capture template to + an entry not having an ID, create it first by explicitly creating + a link to it, using `C-c C-l' first. + +create-if-interactive-and-no-custom-id + Like create-if-interactive, but do not create an ID if there is + a CUSTOM_ID property defined in the entry. + +use-existing + Use existing ID, do not create one. + +nil Never use an ID to make a link, instead link using a text search for + the headline text." + :group 'org-link-store + :group 'org-id + :version "24.3" + :type '(choice + (const :tag "Create ID to make link" t) + (const :tag "Create if storing link interactively" + create-if-interactive) + (const :tag "Create if storing link interactively and no CUSTOM_ID is present" + create-if-interactive-and-no-custom-id) + (const :tag "Only use existing" use-existing) + (const :tag "Do not use ID to create link" nil))) + (defcustom org-id-uuid-program "uuidgen" "The uuidgen program." :group 'org-id @@ -216,8 +257,7 @@ In any case, the ID of the entry is returned." (setq id (org-id-new prefix)) (org-entry-put pom "ID" id) (org-id-add-location id (buffer-file-name (buffer-base-buffer))) - id) - (t nil))))) + id))))) ;;;###autoload (defun org-id-get-with-outline-path-completion (&optional targets) @@ -273,7 +313,7 @@ With optional argument MARKERP, return the position as a new marker." (when file (setq where (org-id-find-id-in-file id file markerp))) (unless where - (org-id-update-id-locations) + (org-id-update-id-locations nil t) (setq file (org-id-find-id-file id)) (when file (setq where (org-id-find-id-in-file id file markerp)))) @@ -403,7 +443,7 @@ and time is the usual three-integer representation of time." ;; Storing ID locations (files) -(defun org-id-update-id-locations (&optional files) +(defun org-id-update-id-locations (&optional files silent) "Scan relevant files for IDs. Store the relation between files and corresponding IDs. This will scan all agenda files, all associated archives, and all @@ -427,11 +467,11 @@ When CHECK is given, prepare detailed information about duplicate IDs." (if (symbolp org-id-extra-files) (symbol-value org-id-extra-files) org-id-extra-files) - ;; Files associated with live org-mode buffers + ;; Files associated with live org-mode buffers (delq nil (mapcar (lambda (b) (with-current-buffer b - (and (eq major-mode 'org-mode) (buffer-file-name)))) + (and (derived-mode-p 'org-mode) (buffer-file-name)))) (buffer-list))) ;; All files known to have IDs org-id-files))) @@ -441,8 +481,9 @@ When CHECK is given, prepare detailed information about duplicate IDs." (setq files (delq 'agenda-archives (copy-sequence files)))) (setq nfiles (length files)) (while (setq file (pop files)) - (message "Finding ID locations (%d/%d files): %s" - (- nfiles (length files)) nfiles file) + (unless silent + (message "Finding ID locations (%d/%d files): %s" + (- nfiles (length files)) nfiles file)) (setq tfile (file-truename file)) (when (and (file-exists-p file) (not (member tfile seen))) (push tfile seen) @@ -505,7 +546,7 @@ When CHECK is given, prepare detailed information about duplicate IDs." (goto-char (point-min)) (setq org-id-locations (read (current-buffer)))) (error - (message "Could not read org-id-values from %s. Setting it to nil." + (message "Could not read org-id-values from %s. Setting it to nil." org-id-locations-file)))) (setq org-id-files (mapcar 'car org-id-locations)) (setq org-id-locations (org-id-alist-to-hash org-id-locations)))) @@ -600,8 +641,8 @@ 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)) (eq major-mode 'org-mode)) - (let* ((link (org-make-link "id:" (org-id-get-create))) + (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + (let* ((link (concat "id:" (org-id-get-create))) (case-fold-search nil) (desc (save-excursion (org-back-to-heading t) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 99a75841dee..d006df86747 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -45,6 +45,7 @@ (declare-function org-inlinetask-get-task-level "org-inlinetask" ()) (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) (declare-function org-list-item-body-column "org-list" (item)) +(defvar org-inlinetask-show-first-star) (defgroup org-indent nil "Options concerning dynamic virtual outline indentation." @@ -159,72 +160,75 @@ properties, after each buffer modification, on the modified zone. The process is synchronous. Though, initial indentation of buffer, which can take a few seconds on large buffers, is done during idle time." nil " Ind" nil - (cond - ((org-bound-and-true-p org-inhibit-startup) - (setq org-indent-mode nil)) - ((and org-indent-mode (featurep 'xemacs)) - (message "org-indent-mode does not work in XEmacs - refusing to turn it on") - (setq org-indent-mode nil)) - ((and org-indent-mode - (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) - (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!") - (ding) - (sit-for 1) - (setq org-indent-mode nil)) - (org-indent-mode - ;; mode was turned on. - (org-set-local 'indent-tabs-mode nil) - (or org-indent-strings (org-indent-initialize)) - (org-set-local 'org-indent-initial-marker (copy-marker 1)) - (when org-indent-mode-turns-off-org-adapt-indentation - (org-set-local 'org-adapt-indentation nil)) - (when org-indent-mode-turns-on-hiding-stars - (org-set-local 'org-hide-leading-stars-before-indent-mode - org-hide-leading-stars) - (org-set-local 'org-hide-leading-stars t)) - (make-local-variable 'buffer-substring-filters) - (add-to-list 'buffer-substring-filters - 'org-indent-remove-properties-from-string) - (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) - (org-add-hook 'before-change-functions - 'org-indent-notify-modified-headline nil 'local) - (and font-lock-mode (org-restart-font-lock)) - (org-indent-remove-properties (point-min) (point-max)) - ;; Submit current buffer to initialize agent. If it's the first - ;; buffer submitted, also start the agent. Current buffer is - ;; pushed in both cases to avoid a race condition. - (if org-indent-agentized-buffers - (push (current-buffer) org-indent-agentized-buffers) +(cond + ((org-bound-and-true-p org-inhibit-startup) + (setq org-indent-mode nil)) + ((and org-indent-mode (featurep 'xemacs)) + (message "org-indent-mode does not work in XEmacs - refusing to turn it on") + (setq org-indent-mode nil)) + ((and org-indent-mode + (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) + (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!") + (ding) + (sit-for 1) + (setq org-indent-mode nil)) + (org-indent-mode + ;; mode was turned on. + (org-set-local 'indent-tabs-mode nil) + (or org-indent-strings (org-indent-initialize)) + (org-set-local 'org-indent-initial-marker (copy-marker 1)) + (when org-indent-mode-turns-off-org-adapt-indentation + (org-set-local 'org-adapt-indentation nil)) + (when org-indent-mode-turns-on-hiding-stars + (org-set-local 'org-hide-leading-stars-before-indent-mode + org-hide-leading-stars) + (org-set-local 'org-hide-leading-stars t)) + (make-local-variable 'filter-buffer-substring-functions) + (add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete)))) + (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) + (org-add-hook 'before-change-functions + 'org-indent-notify-modified-headline nil 'local) + (and font-lock-mode (org-restart-font-lock)) + (org-indent-remove-properties (point-min) (point-max)) + ;; Submit current buffer to initialize agent. If it's the first + ;; buffer submitted, also start the agent. Current buffer is + ;; pushed in both cases to avoid a race condition. + (if org-indent-agentized-buffers (push (current-buffer) org-indent-agentized-buffers) - (setq org-indent-agent-timer - (run-with-idle-timer 0.2 t #'org-indent-initialize-agent)))) - (t - ;; mode was turned off (or we refused to turn it on) - (kill-local-variable 'org-adapt-indentation) - (setq org-indent-agentized-buffers - (delq (current-buffer) org-indent-agentized-buffers)) - (when (markerp org-indent-initial-marker) - (set-marker org-indent-initial-marker nil)) - (when (boundp 'org-hide-leading-stars-before-indent-mode) - (org-set-local 'org-hide-leading-stars - org-hide-leading-stars-before-indent-mode)) - (setq buffer-substring-filters - (delq 'org-indent-remove-properties-from-string - buffer-substring-filters)) - (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local) - (remove-hook 'before-change-functions - 'org-indent-notify-modified-headline 'local) - (org-with-wide-buffer - (org-indent-remove-properties (point-min) (point-max))) - (and font-lock-mode (org-restart-font-lock)) - (redraw-display)))) + (push (current-buffer) org-indent-agentized-buffers) + (setq org-indent-agent-timer + (run-with-idle-timer 0.2 t #'org-indent-initialize-agent)))) + (t + ;; mode was turned off (or we refused to turn it on) + (kill-local-variable 'org-adapt-indentation) + (setq org-indent-agentized-buffers + (delq (current-buffer) org-indent-agentized-buffers)) + (when (markerp org-indent-initial-marker) + (set-marker org-indent-initial-marker nil)) + (when (boundp 'org-hide-leading-stars-before-indent-mode) + (org-set-local 'org-hide-leading-stars + org-hide-leading-stars-before-indent-mode)) + (remove-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete)))) + (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local) + (remove-hook 'before-change-functions + 'org-indent-notify-modified-headline 'local) + (org-with-wide-buffer + (org-indent-remove-properties (point-min) (point-max))) + (and font-lock-mode (org-restart-font-lock)) + (redraw-display)))) (defun org-indent-indent-buffer () "Add indentation properties to the accessible part of the buffer." (interactive) - (if (not (eq major-mode 'org-mode)) + (if (not (derived-mode-p 'org-mode)) (error "Not in Org mode") - (message "Setting buffer indentation. It may take a few seconds...") + (message "Setting buffer indentation. It may take a few seconds...") (org-indent-remove-properties (point-min) (point-max)) (org-indent-add-properties (point-min) (point-max)) (message "Indentation of buffer set."))) @@ -293,8 +297,10 @@ Assume point is at beginning of line." (let ((stars (aref org-indent-stars (min l org-indent-max-levels)))) (and stars - (concat org-indent-inlinetask-first-star - (substring stars 1))))) + (if (org-bound-and-true-p org-inlinetask-show-first-star) + (concat org-indent-inlinetask-first-star + (substring stars 1)) + stars)))) (h (aref org-indent-stars (min l org-indent-max-levels))) (t (aref org-indent-strings @@ -414,12 +420,12 @@ This function is meant to be called by `after-change-functions'." (goto-char beg) (beginning-of-line) (re-search-forward org-outline-regexp-bol end t))) - (let ((end (save-excursion - (goto-char end) - (org-with-limited-levels (outline-next-heading)) - (point)))) - (setq org-indent-modified-headline-flag nil) - (org-indent-add-properties beg end)) + (let ((end (save-excursion + (goto-char end) + (org-with-limited-levels (outline-next-heading)) + (point)))) + (setq org-indent-modified-headline-flag nil) + (org-indent-add-properties beg end)) ;; Otherwise, only set properties on modified area. (org-indent-add-properties beg end))))) diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index b4e5c2244d5..31981ae1b29 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -48,9 +48,9 @@ "Store a link to an Info file and node." (when (eq major-mode 'Info-mode) (let (link desc) - (setq link (org-make-link "info:" - (file-name-nondirectory Info-current-file) - "#" Info-current-node)) + (setq link (concat "info:" + (file-name-nondirectory Info-current-file) + "#" Info-current-node)) (setq desc (concat (file-name-nondirectory Info-current-file) "#" Info-current-node)) (org-store-link-props :type "info" :file Info-current-file diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 5cd190050b4..01f861e611a 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -90,6 +90,9 @@ (defcustom org-inlinetask-min-level 15 "Minimum level a headline must have before it is treated as an inline task. +Don't set it to something higher than `29' or clocking will break since this +is the hardcoded maximum number of stars `org-clock-sum' will work with. + It is strongly recommended that you set `org-cycle-max-level' not at all, or to a number smaller than this one. In fact, when `org-cycle-max-level' is not set, it will be assumed to be one less than the value of smaller than @@ -99,6 +102,12 @@ the value of this variable." (const :tag "Off" nil) (integer))) +(defcustom org-inlinetask-show-first-star nil + "Non-nil means display the first star of an inline task as additional marker. +When nil, the first star is not shown." + :tag "Org Inline Tasks" + :group 'org-structure) + (defcustom org-inlinetask-export t "Non-nil means export inline tasks. When nil, they will not be exported." @@ -329,75 +338,75 @@ Either remove headline and meta data, or do special formatting." (end (copy-marker (save-excursion (org-inlinetask-goto-end) (point)))) content) - ;; Delete SCHEDULED, DEADLINE... - (while (re-search-forward keywords-re end t) - (delete-region (point-at-bol) (1+ (point-at-eol)))) - (goto-char beg) - ;; Delete drawers - (while (re-search-forward org-drawer-regexp end t) - (when (save-excursion (re-search-forward org-property-end-re nil t)) - (delete-region beg (1+ (match-end 0))))) - ;; Get CONTENT, if any. - (goto-char beg) - (forward-line 1) - (unless (= (point) end) - (setq content (buffer-substring (point) - (save-excursion (goto-char end) - (forward-line -1) - (point))))) - ;; Remove the task. - (goto-char beg) - (delete-region beg end) - (when (and org-inlinetask-export - (assq org-export-current-backend - org-inlinetask-export-templates)) - ;; Format CONTENT, if appropriate. - (setq content - (if (not (and content (string-match "\\S-" content))) - "" - ;; Ensure CONTENT has minimal indentation, a single - ;; newline character at its boundaries, and isn't - ;; protected. - (when (string-match "\\`\\([ \t]*\n\\)+" content) - (setq content (substring content (match-end 0)))) - (when (string-match "[ \t\n]+\\'" content) - (setq content (substring content 0 (match-beginning 0)))) - (org-add-props - (concat "\n\n" (org-remove-indentation content) "\n\n") - '(org-protected nil org-native-text nil)))) - - (when (string-match org-complex-heading-regexp headline) - (let* ((nil-to-str - (function - ;; Change nil arguments into empty strings. - (lambda (el) (or (eval el) "")))) - ;; Set up keywords provided to templates. - (todo (or (match-string 2 headline) "")) - (class (or (and (eq "" todo) "") - (if (member todo org-done-keywords) "done" "todo"))) - (priority (or (match-string 3 headline) "")) - (heading (or (match-string 4 headline) "")) - (tags (or (match-string 5 headline) "")) - ;; Read `org-inlinetask-export-templates'. - (backend-spec (assq org-export-current-backend - org-inlinetask-export-templates)) - (format-str (org-add-props (nth 1 backend-spec) - '(org-protected t org-native-text t))) - (tokens (cadr (nth 2 backend-spec))) - ;; Build export string. Ensure it won't break - ;; surrounding lists by giving it arbitrary high - ;; indentation. - (export-str (org-add-props - (eval (append '(format format-str) - (mapcar nil-to-str tokens))) - '(original-indentation 1000)))) - ;; Ensure task starts a new paragraph. - (unless (or (bobp) - (save-excursion (forward-line -1) - (looking-at "[ \t]*$"))) - (insert "\n")) - (insert export-str) - (unless (bolp) (insert "\n"))))))))) + ;; Delete SCHEDULED, DEADLINE... + (while (re-search-forward keywords-re end t) + (delete-region (point-at-bol) (1+ (point-at-eol)))) + (goto-char beg) + ;; Delete drawers + (while (re-search-forward org-drawer-regexp end t) + (when (save-excursion (re-search-forward org-property-end-re nil t)) + (delete-region beg (1+ (match-end 0))))) + ;; Get CONTENT, if any. + (goto-char beg) + (forward-line 1) + (unless (= (point) end) + (setq content (buffer-substring (point) + (save-excursion (goto-char end) + (forward-line -1) + (point))))) + ;; Remove the task. + (goto-char beg) + (delete-region beg end) + (when (and org-inlinetask-export + (assq org-export-current-backend + org-inlinetask-export-templates)) + ;; Format CONTENT, if appropriate. + (setq content + (if (not (and content (string-match "\\S-" content))) + "" + ;; Ensure CONTENT has minimal indentation, a single + ;; newline character at its boundaries, and isn't + ;; protected. + (when (string-match "\\`\\([ \t]*\n\\)+" content) + (setq content (substring content (match-end 0)))) + (when (string-match "[ \t\n]+\\'" content) + (setq content (substring content 0 (match-beginning 0)))) + (org-add-props + (concat "\n\n" (org-remove-indentation content) "\n\n") + '(org-protected nil org-native-text nil)))) + + (when (string-match org-complex-heading-regexp headline) + (let* ((nil-to-str + (function + ;; Change nil arguments into empty strings. + (lambda (el) (or (eval el) "")))) + ;; Set up keywords provided to templates. + (todo (or (match-string 2 headline) "")) + (class (or (and (eq "" todo) "") + (if (member todo org-done-keywords) "done" "todo"))) + (priority (or (match-string 3 headline) "")) + (heading (or (match-string 4 headline) "")) + (tags (or (match-string 5 headline) "")) + ;; Read `org-inlinetask-export-templates'. + (backend-spec (assq org-export-current-backend + org-inlinetask-export-templates)) + (format-str (org-add-props (nth 1 backend-spec) + '(org-protected t org-native-text t))) + (tokens (cadr (nth 2 backend-spec))) + ;; Build export string. Ensure it won't break + ;; surrounding lists by giving it arbitrary high + ;; indentation. + (export-str (org-add-props + (eval (append '(format format-str) + (mapcar nil-to-str tokens))) + '(original-indentation 1000)))) + ;; Ensure task starts a new paragraph. + (unless (or (bobp) + (save-excursion (forward-line -1) + (looking-at "[ \t]*$"))) + (insert "\n")) + (insert export-str) + (unless (bolp) (insert "\n"))))))))) (defun org-inlinetask-get-current-indentation () "Get the indentation of the last non-while line above this one." @@ -423,18 +432,21 @@ Either remove headline and meta data, or do special formatting." (1- (* 2 (or org-inlinetask-min-level 200))) (or org-inlinetask-min-level 200))) (re (concat "^\\(\\*\\)\\(\\*\\{" - (format "%d" (- nstars 3)) - ",\\}\\)\\(\\*\\* .*\\)")) + (format "%d" (- nstars 3)) + ",\\}\\)\\(\\*\\* .*\\)")) ;; Virtual indentation will add the warning face on the first - ;; star. Thus, in that case, only hide it. + ;; star. Thus, in that case, only hide it. (start-face (if (and (org-bound-and-true-p org-indent-mode) (> org-indent-indentation-per-level 1)) 'org-hide 'org-warning))) (while (re-search-forward re limit t) - (add-text-properties (match-beginning 1) (match-end 1) - `(face ,start-face font-lock-fontified t)) - (add-text-properties (match-beginning 2) (match-end 2) + (if org-inlinetask-show-first-star + (add-text-properties (match-beginning 1) (match-end 1) + `(face ,start-face font-lock-fontified t))) + (add-text-properties (match-beginning + (if org-inlinetask-show-first-star 2 1)) + (match-end 2) '(face org-hide font-lock-fontified t)) (add-text-properties (match-beginning 3) (match-end 3) '(face org-inlinetask font-lock-fontified t))))) @@ -452,7 +464,7 @@ Either remove headline and meta data, or do special formatting." ((= end start)) ;; Inlinetask was folded: expand it. ((get-char-property (1+ start) 'invisible) - (outline-flag-region start end nil)) + (org-show-entry)) (t (outline-flag-region start end t))))) (defun org-inlinetask-remove-END-maybe () diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 107428366dc..787eed7950f 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -81,10 +81,10 @@ "Parse LINK and dispatch to the correct function based on the client found." (let ((link (org-irc-parse-link link))) (cond - ((eq org-irc-client 'erc) - (org-irc-visit-erc link)) - (t - (error "erc only known client"))))) + ((eq org-irc-client 'erc) + (org-irc-visit-erc link)) + (t + (error "ERC only known client"))))) (defun org-irc-parse-link (link) "Parse an IRC LINK and return the attributes found. @@ -102,8 +102,8 @@ attributes that are found." (defun org-irc-store-link () "Dispatch to the appropriate function to store a link to an IRC session." (cond - ((eq major-mode 'erc-mode) - (org-irc-erc-store-link)))) + ((eq major-mode 'erc-mode) + (org-irc-erc-store-link)))) (defun org-irc-elipsify-description (string &optional after) "Remove unnecessary white space from STRING and add ellipses if necessary. @@ -140,9 +140,9 @@ result is a cons of the filename and search string." (when (search-backward-regexp "^[^ ]" nil t) (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) - (when (search-backward erc-line nil t) - (buffer-substring-no-properties (point-at-bol) - (point-at-eol))))))) + (when (search-backward erc-line nil t) + (buffer-substring-no-properties (point-at-bol) + (point-at-eol))))))) (defun org-irc-erc-store-link () "Store a link to the IRC log file or the session itself. @@ -164,27 +164,27 @@ the session itself." :link (concat "file:" (car parsed-line) "::" (cadr parsed-line))) t) - (error "This ERC session is not being logged"))) - (let* ((link-text (org-irc-get-erc-link)) - (link (org-irc-parse-link link-text))) - (if link-text - (progn - (org-store-link-props - :type "irc" - :link (org-make-link "irc:/" link-text) - :description (concat "irc session '" link-text "'") - :server (car (car link)) - :port (or (string-to-number (cadr (pop link))) erc-default-port) - :nick (pop link)) - t) - (error "Failed to create ('irc:/' style) ERC link"))))) + (error "This ERC session is not being logged"))) + (let* ((link-text (org-irc-get-erc-link)) + (link (org-irc-parse-link link-text))) + (if link-text + (progn + (org-store-link-props + :type "irc" + :link (concat "irc:/" link-text) + :description (concat "irc session '" link-text "'") + :server (car (car link)) + :port (or (string-to-number (cadr (pop link))) erc-default-port) + :nick (pop link)) + t) + (error "Failed to create ('irc:/' style) ERC link"))))) (defun org-irc-get-erc-link () "Return an org compatible irc:/ link from an ERC buffer." (let* ((session-port (if (numberp erc-session-port) (number-to-string erc-session-port) - erc-session-port)) - (link (concat erc-session-server ":" session-port))) + erc-session-port)) + (link (concat erc-session-server ":" session-port))) (concat link "/" (if (and (erc-default-target) (erc-channel-p (erc-default-target)) @@ -192,19 +192,19 @@ the session itself." ;; we can get a nick (let ((nick (car (get-text-property (point) 'erc-data)))) (concat (erc-default-target) "/" nick)) - (erc-default-target))))) + (erc-default-target))))) (defun org-irc-get-current-erc-port () "Return the current port as a number. Return the current port number or, if none is set, return the ERC default." (cond - ((stringp erc-session-port) - (string-to-number erc-session-port)) - ((numberp erc-session-port) - erc-session-port) - (t - erc-default-port))) + ((stringp erc-session-port) + (string-to-number erc-session-port)) + ((numberp erc-session-port) + erc-session-port) + (t + erc-default-port))) (defun org-irc-visit-erc (link) "Visit an ERC buffer based on criteria found in LINK." @@ -242,13 +242,13 @@ default." (progn (goto-char (point-max)) (insert (concat nick ": "))) - (error "%s not found in %s" nick chan-name))))) - (progn - (org-pop-to-buffer-same-window server-buffer) - (erc-cmd-JOIN chan-name)))) - (org-pop-to-buffer-same-window server-buffer))) - ;; no server match, make new connection - (erc-select :server server :port port)))) + (error "%s not found in %s" nick chan-name))))) + (progn + (org-pop-to-buffer-same-window server-buffer) + (erc-cmd-JOIN chan-name)))) + (org-pop-to-buffer-same-window server-buffer))) + ;; no server match, make new connection + (erc-select :server server :port port)))) (provide 'org-irc) diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el index f4075d02981..35d43dec8da 100644 --- a/lisp/org/org-jsinfo.el +++ b/lisp/org/org-jsinfo.el @@ -99,13 +99,69 @@ means to use the maximum value consistent with other options." (lambda (x) (list 'cons (list 'const (car x)) '(choice - (symbol :tag "Publishing/Export property") - (string :tag "Value")))) + (symbol :tag "Publishing/Export property") + (string :tag "Value")))) org-infojs-opts-table))) (defcustom org-infojs-template - "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\"></script> -<script type=\"text/javascript\" > + "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\"> +/** + * + * @source: %SCRIPT_PATH + * + * @licstart The following is the entire license notice for the + * JavaScript code in %SCRIPT_PATH. + * + * Copyright (C) 2012 Sebastian Rose + * + * + * The JavaScript code in this tag is free software: you can + * redistribute it and/or modify it under the terms of the GNU + * General Public License (GNU GPL) as published by the Free Software + * Foundation, either version 3 of the License, or (at your option) + * any later version. The code is distributed WITHOUT ANY WARRANTY; + * without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + * + * As additional permission under GNU GPL version 3 section 7, you + * may distribute non-source (e.g., minimized or compacted) forms of + * that code without the copy of the GNU GPL normally required by + * section 4, provided you include this license notice and a URL + * through which recipients can access the Corresponding Source. + * + * @licend The above is the entire license notice + * for the JavaScript code in %SCRIPT_PATH. + * + */ +</script> + +<script type=\"text/javascript\"> + +/* +@licstart The following is the entire license notice for the +JavaScript code in this tag. + +Copyright (C) 2012 Free Software Foundation, Inc. + +The JavaScript code in this tag is free software: you can +redistribute it and/or modify it under the terms of the GNU +General Public License (GNU GPL) as published by the Free Software +Foundation, either version 3 of the License, or (at your option) +any later version. The code is distributed WITHOUT ANY WARRANTY; +without even the implied warranty of MERCHANTABILITY or FITNESS +FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + +As additional permission under GNU GPL version 3 section 7, you +may distribute non-source (e.g., minimized or compacted) forms of +that code without the copy of the GNU GPL normally required by +section 4, provided you include this license notice and a URL +through which recipients can access the Corresponding Source. + + +@licend The above is the entire license notice +for the JavaScript code in this tag. +*/ + <!--/*--><![CDATA[/*><!--*/ %MANAGER_OPTIONS org_html_manager.setup(); // activate after the parameters are set @@ -127,67 +183,67 @@ Option settings will replace the %MANAGER-OPTIONS cookie." exp-plist ;; We do want to use the script, set it up (let ((template org-infojs-template) - (ptoc (plist-get exp-plist :table-of-contents)) - (hlevels (plist-get exp-plist :headline-levels)) - tdepth sdepth s v e opt var val table default) - (setq sdepth hlevels - tdepth hlevels) - (if (integerp ptoc) (setq tdepth (min ptoc tdepth))) - (setq v (plist-get exp-plist :infojs-opt) - table org-infojs-opts-table) - (while (setq e (pop table)) - (setq opt (car e) var (nth 1 e) - default (cdr (assoc opt org-infojs-options))) - (and (symbolp default) (not (memq default '(t nil))) - (setq default (plist-get exp-plist default))) - (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v)) - (setq val (match-string 1 v)) - (setq val default)) - (cond - ((eq opt 'path) - (and (string-match "%SCRIPT_PATH" template) - (setq template (replace-match val t t template)))) - ((eq opt 'sdepth) - (if (integerp (read val)) - (setq sdepth (min (read val) hlevels)))) - ((eq opt 'tdepth) - (if (integerp (read val)) - (setq tdepth (min (read val) hlevels)))) - (t - (setq val - (cond - ((or (eq val t) (equal val "t")) "1") - ((or (eq val nil) (equal val "nil")) "0") - ((stringp val) val) - (t (format "%s" val)))) - (push (cons var val) s)))) - - ;; Now we set the depth of the *generated* TOC to SDEPTH, because the - ;; toc will actually determine the splitting. How much of the toc will - ;; actually be displayed is governed by the TDEPTH option. - (setq exp-plist (plist-put exp-plist :table-of-contents sdepth)) - - ;; The table of contents should not show more sections then we generate - (setq tdepth (min tdepth sdepth)) - (push (cons "TOC_DEPTH" tdepth) s) - - (setq s (mapconcat - (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" - (car x) (cdr x))) - s "\n")) - (when (and s (> (length s) 0)) - (and (string-match "%MANAGER_OPTIONS" template) - (setq s (replace-match s t t template)) - (setq exp-plist - (plist-put - exp-plist :style-extra - (concat (or (plist-get exp-plist :style-extra) "") "\n" s))))) - ;; This script absolutely needs the table of contents, to we change that - ;; setting - (if (not (plist-get exp-plist :table-of-contents)) - (setq exp-plist (plist-put exp-plist :table-of-contents t))) - ;; Return the modified property list - exp-plist))) + (ptoc (plist-get exp-plist :table-of-contents)) + (hlevels (plist-get exp-plist :headline-levels)) + tdepth sdepth s v e opt var val table default) + (setq sdepth hlevels + tdepth hlevels) + (if (integerp ptoc) (setq tdepth (min ptoc tdepth))) + (setq v (plist-get exp-plist :infojs-opt) + table org-infojs-opts-table) + (while (setq e (pop table)) + (setq opt (car e) var (nth 1 e) + default (cdr (assoc opt org-infojs-options))) + (and (symbolp default) (not (memq default '(t nil))) + (setq default (plist-get exp-plist default))) + (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v)) + (setq val (match-string 1 v)) + (setq val default)) + (cond + ((eq opt 'path) + (setq template + (replace-regexp-in-string "%SCRIPT_PATH" val template t t))) + ((eq opt 'sdepth) + (if (integerp (read val)) + (setq sdepth (min (read val) hlevels)))) + ((eq opt 'tdepth) + (if (integerp (read val)) + (setq tdepth (min (read val) hlevels)))) + (t + (setq val + (cond + ((or (eq val t) (equal val "t")) "1") + ((or (eq val nil) (equal val "nil")) "0") + ((stringp val) val) + (t (format "%s" val)))) + (push (cons var val) s)))) + + ;; Now we set the depth of the *generated* TOC to SDEPTH, because the + ;; toc will actually determine the splitting. How much of the toc will + ;; actually be displayed is governed by the TDEPTH option. + (setq exp-plist (plist-put exp-plist :table-of-contents sdepth)) + + ;; The table of contents should not show more sections then we generate + (setq tdepth (min tdepth sdepth)) + (push (cons "TOC_DEPTH" tdepth) s) + + (setq s (mapconcat + (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" + (car x) (cdr x))) + s "\n")) + (when (and s (> (length s) 0)) + (and (string-match "%MANAGER_OPTIONS" template) + (setq s (replace-match s t t template)) + (setq exp-plist + (plist-put + exp-plist :style-extra + (concat (or (plist-get exp-plist :style-extra) "") "\n" s))))) + ;; This script absolutely needs the table of contents, to we change that + ;; setting + (if (not (plist-get exp-plist :table-of-contents)) + (setq exp-plist (plist-put exp-plist :table-of-contents t))) + ;; Return the modified property list + exp-plist))) (defun org-infojs-options-inbuffer-template () (format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s" diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el index 4418dee73e8..933fa56b8dd 100644 --- a/lisp/org/org-latex.el +++ b/lisp/org/org-latex.el @@ -235,7 +235,7 @@ are written as utf8 files." "Alist of LaTeX expressions to convert emphasis fontifiers. Each element of the list is a list of three elements. The first element is the character used as a marker for fontification. -The second element is a formatting string to wrap fontified text with. +The second element is a format string to wrap fontified text with. If it is \"\\verb\", Org will automatically select a delimiter character that is not in the string. \"\\protectedtexttt\" will use \\texttt to typeset and try to protect special characters. @@ -247,7 +247,7 @@ conversions." (defcustom org-export-latex-title-command "\\maketitle" "The command used to insert the title just after \\begin{document}. If this string contains the formatting specification \"%s\" then -it will be used as a formatting string, passing the title as an +it will be used as a format string, passing the title as an argument." :group 'org-export-latex :type 'string) @@ -321,6 +321,18 @@ will be filled with the link, the second with its description." :version "24.1" :type 'string) +(defcustom org-export-latex-hyperref-options-format + "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={Emacs Org-mode version %s}}\n" + "A format string for hyperref options. +When non-nil, it must contain three %s format specifications +which will respectively be replaced by the document's keywords, +its description and the Org's version number, as a string. Set +this option to the empty string if you don't want to include +hyperref options altogether." + :type 'string + :version "24.3" + :group 'org-export-latex) + (defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\," "Text used to separate footnotes." :group 'org-export-latex @@ -377,6 +389,33 @@ When nil, grouping causes only separation lines between groups." :group 'org-export-latex :type 'boolean) +(defcustom org-export-latex-tables-tstart nil + "LaTeX command for top rule for tables." + :group 'org-export-latex + :version "24.1" + :type '(choice + (const :tag "Nothing" nil) + (string :tag "String") + (const :tag "Booktabs default: \\toprule" "\\toprule"))) + +(defcustom org-export-latex-tables-hline "\\hline" + "LaTeX command to use for a rule somewhere in the middle of a table." + :group 'org-export-latex + :version "24.1" + :type '(choice + (string :tag "String") + (const :tag "Standard: \\hline" "\\hline") + (const :tag "Booktabs default: \\midrule" "\\midrule"))) + +(defcustom org-export-latex-tables-tend nil + "LaTeX command for bottom rule for tables." + :group 'org-export-latex + :version "24.1" + :type '(choice + (const :tag "Nothing" nil) + (string :tag "String") + (const :tag "Booktabs default: \\bottomrule" "\\bottomrule"))) + (defcustom org-export-latex-low-levels 'itemize "How to convert sections below the current level of sectioning. This is specified by the `org-export-headline-levels' option or the @@ -518,9 +557,9 @@ pygmentize -L lexers "Association list of options for the latex listings package. These options are supplied as a comma-separated list to the -\\lstset command. Each element of the association list should be +\\lstset command. Each element of the association list should be a list containing two strings: the name of the option, and the -value. For example, +value. For example, (setq org-export-latex-listings-options '((\"basicstyle\" \"\\small\") @@ -542,9 +581,9 @@ languages." "Association list of options for the latex minted package. These options are supplied within square brackets in -\\begin{minted} environments. Each element of the alist should be +\\begin{minted} environments. Each element of the alist should be a list containing two strings: the name of the option, and the -value. For example, +value. For example, (setq org-export-latex-minted-options '((\"bgcolor\" \"bg\") (\"frame\" \"lines\"))) @@ -553,7 +592,7 @@ will result in src blocks being exported with \\begin{minted}[bgcolor=bg,frame=lines]{<LANG>} -as the start of the minted environment. Note that the same +as the start of the minted environment. Note that the same options will be applied to blocks of all languages." :group 'org-export-latex :version "24.1" @@ -565,7 +604,7 @@ options will be applied to blocks of all languages." (defvar org-export-latex-custom-lang-environments nil "Association list mapping languages to language-specific latex environments used during export of src blocks by the listings - and minted latex packages. For example, + and minted latex packages. For example, (setq org-export-latex-custom-lang-environments '((python \"pythoncode\"))) @@ -607,6 +646,12 @@ and `org-export-with-tags' instead." :version "24.1" :type 'string) +(defcustom org-export-latex-link-with-unknown-path-format "\\texttt{%s}" + "Format string for links with unknown path type." + :group 'org-export-latex + :version "24.3" + :type 'string) + (defcustom org-export-latex-inline-image-extensions '("pdf" "jpeg" "jpg" "png" "ps" "eps") "Extensions of image files that can be inlined into LaTeX. @@ -632,11 +677,24 @@ allowed. The default we use here encompasses both." '("pdflatex -interaction nonstopmode -output-directory %o %f" "pdflatex -interaction nonstopmode -output-directory %o %f" "pdflatex -interaction nonstopmode -output-directory %o %f") - "Commands to process a LaTeX file to a PDF file. -This is a list of strings, each of them will be given to the shell -as a command. %f in the command will be replaced by the full file name, %b -by the file base name (i.e. without extension) and %o by the base directory -of the file. + "Commands to process a LaTeX file to a PDF file and process latex +fragments to pdf files.By default,this is a list of strings,and each of +strings will be given to the shell as a command. %f in the command will +be replaced by the full file name, %b by the file base name (i.e. without +extension) and %o by the base directory of the file. + +If you set `org-create-formula-image-program' +`org-export-with-LaTeX-fragments' to 'imagemagick, you can add a +sublist which contains your own command(s) for LaTeX fragments +previewing, like this: + + '(\"xelatex -interaction nonstopmode -output-directory %o %f\" + \"xelatex -interaction nonstopmode -output-directory %o %f\" + ;; use below command(s) to convert latex fragments + (\"xelatex %f\")) + +With no such sublist, the default command used to convert LaTeX +fragments will be the first string in the list. The reason why this is a list is that it usually takes several runs of `pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever @@ -661,28 +719,28 @@ This function should accept the file name as its single argument." (string :tag "Shell command")) (const :tag "2 runs of pdflatex" ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) + "pdflatex -interaction nonstopmode -output-directory %o %f")) (const :tag "3 runs of pdflatex" ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) (const :tag "pdflatex,bibtex,pdflatex,pdflatex" ("pdflatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) + "bibtex %b" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) (const :tag "2 runs of xelatex" ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) + "xelatex -interaction nonstopmode -output-directory %o %f")) (const :tag "3 runs of xelatex" ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) + "xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) (const :tag "xelatex,bibtex,xelatex,xelatex" ("xelatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) + "bibtex %b" + "xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) (const :tag "texi2dvi" ("texi2dvi -p -b -c -V %f")) (const :tag "rubber" @@ -750,7 +808,7 @@ then use this command to convert it." (interactive "r") (let (reg latex buf) (save-window-excursion - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq latex (org-export-region-as-latex beg end t 'string)) (setq reg (buffer-substring beg end) @@ -985,7 +1043,7 @@ when PUB-DIR is set, use this as the publishing directory." (when (and text (not (eq to-buffer 'string))) (insert (org-export-latex-content text '(lists tables fixed-width keywords)) - "\n\n")) + "\n\n")) ;; insert lines before the first headline (unless (or skip (string-match "^\\*" first-lines)) @@ -1034,6 +1092,11 @@ when PUB-DIR is set, use this as the publishing directory." (if (looking-at "[\n \t]+") (replace-match "\n"))) + ;; Ensure we have a final newline + (goto-char (point-max)) + (or (eq (char-before) ?\n) + (insert ?\n)) + (run-hooks 'org-export-latex-final-hook) (if to-buffer (unless (eq major-mode 'latex-mode) (latex-mode)) @@ -1084,22 +1147,24 @@ when PUB-DIR is set, use this as the publishing directory." (funcall cmds (shell-quote-argument file)) (while cmds (setq cmd (pop cmds)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument base)) - t t cmd))) - (while (string-match "%f" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument file)) - t t cmd))) - (while (string-match "%o" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument output-dir)) - t t cmd))) - (shell-command cmd outbuf))))) + (cond + ((not (listp cmd)) + (while (string-match "%b" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument base)) + t t cmd))) + (while (string-match "%f" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument file)) + t t cmd))) + (while (string-match "%o" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument output-dir)) + t t cmd))) + (shell-command cmd outbuf))))))) (message (concat "Processing LaTeX file " file "...done")) (setq errors (org-export-latex-get-error outbuf)) (if (not (file-exists-p pdffile)) @@ -1471,11 +1536,10 @@ OPT-PLIST is the options plist for current buffer." (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)) + (format org-export-latex-hyperref-options-format + (org-export-latex-fontify-headline keywords) + (org-export-latex-fontify-headline description) + (org-version)) ;; beginning of the document "\n\\begin{document}\n\n" ;; insert the title command @@ -1569,7 +1633,7 @@ links, keywords, lists, tables, fixed-width" (unless (memq 'fixed-width exclude-list) (org-export-latex-fixed-width (plist-get org-export-latex-options-plist :fixed-width))) - ;; return string + ;; return string (buffer-substring (point-min) (point-max)))) (defun org-export-latex-protect-string (s) @@ -1691,13 +1755,13 @@ links, keywords, lists, tables, fixed-width" (let ((org-display-custom-times org-export-latex-display-custom-times)) (while (re-search-forward org-ts-regexp-both nil t) (org-if-unprotected-at (1- (point)) - (replace-match - (org-export-latex-protect-string - (format (if (string= "<" (substring (match-string 0) 0 1)) - org-export-latex-timestamp-markup - org-export-latex-timestamp-inactive-markup) - (substring (org-translate-time (match-string 0)) 1 -1))) - t t))))) + (replace-match + (org-export-latex-protect-string + (format (if (string= "<" (substring (match-string 0) 0 1)) + org-export-latex-timestamp-markup + org-export-latex-timestamp-inactive-markup) + (substring (org-translate-time (match-string 0)) 1 -1))) + t t))))) (defun org-export-latex-quotation-marks () "Export quotation marks depending on language conventions." @@ -1723,8 +1787,7 @@ See the `org-export-latex.el' code for a complete conversion table." (goto-char (point-min)) (while (re-search-forward c nil t) ;; Put the point where to check for org-protected - (unless (or (get-text-property (match-beginning 2) 'org-protected) - (save-match-data (org-at-table.el-p))) + (unless (get-text-property (match-beginning 2) 'org-protected) (cond ((member (match-string 2) '("\\$" "$")) (if (equal (match-string 2) "\\$") nil @@ -1752,7 +1815,7 @@ See the `org-export-latex.el' code for a complete conversion table." (replace-match (match-string 2) t t) (replace-match (concat (match-string 1) "\\" (match-string 2)) t t))))) - (unless (save-match-data (org-inside-latex-math-p)) + (unless (save-match-data (or (org-inside-latex-math-p) (org-at-table-p))) (cond ((equal (match-string 2) "\\") (replace-match (or (save-match-data (org-export-latex-treat-backslash-char @@ -1877,19 +1940,19 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (goto-char (point-min)) (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t) (unless (get-text-property (point) 'org-example) - (if opt - (progn (goto-char (match-beginning 0)) - (insert "\\begin{verbatim}\n") - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat (match-string 1) - (match-string 2)) t t) - (forward-line)) - (insert "\\end{verbatim}\n")) - (progn (goto-char (match-beginning 0)) - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat "%" (match-string 1) - (match-string 2)) t t) - (forward-line))))))) + (if opt + (progn (goto-char (match-beginning 0)) + (insert "\\begin{verbatim}\n") + (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") + (replace-match (concat (match-string 1) + (match-string 2)) t t) + (forward-line)) + (insert "\\end{verbatim}\n")) + (progn (goto-char (match-beginning 0)) + (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") + (replace-match (concat "%" (match-string 1) + (match-string 2)) t t) + (forward-line))))))) (defvar org-table-last-alignment) ; defined in org-table.el (defvar org-table-last-column-widths) ; defined in org-table.el @@ -1915,7 +1978,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (org-table-last-column-widths (copy-sequence org-table-last-column-widths)) fnum fields line lines olines gr colgropen line-fmt align - caption width shortn label attr floatp placement + caption width shortn label attr hfmt floatp placement longtblp tblenv tabular-env) (if org-export-latex-tables-verbatim (let* ((tbl (concat "\\begin{verbatim}\n" raw-table @@ -1952,6 +2015,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." align (and attr (stringp attr) (string-match "\\<align=\\([^ \t\n\r]+\\)" attr) (match-string 1 attr)) + hfmt (and attr (stringp attr) + (string-match "\\<hfmt=\\(\\S-+\\)" attr) + (match-string 1 attr)) floatp (or caption label (string= "table*" tblenv)) placement (if (and attr (stringp attr) @@ -1967,7 +2033,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (when org-table-clean-did-remove-column (pop org-table-last-alignment) (pop org-table-last-column-widths)) - ;; make a formatting string to reflect alignment + ;; make a format string to reflect alignment (setq olines lines) (while (and (not line-fmt) (setq line (pop olines))) (unless (string-match "^[ \t]*|-" line) @@ -2034,14 +2100,21 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." align)) (orgtbl-to-latex lines - `(:tstart nil :tend nil + `(:tstart ,org-export-latex-tables-tstart + :tend ,org-export-latex-tables-tend + :hline ,org-export-latex-tables-hline + :skipheadrule ,longtblp + :hfmt ,hfmt :hlend ,(if longtblp (format "\\\\ -\\hline +%s \\endhead -\\hline\\multicolumn{%d}{r}{Continued on next page}\\ +%s\\multicolumn{%d}{r}{Continued on next page}\\ \\endfoot -\\endlastfoot" (length org-table-last-alignment)) +\\endlastfoot" + org-export-latex-tables-hline + org-export-latex-tables-hline + (length org-table-last-alignment)) nil))) (if (not longtblp) (format "\n\\end{%s}" tabular-env)) (if longtblp "\n" (if org-export-latex-tables-centered @@ -2272,8 +2345,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (insert (save-match-data (funcall fnc (org-link-unescape raw-path) desc 'latex)))) - - (t (insert "\\texttt{" desc "}"))))))) + ;; Unrecognized path type + (t (insert (format org-export-latex-link-with-unknown-path-format desc)))))))) (defun org-export-latex-format-image (path caption label attr &optional shortn) @@ -2382,7 +2455,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ;; Compute string to insert (FNOTE), and protect the outside ;; macro from further transformation. When footnote at ;; point is referring to a previously defined footnote, use - ;; \footnotemark. Otherwise, use \footnote. + ;; \footnotemark. Otherwise, use \footnote. (let ((fnote (if (member lbl org-export-latex-footmark-seen) (org-export-latex-protect-string (format "\\footnotemark[%s]" lbl)) @@ -2607,7 +2680,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defun org-export-latex-lists () "Convert plain text lists in current buffer into LaTeX lists." ;; `org-list-end-re' output has changed since preprocess from - ;; org-exp.el. Make sure it is taken into account. + ;; org-exp.el. Make sure it is taken into account. (let ((org-list-end-re "^ORG-LIST-END-MARKER\n")) (mapc (lambda (e) @@ -2638,181 +2711,181 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (append org-list-export-context '(nil))))) (defconst org-latex-entities - '("\\!" - "\\'" - "\\+" - "\\," - "\\-" - "\\:" - "\\;" - "\\<" - "\\=" - "\\>" - "\\Huge" - "\\LARGE" - "\\Large" - "\\Styles" - "\\\\" - "\\`" - "\\\"" - "\\addcontentsline" - "\\address" - "\\addtocontents" - "\\addtocounter" - "\\addtolength" - "\\addvspace" - "\\alph" - "\\appendix" - "\\arabic" - "\\author" - "\\begin{array}" - "\\begin{center}" - "\\begin{description}" - "\\begin{enumerate}" - "\\begin{eqnarray}" - "\\begin{equation}" - "\\begin{figure}" - "\\begin{flushleft}" - "\\begin{flushright}" - "\\begin{itemize}" - "\\begin{list}" - "\\begin{minipage}" - "\\begin{picture}" - "\\begin{quotation}" - "\\begin{quote}" - "\\begin{tabbing}" - "\\begin{table}" - "\\begin{tabular}" - "\\begin{thebibliography}" - "\\begin{theorem}" - "\\begin{titlepage}" - "\\begin{verbatim}" - "\\begin{verse}" - "\\bf" - "\\bf" - "\\bibitem" - "\\bigskip" - "\\cdots" - "\\centering" - "\\circle" - "\\cite" - "\\cleardoublepage" - "\\clearpage" - "\\cline" - "\\closing" - "\\dashbox" - "\\date" - "\\ddots" - "\\dotfill" - "\\em" - "\\fbox" - "\\flushbottom" - "\\fnsymbol" - "\\footnote" - "\\footnotemark" - "\\footnotesize" - "\\footnotetext" - "\\frac" - "\\frame" - "\\framebox" - "\\hfill" - "\\hline" - "\\hrulespace" - "\\hspace" - "\\huge" - "\\hyphenation" - "\\include" - "\\includeonly" - "\\indent" - "\\input" - "\\it" - "\\kill" - "\\label" - "\\large" - "\\ldots" - "\\line" - "\\linebreak" - "\\linethickness" - "\\listoffigures" - "\\listoftables" - "\\location" - "\\makebox" - "\\maketitle" - "\\mark" - "\\mbox" - "\\medskip" - "\\multicolumn" - "\\multiput" - "\\newcommand" - "\\newcounter" - "\\newenvironment" - "\\newfont" - "\\newlength" - "\\newline" - "\\newpage" - "\\newsavebox" - "\\newtheorem" - "\\nocite" - "\\nofiles" - "\\noindent" - "\\nolinebreak" - "\\nopagebreak" - "\\normalsize" - "\\onecolumn" - "\\opening" - "\\oval" - "\\overbrace" - "\\overline" - "\\pagebreak" - "\\pagenumbering" - "\\pageref" - "\\pagestyle" - "\\par" - "\\parbox" - "\\put" - "\\raggedbottom" - "\\raggedleft" - "\\raggedright" - "\\raisebox" - "\\ref" - "\\rm" - "\\roman" - "\\rule" - "\\savebox" - "\\sc" - "\\scriptsize" - "\\setcounter" - "\\setlength" - "\\settowidth" - "\\sf" - "\\shortstack" - "\\signature" - "\\sl" - "\\small" - "\\smallskip" - "\\sqrt" - "\\tableofcontents" - "\\telephone" - "\\thanks" - "\\thispagestyle" - "\\tiny" - "\\title" - "\\tt" - "\\twocolumn" - "\\typein" - "\\typeout" - "\\underbrace" - "\\underline" - "\\usebox" - "\\usecounter" - "\\value" - "\\vdots" - "\\vector" - "\\verb" - "\\vfill" - "\\vline" - "\\vspace") - "A list of LaTeX commands to be protected when performing conversion.") + '("\\!" + "\\'" + "\\+" + "\\," + "\\-" + "\\:" + "\\;" + "\\<" + "\\=" + "\\>" + "\\Huge" + "\\LARGE" + "\\Large" + "\\Styles" + "\\\\" + "\\`" + "\\\"" + "\\addcontentsline" + "\\address" + "\\addtocontents" + "\\addtocounter" + "\\addtolength" + "\\addvspace" + "\\alph" + "\\appendix" + "\\arabic" + "\\author" + "\\begin{array}" + "\\begin{center}" + "\\begin{description}" + "\\begin{enumerate}" + "\\begin{eqnarray}" + "\\begin{equation}" + "\\begin{figure}" + "\\begin{flushleft}" + "\\begin{flushright}" + "\\begin{itemize}" + "\\begin{list}" + "\\begin{minipage}" + "\\begin{picture}" + "\\begin{quotation}" + "\\begin{quote}" + "\\begin{tabbing}" + "\\begin{table}" + "\\begin{tabular}" + "\\begin{thebibliography}" + "\\begin{theorem}" + "\\begin{titlepage}" + "\\begin{verbatim}" + "\\begin{verse}" + "\\bf" + "\\bf" + "\\bibitem" + "\\bigskip" + "\\cdots" + "\\centering" + "\\circle" + "\\cite" + "\\cleardoublepage" + "\\clearpage" + "\\cline" + "\\closing" + "\\dashbox" + "\\date" + "\\ddots" + "\\dotfill" + "\\em" + "\\fbox" + "\\flushbottom" + "\\fnsymbol" + "\\footnote" + "\\footnotemark" + "\\footnotesize" + "\\footnotetext" + "\\frac" + "\\frame" + "\\framebox" + "\\hfill" + "\\hline" + "\\hrulespace" + "\\hspace" + "\\huge" + "\\hyphenation" + "\\include" + "\\includeonly" + "\\indent" + "\\input" + "\\it" + "\\kill" + "\\label" + "\\large" + "\\ldots" + "\\line" + "\\linebreak" + "\\linethickness" + "\\listoffigures" + "\\listoftables" + "\\location" + "\\makebox" + "\\maketitle" + "\\mark" + "\\mbox" + "\\medskip" + "\\multicolumn" + "\\multiput" + "\\newcommand" + "\\newcounter" + "\\newenvironment" + "\\newfont" + "\\newlength" + "\\newline" + "\\newpage" + "\\newsavebox" + "\\newtheorem" + "\\nocite" + "\\nofiles" + "\\noindent" + "\\nolinebreak" + "\\nopagebreak" + "\\normalsize" + "\\onecolumn" + "\\opening" + "\\oval" + "\\overbrace" + "\\overline" + "\\pagebreak" + "\\pagenumbering" + "\\pageref" + "\\pagestyle" + "\\par" + "\\parbox" + "\\put" + "\\raggedbottom" + "\\raggedleft" + "\\raggedright" + "\\raisebox" + "\\ref" + "\\rm" + "\\roman" + "\\rule" + "\\savebox" + "\\sc" + "\\scriptsize" + "\\setcounter" + "\\setlength" + "\\settowidth" + "\\sf" + "\\shortstack" + "\\signature" + "\\sl" + "\\small" + "\\smallskip" + "\\sqrt" + "\\tableofcontents" + "\\telephone" + "\\thanks" + "\\thispagestyle" + "\\tiny" + "\\title" + "\\tt" + "\\twocolumn" + "\\typein" + "\\typeout" + "\\underbrace" + "\\underline" + "\\usebox" + "\\usecounter" + "\\value" + "\\vdots" + "\\vector" + "\\verb" + "\\vfill" + "\\vline" + "\\vspace") + "A list of LaTeX commands to be protected when performing conversion.") (defconst org-latex-entities-regexp (let (names rest) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 8d3948698fc..10f5e6ec6a9 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -236,8 +236,7 @@ Otherwise, two of them will be necessary." :group 'org-plain-lists :type 'boolean) -(defcustom org-list-automatic-rules '((bullet . t) - (checkbox . t) +(defcustom org-list-automatic-rules '((checkbox . t) (indent . t)) "Non-nil means apply set of rules when acting on lists. By default, automatic actions are taken when using @@ -247,27 +246,21 @@ By default, automatic actions are taken when using \\[org-insert-todo-heading]. You can disable individually these rules by setting them to nil. Valid rules are: -bullet when non-nil, cycling bullet do not allow lists at - column 0 to have * as a bullet and descriptions lists - to be numbered. checkbox when non-nil, checkbox statistics is updated each time you either insert a new checkbox or toggle a checkbox. - It also prevents from inserting a checkbox in a - description item. indent when non-nil, indenting or outdenting list top-item with its subtree will move the whole list and outdenting a list whose bullet is * to column 0 will change that bullet to \"-\"." - :group 'org-plain-lists - :version "24.1" - :type '(alist :tag "Sets of rules" - :key-type - (choice - (const :tag "Bullet" bullet) - (const :tag "Checkbox" checkbox) - (const :tag "Indent" indent)) - :value-type - (boolean :tag "Activate" :value t))) + :group 'org-plain-lists + :version "24.1" + :type '(alist :tag "Sets of rules" + :key-type + (choice + (const :tag "Checkbox" checkbox) + (const :tag "Indent" indent)) + :value-type + (boolean :tag "Activate" :value t))) (defcustom org-list-use-circular-motion nil "Non-nil means commands implying motion in lists should be cyclic. @@ -491,7 +484,7 @@ group 4: description tag") (defun org-at-item-description-p () "Is point at a description list item?" - (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+")) + (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::\\([ \t]+\\|$\\)")) (defun org-at-item-checkbox-p () "Is point at a line starting a plain-list item with a checklet?" @@ -628,12 +621,15 @@ Assume point is at an item." ;; Return association at point. (lambda (ind) (looking-at org-list-full-item-re) - (list (point) - ind - (match-string-no-properties 1) ; bullet - (match-string-no-properties 2) ; counter - (match-string-no-properties 3) ; checkbox - (match-string-no-properties 4))))) ; description tag + (let ((bullet (match-string-no-properties 1))) + (list (point) + ind + bullet + (match-string-no-properties 2) ; counter + (match-string-no-properties 3) ; checkbox + ;; Description tag. + (and (save-match-data (string-match "[-+*]" bullet)) + (match-string-no-properties 4))))))) (end-before-blank (function ;; Ensure list ends at the first blank line. @@ -694,7 +690,7 @@ Assume point is at an item." (forward-line -1)) ((looking-at "^[ \t]*$") (forward-line -1)) - ;; From there, point is not at an item. Interpret + ;; From there, point is not at an item. Interpret ;; line's indentation: ;; - text at column 0 is necessarily out of any list. ;; Dismiss data recorded above BEG-CELL. Jump to @@ -1015,10 +1011,45 @@ Possible types are `descriptive', `ordered' and `unordered'. The type is determined by the first item of the list." (let ((first (org-list-get-list-begin item struct prevs))) (cond - ((org-list-get-tag first struct) 'descriptive) ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) + ((org-list-get-tag first struct) 'descriptive) (t 'unordered)))) +(defun org-list-get-item-number (item struct prevs parents) + "Return ITEM's sequence number. + +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. PARENTS is the +alist of ancestors, as returned by `org-list-parents-alist'. + +Return value is a list of integers. Counters have an impact on +that value." + (let ((get-relative-number + (function + (lambda (item struct prevs) + ;; Return relative sequence number of ITEM in the sub-list + ;; it belongs. STRUCT is the list structure. PREVS is + ;; the alist of previous items. + (let ((seq 0) (pos item) counter) + (while (and (not (setq counter (org-list-get-counter pos struct))) + (setq pos (org-list-get-prev-item pos struct prevs))) + (incf seq)) + (if (not counter) (1+ seq) + (cond + ((string-match "[A-Za-z]" counter) + (+ (- (string-to-char (upcase (match-string 0 counter))) 64) + seq)) + ((string-match "[0-9]+" counter) + (+ (string-to-number (match-string 0 counter)) seq)) + (t (1+ seq))))))))) + ;; Cons each parent relative number into return value (OUT). + (let ((out (list (funcall get-relative-number item struct prevs))) + (parent item)) + (while (setq parent (org-list-get-parent parent struct parents)) + (push (funcall get-relative-number parent struct prevs) out)) + ;; Return value. + out))) + ;;; Searching @@ -1225,8 +1256,15 @@ This function modifies STRUCT." (let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin)))) (item-end (org-list-get-item-end item struct)) (item-end-no-blank (org-list-get-item-end-before-blank item struct)) - (beforep (and (looking-at org-list-full-item-re) - (<= pos (match-end 0)))) + (beforep + (progn + (looking-at org-list-full-item-re) + ;; Do not count tag in a non-descriptive list. + (<= pos (if (and (match-beginning 4) + (save-match-data + (string-match "[.)]" (match-string 1)))) + (match-beginning 4) + (match-end 0))))) (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) (blank-nb (org-list-separating-blank-lines-number pos struct prevs)) @@ -1270,9 +1308,8 @@ This function modifies STRUCT." (insert body item-sep) ;; 5. Add new item to STRUCT. (mapc (lambda (e) - (let ((p (car e)) - (end (nth 6 e))) - (cond + (let ((p (car e)) (end (nth 6 e))) + (cond ;; Before inserted item, positions don't change but ;; an item ending after insertion has its end shifted ;; by SIZE-OFFSET. @@ -1591,7 +1628,7 @@ as returned by `org-list-prevs-alist'." (if (> ascii 90) (throw 'exit nil) (setq item (org-list-get-next-item item struct prevs))))) - ;; All items checked. All good. + ;; All items checked. All good. t)))) (defun org-list-inc-bullet-maybe (bullet) @@ -1808,7 +1845,6 @@ Initial position of cursor is restored after the changes." (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) (item-re (org-item-re)) - (box-rule-p (cdr (assq 'checkbox org-list-automatic-rules))) (shift-body-ind (function ;; Shift the indentation between END and BEG by DELTA. @@ -1842,14 +1878,11 @@ Initial position of cursor is restored after the changes." (old-bul (org-list-get-bullet item old-struct)) (new-box (org-list-get-checkbox item struct))) (looking-at org-list-full-item-re) - ;; a. Replace bullet + ;; a. Replace bullet (unless (equal old-bul new-bul) (replace-match new-bul nil nil nil 1)) - ;; b. Replace checkbox. + ;; b. Replace checkbox. (cond - ((and new-box box-rule-p - (save-match-data (org-at-item-description-p))) - (message "Cannot add a checkbox to a description list item")) ((equal (match-string 3) new-box)) ((and (match-string 3) new-box) (replace-match new-box nil nil nil 3)) @@ -1859,7 +1892,7 @@ Initial position of cursor is restored after the changes." (t (let ((counterp (match-end 2))) (goto-char (if counterp (1+ counterp) (match-end 1))) (insert (concat new-box (unless counterp " ")))))) - ;; c. Indent item to appropriate column. + ;; c. Indent item to appropriate column. (unless (= new-ind old-ind) (delete-region (goto-char (point-at-bol)) (progn (skip-chars-forward " \t") (point))) @@ -2007,7 +2040,7 @@ Possible values are: `folded', `children' or `subtree'. See (let (bpos bcol tpos tcol) (save-excursion (goto-char item) - (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?[ \t]+") + (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)") (setq bpos (match-beginning 1) tpos (match-end 0) bcol (progn (goto-char bpos) (current-column)) tcol (progn (goto-char tpos) (current-column))) @@ -2164,20 +2197,19 @@ item is invisible." (org-list-struct))) (prevs (org-list-prevs-alist struct)) ;; If we're in a description list, ask for the new term. - (desc (when (org-list-get-tag itemp struct) - (concat (read-string "Term: ") " :: "))) - ;; Don't insert a checkbox if checkbox rule is applied - ;; and it is a description item. - (checkp (and checkbox - (or (not desc) - (not (cdr (assq 'checkbox - org-list-automatic-rules))))))) + (desc (when (eq (org-list-get-list-type itemp struct prevs) + 'descriptive) + (concat (read-string "Term: ") " :: ")))) (setq struct - (org-list-insert-item pos struct prevs checkp desc)) + (org-list-insert-item pos struct prevs checkbox desc)) (org-list-write-struct struct (org-list-parents-alist struct)) - (when checkp (org-update-checkbox-count-maybe)) + (when checkbox (org-update-checkbox-count-maybe)) (looking-at org-list-full-item-re) - (goto-char (match-end 0)) + (goto-char (if (and (match-beginning 4) + (save-match-data + (string-match "[.)]" (match-string 1)))) + (match-beginning 4) + (match-end 0))) t))))) (defun org-list-repair () @@ -2206,7 +2238,6 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (prevs (org-list-prevs-alist struct)) (list-beg (org-list-get-first-item (point) struct prevs)) (bullet (org-list-get-bullet list-beg struct)) - (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) (alpha-p (org-list-use-alpha-bul-p list-beg struct prevs)) (case-fold-search nil) (current (cond @@ -2221,22 +2252,21 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (bullet-list (append '("-" "+" ) ;; *-bullets are not allowed at column 0. - (unless (and bullet-rule-p - (looking-at "\\S-")) '("*")) + (unless (looking-at "\\S-") '("*")) ;; Description items cannot be numbered. (unless (or (eq org-plain-list-ordered-item-terminator ?\)) - (and bullet-rule-p (org-at-item-description-p))) + (org-at-item-description-p)) '("1.")) (unless (or (eq org-plain-list-ordered-item-terminator ?.) - (and bullet-rule-p (org-at-item-description-p))) + (org-at-item-description-p)) '("1)")) (unless (or (not alpha-p) (eq org-plain-list-ordered-item-terminator ?\)) - (and bullet-rule-p (org-at-item-description-p))) + (org-at-item-description-p)) '("a." "A.")) (unless (or (not alpha-p) (eq org-plain-list-ordered-item-terminator ?.) - (and bullet-rule-p (org-at-item-description-p))) + (org-at-item-description-p)) '("a)" "A)")))) (len (length bullet-list)) (item-index (- len (length (member current bullet-list)))) @@ -2339,13 +2369,13 @@ in subtree, ignoring drawers." (lambda (e) (or (< e lim-up) (> e lim-down))) (mapcar 'car struct)))) (mapc (lambda (e) (org-list-set-checkbox - e struct - ;; If there is no box at item, leave as-is - ;; unless function was called with C-u prefix. - (let ((cur-box (org-list-get-checkbox e struct))) - (if (or cur-box (equal toggle-presence '(4))) - ref-checkbox - cur-box)))) + e struct + ;; If there is no box at item, leave as-is + ;; unless function was called with C-u prefix. + (let ((cur-box (org-list-get-checkbox e struct))) + (if (or cur-box (equal toggle-presence '(4))) + ref-checkbox + cur-box)))) items-to-toggle) (setq block-item (org-list-struct-fix-box struct parents prevs orderedp)) @@ -2792,11 +2822,10 @@ COMPARE-FUNC to compare entries." (sort-func (cond ((= dcst ?a) 'string<) ((= dcst ?f) compare-func) - ((= dcst ?t) '<) - (t nil))) + ((= dcst ?t) '<))) (next-record (lambda () - (skip-chars-forward " \r\t\n") - (beginning-of-line))) + (skip-chars-forward " \r\t\n") + (beginning-of-line))) (end-record (lambda () (goto-char (org-list-get-item-end-before-blank (point) struct)))) @@ -2910,7 +2939,7 @@ Point is left at list end." (goto-char e) (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*") (match-end 0))) - ;; Get counter number. For alphabetic counter, get + ;; Get counter number. For alphabetic counter, get ;; its position in the alphabet. (counter (let ((c (org-list-get-counter e struct))) (cond @@ -3116,7 +3145,7 @@ items." ((and counter (eq type 'ordered)) (concat (eval icount) "%s")) (t (concat (eval istart) "%s"))) - (eval iend))) + (eval iend))) (first (car item))) ;; Replace checkbox if any is found. (cond @@ -3173,21 +3202,21 @@ with overruling parameters for `org-list-to-generic'." list (org-combine-plists '(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}" - :ustart "\\begin{itemize}\n" :uend "\\end{itemize}" - :dstart "\\begin{description}\n" :dend "\\end{description}" - :dtstart "[" :dtend "] " - :istart "\\item " :iend "\n" - :icount (let ((enum (nth depth '("i" "ii" "iii" "iv")))) - (if enum - ;; LaTeX increments counter just before - ;; using it, so set it to the desired - ;; value, minus one. - (format "\\setcounter{enum%s}{%s}\n\\item " - enum (1- counter)) - "\\item ")) - :csep "\n" - :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}" - :cbtrans "\\texttt{[-]}") + :ustart "\\begin{itemize}\n" :uend "\\end{itemize}" + :dstart "\\begin{description}\n" :dend "\\end{description}" + :dtstart "[" :dtend "] " + :istart "\\item " :iend "\n" + :icount (let ((enum (nth depth '("i" "ii" "iii" "iv")))) + (if enum + ;; LaTeX increments counter just before + ;; using it, so set it to the desired + ;; value, minus one. + (format "\\setcounter{enum%s}{%s}\n\\item " + enum (1- counter)) + "\\item ")) + :csep "\n" + :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}" + :cbtrans "\\texttt{[-]}") params))) (defun org-list-to-html (list &optional params) @@ -3198,15 +3227,15 @@ with overruling parameters for `org-list-to-generic'." list (org-combine-plists '(:splice nil :ostart "<ol>\n" :oend "\n</ol>" - :ustart "<ul>\n" :uend "\n</ul>" - :dstart "<dl>\n" :dend "\n</dl>" - :dtstart "<dt>" :dtend "</dt>\n" - :ddstart "<dd>" :ddend "</dd>" - :istart "<li>" :iend "</li>" - :icount (format "<li value=\"%s\">" counter) - :isep "\n" :lsep "\n" :csep "\n" - :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>" - :cbtrans "<code>[-]</code>") + :ustart "<ul>\n" :uend "\n</ul>" + :dstart "<dl>\n" :dend "\n</dl>" + :dtstart "<dt>" :dtend "</dt>\n" + :ddstart "<dd>" :ddend "</dd>" + :istart "<li>" :iend "</li>" + :icount (format "<li value=\"%s\">" counter) + :isep "\n" :lsep "\n" :csep "\n" + :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>" + :cbtrans "<code>[-]</code>") params))) (defun org-list-to-texinfo (list &optional params) @@ -3217,14 +3246,14 @@ with overruling parameters for `org-list-to-generic'." list (org-combine-plists '(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize" - :ustart "@enumerate\n" :uend "@end enumerate" - :dstart "@table @asis\n" :dend "@end table" - :dtstart " " :dtend "\n" - :istart "@item\n" :iend "\n" - :icount "@item\n" - :csep "\n" - :cbon "@code{[X]}" :cboff "@code{[ ]}" - :cbtrans "@code{[-]}") + :ustart "@enumerate\n" :uend "@end enumerate" + :dstart "@table @asis\n" :dend "@end table" + :dtstart " " :dtend "\n" + :istart "@item\n" :iend "\n" + :icount "@item\n" + :csep "\n" + :cbon "@code{[X]}" :cboff "@code{[ ]}" + :cbtrans "@code{[-]}") params))) (defun org-list-to-subtree (list &optional params) diff --git a/lisp/org/org-lparse.el b/lisp/org/org-lparse.el index 9c3cd5b4811..7024912050a 100644 --- a/lisp/org/org-lparse.el +++ b/lisp/org/org-lparse.el @@ -67,7 +67,7 @@ lists." ((file-exists-p file-or-buf) file-or-buf) (t (error "org-lparse-and-open: This shouldn't happen")))) (message "Opening file %s" f) - (org-open-file f) + (org-open-file f 'system) (when org-export-kill-product-buffer-when-displayed (kill-buffer (current-buffer)))))) @@ -89,9 +89,9 @@ emacs --batch No file is created. The prefix ARG is passed through to `org-lparse'." (let ((tempbuf (format "*Org %s Export*" (upcase backend)))) - (org-lparse backend backend arg nil nil tempbuf) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window tempbuf)))) + (org-lparse backend backend arg nil nil tempbuf) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window tempbuf)))) ;;;###autoload (defun org-replace-region-by (backend beg end) @@ -101,7 +101,7 @@ itemized list in org-mode syntax in an HTML buffer and then use this command to convert it." (let (reg backend-string buf pop-up-frames) (save-window-excursion - (if (eq major-mode 'org-mode) + (if (derived-mode-p '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*")) @@ -145,16 +145,16 @@ in a window. A non-interactive call will only return the buffer." (defvar org-lparse-par-open nil) (defun org-lparse-should-inline-p (filename descp) - "Return non-nil if link FILENAME should be inlined. + "Return non-nil if link FILENAME should be inlined. The decision to inline the FILENAME link is based on the current settings. DESCP is the boolean of whether there was a link description. See variables `org-export-html-inline-images' and `org-export-html-inline-image-extensions'." - (let ((inline-images (org-lparse-get 'INLINE-IMAGES)) - (inline-image-extensions - (org-lparse-get 'INLINE-IMAGE-EXTENSIONS))) - (and (or (eq t inline-images) (and inline-images (not descp))) - (org-file-image-p filename inline-image-extensions)))) + (let ((inline-images (org-lparse-get 'INLINE-IMAGES)) + (inline-image-extensions + (org-lparse-get 'INLINE-IMAGE-EXTENSIONS))) + (and (or (eq t inline-images) (and inline-images (not descp))) + (org-file-image-p filename inline-image-extensions)))) (defun org-lparse-format-org-link (line opt-plist) "Return LINE with markup of Org mode links. @@ -435,6 +435,10 @@ PUB-DIR specifies the publishing directory." (let* ((org-lparse-backend (intern native-backend)) (org-lparse-other-backend (and target-backend (intern target-backend)))) + (add-hook 'org-export-preprocess-hook + 'org-lparse-strip-experimental-blocks-maybe) + (add-hook 'org-export-preprocess-after-blockquote-hook + 'org-lparse-preprocess-after-blockquote) (unless (org-lparse-backend-is-native-p native-backend) (error "Don't know how to export natively to backend %s" native-backend)) @@ -443,7 +447,11 @@ PUB-DIR specifies the publishing directory." (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))) + (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir) + (remove-hook 'org-export-preprocess-hook + 'org-lparse-strip-experimental-blocks-maybe) + (remove-hook 'org-export-preprocess-after-blockquote-hook + 'org-lparse-preprocess-after-blockquote))) (defcustom org-lparse-use-flashy-warning nil "Control flashing of messages logged with `org-lparse-warn'. @@ -509,7 +517,7 @@ This is a helper routine for interactive use." (message "Exported to %s" out-file) (when prefix-arg (message "Opening %s..." out-file) - (org-open-file out-file)) + (org-open-file out-file 'system)) out-file) (t (message "Export to %s failed" out-file) @@ -565,7 +573,7 @@ and then converted to \"doc\" then org-lparse-backend is set to (defun org-do-lparse (arg &optional hidden ext-plist to-buffer body-only pub-dir) "Export the outline to various formats. -See `org-lparse' for more information. This function is a +See `org-lparse' for more information. This function is a html-agnostic version of the `org-export-as-html' function in 7.5 version." ;; Make sure we have a file name when we need it. @@ -771,7 +779,7 @@ version." ;; collection org-lparse-collect-buffer (org-lparse-collect-count 0) ; things will get haywire if - ; collections are chained. Use + ; collections are chained. Use ; this variable to assert this ; pre-requisite org-lparse-toc @@ -901,7 +909,6 @@ version." (funcall f style env-options-plist) (throw 'nextline nil)))) - (run-hooks 'org-export-html-after-blockquotes-hook) (when (org-lparse-current-environment-p 'verse) (let ((i (org-get-string-indentation line))) (if (> i 0) @@ -1158,7 +1165,7 @@ version." (defun org-lparse-table-get-colalign-info (lines) (let ((col-cookies (org-find-text-property-in-string - 'org-col-cookies (car lines)))) + 'org-col-cookies (car lines)))) (when (and col-cookies org-table-clean-did-remove-column) (setq col-cookies (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies))) @@ -1218,7 +1225,11 @@ for formatting. This is required for the DocBook exporter." ;; column and the special lines (setq lines (org-table-clean-before-export lines))) (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) + (short-caption (or (org-find-text-property-in-string + 'org-caption-shortn (car lines)) caption)) (caption (and caption (org-xml-encode-org-text caption))) + (short-caption (and short-caption + (org-xml-encode-plain-text short-caption))) (label (org-find-text-property-in-string 'org-label (car lines))) (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines)) (attributes (org-find-text-property-in-string 'org-attributes @@ -1229,11 +1240,13 @@ for formatting. This is required for the DocBook exporter." (cdr lines)))))) (setq lines (org-lparse-org-table-to-list-table lines splice)) (org-lparse-insert-list-table - lines splice caption label attributes head org-lparse-table-colalign-info))) + lines splice caption label attributes head org-lparse-table-colalign-info + short-caption))) (defun org-lparse-insert-list-table (lines &optional splice - caption label attributes head - org-lparse-table-colalign-info) + caption label attributes head + org-lparse-table-colalign-info + short-caption) (or (featurep 'org-table) ; required for (require 'org-table)) ; `org-table-number-regexp' (let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0) @@ -1253,7 +1266,7 @@ for formatting. This is required for the DocBook exporter." (insert (org-lparse-format-table-row line) "\n"))) (t (setq org-lparse-table-is-styled t) - (org-lparse-begin 'TABLE caption label attributes) + (org-lparse-begin 'TABLE caption label attributes short-caption) (setq org-lparse-table-begin-marker (point)) (org-lparse-begin-table-rowgroup head) (while (setq line (pop lines)) @@ -1284,13 +1297,14 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." (org-lparse-table-cur-rowgrp-is-hdr org-export-highlight-first-table-line) (caption nil) + (short-caption nil) (attributes nil) (label nil) (org-lparse-table-style 'table-table) (org-lparse-table-is-styled nil) fields org-lparse-table-ncols i (org-lparse-table-rownum -1) (empty (org-lparse-format 'SPACES 1))) - (org-lparse-begin 'TABLE caption label attributes) + (org-lparse-begin 'TABLE caption label attributes short-caption) (while (setq line (pop lines)) (cond ((string-match "^[ \t]*\\+-" line) @@ -1320,9 +1334,9 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." (defvar table-source-languages) ; defined in table.el (defun org-lparse-format-table-table-using-table-generate-source (backend - lines - &optional - spanned-only) + lines + &optional + spanned-only) "Format a table into BACKEND, using `table-generate-source' from table.el. Use SPANNED-ONLY to suppress exporting of simple table.el tables. @@ -1353,9 +1367,9 @@ for further information." (set-buffer " org-tmp2 ") (buffer-substring (point-min) (point-max))) (t - ;; table.el doesn't support the given backend. Currently this + ;; table.el doesn't support the given backend. Currently this ;; happens in case of odt export. Strip the table from the - ;; generated document. A better alternative would be to embed + ;; generated document. A better alternative would be to embed ;; the table as ascii text in the output document. (org-lparse-warn (concat @@ -1706,7 +1720,12 @@ information." (org-lparse-end-paragraph) (org-lparse-end-list-item (or type "u"))) -(defun org-lparse-preprocess-after-blockquote-hook () +(define-obsolete-function-alias + 'org-lparse-preprocess-after-blockquote-hook + 'org-lparse-preprocess-after-blockquote + "24.3") + +(defun org-lparse-preprocess-after-blockquote () "Treat `org-lparse-special-blocks' specially." (goto-char (point-min)) (while (re-search-forward @@ -1719,10 +1738,12 @@ information." (format "ORG-%s-END %s" (upcase (match-string 2)) (match-string 3))) t t)))) -(add-hook 'org-export-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote-hook) +(define-obsolete-function-alias + 'org-lparse-strip-experimental-blocks-maybe-hook + 'org-lparse-strip-experimental-blocks-maybe + "24.3") -(defun org-lparse-strip-experimental-blocks-maybe-hook () +(defun org-lparse-strip-experimental-blocks-maybe () "Strip \"list-table\" and \"annotation\" blocks. Stripping happens only when the exported backend is not one of \"odt\" or \"xhtml\"." @@ -1737,9 +1758,6 @@ Stripping happens only when the exported backend is not one of (when (member (match-string 1) org-lparse-special-blocks) (replace-match "" t t)))))) -(add-hook 'org-export-preprocess-hook - 'org-lparse-strip-experimental-blocks-maybe-hook) - (defvar org-lparse-list-table-p nil "Non-nil if `org-do-lparse' is within a list-table.") @@ -1871,7 +1889,7 @@ See `org-xhtml-entity-format-callbacks-alist' for more information." (replace-match (let ((org-lparse-encode-pending t)) (org-lparse-format 'FONTIFY - (match-string 1 line) "target")) + (match-string 1 line) "target")) t t line))) (when (string-match (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) @@ -1923,8 +1941,7 @@ See `org-xhtml-entity-format-callbacks-alist' for more information." (cond ((string= align "l") "left") ((string= align "r") "right") - ((string= align "c") "center") - (t nil)))))))) + ((string= align "c") "center")))))))) (incf org-lparse-table-rownum) (let ((i -1)) (org-lparse-format @@ -2036,8 +2053,8 @@ When TITLE is nil, just close all open levels." (defvar org-lparse-outline-text-open) (defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags - target extra-targets - extra-class) + target extra-targets + extra-class) (org-lparse-begin 'OUTLINE level1 snumber title tags target extra-targets extra-class) (org-lparse-begin-outline-text level1 snumber extra-class)) @@ -2087,7 +2104,7 @@ When TITLE is nil, just close all open levels." ;; Note that org-tables are NOT multi-line and each line is mapped to ;; a unique row in the exported document. So if an exported table ;; needs to contain a single paragraph (with copious text) it needs to -;; be typed up in a single line. Editing such long lines using the +;; be typed up in a single line. Editing such long lines using the ;; table editor will be a cumbersome task. Furthermore inclusion of ;; multi-paragraph text in a table cell is well-nigh impossible. ;; @@ -2232,11 +2249,11 @@ Replaces invalid characters with \"_\"." (defun org-lparse-format-extra-targets (extra-targets) (if (not extra-targets) "" - (mapconcat (lambda (x) - (setq x (org-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) x))) - (org-lparse-format 'ANCHOR "" x)) - extra-targets ""))) + (mapconcat (lambda (x) + (setq x (org-solidify-link-text + (if (org-uuidgen-p x) (concat "ID-" x) x))) + (org-lparse-format 'ANCHOR "" x)) + extra-targets ""))) (defun org-lparse-format-org-tags (tags) (if (not tags) "" diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el index 2223c63f154..91866b46c0a 100644 --- a/lisp/org/org-mac-message.el +++ b/lisp/org/org-mac-message.el @@ -47,7 +47,7 @@ (require 'org) (defgroup org-mac-flagged-mail nil - "Options concerning linking to flagged Mail.app messages" + "Options concerning linking to flagged Mail.app messages." :tag "Org Mail.app" :group 'org-link) @@ -84,15 +84,15 @@ This will use the command `open' with the message URL." (do-applescript (concat "tell application \"Mail\"\n" - "set theLinkList to {}\n" - "set theSelection to selection\n" - "repeat with theMessage in theSelection\n" - "set theID to message id of theMessage\n" - "set theSubject to subject of theMessage\n" - "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - "end repeat\n" - "return theLinkList as string\n" + "set theLinkList to {}\n" + "set theSelection to selection\n" + "repeat with theMessage in theSelection\n" + "set theID to message id of theMessage\n" + "set theSubject to subject of theMessage\n" + "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" + "copy theLink to end of theLinkList\n" + "end repeat\n" + "return theLinkList as string\n" "end tell"))) (defun as-get-flagged-mail () @@ -101,47 +101,47 @@ This will use the command `open' with the message URL." (concat ;; Is Growl installed? "tell application \"System Events\"\n" - "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n" - "if (count of growlHelpers) > 0 then\n" - "set growlHelperApp to item 1 of growlHelpers\n" - "else\n" - "set growlHelperApp to \"\"\n" - "end if\n" + "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n" + "if (count of growlHelpers) > 0 then\n" + "set growlHelperApp to item 1 of growlHelpers\n" + "else\n" + "set growlHelperApp to \"\"\n" + "end if\n" "end tell\n" ;; Get links "tell application \"Mail\"\n" - "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n" - "set theLinkList to {}\n" - "repeat with aMailbox in theMailboxes\n" - "set theSelection to (every message in aMailbox whose flagged status = true)\n" - "repeat with theMessage in theSelection\n" - "set theID to message id of theMessage\n" - "set theSubject to subject of theMessage\n" - "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - - ;; Report progress through Growl - ;; This "double tell" idiom is described in detail at - ;; http://macscripter.net/viewtopic.php?id=24570 The - ;; script compiler needs static knowledge of the - ;; growlHelperApp. Hmm, since we're compiling - ;; on-the-fly here, this is likely to be way less - ;; portable than I'd hoped. It'll work when the name - ;; is still "GrowlHelperApp", though. - "if growlHelperApp is not \"\" then\n" - "tell application \"GrowlHelperApp\"\n" - "tell application growlHelperApp\n" - "set the allNotificationsList to {\"FlaggedMail\"}\n" - "set the enabledNotificationsList to allNotificationsList\n" - "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n" - "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n" - "end tell\n" - "end tell\n" - "end if\n" - "end repeat\n" - "end repeat\n" - "return theLinkList as string\n" + "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n" + "set theLinkList to {}\n" + "repeat with aMailbox in theMailboxes\n" + "set theSelection to (every message in aMailbox whose flagged status = true)\n" + "repeat with theMessage in theSelection\n" + "set theID to message id of theMessage\n" + "set theSubject to subject of theMessage\n" + "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" + "copy theLink to end of theLinkList\n" + + ;; Report progress through Growl + ;; This "double tell" idiom is described in detail at + ;; http://macscripter.net/viewtopic.php?id=24570 The + ;; script compiler needs static knowledge of the + ;; growlHelperApp. Hmm, since we're compiling + ;; on-the-fly here, this is likely to be way less + ;; portable than I'd hoped. It'll work when the name + ;; is still "GrowlHelperApp", though. + "if growlHelperApp is not \"\" then\n" + "tell application \"GrowlHelperApp\"\n" + "tell application growlHelperApp\n" + "set the allNotificationsList to {\"FlaggedMail\"}\n" + "set the enabledNotificationsList to allNotificationsList\n" + "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n" + "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n" + "end tell\n" + "end tell\n" + "end if\n" + "end repeat\n" + "end repeat\n" + "return theLinkList as string\n" "end tell"))) (defun org-mac-message-get-links (&optional select-or-flag) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index daeea715789..e99991702fe 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -54,21 +54,22 @@ (defmacro org-called-interactively-p (&optional kind) (if (featurep 'xemacs) - `(interactive-p) - (if (or (> emacs-major-version 23) - (and (>= emacs-major-version 23) - (>= emacs-minor-version 2))) - `(with-no-warnings (called-interactively-p ,kind)) ;; defined with no argument in <=23.1 - `(interactive-p)))) + `(interactive-p) + (if (or (> emacs-major-version 23) + (and (>= emacs-major-version 23) + (>= emacs-minor-version 2))) + ;; defined with no argument in <=23.1 + `(with-no-warnings (called-interactively-p ,kind)) + `(interactive-p)))) (def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp))) (when (and (not (fboundp 'with-silent-modifications)) - (or (< emacs-major-version 23) - (and (= emacs-major-version 23) - (< emacs-minor-version 2)))) - (defmacro with-silent-modifications (&rest body) - `(org-unmodified ,@body)) - (def-edebug-spec with-silent-modifications (body))) + (or (< emacs-major-version 23) + (and (= emacs-major-version 23) + (< emacs-minor-version 2)))) + (defmacro with-silent-modifications (&rest body) + `(org-unmodified ,@body)) + (def-edebug-spec with-silent-modifications (body))) (defmacro org-bound-and-true-p (var) "Return the value of symbol VAR if it is bound, else nil." @@ -129,15 +130,15 @@ Also, do not record undo information." `(if (and (boundp 'partial-completion-mode) partial-completion-mode (fboundp 'partial-completion-mode)) - (unwind-protect - (progn - (partial-completion-mode -1) - ,@body) - (partial-completion-mode 1)) + (unwind-protect + (progn + (partial-completion-mode -1) + ,@body) + (partial-completion-mode 1)) ,@body)) (def-edebug-spec org-without-partial-completion (body)) -;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22 +;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22 (defmacro org-maybe-intangible (props) "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22. In Emacs 21, invisible text is not avoided by the command loop, so the @@ -238,10 +239,15 @@ We use a macro so that the test can happen at compilation time." s) (match-string-no-properties num string))) -(defsubst org-no-properties (s) +(defsubst org-no-properties (s &optional restricted) + "Remove all text properties from string S. +When RESTRICTED is non-nil, only remove the properties listed +in `org-rm-props'." (if (fboundp 'set-text-properties) (set-text-properties 0 (length s) nil s) - (remove-text-properties 0 (length s) org-rm-props s)) + (if restricted + (remove-text-properties 0 (length s) org-rm-props s) + (set-text-properties 0 (length s) nil s))) s) (defsubst org-get-alist-option (option key) @@ -363,18 +369,19 @@ point nowhere." (def-edebug-spec org-save-outline-visibility (form body)) (defmacro org-with-wide-buffer (&rest body) - "Execute body while temporarily widening the buffer." - `(save-excursion - (save-restriction + "Execute body while temporarily widening the buffer." + `(save-excursion + (save-restriction (widen) ,@body))) (def-edebug-spec org-with-wide-buffer (body)) (defmacro org-with-limited-levels (&rest body) "Execute BODY with limited number of outline levels." - `(let* ((org-outline-regexp (org-get-limited-outline-regexp)) + `(let* ((org-called-with-limited-levels t) + (org-outline-regexp (org-get-limited-outline-regexp)) (outline-regexp org-outline-regexp) - (org-outline-regexp-at-bol (concat "^" org-outline-regexp))) + (org-outline-regexp-bol (concat "^" org-outline-regexp))) ,@body)) (def-edebug-spec org-with-limited-levels (body)) @@ -384,14 +391,14 @@ 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 (eq major-mode 'org-mode)) (not (featurep 'org-inlinetask))) + (if (or (not (derived-mode-p 'org-mode)) (not (featurep 'org-inlinetask))) org-outline-regexp (let* ((limit-level (1- org-inlinetask-min-level)) (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) (format "\\*\\{1,%d\\} " nstars)))) (defun org-format-seconds (string seconds) - "Compatibility function replacing format-seconds" + "Compatibility function replacing format-seconds." (if (fboundp 'format-seconds) (format-seconds string seconds) (format-time-string string (seconds-to-time seconds)))) @@ -403,12 +410,12 @@ The number of levels is controlled by `org-inlinetask-min-level'" (defun org-make-parameter-alist (flat) "Return alist based on FLAT. -FLAT is a list with alternating symbol names and values. The +FLAT is a list with alternating symbol names and values. The returned alist is a list of lists with the symbol name in car and the value in cdr." (when flat (cons (list (car flat) (cadr flat)) - (org-make-parameter-alist (cddr flat))))) + (org-make-parameter-alist (cddr flat))))) (provide 'org-macs) diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el index 9cc767eaec4..74ace5a529f 100644 --- a/lisp/org/org-mew.el +++ b/lisp/org/org-mew.el @@ -103,8 +103,7 @@ :date-timestamp-inactive date-ts-ia)) (setq message-id (org-remove-angle-brackets message-id)) (setq desc (org-email-link-description)) - (setq link (org-make-link "mew:" folder-name - "#" message-id)) + (setq link (concat "mew:" folder-name "#" message-id)) (org-add-link-props :link link :description desc) link))) diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index 0c59d500735..7c8b0b23905 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -99,8 +99,8 @@ supported by MH-E." (org-add-link-props :date date :date-timestamp date-ts :date-timestamp-inactive date-ts-ia)) (setq desc (org-email-link-description)) - (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" - (org-remove-angle-brackets message-id))) + (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#" + (org-remove-angle-brackets message-id))) (org-add-link-props :link link :description desc) link)))) @@ -179,17 +179,17 @@ you have a better idea of how to do this then please let us know." (num (org-mhe-get-message-num)) (buffer (get-buffer-create (concat "show-" folder))) (header-field)) - (with-current-buffer buffer - (mh-display-msg num folder) - (if (equal major-mode 'mh-folder-mode) - (mh-header-display) - (mh-show-header-display)) - (set-buffer buffer) - (setq header-field (mh-get-header-field header)) - (if (equal major-mode 'mh-folder-mode) - (mh-show) - (mh-show-show)) - (org-trim header-field)))) + (with-current-buffer buffer + (mh-display-msg num folder) + (if (equal major-mode 'mh-folder-mode) + (mh-header-display) + (mh-show-header-display)) + (set-buffer buffer) + (setq header-field (mh-get-header-field header)) + (if (equal major-mode 'mh-folder-mode) + (mh-show) + (mh-show-show)) + (org-trim header-field)))) (defun org-mhe-follow-link (folder article) "Follow an MH-E link to FOLDER and ARTICLE. diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 3bd9a7c0bbd..d2c9c17367f 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -236,7 +236,7 @@ by the mobile device, this hook should be used to copy the capture file directory `org-mobile-directory'.") (defvar org-mobile-post-pull-hook nil - "Hook run after running `org-mobile-pull'. + "Hook run after running `org-mobile-pull', only if new items were found. If Emacs does not have direct write access to the WebDAV directory used by the mobile device, this hook should be used to copy the emptied capture file `mobileorg.org' back to the WebDAV directory, for example @@ -300,6 +300,8 @@ Also exclude files matching `org-mobile-files-exclude-regexp'." (push (cons file link-name) rtn))) (nreverse rtn))) +(defvar org-agenda-filter) + ;;;###autoload (defun org-mobile-push () "Push the current state of Org affairs to the WebDAV directory. @@ -316,7 +318,9 @@ create all custom agenda views, for upload to the mobile phone." (org-mobile-check-setup) (org-mobile-prepare-file-lists) (message "Creating agendas...") - (let ((inhibit-redisplay t)) (org-mobile-create-sumo-agenda)) + (let ((inhibit-redisplay t) + (org-agenda-files (mapcar 'car org-mobile-files-alist))) + (org-mobile-create-sumo-agenda)) (message "Creating agendas...done") (org-save-all-org-buffers) ; to save any IDs created by this process (message "Copying files...") @@ -402,7 +406,7 @@ agenda view showing the flagged items." (error "Cannot write to encryption tempfile %s" org-mobile-encryption-tempfile)) (unless (executable-find "openssl") - (error "openssl is needed to encrypt files")))) + (error "OpenSSL is needed to encrypt files")))) (defun org-mobile-create-index-file () "Write the index file in the WebDAV directory." @@ -414,21 +418,14 @@ agenda view showing the flagged items." org-mobile-directory)) file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds) - (org-prepare-agenda-buffers (mapcar 'car files-alist)) + (org-agenda-prepare-buffers (mapcar 'car files-alist)) (setq done-kwds (org-uniquify org-done-keywords-for-agenda)) (setq todo-kwds (org-delete-all done-kwds (org-uniquify org-todo-keywords-for-agenda))) (setq drawers (org-uniquify org-drawers-for-agenda)) - (setq tags (org-uniquify - (delq nil - (mapcar - (lambda (e) - (cond ((stringp e) e) - ((listp e) - (if (stringp (car e)) (car e) nil)) - (t nil))) - org-tag-alist-for-agenda)))) + (setq tags (mapcar 'car (org-global-tags-completion-table + (mapcar 'car files-alist)))) (with-temp-file (if org-mobile-use-encryption org-mobile-encryption-tempfile @@ -454,8 +451,7 @@ agenda view showing the flagged items." ((eq (car x) :startgroup) "{") ((eq (car x) :endgroup) "}") ((eq (car x) :newline) nil) - ((listp x) (car x)) - (t nil))) + ((listp x) (car x)))) def-tags)) (setq def-tags (delq nil def-tags)) (setq tags (org-delete-all def-tags tags)) @@ -579,7 +575,7 @@ The table of checksums is written to the file mobile-checksums." (concat "<after>KEYS=" key " TITLE: " (if (and (stringp desc) (> (length desc) 0)) desc (symbol-name type)) - " " match "</after>")) + "</after>")) settings)) (push (list type match settings) new)) ((or (functionp (nth 2 e)) (symbolp (nth 2 e))) @@ -596,7 +592,7 @@ The table of checksums is written to the file mobile-checksums." (setq settings (cons (list 'org-agenda-title-append (concat "<after>KEYS=" gkey "#" (number-to-string - (setq cnt (1+ cnt))) + (setq cnt (1+ cnt))) " TITLE: " gdesc " " match "</after>")) settings)) (push (list type match settings) new))))) @@ -827,107 +823,95 @@ If BEG and END are given, only do this in that region." (not (equal (downcase (substring (match-string 1) 0 2)) "f(")) (incf cnt-new))) + ;; Find and apply the edits (goto-char beg) (while (re-search-forward "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[\\(\\(id\\|olp\\):\\([^]\n]+\\)\\)" end t) - (setq id-pos (condition-case msg - (org-mobile-locate-entry (match-string 4)) - (error (nth 1 msg)))) - (when (and (markerp id-pos) - (not (member (marker-buffer id-pos) buf-list))) - (org-mobile-timestamp-buffer (marker-buffer id-pos)) - (push (marker-buffer id-pos) buf-list)) - - (if (or (not id-pos) (stringp id-pos)) - (progn - (goto-char (+ 2 (point-at-bol))) - (insert id-pos " ") - (incf cnt-error)) - (add-text-properties (point-at-bol) (point-at-eol) - (list 'org-mobile-marker - (or id-pos "Linked entry not found"))))) - - ;; OK, now go back and start applying - (goto-char beg) - (while (re-search-forward "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)" end t) (catch 'next - (setq id-pos (get-text-property (point-at-bol) 'org-mobile-marker)) - (if (not (markerp id-pos)) - (progn - (incf cnt-error) - (insert "UNKNOWN PROBLEM")) - (let* ((action (match-string 1)) - (data (and (match-end 3) (match-string 3))) - (bos (point-at-bol)) - (eos (save-excursion (org-end-of-subtree t t))) - (cmd (if (equal action "") - '(progn - (incf cnt-flag) - (org-toggle-tag "FLAGGED" 'on) - (and note - (org-entry-put nil "THEFLAGGINGNOTE" note))) - (incf cnt-edit) - (cdr (assoc action org-mobile-action-alist)))) - (note (and (equal action "") - (buffer-substring (1+ (point-at-eol)) eos))) - (org-inhibit-logging 'note) ;; Do not take notes interactively - old new) - (goto-char bos) - (move-marker bos-marker (point)) - (if (re-search-forward "^** Old value[ \t]*$" eos t) - (setq old (buffer-substring - (1+ (match-end 0)) - (progn (outline-next-heading) (point))))) - (if (re-search-forward "^** New value[ \t]*$" eos t) - (setq new (buffer-substring - (1+ (match-end 0)) - (progn (outline-next-heading) - (if (eobp) (org-back-over-empty-lines)) - (point))))) - (setq old (and old (if (string-match "\\S-" old) old nil))) - (setq new (and new (if (string-match "\\S-" new) new nil))) - (if (and note (> (length note) 0)) - ;; Make Note into a single line, to fit into a property - (setq note (mapconcat 'identity - (org-split-string (org-trim note) "\n") - "\\n"))) - (unless (equal data "body") - (setq new (and new (org-trim new)) - old (and old (org-trim old)))) - (goto-char (+ 2 bos-marker)) - (unless (markerp id-pos) - (insert "BAD REFERENCE ") - (incf cnt-error) - (throw 'next t)) - (unless cmd - (insert "BAD FLAG ") - (incf cnt-error) - (throw 'next t)) - ;; Remember this place so that we can return - (move-marker marker (point)) - (setq org-mobile-error nil) - (save-excursion - (condition-case msg - (org-with-point-at id-pos - (progn - (eval cmd) - (if (member "FLAGGED" (org-get-tags)) - (add-to-list 'org-mobile-last-flagged-files - (buffer-file-name (current-buffer)))))) - (error (setq org-mobile-error msg)))) - (when org-mobile-error - (org-pop-to-buffer-same-window (marker-buffer marker)) - (goto-char marker) - (incf cnt-error) - (insert (if (stringp (nth 1 org-mobile-error)) - (nth 1 org-mobile-error) - "EXECUTION FAILED") - " ") - (throw 'next t)) - ;; If we get here, the action has been applied successfully - ;; So remove the entry - (goto-char bos-marker) - (delete-region (point) (org-end-of-subtree t t)))))) + (let* ((action (match-string 1)) + (data (and (match-end 3) (match-string 3))) + (id-pos (condition-case msg + (org-mobile-locate-entry (match-string 4)) + (error (nth 1 msg)))) + (bos (point-at-bol)) + (eos (save-excursion (org-end-of-subtree t t))) + (cmd (if (equal action "") + '(progn + (incf cnt-flag) + (org-toggle-tag "FLAGGED" 'on) + (and note + (org-entry-put nil "THEFLAGGINGNOTE" note))) + (incf cnt-edit) + (cdr (assoc action org-mobile-action-alist)))) + (note (and (equal action "") + (buffer-substring (1+ (point-at-eol)) eos))) + (org-inhibit-logging 'note) ;; Do not take notes interactively + old new) + + (goto-char bos) + (when (and (markerp id-pos) + (not (member (marker-buffer id-pos) buf-list))) + (org-mobile-timestamp-buffer (marker-buffer id-pos)) + (push (marker-buffer id-pos) buf-list)) + (unless (markerp id-pos) + (goto-char (+ 2 (point-at-bol))) + (if (stringp id-pos) + (insert id-pos " ") + (insert "BAD REFERENCE ")) + (incf cnt-error) + (throw 'next t)) + (unless cmd + (insert "BAD FLAG ") + (incf cnt-error) + (throw 'next t)) + (move-marker bos-marker (point)) + (if (re-search-forward "^** Old value[ \t]*$" eos t) + (setq old (buffer-substring + (1+ (match-end 0)) + (progn (outline-next-heading) (point))))) + (if (re-search-forward "^** New value[ \t]*$" eos t) + (setq new (buffer-substring + (1+ (match-end 0)) + (progn (outline-next-heading) + (if (eobp) (org-back-over-empty-lines)) + (point))))) + (setq old (and old (if (string-match "\\S-" old) old nil))) + (setq new (and new (if (string-match "\\S-" new) new nil))) + (if (and note (> (length note) 0)) + ;; Make Note into a single line, to fit into a property + (setq note (mapconcat 'identity + (org-split-string (org-trim note) "\n") + "\\n"))) + (unless (equal data "body") + (setq new (and new (org-trim new)) + old (and old (org-trim old)))) + (goto-char (+ 2 bos-marker)) + ;; Remember this place so that we can return + (move-marker marker (point)) + (setq org-mobile-error nil) + (save-excursion + (condition-case msg + (org-with-point-at id-pos + (progn + (eval cmd) + (unless (member data (list "delete" "archive" "archive-sibling" "addheading")) + (if (member "FLAGGED" (org-get-tags)) + (add-to-list 'org-mobile-last-flagged-files + (buffer-file-name (current-buffer))))))) + (error (setq org-mobile-error msg)))) + (when org-mobile-error + (org-pop-to-buffer-same-window (marker-buffer marker)) + (goto-char marker) + (incf cnt-error) + (insert (if (stringp (nth 1 org-mobile-error)) + (nth 1 org-mobile-error) + "EXECUTION FAILED") + " ") + (throw 'next t)) + ;; If we get here, the action has been applied successfully + ;; So remove the entry + (goto-char bos-marker) + (delete-region (point) (org-end-of-subtree t t))))) (save-buffer) (move-marker marker nil) (move-marker end nil) @@ -988,7 +972,19 @@ is currently a noop.") (if (string-match "\\`id:\\(.*\\)$" link) (org-id-find (match-string 1 link) 'marker) (if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link)) - nil + ; not found with path, but maybe it is to be inserted + ; in top level of the file? + (if (not (string-match "\\`olp:\\(.*?\\)$" link)) + nil + (let ((file (match-string 1 link))) + (setq file (org-link-unescape file)) + (setq file (expand-file-name file org-directory)) + (save-excursion + (find-file file) + (goto-char (point-max)) + (newline) + (goto-char (point-max)) + (move-marker (make-marker) (point))))) (let ((file (match-string 1 link)) (path (match-string 2 link))) (setq file (org-link-unescape file)) @@ -1004,7 +1000,7 @@ The edit only takes place if the current value is equal (except for white space) the OLD. If this is so, OLD will be replace by NEW and the command will return t. If something goes wrong, a string will be returned that indicates what went wrong." - (let (current old1 new1) + (let (current old1 new1 level) (if (stringp what) (setq what (intern what))) (cond @@ -1062,6 +1058,36 @@ be returned that indicates what went wrong." (org-set-tags nil 'align)) (t (error "Heading changed in MobileOrg and on the computer"))))) + ((eq what 'addheading) + (if (org-on-heading-p) ; if false we are in top-level of file + (progn + (end-of-line 1) + (org-insert-heading-respect-content) + (org-demote)) + (beginning-of-line) + (insert "* ")) + (insert new)) + + ((eq what 'refile) + (org-copy-subtree) + (org-with-point-at (org-mobile-locate-entry new) + (if (org-on-heading-p) ; if false we are in top-level of file + (progn + (setq level (org-get-valid-level (funcall outline-level) 1)) + (org-end-of-subtree t t) + (org-paste-subtree level)) + (org-paste-subtree 1))) + (org-cut-subtree)) + + ((eq what 'delete) + (org-cut-subtree)) + + ((eq what 'archive) + (org-archive-subtree)) + + ((eq what 'archive-sibling) + (org-archive-to-archive-sibling)) + ((eq what 'body) (setq current (buffer-substring (min (1+ (point-at-eol)) (point-max)) (save-excursion (outline-next-heading) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index b467064b888..b5a6dad733a 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -260,7 +260,7 @@ after the current heading." (interactive) (case (org-mouse-line-position) (:beginning (beginning-of-line) - (org-insert-heading)) + (org-insert-heading)) (t (org-mouse-next-heading) (org-insert-heading)))) @@ -269,10 +269,8 @@ after the current heading." For the acceptable UNITS, see `org-timestamp-change'." (interactive) - (flet ((org-read-date (&rest rest) (current-time))) - (org-time-stamp nil)) - (when shift - (org-timestamp-change shift units))) + (org-time-stamp nil) + (when shift (org-timestamp-change shift units))) (defun org-mouse-keyword-menu (keywords function &optional selected itemformat) "A helper function. @@ -295,19 +293,19 @@ string to (format ITEMFORMAT keyword). If it is neither a string nor a function, elements of KEYWORDS are used directly." (mapcar `(lambda (keyword) - (vector (cond - ((functionp ,itemformat) (funcall ,itemformat keyword)) - ((stringp ,itemformat) (format ,itemformat keyword)) - (t keyword)) - (list 'funcall ,function keyword) - :style (cond - ((null ,selected) t) - ((functionp ,selected) 'toggle) - (t 'radio)) - :selected (if (functionp ,selected) - (and (funcall ,selected keyword) t) - (equal ,selected keyword)))) - keywords)) + (vector (cond + ((functionp ,itemformat) (funcall ,itemformat keyword)) + ((stringp ,itemformat) (format ,itemformat keyword)) + (t keyword)) + (list 'funcall ,function keyword) + :style (cond + ((null ,selected) t) + ((functionp ,selected) 'toggle) + (t 'radio)) + :selected (if (functionp ,selected) + (and (funcall ,selected keyword) t) + (equal ,selected keyword)))) + keywords)) (defun org-mouse-remove-match-and-spaces () "Remove the match, make just one space around the point." @@ -375,8 +373,7 @@ nor a function, elements of KEYWORDS are used directly." (defun org-mouse-set-priority (priority) "Set the priority of the current headline to PRIORITY." - (flet ((read-char-exclusive () priority)) - (org-priority))) + (org-priority priority)) (defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]" "Regular expression matching the priority indicator. @@ -410,8 +407,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (> (match-end 0) point)))))) (defun org-mouse-priority-list () - (loop for priority from ?A to org-lowest-priority - collect (char-to-string priority))) + (loop for priority from ?A to org-lowest-priority + collect (char-to-string priority))) (defun org-mouse-todo-menu (state) "Create the menu with TODO keywords." @@ -464,12 +461,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (defun org-mouse-agenda-type (type) (case type - ('tags "Tags: ") - ('todo "TODO: ") - ('tags-tree "Tags tree: ") - ('todo-tree "TODO tree: ") - ('occur-tree "Occur tree: ") - (t "Agenda command ???"))) + ('tags "Tags: ") + ('todo "TODO: ") + ('tags-tree "Tags tree: ") + ('todo-tree "TODO tree: ") + ('occur-tree "Occur tree: ") + (t "Agenda command ???"))) (defun org-mouse-list-options-menu (alloptions &optional function) (let ((options (save-match-data @@ -488,8 +485,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" " ") nil nil nil 1) (when (functionp ',function) (funcall ',function))) - :style 'toggle - :selected (and (member name options) t))))) + :style 'toggle + :selected (and (member name options) t))))) (defun org-mouse-clip-text (text maxlength) (if (> (length text) maxlength) @@ -532,19 +529,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ,@(org-mouse-keyword-menu (mapcar 'car org-agenda-custom-commands) #'(lambda (key) - (eval `(flet ((read-char-exclusive () (string-to-char ,key))) - (org-agenda nil)))) + (eval `(org-agenda nil (string-to-char ,key)))) nil #'(lambda (key) - (let ((entry (assoc key org-agenda-custom-commands))) - (org-mouse-clip-text - (cond - ((stringp (nth 1 entry)) (nth 1 entry)) - ((stringp (nth 2 entry)) - (concat (org-mouse-agenda-type (nth 1 entry)) - (nth 2 entry))) - (t "Agenda Command '%s'")) - 30)))) + (let ((entry (assoc key org-agenda-custom-commands))) + (org-mouse-clip-text + (cond + ((stringp (nth 1 entry)) (nth 1 entry)) + ((stringp (nth 2 entry)) + (concat (org-mouse-agenda-type (nth 1 entry)) + (nth 2 entry))) + (t "Agenda Command '%s'")) + 30)))) "--" ["Delete Blank Lines" delete-blank-lines :visible (org-mouse-empty-line)] @@ -597,21 +593,21 @@ 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 (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (org-mouse-insert-item text) ad-do-it)) (defadvice dnd-open-file (around org-mouse-dnd-open-file activate) - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (org-mouse-insert-item uri) ad-do-it)) (defun org-mouse-match-closure (function) (let ((match (match-data t))) `(lambda (&rest rest) - (save-match-data - (set-match-data ',match) - (apply ',function rest))))) + (save-match-data + (set-match-data ',match) + (apply ',function rest))))) (defun org-mouse-yank-link (click) (interactive "e") @@ -623,234 +619,234 @@ This means, between the beginning of line and the point." (insert-for-yank (concat " [[" (current-kill 0) "]] "))) (defun org-mouse-context-menu (&optional event) - (let ((stamp-prefixes (list org-deadline-string org-scheduled-string)) - (contextlist (org-context))) - (flet ((get-context (context) (org-mouse-get-context contextlist context))) - (cond - ((org-mouse-mark-active) - (let ((region-string (buffer-substring (region-beginning) (region-end)))) + (let* ((stamp-prefixes (list org-deadline-string org-scheduled-string)) + (contextlist (org-context)) + (get-context (lambda (context) (org-mouse-get-context contextlist context)))) + (cond + ((org-mouse-mark-active) + (let ((region-string (buffer-substring (region-beginning) (region-end)))) + (popup-menu + `(nil + ["Sparse Tree" (org-occur ',region-string)] + ["Find in Buffer" (occur ',region-string)] + ["Grep in Current Dir" + (grep (format "grep -rnH -e '%s' *" ',region-string))] + ["Grep in Parent Dir" + (grep (format "grep -rnH -e '%s' ../*" ',region-string))] + "--" + ["Convert to Link" + (progn (save-excursion (goto-char (region-beginning)) (insert "[[")) + (save-excursion (goto-char (region-end)) (insert "]]")))] + ["Insert Link Here" (org-mouse-yank-link ',event)])))) + ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)")) (popup-menu `(nil - ["Sparse Tree" (org-occur ',region-string)] - ["Find in Buffer" (occur ',region-string)] - ["Grep in Current Dir" - (grep (format "grep -rnH -e '%s' *" ',region-string))] - ["Grep in Parent Dir" - (grep (format "grep -rnH -e '%s' ../*" ',region-string))] - "--" - ["Convert to Link" - (progn (save-excursion (goto-char (region-beginning)) (insert "[[")) - (save-excursion (goto-char (region-end)) (insert "]]")))] - ["Insert Link Here" (org-mouse-yank-link ',event)])))) - ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)")) - (popup-menu - `(nil - ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options) - 'org-mode-restart)))) - ((or (eolp) - (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") - (org-looking-back " \\|\t"))) - (org-mouse-popup-global-menu)) - ((get-context :checkbox) - (popup-menu - '(nil - ["Toggle" org-toggle-checkbox t] - ["Remove" org-mouse-remove-match-and-spaces t] - "" - ["All Clear" (org-mouse-for-each-item - (lambda () - (when (save-excursion (org-at-item-checkbox-p)) - (replace-match "[ ]"))))] - ["All Set" (org-mouse-for-each-item + ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options) + 'org-mode-restart)))) + ((or (eolp) + (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") + (org-looking-back " \\|\t"))) + (org-mouse-popup-global-menu)) + ((funcall get-context :checkbox) + (popup-menu + '(nil + ["Toggle" org-toggle-checkbox t] + ["Remove" org-mouse-remove-match-and-spaces t] + "" + ["All Clear" (org-mouse-for-each-item + (lambda () + (when (save-excursion (org-at-item-checkbox-p)) + (replace-match "[ ]"))))] + ["All Set" (org-mouse-for-each-item (lambda () (when (save-excursion (org-at-item-checkbox-p)) (replace-match "[X]"))))] - ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] - ["All Remove" (org-mouse-for-each-item - (lambda () - (when (save-excursion (org-at-item-checkbox-p)) - (org-mouse-remove-match-and-spaces))))] - ))) - ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") - (member (match-string 0) org-todo-keywords-1)) - (popup-menu - `(nil - ,@(org-mouse-todo-menu (match-string 0)) - "--" - ["Check TODOs" org-show-todo-tree t] - ["List all TODO keywords" org-todo-list t] - [,(format "List only %s" (match-string 0)) - (org-todo-list (match-string 0)) t] - ))) - ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z") - (member (match-string 0) stamp-prefixes)) - (popup-menu - `(nil - ,@(org-mouse-keyword-replace-menu stamp-prefixes) - "--" - ["Check Deadlines" org-check-deadlines t] - ))) - ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority - (popup-menu `(nil ,@(org-mouse-keyword-replace-menu - (org-mouse-priority-list) 1 "Priority %s" t)))) - ((get-context :link) - (popup-menu - '(nil - ["Open" org-open-at-point t] - ["Open in Emacs" (org-open-at-point t) t] - "--" - ["Copy link" (org-kill-new (match-string 0))] - ["Cut link" - (progn - (kill-region (match-beginning 0) (match-end 0)) - (just-one-space))] - "--" - ["Grep for TODOs" - (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))] -; ["Paste file link" ((insert "file:") (yank))] - ))) - ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags - (popup-menu - `(nil - [,(format "Display '%s'" (match-string 1)) - (org-tags-view nil ,(match-string 1))] - [,(format "Sparse Tree '%s'" (match-string 1)) - (org-tags-sparse-tree nil ,(match-string 1))] - "--" - ,@(org-mouse-tag-menu)))) - ((org-at-timestamp-p) - (popup-menu - '(nil - ["Show Day" org-open-at-point t] - ["Change Timestamp" org-time-stamp t] - ["Delete Timestamp" (org-mouse-delete-timestamp) t] - ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)] - "--" - ["Set for Today" org-mouse-timestamp-today] - ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)] - ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)] - ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)] - ["Set in a Month" (org-mouse-timestamp-today 1 'month)] - "--" - ["+ 1 Day" (org-timestamp-change 1 'day)] - ["+ 1 Week" (org-timestamp-change 7 'day)] - ["+ 1 Month" (org-timestamp-change 1 'month)] - "--" - ["- 1 Day" (org-timestamp-change -1 'day)] - ["- 1 Week" (org-timestamp-change -7 'day)] - ["- 1 Month" (org-timestamp-change -1 'month)]))) - ((get-context :table-special) - (let ((mdata (match-data))) - (incf (car mdata) 2) - (store-match-data mdata)) - (message "match: %S" (match-string 0)) - (popup-menu `(nil ,@(org-mouse-keyword-replace-menu - '(" " "!" "^" "_" "$" "#" "*" "'") 0 - (lambda (mark) - (case (string-to-char mark) - (? "( ) Nothing Special") - (?! "(!) Column Names") - (?^ "(^) Field Names Above") - (?_ "(^) Field Names Below") - (?$ "($) Formula Parameters") - (?# "(#) Recalculation: Auto") - (?* "(*) Recalculation: Manual") - (?' "(') Recalculation: None"))) t)))) - ((assq :table contextlist) - (popup-menu - '(nil - ["Align Table" org-ctrl-c-ctrl-c] - ["Blank Field" org-table-blank-field] - ["Edit Field" org-table-edit-field] - "--" - ("Column" - ["Move Column Left" org-metaleft] - ["Move Column Right" org-metaright] - ["Delete Column" org-shiftmetaleft] - ["Insert Column" org-shiftmetaright] + ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] + ["All Remove" (org-mouse-for-each-item + (lambda () + (when (save-excursion (org-at-item-checkbox-p)) + (org-mouse-remove-match-and-spaces))))] + ))) + ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") + (member (match-string 0) org-todo-keywords-1)) + (popup-menu + `(nil + ,@(org-mouse-todo-menu (match-string 0)) "--" - ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle]) - ("Row" - ["Move Row Up" org-metaup] - ["Move Row Down" org-metadown] - ["Delete Row" org-shiftmetaup] - ["Insert Row" org-shiftmetadown] - ["Sort lines in region" org-table-sort-lines (org-at-table-p)] + ["Check TODOs" org-show-todo-tree t] + ["List all TODO keywords" org-todo-list t] + [,(format "List only %s" (match-string 0)) + (org-todo-list (match-string 0)) t] + ))) + ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z") + (member (match-string 0) stamp-prefixes)) + (popup-menu + `(nil + ,@(org-mouse-keyword-replace-menu stamp-prefixes) "--" - ["Insert Hline" org-table-insert-hline]) - ("Rectangle" - ["Copy Rectangle" org-copy-special] - ["Cut Rectangle" org-cut-special] - ["Paste Rectangle" org-paste-special] - ["Fill Rectangle" org-table-wrap-region]) - "--" - ["Set Column Formula" org-table-eval-formula] - ["Set Field Formula" (org-table-eval-formula '(4))] - ["Edit Formulas" org-table-edit-formulas] - "--" - ["Recalculate Line" org-table-recalculate] - ["Recalculate All" (org-table-recalculate '(4))] - ["Iterate All" (org-table-recalculate '(16))] - "--" - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks] - ["Sum Column/Rectangle" org-table-sum - :active (or (org-at-table-p) (org-region-active-p))] - ["Field Info" org-table-field-info] - ["Debug Formulas" - (setq org-table-formula-debug (not org-table-formula-debug)) - :style toggle :selected org-table-formula-debug] - ))) - ((and (assq :headline contextlist) (not (eolp))) - (let ((priority (org-mouse-get-priority t))) + ["Check Deadlines" org-check-deadlines t] + ))) + ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority + (popup-menu `(nil ,@(org-mouse-keyword-replace-menu + (org-mouse-priority-list) 1 "Priority %s" t)))) + ((funcall get-context :link) (popup-menu - `("Headline Menu" - ("Tags and Priorities" - ,@(org-mouse-keyword-menu - (org-mouse-priority-list) - #'(lambda (keyword) - (org-mouse-set-priority (string-to-char keyword))) - priority "Priority %s") - "--" - ,@(org-mouse-tag-menu)) - ("TODO Status" - ,@(org-mouse-todo-menu (org-get-todo-state))) - ["Show Tags" - (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) - :visible (not org-mouse-direct)] - ["Show Priority" - (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority)) - :visible (not org-mouse-direct)] - ,@(if org-mouse-direct '("--") nil) - ["New Heading" org-mouse-insert-heading :visible org-mouse-direct] - ["Set Deadline" - (progn (org-mouse-end-headline) (insert " ") (org-deadline)) - :active (not (save-excursion - (org-mouse-re-search-line org-deadline-regexp)))] - ["Schedule Task" - (progn (org-mouse-end-headline) (insert " ") (org-schedule)) - :active (not (save-excursion - (org-mouse-re-search-line org-scheduled-regexp)))] - ["Insert Timestamp" - (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t] -; ["Timestamp (inactive)" org-time-stamp-inactive t] + '(nil + ["Open" org-open-at-point t] + ["Open in Emacs" (org-open-at-point t) t] + "--" + ["Copy link" (org-kill-new (match-string 0))] + ["Cut link" + (progn + (kill-region (match-beginning 0) (match-end 0)) + (just-one-space))] "--" - ["Archive Subtree" org-archive-subtree] - ["Cut Subtree" org-cut-special] - ["Copy Subtree" org-copy-special] - ["Paste Subtree" org-paste-special :visible org-mouse-direct] - ("Sort Children" - ["Alphabetically" (org-sort-entries nil ?a)] - ["Numerically" (org-sort-entries nil ?n)] - ["By Time/Date" (org-sort-entries nil ?t)] + ["Grep for TODOs" + (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))] + ; ["Paste file link" ((insert "file:") (yank))] + ))) + ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags + (popup-menu + `(nil + [,(format "Display '%s'" (match-string 1)) + (org-tags-view nil ,(match-string 1))] + [,(format "Sparse Tree '%s'" (match-string 1)) + (org-tags-sparse-tree nil ,(match-string 1))] + "--" + ,@(org-mouse-tag-menu)))) + ((org-at-timestamp-p) + (popup-menu + '(nil + ["Show Day" org-open-at-point t] + ["Change Timestamp" org-time-stamp t] + ["Delete Timestamp" (org-mouse-delete-timestamp) t] + ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)] + "--" + ["Set for Today" org-mouse-timestamp-today] + ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)] + ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)] + ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)] + ["Set in a Month" (org-mouse-timestamp-today 1 'month)] + "--" + ["+ 1 Day" (org-timestamp-change 1 'day)] + ["+ 1 Week" (org-timestamp-change 7 'day)] + ["+ 1 Month" (org-timestamp-change 1 'month)] + "--" + ["- 1 Day" (org-timestamp-change -1 'day)] + ["- 1 Week" (org-timestamp-change -7 'day)] + ["- 1 Month" (org-timestamp-change -1 'month)]))) + ((funcall get-context :table-special) + (let ((mdata (match-data))) + (incf (car mdata) 2) + (store-match-data mdata)) + (message "match: %S" (match-string 0)) + (popup-menu `(nil ,@(org-mouse-keyword-replace-menu + '(" " "!" "^" "_" "$" "#" "*" "'") 0 + (lambda (mark) + (case (string-to-char mark) + (? "( ) Nothing Special") + (?! "(!) Column Names") + (?^ "(^) Field Names Above") + (?_ "(^) Field Names Below") + (?$ "($) Formula Parameters") + (?# "(#) Recalculation: Auto") + (?* "(*) Recalculation: Manual") + (?' "(') Recalculation: None"))) t)))) + ((assq :table contextlist) + (popup-menu + '(nil + ["Align Table" org-ctrl-c-ctrl-c] + ["Blank Field" org-table-blank-field] + ["Edit Field" org-table-edit-field] + "--" + ("Column" + ["Move Column Left" org-metaleft] + ["Move Column Right" org-metaright] + ["Delete Column" org-shiftmetaleft] + ["Insert Column" org-shiftmetaright] + "--" + ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle]) + ("Row" + ["Move Row Up" org-metaup] + ["Move Row Down" org-metadown] + ["Delete Row" org-shiftmetaup] + ["Insert Row" org-shiftmetadown] + ["Sort lines in region" org-table-sort-lines (org-at-table-p)] "--" - ["Reverse Alphabetically" (org-sort-entries nil ?A)] - ["Reverse Numerically" (org-sort-entries nil ?N)] - ["Reverse By Time/Date" (org-sort-entries nil ?T)]) + ["Insert Hline" org-table-insert-hline]) + ("Rectangle" + ["Copy Rectangle" org-copy-special] + ["Cut Rectangle" org-cut-special] + ["Paste Rectangle" org-paste-special] + ["Fill Rectangle" org-table-wrap-region]) "--" - ["Move Trees" org-mouse-move-tree :active nil] - )))) - (t - (org-mouse-popup-global-menu)))))) + ["Set Column Formula" org-table-eval-formula] + ["Set Field Formula" (org-table-eval-formula '(4))] + ["Edit Formulas" org-table-edit-formulas] + "--" + ["Recalculate Line" org-table-recalculate] + ["Recalculate All" (org-table-recalculate '(4))] + ["Iterate All" (org-table-recalculate '(16))] + "--" + ["Toggle Recalculate Mark" org-table-rotate-recalc-marks] + ["Sum Column/Rectangle" org-table-sum + :active (or (org-at-table-p) (org-region-active-p))] + ["Field Info" org-table-field-info] + ["Debug Formulas" + (setq org-table-formula-debug (not org-table-formula-debug)) + :style toggle :selected org-table-formula-debug] + ))) + ((and (assq :headline contextlist) (not (eolp))) + (let ((priority (org-mouse-get-priority t))) + (popup-menu + `("Headline Menu" + ("Tags and Priorities" + ,@(org-mouse-keyword-menu + (org-mouse-priority-list) + #'(lambda (keyword) + (org-mouse-set-priority (string-to-char keyword))) + priority "Priority %s") + "--" + ,@(org-mouse-tag-menu)) + ("TODO Status" + ,@(org-mouse-todo-menu (org-get-todo-state))) + ["Show Tags" + (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) + :visible (not org-mouse-direct)] + ["Show Priority" + (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority)) + :visible (not org-mouse-direct)] + ,@(if org-mouse-direct '("--") nil) + ["New Heading" org-mouse-insert-heading :visible org-mouse-direct] + ["Set Deadline" + (progn (org-mouse-end-headline) (insert " ") (org-deadline)) + :active (not (save-excursion + (org-mouse-re-search-line org-deadline-regexp)))] + ["Schedule Task" + (progn (org-mouse-end-headline) (insert " ") (org-schedule)) + :active (not (save-excursion + (org-mouse-re-search-line org-scheduled-regexp)))] + ["Insert Timestamp" + (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t] + ; ["Timestamp (inactive)" org-time-stamp-inactive t] + "--" + ["Archive Subtree" org-archive-subtree] + ["Cut Subtree" org-cut-special] + ["Copy Subtree" org-copy-special] + ["Paste Subtree" org-paste-special :visible org-mouse-direct] + ("Sort Children" + ["Alphabetically" (org-sort-entries nil ?a)] + ["Numerically" (org-sort-entries nil ?n)] + ["By Time/Date" (org-sort-entries nil ?t)] + "--" + ["Reverse Alphabetically" (org-sort-entries nil ?A)] + ["Reverse Numerically" (org-sort-entries nil ?N)] + ["Reverse By Time/Date" (org-sort-entries nil ?T)]) + "--" + ["Move Trees" org-mouse-move-tree :active nil] + )))) + (t + (org-mouse-popup-global-menu))))) (defun org-mouse-mark-active () (and mark-active transient-mark-mode)) @@ -868,55 +864,55 @@ This means, between the beginning of line and the point." (mouse-drag-region event))) (add-hook 'org-mode-hook - #'(lambda () - (setq org-mouse-context-menu-function 'org-mouse-context-menu) - - (when (memq 'context-menu org-mouse-features) - (org-defkey org-mouse-map [mouse-3] nil) - (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu)) - (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse) - (when (memq 'context-menu org-mouse-features) - (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) - (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) - (when (memq 'yank-link org-mouse-features) - (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link) - (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) - (when (memq 'move-tree org-mouse-features) - (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) - (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) - - (when (memq 'activate-stars org-mouse-features) - (font-lock-add-keywords - nil - `((,org-outline-regexp - 0 `(face org-link mouse-face highlight keymap ,org-mouse-map) - 'prepend)) - t)) - - (when (memq 'activate-bullets org-mouse-features) - (font-lock-add-keywords - nil - `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +" - (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) - 'prepend))) - t)) - - (when (memq 'activate-checkboxes org-mouse-features) - (font-lock-add-keywords - nil - `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" - (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t))) - t)) - - (defadvice org-open-at-point (around org-mouse-open-at-point activate) - (let ((context (org-context))) - (cond - ((assq :headline-stars context) (org-cycle)) - ((assq :checkbox context) (org-toggle-checkbox)) - ((assq :item-bullet context) - (let ((org-cycle-include-plain-lists t)) (org-cycle))) - ((org-footnote-at-reference-p) nil) - (t ad-do-it)))))) + #'(lambda () + (setq org-mouse-context-menu-function 'org-mouse-context-menu) + + (when (memq 'context-menu org-mouse-features) + (org-defkey org-mouse-map [mouse-3] nil) + (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu)) + (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse) + (when (memq 'context-menu org-mouse-features) + (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) + (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) + (when (memq 'yank-link org-mouse-features) + (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link) + (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) + (when (memq 'move-tree org-mouse-features) + (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) + (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) + + (when (memq 'activate-stars org-mouse-features) + (font-lock-add-keywords + nil + `((,org-outline-regexp + 0 `(face org-link mouse-face highlight keymap ,org-mouse-map) + 'prepend)) + t)) + + (when (memq 'activate-bullets org-mouse-features) + (font-lock-add-keywords + nil + `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +" + (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) + 'prepend))) + t)) + + (when (memq 'activate-checkboxes org-mouse-features) + (font-lock-add-keywords + nil + `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" + (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t))) + t)) + + (defadvice org-open-at-point (around org-mouse-open-at-point activate) + (let ((context (org-context))) + (cond + ((assq :headline-stars context) (org-cycle)) + ((assq :checkbox context) (org-toggle-checkbox)) + ((assq :item-bullet context) + (let ((org-cycle-include-plain-lists t)) (org-cycle))) + ((org-footnote-at-reference-p) nil) + (t ad-do-it)))))) (defun org-mouse-move-tree-start (event) (interactive "e") @@ -936,42 +932,42 @@ This means, between the beginning of line and the point." (sbuf (marker-buffer start)) (ebuf (marker-buffer end))) - (when (and sbuf ebuf) - (set-buffer sbuf) - (goto-char start) - (org-back-to-heading) - (if (and (eq sbuf ebuf) - (equal - (point) - (save-excursion (goto-char end) (org-back-to-heading) (point)))) - ;; if the same line then promote/demote - (if (>= end start) (org-demote-subtree) (org-promote-subtree)) - ;; if different lines then move - (org-cut-subtree) - - (set-buffer ebuf) - (goto-char end) - (org-back-to-heading) - (when (and (eq sbuf ebuf) - (equal - (point) - (save-excursion (goto-char start) - (org-back-to-heading) (point)))) - (outline-end-of-subtree) - (end-of-line) - (if (eobp) (newline) (forward-char))) - - (when (looking-at org-outline-regexp) - (let ((level (- (match-end 0) (match-beginning 0)))) - (when (> end (match-end 0)) + (when (and sbuf ebuf) + (set-buffer sbuf) + (goto-char start) + (org-back-to-heading) + (if (and (eq sbuf ebuf) + (equal + (point) + (save-excursion (goto-char end) (org-back-to-heading) (point)))) + ;; if the same line then promote/demote + (if (>= end start) (org-demote-subtree) (org-promote-subtree)) + ;; if different lines then move + (org-cut-subtree) + + (set-buffer ebuf) + (goto-char end) + (org-back-to-heading) + (when (and (eq sbuf ebuf) + (equal + (point) + (save-excursion (goto-char start) + (org-back-to-heading) (point)))) (outline-end-of-subtree) (end-of-line) - (if (eobp) (newline) (forward-char)) - (setq level (1+ level))) - (org-paste-subtree level) - (save-excursion - (outline-end-of-subtree) - (when (bolp) (delete-char -1)))))))))) + (if (eobp) (newline) (forward-char))) + + (when (looking-at org-outline-regexp) + (let ((level (- (match-end 0) (match-beginning 0)))) + (when (> end (match-end 0)) + (outline-end-of-subtree) + (end-of-line) + (if (eobp) (newline) (forward-char)) + (setq level (1+ level))) + (org-paste-subtree level) + (save-excursion + (outline-end-of-subtree) + (when (bolp) (delete-char -1)))))))))) (defun org-mouse-transform-to-outline () @@ -994,7 +990,7 @@ This means, between the beginning of line and the point." (defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'. (defun org-mouse-do-remotely (command) -; (org-agenda-check-no-diary) + ; (org-agenda-check-no-diary) (when (get-text-property (point) 'org-marker) (let* ((anticol (- (point-at-eol) (point))) (marker (get-text-property (point) 'org-marker)) @@ -1091,20 +1087,20 @@ This means, between the beginning of line and the point." (if (< (car startxy) (car endxy)) :right :left))) -; (setq org-agenda-mode-hook nil) + ; (setq org-agenda-mode-hook nil) (defvar org-agenda-mode-map) (add-hook 'org-agenda-mode-hook - #'(lambda () - (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) - (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) - (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) - (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) - (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) - (org-defkey org-agenda-mode-map [drag-mouse-3] - #'(lambda (event) (interactive "e") - (case (org-mouse-get-gesture event) - (:left (org-agenda-earlier 1)) - (:right (org-agenda-later 1))))))) + #'(lambda () + (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) + (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) + (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) + (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) + (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) + (org-defkey org-agenda-mode-map [drag-mouse-3] + #'(lambda (event) (interactive "e") + (case (org-mouse-get-gesture event) + (:left (org-agenda-earlier 1)) + (:right (org-agenda-later 1))))))) (provide 'org-mouse) diff --git a/lisp/org/org-odt.el b/lisp/org/org-odt.el index ca43d05bdbd..7de4b5de853 100644 --- a/lisp/org/org-odt.el +++ b/lisp/org/org-odt.el @@ -100,9 +100,7 @@ Use this to infer values of `org-odt-styles-dir' and (expand-file-name "./schema/" org-odt-data-dir)) ; bail out (eval-when-compile (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install - (expand-file-name "./schema/" org-odt-data-dir))) - (expand-file-name "../contrib/odt/etc/schema/" org-odt-lib-dir) ; git - ) + (expand-file-name "./schema/" org-odt-data-dir)))) "List of directories to search for OpenDocument schema files. Use this list to set the default value of `org-export-odt-schema-dir'. The entries in this list are @@ -213,7 +211,7 @@ heuristically based on the values of `org-odt-lib-dir' and org-odt-styles-dir-list) nil))) (unless styles-dir - (error "Error (org-odt): Cannot find factory styles files. Aborting.")) + (error "Error (org-odt): Cannot find factory styles files, aborting")) styles-dir) "Directory that holds auxiliary XML files used by the ODT exporter. @@ -245,9 +243,6 @@ standard Emacs.") (mapc (lambda (desc) - ;; Let Org open all OpenDocument files using system-registered app - (add-to-list 'org-file-apps - (cons (concat "\\." (car desc) "\\'") 'system)) ;; Let Emacs open all OpenDocument files in archive mode (add-to-list 'auto-mode-alist (cons (concat "\\." (car desc) "\\'") 'archive-mode))) @@ -285,7 +280,7 @@ Valid values are one of: 4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2 ...)) -In case of option 1, an in-built styles.xml is used. See +In case of option 1, an in-built styles.xml is used. See `org-odt-styles-dir' for more information. In case of option 3, the specified file is unzipped and the @@ -326,6 +321,8 @@ a per-file basis. For example, (defconst org-export-odt-tmpdir-prefix "%s-") (defconst org-export-odt-bookmark-prefix "OrgXref.") +(defvar org-odt-zip-dir nil + "Temporary directory that holds XML files during export.") (defvar org-export-odt-embed-images t "Should the images be copied in to the odt file or just linked?") @@ -382,7 +379,8 @@ This variable is effective only if (table . "Table") (definition-term . "Text_20_body_20_bold") (horizontal-line . "Horizontal_20_Line"))) - (character . ((bold . "Bold") + (character . ((default . "Default") + (bold . "Bold") (emphasis . "Emphasis") (code . "OrgCode") (verbatim . "OrgCode") @@ -413,7 +411,10 @@ Interactive commands `org-export-as-odt' and 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'." +`org-export-odt-convert-capabilities'. + +You can set this option on per-file basis using file local +values. See Info node `(emacs) File Variables'." :group 'org-export-odt :version "24.1" :type '(choice :convert-widget @@ -424,6 +425,35 @@ variable, the list of valid values are populated based on ,@(mapcar (lambda (c) `(const :tag ,c ,c)) (org-lparse-reachable-formats "odt"))))) +;;;###autoload +(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp) + +(defmacro org-odt-cleanup-xml-buffers (&rest body) + `(let ((org-odt-zip-dir + (make-temp-file + (format org-export-odt-tmpdir-prefix "odf") t)) + (--cleanup-xml-buffers + (function + (lambda nil + (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" + "meta.xml" "styles.xml"))) + ;; kill all xml buffers + (mapc (lambda (file) + (let ((buf (find-file-noselect + (expand-file-name file org-odt-zip-dir) t))) + (when (buffer-name buf) + (set-buffer-modified-p nil) + (kill-buffer buf)))) + xml-files)) + ;; delete temporary directory. + (delete-directory org-odt-zip-dir t))))) + (org-condition-case-unless-debug err + (prog1 (progn ,@body) + (funcall --cleanup-xml-buffers)) + ((quit error) + (funcall --cleanup-xml-buffers) + (message "OpenDocument export failed: %s" + (error-message-string err)))))) ;;;###autoload (defun org-export-as-odt-and-open (arg) @@ -432,8 +462,9 @@ 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 "P") - (org-lparse-and-open - (or org-export-odt-preferred-output-format "odt") "odt" arg)) + (org-odt-cleanup-xml-buffers + (org-lparse-and-open + (or org-export-odt-preferred-output-format "odt") "odt" arg))) ;;;###autoload (defun org-export-as-odt-batch () @@ -464,8 +495,9 @@ the file header and footer, simply return the content of <body>...</body>, without even the body tags themselves. When PUB-DIR is set, use this as the publishing directory." (interactive "P") - (org-lparse (or org-export-odt-preferred-output-format "odt") - "odt" arg hidden ext-plist to-buffer body-only pub-dir)) + (org-odt-cleanup-xml-buffers + (org-lparse (or org-export-odt-preferred-output-format "odt") + "odt" arg hidden ext-plist to-buffer body-only pub-dir))) (defvar org-odt-entity-control-callbacks-alist `((EXPORT @@ -539,7 +571,7 @@ PUB-DIR is set, use this as the publishing directory." (delete-region (match-beginning 0) (point-max))) ;; Following variable is let bound when `org-do-lparse' is in -;; progress. See org-html.el. +;; progress. See org-html.el. (defvar org-lparse-toc) (defun org-odt-format-toc () (if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n"))) @@ -810,7 +842,7 @@ PUB-DIR is set, use this as the publishing directory." (org-lparse-begin-list-item list-type))) ;; Following variables are let bound when table emission is in -;; progress. See org-lparse.el. +;; progress. See org-lparse.el. (defvar org-lparse-table-begin-marker) (defvar org-lparse-table-ncols) (defvar org-lparse-table-rowgrp-open) @@ -944,7 +976,7 @@ Use `org-odt-add-automatic-style' to add update this variable.'") (defvar org-odt-object-counters nil "Running counters for various OBJECT-TYPEs. -Use this to generate automatic names and style-names. See +Use this to generate automatic names and style-names. See `org-odt-add-automatic-style'.") (defun org-odt-write-automatic-styles () @@ -987,7 +1019,7 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME (cons object-name style-name))) (defvar org-odt-table-indentedp nil) -(defun org-odt-begin-table (caption label attributes) +(defun org-odt-begin-table (caption label attributes short-caption) (setq org-odt-table-indentedp (not (null org-lparse-list-stack))) (when org-odt-table-indentedp ;; Within the Org file, the table is appearing within a list item. @@ -1006,11 +1038,12 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME (insert (org-odt-format-stylized-paragraph 'table (org-odt-format-entity-caption label caption "__Table__")))) - (let ((name-and-style (org-odt-add-automatic-style "Table" attributes))) + (let ((automatic-name (org-odt-add-automatic-style "Table" attributes))) (org-lparse-insert-tag "<table:table table:name=\"%s\" table:style-name=\"%s\">" - (car name-and-style) (or (nth 1 org-odt-table-style-spec) - (cdr name-and-style) "OrgTable"))) + (or short-caption (car automatic-name)) + (or (nth 1 org-odt-table-style-spec) + (cdr automatic-name) "OrgTable"))) (setq org-lparse-table-begin-marker (point))) (defvar org-lparse-table-colalign-info) @@ -1097,7 +1130,7 @@ styles congruent with the ODF-1.2 specification." ;; Additional Note: LibreOffice's AutoFormat facility for tables - ;; which recognizes as many as 16 different cell types - is much - ;; richer. Unfortunately it is NOT amenable to easy configuration + ;; richer. Unfortunately it is NOT amenable to easy configuration ;; by hand. (let* ((template-name (nth 1 style-spec)) @@ -1247,7 +1280,7 @@ styles congruent with the ODF-1.2 specification." (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1)))) (insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n"))) -;; Following variable is let bound during 'ORG-LINK callback. See +;; Following variable is let bound during 'ORG-LINK callback. See ;; org-html.el (defvar org-lparse-link-description-is-image nil) (defun org-odt-format-link (desc href &optional attr) @@ -1443,7 +1476,7 @@ is turned on." (" " "<text:s/>") (" " "<text:tab/>"))) (hfy-face-to-css 'org-odt-hfy-face-to-css) - (hfy-optimisations-1 (copy-seq hfy-optimisations)) + (hfy-optimisations-1 (copy-sequence hfy-optimisations)) (hfy-optimisations (add-to-list 'hfy-optimisations-1 'body-text-only)) (hfy-begin-span-handler @@ -1552,7 +1585,12 @@ See `org-odt-add-label-definition' and (defun org-export-odt-format-formula (src href) (save-match-data (let* ((caption (org-find-text-property-in-string 'org-caption src)) + (short-caption + (or (org-find-text-property-in-string 'org-caption-shortn src) + caption)) (caption (and caption (org-xml-format-desc caption))) + (short-caption (and short-caption + (org-xml-encode-plain-text short-caption))) (label (org-find-text-property-in-string 'org-label src)) (latex-frag (org-find-text-property-in-string 'org-latex-src src)) (embed-as (or (and latex-frag @@ -1572,7 +1610,8 @@ See `org-odt-add-label-definition' and `((,(org-odt-format-entity (if (not (or caption label)) "DisplayFormula" "CaptionedDisplayFormula") - href width height :caption caption :label label) + href width height :caption caption :label label + :short-caption short-caption) ,(if (not (or caption label)) "" (let* ((label-props (car org-odt-entity-labels-alist))) (setcar (last label-props) "math-label") @@ -1732,7 +1771,7 @@ ATTR is a string of other attributes of the a element." (concat (org-lparse-format 'EXTRA-TARGETS extra-targets) - ;; No need to generate section numbers. They are auto-generated by + ;; No need to generate section numbers. They are auto-generated by ;; the application ;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ") @@ -1799,7 +1838,12 @@ ATTR is a string of other attributes of the a element." "Create image tag with source and attributes." (save-match-data (let* ((caption (org-find-text-property-in-string 'org-caption src)) + (short-caption + (or (org-find-text-property-in-string 'org-caption-shortn src) + caption)) (caption (and caption (org-xml-format-desc caption))) + (short-caption (and short-caption + (org-xml-encode-plain-text short-caption))) (attr (org-find-text-property-in-string 'org-attributes src)) (label (org-find-text-property-in-string 'org-label src)) (latex-frag (org-find-text-property-in-string @@ -1837,6 +1881,7 @@ ATTR is a string of other attributes of the a element." (org-odt-format-entity frame-style-handle href width height :caption caption :label label :category category + :short-caption short-caption :user-frame-params user-frame-params))))) (defun org-odt-format-object-description (title description) @@ -1915,7 +1960,7 @@ ATTR is a string of other attributes of the a element." (defun* org-odt-format-entity (entity href width height &key caption label category - user-frame-params) + user-frame-params short-caption) (let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t)) default-frame-params frame-params) (cond @@ -1933,7 +1978,16 @@ ATTR is a string of other attributes of the a element." 'illustration (concat (apply 'org-odt-format-frame href width height - (nth 2 entity-style)) + (let ((entity-style-1 (copy-sequence + (nth 2 entity-style)))) + (setcar (cdr entity-style-1) + (concat + (cadr entity-style-1) + (and short-caption + (format " draw:name=\"%s\" " + short-caption)))) + + entity-style-1)) (org-odt-format-entity-caption label caption (or category (nth 1 entity-style))))) width height frame-params))))) @@ -1973,37 +2027,43 @@ ATTR is a string of other attributes of the a element." methods.") ;; A4 page size is 21.0 by 29.7 cms -;; The default page settings has 2cm margin on each of the sides. So +;; The default page settings has 2cm margin on each of the sides. So ;; the effective text area is 17.0 by 25.7 cm (defvar org-export-odt-max-image-size '(17.0 . 20.0) "Limiting dimensions for an embedded image.") (defun org-odt-do-image-size (probe-method file &optional dpi anchor-type) - (setq dpi (or dpi org-export-odt-pixels-per-inch)) - (setq anchor-type (or anchor-type "paragraph")) - (flet ((size-in-cms (size-in-pixels) - (flet ((pixels-to-cms (pixels) - (let* ((cms-per-inch 2.54) - (inches (/ pixels dpi))) - (* cms-per-inch inches)))) - (and size-in-pixels - (cons (pixels-to-cms (car size-in-pixels)) - (pixels-to-cms (cdr size-in-pixels))))))) + (let* ((dpi (or dpi org-export-odt-pixels-per-inch)) + (anchor-type (or anchor-type "paragraph")) + (--pixels-to-cms + (function + (lambda (pixels dpi) + (let* ((cms-per-inch 2.54) + (inches (/ pixels dpi))) + (* cms-per-inch inches))))) + (--size-in-cms + (function + (lambda (size-in-pixels dpi) + (and size-in-pixels + (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) + (funcall --pixels-to-cms (cdr size-in-pixels) dpi))))))) (case probe-method (emacs - (size-in-cms (ignore-errors ; Emacs could be in batch mode - (clear-image-cache) - (image-size (create-image file) 'pixels)))) + (let ((size-in-pixels + (ignore-errors ; Emacs could be in batch mode + (clear-image-cache) + (image-size (create-image file) 'pixels)))) + (funcall --size-in-cms size-in-pixels dpi))) (imagemagick - (size-in-cms - (let ((dim (shell-command-to-string - (format "identify -format \"%%w:%%h\" \"%s\"" file)))) - (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) - (cons (string-to-number (match-string 1 dim)) - (string-to-number (match-string 2 dim))))))) - (t - (cdr (assoc-string anchor-type - org-export-odt-default-image-sizes-alist)))))) + (let ((size-in-pixels + (let ((dim (shell-command-to-string + (format "identify -format \"%%w:%%h\" \"%s\"" file)))) + (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) + (cons (string-to-number (match-string 1 dim)) + (string-to-number (match-string 2 dim))))))) + (funcall --size-in-cms size-in-pixels dpi))) + (t (cdr (assoc-string anchor-type + org-export-odt-default-image-sizes-alist)))))) (defun org-odt-image-size-from-file (file &optional user-width user-height scale dpi embed-as) @@ -2016,7 +2076,7 @@ ATTR is a string of other attributes of the a element." until size do (setq size (org-odt-do-image-size probe-method file dpi embed-as))) - (or size (error "Cannot determine Image size. Aborting ...")) + (or size (error "Cannot determine image size, aborting")) (setq width (car size) height (cdr size))) (cond (scale @@ -2206,10 +2266,7 @@ captions on export.") ;; Not at all OSes ship with zip by default (error "Executable \"zip\" needed for creating OpenDocument files")) - (let* ((outdir (make-temp-file - (format org-export-odt-tmpdir-prefix org-lparse-backend) t)) - (content-file (expand-file-name "content.xml" outdir))) - + (let* ((content-file (expand-file-name "content.xml" org-odt-zip-dir))) ;; init conten.xml (require 'nxml-mode) (let ((nxml-auto-insert-xml-declaration-flag nil)) @@ -2259,11 +2316,9 @@ visually." (org-odt-write-manifest-file) (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" - "meta.xml")) - (zipdir default-directory)) + "meta.xml"))) (when (equal org-lparse-backend 'odt) (push "styles.xml" xml-files)) - (message "Switching to directory %s" (expand-file-name zipdir)) ;; save all xml files (mapc (lambda (file) @@ -2299,15 +2354,8 @@ visually." cmds)) ;; move the file from outdir to target-dir - (rename-file target-name target-dir) - - ;; kill all xml buffers - (mapc (lambda (file) - (kill-buffer - (find-file-noselect (expand-file-name file zipdir) t))) - xml-files) + (rename-file target-name target-dir))) - (delete-directory zipdir))) (message "Created %s" target) (set-buffer (find-file-noselect target t))) @@ -2366,7 +2414,8 @@ visually." (org-odt-format-tags '("\n<meta:generator>" . "</meta:generator>") (when org-export-creator-info (format "Org-%s/Emacs-%s" - org-version emacs-version))) + (org-version) + emacs-version))) (org-odt-format-tags '("\n<meta:keyword>" . "</meta:keyword>") keywords) (org-odt-format-tags '("\n<dc:subject>" . "</dc:subject>") description) (org-odt-format-tags '("\n<dc:title>" . "</dc:title>") title) @@ -2386,12 +2435,12 @@ visually." ;; Update styles.xml - take care of outline numbering (with-current-buffer (find-file-noselect (expand-file-name "styles.xml") t) - ;; Don't make automatic backup of styles.xml file. This setting + ;; Don't make automatic backup of styles.xml file. This setting ;; prevents the backed-up styles.xml file from being zipped in to - ;; odt file. This is more of a hackish fix. Better alternative + ;; odt file. This is more of a hackish fix. Better alternative ;; would be to fix the zip command so that the output odt file ;; includes only the needed files and excludes any auto-generated - ;; extra files like backups and auto-saves etc etc. Note that + ;; extra files like backups and auto-saves etc etc. Note that ;; currently the zip command zips up the entire temp directory so ;; that any auto-generated files created under the hood ends up in ;; the resulting odt file. @@ -2609,7 +2658,7 @@ using `org-open-file'." cache-dir display-msg) (cond ((eq latex-frag-opt 'dvipng) - (setq cache-dir "ltxpng/") + (setq cache-dir org-latex-preview-ltxpng-directory) (setq display-msg "Creating LaTeX image %s")) ((member latex-frag-opt '(mathjax t)) (setq latex-frag-opt 'mathml) @@ -2657,7 +2706,7 @@ Do this when translation to MathML fails." "" (org-add-props label '(org-protected t)))) t t))))) ;; process latex fragments as part of -;; `org-export-preprocess-after-blockquote-hook'. Note that this hook +;; `org-export-preprocess-after-blockquote-hook'. Note that this hook ;; is the one that is closest and well before the call to ;; `org-export-attach-captions-and-attributes' in ;; `org-export-preprocess-string'. The above arrangement permits @@ -2692,7 +2741,7 @@ Do this when translation to MathML fails." members)) (defun org-odt-copy-styles-file (&optional styles-file) - ;; Non-availability of styles.xml is not a critical error. For now + ;; Non-availability of styles.xml is not a critical error. For now ;; throw an error purely for aesthetic reasons. (setq styles-file (or styles-file org-export-odt-styles-file @@ -2749,7 +2798,7 @@ MathML source to kill ring, if `org-export-copy-to-kill-ring' is non-nil." (interactive `(,(let (frag) - (setq frag (and (setq frag (and (region-active-p) + (setq frag (and (setq frag (and (org-region-active-p) (buffer-substring (region-beginning) (region-end)))) (loop for e in org-latex-regexps @@ -2764,27 +2813,28 @@ non-nil." (file-name-directory buffer-file-name)))) (read-file-name "ODF filename: " nil odf-filename nil (file-name-nondirectory odf-filename))))) - (let* ((org-lparse-backend 'odf) - org-lparse-opt-plist - (filename (or odf-file - (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name)))) - (buffer (find-file-noselect (org-odt-init-outfile filename))) - (coding-system-for-write 'utf-8) - (save-buffer-coding-system 'utf-8)) - (set-buffer buffer) - (set-buffer-file-coding-system coding-system-for-write) - (let ((mathml (org-create-math-formula latex-frag))) - (unless mathml (error "No Math formula created")) - (insert mathml) - (or (org-export-push-to-kill-ring - (upcase (symbol-name org-lparse-backend))) - (message "Exporting... done"))) - (org-odt-save-as-outfile filename nil))) + (org-odt-cleanup-xml-buffers + (let* ((org-lparse-backend 'odf) + org-lparse-opt-plist + (filename (or odf-file + (expand-file-name + (concat + (file-name-sans-extension + (or (file-name-nondirectory buffer-file-name))) + "." "odf") + (file-name-directory buffer-file-name)))) + (buffer (find-file-noselect (org-odt-init-outfile filename))) + (coding-system-for-write 'utf-8) + (save-buffer-coding-system 'utf-8)) + (set-buffer buffer) + (set-buffer-file-coding-system coding-system-for-write) + (let ((mathml (org-create-math-formula latex-frag))) + (unless mathml (error "No Math formula created")) + (insert mathml) + (or (org-export-push-to-kill-ring + (upcase (symbol-name org-lparse-backend))) + (message "Exporting... done"))) + (org-odt-save-as-outfile filename nil)))) ;;;###autoload (defun org-export-as-odf-and-open () diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index 5950d8e26da..64678409920 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -31,6 +31,7 @@ (require 'cl)) (require 'org-macs) +(require 'org-compat) (require 'pcomplete) (declare-function org-split-string "org" (string &optional separators)) @@ -50,14 +51,17 @@ :tag "Org" :group 'org) +(defvar org-drawer-regexp) +(defvar org-property-re) + (defun org-thing-at-point () "Examine the thing at point and let the caller know what it is. The return value is a string naming the thing at point." (let ((beg1 (save-excursion - (skip-chars-backward (org-re "[:alnum:]_@")) + (skip-chars-backward (org-re "[:alnum:]-_@")) (point))) (beg (save-excursion - (skip-chars-backward "a-zA-Z0-9_:$") + (skip-chars-backward "a-zA-Z0-9-_:$") (point))) (line-to-here (buffer-substring (point-at-bol) (point)))) (cond @@ -84,8 +88,18 @@ The return value is a string naming the thing at point." (equal (char-after (point-at-bol)) ?*)) (cons "tag" nil)) ((and (equal (char-before beg1) ?:) - (not (equal (char-after (point-at-bol)) ?*))) + (not (equal (char-after (point-at-bol)) ?*)) + (save-excursion + (move-beginning-of-line 1) + (skip-chars-backward "[ \t\n]") + ;; org-drawer-regexp matches a whole line but while + ;; looking-back, we just ignore trailing whitespaces + (or (org-looking-back (substring org-drawer-regexp 0 -1)) + (org-looking-back org-property-re)))) (cons "prop" nil)) + ((and (equal (char-before beg1) ?:) + (not (equal (char-after (point-at-bol)) ?*))) + (cons "drawer" nil)) (t nil)))) (defun org-command-at-point () @@ -119,7 +133,6 @@ When completing for #+STARTUP, for example, this function returns args))) (cons (reverse args) (reverse begins)))))) - (defun org-pcomplete-initial () "Calls the right completion function for first argument completions." (ignore @@ -127,7 +140,8 @@ When completing for #+STARTUP, for example, this function returns (car (org-thing-at-point))) pcomplete-default-completion-function)))) -(defvar org-additional-option-like-keywords) +(defvar org-options-keywords) ; From org.el +(defvar org-additional-option-like-keywords) ; From org.el (defun pcomplete/org-mode/file-option () "Complete against all valid file options." (require 'org-exp) @@ -137,14 +151,8 @@ When completing for #+STARTUP, for example, this function returns (if (= ?: (aref x (1- (length x)))) (concat x " ") x)) - (delq nil - (pcomplete-uniqify-list - (append - (mapcar (lambda (x) - (if (string-match "^#\\+\\([A-Z_]+:?\\)" x) - (match-string 1 x))) - (org-split-string (org-get-current-options) "\n")) - (copy-sequence org-additional-option-like-keywords)))))) + (append org-options-keywords + org-additional-option-like-keywords))) (substring pcomplete-stub 2))) (defvar org-startup-options) @@ -161,8 +169,40 @@ When completing for #+STARTUP, for example, this function returns (setq opts (delete "showstars" opts))))) opts)))) +(defmacro pcomplete/org-mode/file-option/x (option) + "Complete arguments for OPTION." + `(while + (pcomplete-here + (pcomplete-uniqify-list + (delq nil + (mapcar (lambda(o) + (when (string-match (concat "^[ \t]*#\\+" + ,option ":[ \t]+\\(.*\\)[ \t]*$") o) + (match-string 1 o))) + (split-string (org-get-current-options) "\n"))))))) + +(defun pcomplete/org-mode/file-option/options () + "Complete arguments for the #+OPTIONS file option." + (pcomplete/org-mode/file-option/x "OPTIONS")) + +(defun pcomplete/org-mode/file-option/title () + "Complete arguments for the #+TITLE file option." + (pcomplete/org-mode/file-option/x "TITLE")) + +(defun pcomplete/org-mode/file-option/author () + "Complete arguments for the #+AUTHOR file option." + (pcomplete/org-mode/file-option/x "AUTHOR")) + +(defun pcomplete/org-mode/file-option/email () + "Complete arguments for the #+EMAIL file option." + (pcomplete/org-mode/file-option/x "EMAIL")) + +(defun pcomplete/org-mode/file-option/date () + "Complete arguments for the #+DATE file option." + (pcomplete/org-mode/file-option/x "DATE")) + (defun pcomplete/org-mode/file-option/bind () - "Complete arguments for the #+BIND file option, which are variable names" + "Complete arguments for the #+BIND file option, which are variable names." (let (vars) (mapatoms (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars))))) @@ -196,16 +236,16 @@ When completing for #+STARTUP, for example, this function returns "Complete against all headings. This needs more work, to handle headings with lots of spaces in them." (while - (pcomplete-here - (save-excursion - (goto-char (point-min)) - (let (tbl) - (while (re-search-forward org-todo-line-regexp nil t) - (push (org-make-org-heading-search-string - (match-string-no-properties 3) t) - tbl)) - (pcomplete-uniqify-list tbl))) - (substring pcomplete-stub 1)))) + (pcomplete-here + (save-excursion + (goto-char (point-min)) + (let (tbl) + (while (re-search-forward org-todo-line-regexp nil t) + (push (org-make-org-heading-search-string + (match-string-no-properties 3) t) + tbl)) + (pcomplete-uniqify-list tbl))) + (substring pcomplete-stub 1)))) (defvar org-tag-alist) (defun pcomplete/org-mode/tag () @@ -239,6 +279,25 @@ This needs more work, to handle headings with lots of spaces in them." lst)) (substring pcomplete-stub 1))) +(defvar org-drawers) + +(defun pcomplete/org-mode/drawer () + "Complete a drawer name." + (let ((spc (save-excursion + (move-beginning-of-line 1) + (looking-at "^\\([ \t]*\\):") + (match-string 1))) + (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers))) + (pcomplete-here cpllist + (substring pcomplete-stub 1) + (unless (or (not (delete + nil + (mapcar (lambda(x) + (string-match (substring pcomplete-stub 1) x)) + cpllist))) + (looking-at "[ \t]*\n.*:END:")) + (save-excursion (insert "\n" spc ":END:")))))) + (defun pcomplete/org-mode/block-option/src () "Complete the arguments of a begin_src block. Complete a language in the first field, the header arguments and switches." @@ -256,7 +315,7 @@ Complete a language in the first field, the header arguments and switches." ":session" ":shebang" ":tangle" ":var")))) (defun pcomplete/org-mode/block-option/clocktable () - "Complete keywords in a clocktable line" + "Complete keywords in a clocktable line." (while (pcomplete-here '(":maxlevel" ":scope" ":tstart" ":tend" ":block" ":step" ":stepskip0" ":fileskip0" diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index f44694fa781..48d72ac2810 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -144,7 +144,8 @@ and dependant variables." (dotimes (col (length (first table))) (setf collector (cons col collector))) collector))) - row-vals (counter 0)) + (counter 0) + row-vals) (when (>= ind 0) ;; collect values of ind col (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter)) (cons counter (nth ind row))) table))) @@ -159,26 +160,26 @@ and dependant variables." ;; write table to gnuplot grid datafile format (with-temp-file data-file (let ((num-rows (length table)) (num-cols (length (first table))) + (gnuplot-row (lambda (col row value) + (setf col (+ 1 col)) (setf row (+ 1 row)) + (format "%f %f %f\n%f %f %f\n" + col (- row 0.5) value ;; lower edge + col (+ row 0.5) value))) ;; upper edge front-edge back-edge) - (flet ((gnuplot-row (col row value) - (setf col (+ 1 col)) (setf row (+ 1 row)) - (format "%f %f %f\n%f %f %f\n" - col (- row 0.5) value ;; lower edge - col (+ row 0.5) value))) ;; upper edge - (dotimes (col num-cols) - (dotimes (row num-rows) - (setf back-edge - (concat back-edge - (gnuplot-row (- col 1) row (string-to-number - (nth col (nth row table)))))) - (setf front-edge - (concat front-edge - (gnuplot-row col row (string-to-number - (nth col (nth row table))))))) - ;; only insert once per row - (insert back-edge) (insert "\n") ;; back edge - (insert front-edge) (insert "\n") ;; front edge - (setf back-edge "") (setf front-edge ""))))) + (dotimes (col num-cols) + (dotimes (row num-rows) + (setf back-edge + (concat back-edge + (funcall gnuplot-row (- col 1) row + (string-to-number (nth col (nth row table)))))) + (setf front-edge + (concat front-edge + (funcall gnuplot-row col row + (string-to-number (nth col (nth row table))))))) + ;; only insert once per row + (insert back-edge) (insert "\n") ;; back edge + (insert front-edge) (insert "\n") ;; front edge + (setf back-edge "") (setf front-edge "")))) row-vals)) (defun org-plot/gnuplot-script (data-file num-cols params &optional preface) @@ -208,40 +209,41 @@ manner suitable for prepending to a user-specified script." ('2d "plot") ('3d "splot") ('grid "splot"))) - (script "reset") plot-lines) - (flet ((add-to-script (line) (setf script (format "%s\n%s" script line)))) - (when file ;; output file - (add-to-script (format "set term %s" (file-name-extension file))) - (add-to-script (format "set output '%s'" file))) - (case type ;; type - ('2d ()) - ('3d (if map (add-to-script "set map"))) - ('grid (if map - (add-to-script "set pm3d map") - (add-to-script "set pm3d")))) - (when title (add-to-script (format "set title '%s'" title))) ;; title - (when lines (mapc (lambda (el) (add-to-script el)) lines)) ;; line - (when sets ;; set - (mapc (lambda (el) (add-to-script (format "set %s" el))) sets)) - (when x-labels ;; x labels (xtics) - (add-to-script - (format "set xtics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) - x-labels ", ")))) - (when y-labels ;; y labels (ytics) - (add-to-script - (format "set ytics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) - y-labels ", ")))) - (when time-ind ;; timestamp index - (add-to-script "set xdata time") - (add-to-script (concat "set timefmt \"" - (or timefmt ;; timefmt passed to gnuplot - "%Y-%m-%d-%H:%M:%S") "\""))) - (unless preface - (case type ;; plot command + (script "reset") + ; ats = add-to-script + (ats (lambda (line) (setf script (format "%s\n%s" script line)))) + plot-lines) + (when file ;; output file + (funcall ats (format "set term %s" (file-name-extension file))) + (funcall ats (format "set output '%s'" file))) + (case type ;; type + ('2d ()) + ('3d (if map (funcall ats "set map"))) + ('grid (if map (funcall ats "set pm3d map") + (funcall ats "set pm3d")))) + (when title (funcall ats (format "set title '%s'" title))) ;; title + (when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line + (when sets ;; set + (mapc (lambda (el) (funcall ats (format "set %s" el))) sets)) + (when x-labels ;; x labels (xtics) + (funcall ats + (format "set xtics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + x-labels ", ")))) + (when y-labels ;; y labels (ytics) + (funcall ats + (format "set ytics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + y-labels ", ")))) + (when time-ind ;; timestamp index + (funcall ats "set xdata time") + (funcall ats (concat "set timefmt \"" + (or timefmt ;; timefmt passed to gnuplot + "%Y-%m-%d-%H:%M:%S") "\""))) + (unless preface + (case type ;; plot command ('2d (dotimes (col num-cols) (unless (and (equal type '2d) (or (and ind (equal (+ 1 col) ind)) @@ -263,9 +265,9 @@ manner suitable for prepending to a user-specified script." ('grid (setq plot-lines (list (format "'%s' with %s title ''" data-file with))))) - (add-to-script - (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n ")))) - script))) + (funcall ats + (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n ")))) + script)) ;;----------------------------------------------------------------------------- ;; facade functions diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 74fc35f2db1..31f6fb26711 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -187,7 +187,7 @@ Each element of this list must be of the form: (module-name :property value property: value ...) -where module-name is an arbitrary name. All the values are strings. +where module-name is an arbitrary name. All the values are strings. Possible properties are: @@ -195,7 +195,7 @@ Possible properties are: :working-suffix - the replacement for online-suffix :base-url - the base URL, e.g. http://www.example.com/project/ Last slash required. - :working-directory - the local working directory. This is, what base-url will + :working-directory - the local working directory. This is, what base-url will be replaced with. :redirects - A list of cons cells, each of which maps a regular expression to match to a path relative to :working-directory. @@ -236,21 +236,21 @@ protocol - protocol to detect in a filename without trailing colon and slashes. If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol' will search filenames for \"org-protocol:/my-protocol:/\" and trigger your action for every match. `org-protocol' is defined in - `org-protocol-the-protocol'. Double and triple slashes are compressed + `org-protocol-the-protocol'. Double and triple slashes are compressed to one by emacsclient. function - function that handles requests with protocol and takes exactly one - argument: the filename with all protocols stripped. If the function - returns nil, emacsclient and -server do nothing. Any non-nil return + argument: the filename with all protocols stripped. If the function + returns nil, emacsclient and -server do nothing. Any non-nil return value is considered a valid filename and thus passed to the server. `org-protocol.el provides some support for handling those filenames, if you stay with the conventions used for the standard handlers in - `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. + `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. kill-client - If t, kill the client immediately, once the sub-protocol is - detected. This is necessary for actions that can be interrupted by - `C-g' to avoid dangling emacsclients. Note, that all other command + detected. This is necessary for actions that can be interrupted by + `C-g' to avoid dangling emacsclients. Note, that all other command line arguments but the this one will be discarded, greedy handlers still receive the whole list of arguments though. @@ -273,6 +273,12 @@ string with two characters." :group 'org-protocol :type 'string) +(defcustom org-protocol-data-separator "/+" + "The default data separator to use. + This should be a single regexp string." + :group 'org-protocol + :type 'string) + ;;; Helper functions: (defun org-protocol-sanitize-uri (uri) @@ -316,32 +322,32 @@ Everything up to the end of the protocols is stripped. Note, that this function will always behave as if `org-protocol-reverse-list-of-files' was set to t and the returned list will -reflect that. I.e. emacsclients first parameter will be the first one in the +reflect that. I.e. emacsclients first parameter will be the first one in the returned list." -(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files - param-list - (reverse param-list)))) - (trigger (car l)) - (len 0) - dir - ret) - (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger) - (setq dir (match-string 1 trigger)) - (setq len (length dir)) - (setcar l (concat dir (match-string 3 trigger)))) - (if strip-path - (progn - (dolist (e l ret) - (setq ret - (append ret - (list - (if (stringp e) - (if (stringp replacement) - (setq e (concat replacement (substring e len))) - (setq e (substring e len))) - e))))) - ret) - l))) + (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files + param-list + (reverse param-list)))) + (trigger (car l)) + (len 0) + dir + ret) + (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger) + (setq dir (match-string 1 trigger)) + (setq len (length dir)) + (setcar l (concat dir (match-string 3 trigger)))) + (if strip-path + (progn + (dolist (e l ret) + (setq ret + (append ret + (list + (if (stringp e) + (if (stringp replacement) + (setq e (concat replacement (substring e len))) + (setq e (substring e len))) + e))))) + ret) + l))) (defun org-protocol-flatten (l) "Greedy handlers might receive a list like this from emacsclient: @@ -350,7 +356,7 @@ where \"/dir/\" is the absolute path to emacsclients working directory. This function transforms it into a flat list." (if (null l) () (if (listp l) - (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) + (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) (list l)))) @@ -358,7 +364,7 @@ This function transforms it into a flat list." (defun org-protocol-store-link (fname) "Process an org-protocol://store-link:// style url. -Additionally store a browser URL as an org link. Also pushes the +Additionally store a browser URL as an org link. Also pushes the link's URL to the `kill-ring'. The location for a browser's bookmark has to look like this: @@ -367,17 +373,17 @@ The location for a browser's bookmark has to look like this: encodeURIComponent(location.href) encodeURIComponent(document.title)+'/'+ \\ -Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page +Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page could contain slashes and the location definitely will. The sub-protocol used to reach this function is set in `org-protocol-protocol-alist'." - (let* ((splitparts (org-protocol-split-data fname t)) + (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator)) (uri (org-protocol-sanitize-uri (car splitparts))) (title (cadr splitparts)) orglink) (if (boundp 'org-stored-links) - (setq org-stored-links (cons (list uri title) org-stored-links))) + (setq org-stored-links (cons (list uri title) org-stored-links))) (kill-new uri) (message "`%s' to insert new org-link, `%s' to insert `%s'" (substitute-command-keys"\\[org-insert-link]") @@ -433,7 +439,7 @@ Now template ?b will be used." (defun org-protocol-do-capture (info capture-func) "Support `org-capture' and `org-remember' alike. CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." - (let* ((parts (org-protocol-split-data info t)) + (let* ((parts (org-protocol-split-data info t org-protocol-data-separator)) (template (or (and (>= 2 (length (car parts))) (pop parts)) org-protocol-default-template-key)) (url (org-protocol-sanitize-uri (car parts))) @@ -529,7 +535,7 @@ This is, how the matching is done: protocol and sub-protocol are regexp-quoted. If a matching protocol is found, the protocol is stripped from fname and the -result is passed to the protocols function as the only parameter. If the +result is passed to the protocols function as the only parameter. If the function returns nil, the filename is removed from the list of filenames passed from emacsclient to the server. If the function returns a non nil value, that value is passed to the server @@ -548,7 +554,7 @@ as filename." (split (split-string fname proto)) (result (if greedy restoffiles (cadr split)))) (when (plist-get (cdr prolist) :kill-client) - (message "Greedy org-protocol handler. Killing client.") + (message "Greedy org-protocol handler. Killing client.") (server-edit)) (when (fboundp func) (unless greedy @@ -566,7 +572,7 @@ as filename." (client (ad-get-arg 1))) (catch 'greedy (dolist (var flist) - ;; `\' to `/' on windows. FIXME: could this be done any better? + ;; `\' to `/' on windows. FIXME: could this be done any better? (let ((fname (expand-file-name (car var)))) (setq fname (org-protocol-check-filename-for-protocol fname (member var flist) client)) @@ -589,14 +595,14 @@ most of the work." (require 'org-publish) (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) (if all (org-protocol-create (cdr all)) - (message "Not in an org-project. Did mean %s?" + (message "Not in an org-project. Did mean %s?" (substitute-command-keys"\\[org-protocol-create]"))))) (defun org-protocol-create (&optional project-plist) "Create a new org-protocol project interactively. An org-protocol project is an entry in `org-protocol-project-alist' which is used by `org-protocol-open-source'. -Optionally use project-plist to initialize the defaults for this project. If +Optionally use project-plist to initialize the defaults for this project. If project-plist is the CDR of an element in `org-publish-project-alist', reuse :base-directory, :html-extension and :base-extension." (interactive) @@ -625,19 +631,19 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse (setq strip-suffix (read-string (concat "Extension to strip from published URLs (" strip-suffix "): ") - strip-suffix nil strip-suffix t)) + strip-suffix nil strip-suffix t)) (setq working-suffix (read-string (concat "Extension of editable files (" working-suffix "): ") - working-suffix nil working-suffix t)) + working-suffix nil working-suffix t)) (when (yes-or-no-p "Save the new org-protocol-project to your init file? ") (setq org-protocol-project-alist (cons `(,base-url . (:base-url ,base-url - :working-directory ,working-dir - :online-suffix ,strip-suffix - :working-suffix ,working-suffix)) + :working-directory ,working-dir + :online-suffix ,strip-suffix + :working-suffix ,working-suffix)) org-protocol-project-alist)) (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist)))) diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el index 74cab14716c..947d52b9200 100644 --- a/lisp/org/org-publish.el +++ b/lisp/org/org-publish.el @@ -105,7 +105,7 @@ being published. Its value may be a string or regexp matching file names you don't want to be published. The :include property may be used to include extra files. Its -value may be a list of filenames to include. The filenames are +value may be a list of filenames to include. The filenames are considered relative to the base directory. When both :include and :exclude properties are given values, the @@ -315,7 +315,7 @@ You could use brackets to delimit on what part the link will be. (format "%s" (or pub-func "")))) (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) -(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir) +(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir) "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC. TRUE-PUB-DIR is where the file will truly end up. Currently we are not using this - maybe it can eventually be used to check if the file is present at @@ -325,7 +325,7 @@ function can still decide about that independently." (let ((rtn (if org-publish-use-timestamps-flag (org-publish-cache-file-needs-publishing - filename pub-dir pub-func) + filename pub-dir pub-func base-dir) ;; don't use timestamps, always return t t))) (if rtn @@ -334,7 +334,7 @@ function can still decide about that independently." (message "Skipping unmodified file %s" filename))) rtn)) -(defun org-publish-update-timestamp (filename &optional pub-dir pub-func) +(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir) "Update publishing timestamp for file FILENAME. If there is no timestamp, create one." (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) @@ -418,22 +418,22 @@ This splices all the components into the list." (setq retval (if org-sitemap-ignore-case (not (string-lessp (upcase B) (upcase A))) (not (string-lessp B A)))))) - ((or (equal org-sitemap-sort-files 'chronologically) - (equal org-sitemap-sort-files 'anti-chronologically)) - (let* ((adate (org-publish-find-date a)) - (bdate (org-publish-find-date b)) - (A (+ (lsh (car adate) 16) (cadr adate))) - (B (+ (lsh (car bdate) 16) (cadr bdate)))) - (setq retval (if (equal org-sitemap-sort-files 'chronologically) - (<= A B) - (>= A B))))))) + ((or (equal org-sitemap-sort-files 'chronologically) + (equal org-sitemap-sort-files 'anti-chronologically)) + (let* ((adate (org-publish-find-date a)) + (bdate (org-publish-find-date b)) + (A (+ (lsh (car adate) 16) (cadr adate))) + (B (+ (lsh (car bdate) 16) (cadr bdate)))) + (setq retval (if (equal org-sitemap-sort-files 'chronologically) + (<= A B) + (>= A B))))))) ;; Directory-wise wins: (when org-sitemap-sort-folders ;; a is directory, b not: (cond ((and (file-directory-p a) (not (file-directory-p b))) (setq retval (equal org-sitemap-sort-folders 'first))) - ;; a is not a directory, but b is: + ;; a is not a directory, but b is: ((and (not (file-directory-p a)) (file-directory-p b)) (setq retval (equal org-sitemap-sort-folders 'last)))))) retval)) @@ -506,7 +506,7 @@ matching filenames." (setq org-publish-temp-files nil) (if org-sitemap-requested (pushnew (expand-file-name (concat base-dir sitemap-filename)) - org-publish-temp-files)) + org-publish-temp-files)) (org-publish-get-base-files-1 base-dir recurse match ;; FIXME distinguish exclude regexp ;; for skip-file and skip-dir? @@ -536,14 +536,14 @@ matching filenames." (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) (when (or - (and + (and i (member filename (mapcar (lambda (file) (expand-file-name file b)) i))) - (and - (not (and e (string-match e filename))) - (string-match xm filename))) + (and + (not (and e (string-match e filename))) + (string-match xm filename))) (setq project-name (car prj)) (throw 'p-found project-name)))))) (when up @@ -600,10 +600,10 @@ PUB-DIR is the publishing directory." (defmacro org-publish-with-aux-preprocess-maybe (&rest body) "Execute BODY with a modified hook to preprocess for index." `(let ((org-export-preprocess-after-headline-targets-hook - (if (plist-get project-plist :makeindex) - (cons 'org-publish-aux-preprocess - org-export-preprocess-after-headline-targets-hook) - org-export-preprocess-after-headline-targets-hook))) + (if (plist-get project-plist :makeindex) + (cons 'org-publish-aux-preprocess + org-export-preprocess-after-headline-targets-hook) + org-export-preprocess-after-headline-targets-hook))) ,@body)) (def-edebug-spec org-publish-with-aux-preprocess-maybe (body)) @@ -624,7 +624,7 @@ See `org-publish-org-to' to the list of arguments." "Publish an org file to HTML. See `org-publish-org-to' to the list of arguments." (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "html" plist filename pub-dir))) + (org-publish-org-to "html" plist filename pub-dir))) (defun org-publish-org-to-org (plist filename pub-dir) "Publish an org file to HTML. @@ -635,19 +635,19 @@ See `org-publish-org-to' to the list of arguments." "Publish an org file to ASCII. See `org-publish-org-to' to the list of arguments." (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "ascii" plist filename pub-dir))) + (org-publish-org-to "ascii" plist filename pub-dir))) (defun org-publish-org-to-latin1 (plist filename pub-dir) "Publish an org file to Latin-1. See `org-publish-org-to' to the list of arguments." (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "latin1" plist filename pub-dir))) + (org-publish-org-to "latin1" plist filename pub-dir))) (defun org-publish-org-to-utf8 (plist filename pub-dir) "Publish an org file to UTF-8. See `org-publish-org-to' to the list of arguments." (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "utf8" plist filename pub-dir))) + (org-publish-org-to "utf8" plist filename pub-dir))) (defun org-publish-attachment (plist filename pub-dir) "Publish a file with no transformation of any kind. @@ -705,15 +705,14 @@ See `org-publish-projects'." (if (listp publishing-function) ;; allow chain of publishing functions (mapc (lambda (f) - (when (org-publish-needed-p filename pub-dir f tmp-pub-dir) + (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir) (funcall f project-plist filename tmp-pub-dir) - (org-publish-update-timestamp filename pub-dir f))) + (org-publish-update-timestamp filename pub-dir f base-dir))) publishing-function) - (when (org-publish-needed-p filename pub-dir publishing-function - tmp-pub-dir) + (when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir) (funcall publishing-function project-plist filename tmp-pub-dir) (org-publish-update-timestamp - filename pub-dir publishing-function))) + filename pub-dir publishing-function base-dir))) (unless no-cache (org-publish-write-cache-file)))) (defun org-publish-projects (projects) @@ -733,9 +732,9 @@ If :makeindex is set, also produce a file theindex.org." (sitemap-function (or (plist-get project-plist :sitemap-function) 'org-publish-org-sitemap)) (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format) - org-publish-sitemap-date-format)) + org-publish-sitemap-date-format)) (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format) - org-publish-sitemap-file-entry-format)) + org-publish-sitemap-file-entry-format)) (preparation-function (plist-get project-plist :preparation-function)) (completion-function (plist-get project-plist :completion-function)) (files (org-publish-get-base-files project exclude-regexp)) file) @@ -751,7 +750,7 @@ If :makeindex is set, also produce a file theindex.org." (plist-get project-plist :base-directory)) project t)) (when completion-function (run-hooks 'completion-function)) - (org-publish-write-cache-file))) + (org-publish-write-cache-file))) (org-publish-expand-projects projects))) (defun org-publish-org-sitemap (project &optional sitemap-filename) @@ -767,9 +766,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (files (nreverse (org-publish-get-base-files project exclude-regexp))) (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) (sitemap-title (or (plist-get project-plist :sitemap-title) - (concat "Sitemap for project " (car project)))) + (concat "Sitemap for project " (car project)))) (sitemap-style (or (plist-get project-plist :sitemap-style) - 'tree)) + 'tree)) (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension)) (visiting (find-buffer-visiting sitemap-filename)) (ifn (file-name-nondirectory sitemap-filename)) @@ -833,10 +832,10 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (defun org-publish-format-file-entry (fmt file project-plist) (format-spec fmt - `((?t . ,(org-publish-find-title file t)) - (?d . ,(format-time-string org-sitemap-date-format - (org-publish-find-date file))) - (?a . ,(or (plist-get project-plist :author) user-full-name))))) + `((?t . ,(org-publish-find-title file t)) + (?d . ,(format-time-string org-sitemap-date-format + (org-publish-find-date file))) + (?a . ,(or (plist-get project-plist :author) user-full-name))))) (defun org-publish-find-title (file &optional reset) "Find the title of FILE in project." @@ -902,7 +901,7 @@ It returns time in `current-time' format." ;; If this function is called in batch mode, ;; project is still a string here. (list (assoc project org-publish-project-alist)) - (list project)))))) + (list project)))))) ;;;###autoload (defun org-publish-all (&optional force) @@ -1033,25 +1032,24 @@ the project." ;; Create theindex.org if it doesn't exist already (let ((index-file (expand-file-name "theindex.org" directory))) (unless (file-exists-p index-file) - (setq ibuffer (find-file-noselect index-file)) - (with-current-buffer ibuffer - (erase-buffer) - (insert "\n\n#+include: \"theindex.inc\"\n\n") - (save-buffer)) - (kill-buffer ibuffer))))) + (setq ibuffer (find-file-noselect index-file)) + (with-current-buffer ibuffer + (erase-buffer) + (insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n") + (save-buffer)) + (kill-buffer ibuffer))))) ;; Caching functions: (defun org-publish-write-cache-file (&optional free-cache) "Write `org-publish-cache' to file. If FREE-CACHE, empty the cache." - (unless org-publish-cache - (error "%s" "`org-publish-write-cache-file' called, but no cache present")) + (or org-publish-cache + (error "`org-publish-write-cache-file' called, but no cache present")) (let ((cache-file (org-publish-cache-get ":cache-file:"))) - (unless cache-file - (error - "%s" "Cannot find cache-file name in `org-publish-write-cache-file'")) + (or cache-file + (error "Cannot find cache-file name in `org-publish-write-cache-file'")) (with-temp-file cache-file (let ((print-level nil) (print-length nil)) @@ -1068,9 +1066,8 @@ If FREE-CACHE, empty the cache." (defun org-publish-initialize-cache (project-name) "Initialize the projects cache if not initialized yet and return it." - (unless project-name - (error "%s%s" "Cannot initialize `org-publish-cache' without projects name" - " in `org-publish-initialize-cache'")) + (or project-name + (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) (unless (file-exists-p org-publish-timestamp-directory) (make-directory org-publish-timestamp-directory t)) @@ -1105,23 +1102,24 @@ If FREE-CACHE, empty the cache." (clrhash org-publish-cache)) (setq org-publish-cache nil)) -(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func) +(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir) "Check the timestamp of the last publishing of FILENAME. Return `t', if the file needs publishing. The function also checks if any included files have been more recently published, so that the file including them will be republished as well." - (unless org-publish-cache - (error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present")) + (or org-publish-cache + (error "`org-publish-cache-file-needs-publishing' called, but no cache present")) (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) (pstamp (org-publish-cache-get key)) (visiting (find-buffer-visiting filename)) + (case-fold-search t) included-files-ctime buf) (when (equal (file-name-extension filename) "org") (setq buf (find-file (expand-file-name filename))) (with-current-buffer buf (goto-char (point-min)) - (while (re-search-forward "^#\\+INCLUDE:[ \t]+\"?\\([^ \t\n\r\"]*\\)\"?[ \t]*.*$" nil t) + (while (re-search-forward "^#\\+include:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) (let* ((included-file (expand-file-name (match-string 1)))) (add-to-list 'included-files-ctime (org-publish-cache-ctime-of-src included-file) t)))) @@ -1173,28 +1171,24 @@ If the entry will be created, unless NO-CREATE is not nil." "Return the value stored in `org-publish-cache' for key KEY. Returns nil, if no value or nil is found, or the cache does not exist." - (unless org-publish-cache - (error "%s" "`org-publish-cache-get' called, but no cache present")) + (or org-publish-cache + (error "`org-publish-cache-get' called, but no cache present")) (gethash key org-publish-cache)) (defun org-publish-cache-set (key value) "Store KEY VALUE pair in `org-publish-cache'. Returns value on success, else nil." - (unless org-publish-cache - (error "%s" "`org-publish-cache-set' called, but no cache present")) + (or org-publish-cache + (error "`org-publish-cache-set' called, but no cache present")) (puthash key value org-publish-cache)) -(defun org-publish-cache-ctime-of-src (filename) - "Get the FILENAME ctime as an integer." - (let* ((symlink-maybe (or (file-symlink-p filename) filename)) - (src-attr (file-attributes (if (file-name-absolute-p symlink-maybe) - symlink-maybe - (expand-file-name - symlink-maybe - (file-name-directory filename)))))) - (+ - (lsh (car (nth 5 src-attr)) 16) - (cadr (nth 5 src-attr))))) +(defun org-publish-cache-ctime-of-src (file) + "Get the ctime of filename F as an integer." + (let ((attr (file-attributes + (expand-file-name (or (file-symlink-p file) file) + (file-name-directory file))))) + (+ (lsh (car (nth 5 attr)) 16) + (cadr (nth 5 attr))))) (provide 'org-publish) diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index d1d863c2845..dd493749295 100644 --- a/lisp/org/org-remember.el +++ b/lisp/org/org-remember.el @@ -189,22 +189,22 @@ calendar | %:type %:date" (character :tag "Selection Key") (string :tag "Template") (choice :tag "Destination file" - (file :tag "Specify") - (function :tag "Function") - (const :tag "Use `org-default-notes-file'" nil)) + (file :tag "Specify") + (function :tag "Function") + (const :tag "Use `org-default-notes-file'" nil)) (choice :tag "Destin. headline" - (string :tag "Specify") - (function :tag "Function") - (const :tag "Use `org-remember-default-headline'" nil) - (const :tag "At beginning of file" top) - (const :tag "At end of file" bottom) - (const :tag "In a date tree" date-tree)) + (string :tag "Specify") + (function :tag "Function") + (const :tag "Use `org-remember-default-headline'" nil) + (const :tag "At beginning of file" top) + (const :tag "At end of file" bottom) + (const :tag "In a date tree" date-tree)) (choice :tag "Context" - (const :tag "Use in all contexts" nil) - (const :tag "Use in all contexts" t) - (repeat :tag "Use only if in major mode" - (symbol :tag "Major mode")) - (function :tag "Perform a check against function"))))) + (const :tag "Use in all contexts" nil) + (const :tag "Use in all contexts" t) + (repeat :tag "Use only if in major mode" + (symbol :tag "Major mode")) + (function :tag "Perform a check against function"))))) (defcustom org-remember-delete-empty-lines-at-end t "Non-nil means clean up final empty lines in remember buffer." @@ -277,9 +277,6 @@ opposite case, the default, t, is more useful." :group 'org-remember :type 'boolean) -(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' -(defvar initial) ; from remember.el, dynamically scoped in `remember-mode' - ;;;###autoload (defun org-remember-insinuate () "Setup remember.el for use with Org-mode." @@ -297,7 +294,7 @@ conventions in Org-mode. This function returns such a link." (org-store-link nil)) (defconst org-remember-help -"Select a destination location for the note. + "Select a destination location for the note. UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store RET on headline -> Store as sublevel entry to current headline RET at beg-of-buf -> Append to file as level 2 headline @@ -401,8 +398,7 @@ RET at beg-of-buf -> Append to file as level 2 headline This function should be placed into `remember-mode-hook' and in fact requires to be run from that hook to function properly." (when (and (boundp 'initial) (stringp initial)) - (setq initial (org-no-properties initial)) - (remove-text-properties 0 (length initial) '(read-only t) initial)) + (setq initial (org-no-properties initial))) (if org-remember-templates (let* ((entry (org-select-remember-template use-char)) (ct (or org-overriding-default-time (org-current-time))) @@ -431,10 +427,10 @@ to be run from that hook to function properly." ;; `initial' and `annotation' are bound in `remember'. ;; But if the property list has them, we prefer those values (v-i (or (plist-get org-store-link-plist :initial) - (and (boundp 'initial) initial) + (and (boundp 'initial) (symbol-value 'initial)) "")) (v-a (or (plist-get org-store-link-plist :annotation) - (and (boundp 'annotation) annotation) + (and (boundp 'annotation) (symbol-value 'annotation)) "")) ;; Is the link empty? Then we do not want it... (v-a (if (equal v-a "[[]]") "" v-a)) @@ -449,7 +445,7 @@ to be run from that hook to function properly." v-a)) (v-n user-full-name) (v-k (if (marker-buffer org-clock-marker) - (org-substring-no-properties org-clock-heading))) + (org-no-properties org-clock-heading))) (v-K (if (marker-buffer org-clock-marker) (org-make-link-string (buffer-file-name (marker-buffer org-clock-marker)) @@ -476,7 +472,7 @@ to be run from that hook to function properly." (erase-buffer) (insert (substitute-command-keys (format -"## %s \"%s\" -> \"* %s\" + "## %s \"%s\" -> \"* %s\" ## C-u C-c C-c like C-c C-c, and immediately visit note at target location ## C-0 C-c C-c \"%s\" -> \"* %s\" ## %s to select file and header location interactively. @@ -505,18 +501,20 @@ to be run from that hook to function properly." filename error))))))) ;; Simple %-escapes (goto-char (point-min)) - (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) - (unless (org-remember-escaped-%) - (when (and initial (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity - (org-split-string initial "\n") - (concat "\n" lead)))))) - (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") - t t))) + (let ((init (and (boundp 'initial) + (symbol-value 'initial)))) + (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) + (unless (org-remember-escaped-%) + (when (and init (equal (match-string 0) "%i")) + (save-match-data + (let* ((lead (buffer-substring + (point-at-bol) (match-beginning 0)))) + (setq v-i (mapconcat 'identity + (org-split-string init "\n") + (concat "\n" lead)))))) + (replace-match + (or (eval (intern (concat "v-" (match-string 1)))) "") + t t)))) ;; %() embedded elisp (goto-char (point-min)) @@ -536,10 +534,10 @@ to be run from that hook to function properly." (when plist-p (goto-char (point-min)) (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) - (unless (org-remember-escaped-%) - (and (setq x (or (plist-get org-store-link-plist - (intern (match-string 1))) "")) - (replace-match x t t))))) + (unless (org-remember-escaped-%) + (and (setq x (or (plist-get org-store-link-plist + (intern (match-string 1))) "")) + (replace-match x t t))))) ;; Turn on org-mode in the remember buffer, set local variables (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1)) @@ -599,7 +597,7 @@ to be run from that hook to function properly." (car clipboards)))))) ((equal char "p") (let* - ((prop (org-substring-no-properties prompt)) + ((prop (org-no-properties prompt)) (pall (concat prop "_ALL")) (allowed (with-current-buffer @@ -943,7 +941,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 (eq major-mode 'org-mode) (member heading '(top bottom))) + (unless (or (derived-mode-p '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 +951,7 @@ See also the variable `org-reverse-note-order'." ;; Find the default location (when heading (cond - ((not (eq major-mode 'org-mode)) + ((not (derived-mode-p 'org-mode)) (if (eq heading 'top) (goto-char (point-min)) (goto-char (point-max)) @@ -995,7 +993,7 @@ See also the variable `org-reverse-note-order'." (cond ((and fastp (memq heading '(top bottom))) (setq spos org-goto-start-pos - exitcmd (if (eq heading 'top) 'left nil))) + exitcmd (if (eq heading 'top) 'left nil))) (fastp (setq spos org-goto-start-pos exitcmd 'return)) ((eq org-remember-interactive-interface 'outline) diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index 3146ff32758..4be7bcbb5f6 100644 --- a/lisp/org/org-rmail.el +++ b/lisp/org/org-rmail.el @@ -33,9 +33,12 @@ (require 'org) ;; Declare external functions and variables -(declare-function rmail-show-message "rmail" (&optional n no-summary)) -(declare-function rmail-what-message "rmail" ()) -(defvar rmail-current-message) +(declare-function rmail-show-message "rmail" (&optional n no-summary)) +(declare-function rmail-what-message "rmail" (&optional pos)) +(declare-function rmail-toggle-header "rmail" (&optional arg)) +(declare-function rmail-widen "rmail" ()) +(defvar rmail-current-message) ; From rmail.el +(defvar rmail-header-style) ; From rmail.el ;; Install the link type (org-add-link-type "rmail" 'org-rmail-open) @@ -52,6 +55,8 @@ (rmail-show-message rmail-current-message)) (when (fboundp 'rmail-narrow-to-non-pruned-header) (rmail-narrow-to-non-pruned-header)) + (when (eq rmail-header-style 'normal) + (rmail-toggle-header -1)) (let* ((folder buffer-file-name) (message-id (mail-fetch-field "message-id")) (from (mail-fetch-field "from")) @@ -73,7 +78,7 @@ :date-timestamp-inactive date-ts-ia)) (setq message-id (org-remove-angle-brackets message-id)) (setq desc (org-email-link-description)) - (setq link (org-make-link "rmail:" folder "#" message-id)) + (setq link (concat "rmail:" folder "#" message-id)) (org-add-link-props :link link :description desc) (rmail-show-message rmail-current-message) link))))) @@ -97,7 +102,7 @@ (rmail (if (string= folder "RMAIL") rmail-file-name folder)) (setq message-number (save-restriction - (widen) + (rmail-widen) (goto-char (point-max)) (if (re-search-backward (concat "^Message-ID:\\s-+" (regexp-quote diff --git a/lisp/org/org-special-blocks.el b/lisp/org/org-special-blocks.el index 43b37c64016..ddd612074b4 100644 --- a/lisp/org/org-special-blocks.el +++ b/lisp/org/org-special-blocks.el @@ -80,17 +80,17 @@ seen. This is run after a few special cases are taken care of." (add-hook 'org-export-latex-after-blockquotes-hook 'org-special-blocks-convert-latex-special-cookies) -(defvar line) +(defvar org-line) (defun org-special-blocks-convert-html-special-cookies () "Converts the special cookies into div blocks." - ;; Uses the dynamically-bound variable `line'. - (when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" line) + ;; Uses the dynamically-bound variable `org-line'. + (when (and org-line (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line)) (message "%s" (match-string 1)) - (when (equal (match-string 2 line) "START") + (when (equal (match-string 2 org-line) "START") (org-close-par-maybe) - (insert "\n<div class=\"" (match-string 1 line) "\">") + (insert "\n<div class=\"" (match-string 1 org-line) "\">") (org-open-par)) - (when (equal (match-string 2 line) "END") + (when (equal (match-string 2 org-line) "END") (org-close-par-maybe) (insert "\n</div>") (org-open-par)) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 496dafe5e77..9d6bc1aa2c8 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -41,6 +41,7 @@ (declare-function org-at-table.el-p "org" ()) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-switch-to-buffer-other-window "org" (&rest args)) +(declare-function org-strip-protective-commas "org" (beg end)) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (declare-function org-strip-protective-commas "org" (beg end)) @@ -112,8 +113,7 @@ editing it with \\[org-edit-src-code]. Has no effect if :type 'integer) (defvar org-src-strip-leading-and-trailing-blank-lines nil - "If non-nil, blank lines are removed when exiting the code edit -buffer.") + "If non-nil, blank lines are removed when exiting the code edit buffer.") (defcustom org-edit-src-persistent-message t "Non-nil means show persistent exit help message while editing src examples. @@ -130,7 +130,7 @@ current-window Show edit buffer in the current window, keeping all other windows. other-window Use `switch-to-buffer-other-window' to display edit buffer. reorganize-frame Show only two windows on the current frame, the current - window and the edit buffer. When exiting the edit buffer, + window and the edit buffer. When exiting the edit buffer, return to one window. other-frame Use `switch-to-buffer-other-frame' to display edit buffer. Also, when exiting the edit buffer, kill that frame." @@ -174,6 +174,7 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-src-mode-map (make-sparse-keymap)) (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) +(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save) (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) @@ -187,9 +188,9 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-src-ask-before-returning-to-edit-buffer t "If nil, when org-edit-src code is used on a block that already - has an active edit buffer, it will switch to that edit buffer - immediately; otherwise it will ask whether you want to return - to the existing edit buffer.") +has an active edit buffer, it will switch to that edit buffer +immediately; otherwise it will ask whether you want to return to +the existing edit buffer.") (defvar org-src-babel-info nil) @@ -202,13 +203,13 @@ There is a mode hook, and keybindings for `org-edit-src-exit' and `org-edit-src-save'") (defun org-edit-src-code (&optional context code edit-buffer-name) - "Edit the source code example at point. + "Edit the source CODE example at point. The example is copied to a separate buffer, and that buffer is switched to the correct language mode. When done, exit with \\[org-edit-src-exit]. This will remove the original code in the -Org buffer, and replace it with the edited version. Optional +Org buffer, and replace it with the edited version. An optional argument CONTEXT is used by \\[org-edit-src-save] when calling -this function. See \\[org-src-window-setup] to configure the +this function. See `org-src-window-setup' to configure the display of windows containing the Org buffer and the code buffer." (interactive) @@ -271,8 +272,9 @@ buffer." (setq line (org-current-line) col (current-column))) (if (and (setq buffer (org-edit-src-find-buffer beg end)) - (if org-src-ask-before-returning-to-edit-buffer - (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ") t)) + (or (eq context 'save) + (if org-src-ask-before-returning-to-edit-buffer + (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ") t))) (org-src-switch-to-buffer buffer 'return) (when buffer (with-current-buffer buffer @@ -309,7 +311,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))) - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (progn (goto-char (point-min)) (while (re-search-forward "^," nil t) @@ -328,6 +330,7 @@ buffer." (if org-src-preserve-indentation col (max 0 (- col total-nindent)))) (org-src-mode) (set-buffer-modified-p nil) + (setq buffer-file-name nil) (and org-edit-src-persistent-message (org-set-local 'header-line-format msg)) (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) @@ -336,6 +339,7 @@ buffer." t))) (defun org-edit-src-continue (e) + "Continue editing source blocks." ;; Fixme: be more accurate (interactive "e") (mouse-set-point e) (let ((buf (get-char-property (point) 'edit-buffer))) @@ -412,7 +416,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 (eq major-mode 'org-mode)) + (org-mode-p (derived-mode-p 'org-mode)) (beg (make-marker)) (end (make-marker)) (preserve-indentation org-src-preserve-indentation) @@ -436,7 +440,7 @@ the fragment in the Org-mode buffer." code (buffer-substring-no-properties beg end) begline (save-excursion (goto-char beg) (org-current-line))) (if (and (setq buffer (org-edit-src-find-buffer beg end)) - (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ")) + (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ")) (org-pop-to-buffer-same-window buffer) (when buffer (with-current-buffer buffer @@ -452,10 +456,10 @@ the fragment in the Org-mode buffer." (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") (overlay-put ovl 'face 'secondary-selection) (overlay-put ovl - 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'org-edit-src-continue) - map)) + 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'org-edit-src-continue) + map)) (overlay-put ovl :read-only "Leave me alone") (org-pop-to-buffer-same-window buffer) (insert code) @@ -586,6 +590,21 @@ the language, a switch telling if the content should be in a single line." (goto-char pos) (org-get-indentation))) +(defun org-add-protective-commas (beg end &optional line) + "Add protective commas in region. +Return the delta in size of the region." + (interactive "r") + (let ((org-re "^\\(.\\)") + (other-re "^\\([*]\\|[ \t]*#\\+\\)") + (delta 0)) + (save-excursion + (goto-char beg) + (while (re-search-forward (if (derived-mode-p 'org-mode) org-re other-re) + end t) + (if (and line (eq (org-current-line) line)) (setq delta (1+ delta))) + (replace-match ",\\1"))) + delta)) + (defun org-edit-src-exit (&optional context) "Exit special edit and protect problematic lines." (interactive) @@ -595,6 +614,7 @@ the language, a switch telling if the content should be in a single line." (let* ((beg org-edit-src-beg-marker) (end org-edit-src-end-marker) (ovl org-edit-src-overlay) + (bufstr (buffer-string)) (buffer (current-buffer)) (single (org-bound-and-true-p org-edit-src-force-single-line)) (macro (eq single 'macro-definition)) @@ -629,11 +649,8 @@ the language, a switch telling if the content should be in a single line." (goto-char (point-min)) (if (looking-at "\\s-*") (replace-match " "))) (when (org-bound-and-true-p org-edit-src-from-org-mode) - (goto-char (point-min)) - (while (re-search-forward - (if (eq major-mode 'org-mode) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t) - (if (eq (org-current-line) line) (setq delta (1+ delta))) - (replace-match ",\\1"))) + (setq delta (+ delta (org-add-protective-commas + (point-min) (point-max) line)))) (when (org-bound-and-true-p org-edit-src-picture) (setq preserve-indentation nil) (untabify (point-min) (point-max)) @@ -648,13 +665,18 @@ the language, a switch telling if the content should be in a single line." (if (org-bound-and-true-p org-edit-src-picture) (setq total-nindent (+ total-nindent 2))) (setq code (buffer-string)) + (when (eq context 'save) + (erase-buffer) + (insert bufstr)) (set-buffer-modified-p nil)) (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) - (kill-buffer buffer) + (if (eq context 'save) (save-buffer) + (kill-buffer buffer)) (goto-char beg) (when allow-write-back-p - (delete-region beg end) + (delete-region beg (1- end)) (insert code) + (delete-char 1) (goto-char beg) (if single (just-one-space))) (if (memq t (mapcar (lambda (overlay) @@ -666,28 +688,41 @@ the language, a switch telling if the content should be in a single line." ;; Block is visible, put point where it was in the code buffer (org-goto-line (1- (+ (org-current-line) line))) (org-move-to-column (if preserve-indentation col (+ col total-nindent delta)))) - (move-marker beg nil) - (move-marker end nil)) + (unless (eq context 'save) + (move-marker beg nil) + (move-marker end nil))) (unless (eq context 'save) (when org-edit-src-saved-temp-window-config (set-window-configuration org-edit-src-saved-temp-window-config) (setq org-edit-src-saved-temp-window-config nil)))) +(defmacro org-src-in-org-buffer (&rest body) + `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg) + (save-window-excursion + (org-edit-src-exit 'save) + ,@body + (setq msg (current-message)) + (if (eq org-src-window-setup 'other-frame) + (let ((org-src-window-setup 'current-window)) + (org-edit-src-code 'save)) + (org-edit-src-code 'save))) + (setq buffer-undo-list ul) + (push-mark m 'nomessage) + (goto-char (min p (point-max))) + (message (or msg "")))) +(def-edebug-spec org-src-in-org-buffer (body)) + (defun org-edit-src-save () "Save parent buffer with current state source-code buffer." (interactive) - (let ((p (point)) (m (mark)) msg) - (save-window-excursion - (org-edit-src-exit 'save) - (save-buffer) - (setq msg (current-message)) - (if (eq org-src-window-setup 'other-frame) - (let ((org-src-window-setup 'current-window)) - (org-edit-src-code 'save)) - (org-edit-src-code 'save))) - (push-mark m 'nomessage) - (goto-char (min p (point-max))) - (message (or msg "")))) + (org-src-in-org-buffer (save-buffer))) + +(declare-function org-babel-tangle "ob-tangle" (&optional only-this-block target-file lang)) + +(defun org-src-tangle (arg) + "Tangle the parent buffer." + (interactive) + (org-src-in-org-buffer (org-babel-tangle arg))) (defun org-src-mode-configure-edit-buffer () (when (org-bound-and-true-p org-edit-src-from-org-mode) @@ -739,7 +774,7 @@ remotely with point temporarily at the start of the code block in the Org buffer. This command is not bound to a key by default, to avoid conflicts -with language major mode bindings. To bind it to C-c @ in all +with language major mode bindings. To bind it to C-c @ in all language major modes, you could use (add-hook 'org-src-mode-hook @@ -777,7 +812,7 @@ mode." (defun org-src-font-lock-fontify-block (lang start end) "Fontify code block. This function is called by emacs automatic fontification, as long -as `org-src-fontify-natively' is non-nil. For manual +as `org-src-fontify-natively' is non-nil. For manual fontification of code blocks see `org-src-fontify-block' and `org-src-fontify-buffer'" (let ((lang-mode (org-src-get-lang-mode lang))) @@ -790,13 +825,13 @@ fontification of code blocks see `org-src-fontify-block' and (get-buffer-create (concat " org-src-fontification:" (symbol-name lang-mode))) (delete-region (point-min) (point-max)) - (insert (concat string " ")) ;; so there's a final property change + (insert string " ") ;; so there's a final property change (unless (eq major-mode lang-mode) (funcall lang-mode)) (font-lock-fontify-buffer) (setq pos (point-min)) (while (setq next (next-single-property-change pos 'face)) (put-text-property - (+ start (1- pos)) (+ start next) 'face + (+ start (1- pos)) (1- (+ start next)) 'face (get-text-property pos 'face) org-buffer) (setq pos next))) (add-text-properties @@ -813,7 +848,7 @@ fontification of code blocks see `org-src-fontify-block' and (font-lock-fontify-region (nth 0 info) (nth 1 info))))) (defun org-src-fontify-buffer () - "Fontify all code blocks in the current buffer" + "Fontify all code blocks in the current buffer." (interactive) (org-babel-map-src-blocks nil (org-src-fontify-block))) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index e02062a2b93..3eb63b6e53c 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -41,6 +41,7 @@ (declare-function org-table-clean-before-export "org-exp" (lines &optional maybe-quoted)) (declare-function org-format-org-table-html "org-html" (lines &optional splice)) +(declare-function aa2u "ext:ascii-art-to-unicode" ()) (defvar orgtbl-mode) ; defined below (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized (defvar org-export-html-table-tag) ; defined in org-exp.el @@ -85,7 +86,13 @@ this variable requires a restart of Emacs to become effective." <!-- #+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 | | | --->\n")) +-->\n") + (org-mode "#+ BEGIN RECEIVE ORGTBL %n +#+ END RECEIVE ORGTBL %n + +#+ORGTBL: SEND %n orgtbl-to-orgtbl :splice nil :skip 0 +| | | +")) "Templates for radio tables in different major modes. All occurrences of %n in a template will be replaced with the name of the table, obtained by prompting the user." @@ -102,7 +109,7 @@ table, obtained by prompting the user." (defcustom org-table-default-size "5x2" "The default size for newly created tables, Columns x Rows." :group 'org-table-settings - :type 'string) + :type 'string) (defcustom org-table-number-regexp "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$" @@ -131,6 +138,8 @@ Other options offered by the customize interface are more restrictive." "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") (const :tag "Very General Number-Like, including hex" "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") + (const :tag "Very General Number-Like, including hex, allows comma as decimal mark" + "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") (string :tag "Regexp:"))) (defcustom org-table-number-fraction 0.5 @@ -217,13 +226,13 @@ t accept as input and present for editing" (defcustom org-calc-default-modes '(calc-internal-prec 12 - calc-float-format (float 8) - calc-angle-mode deg - calc-prefer-frac nil - calc-symbolic-mode nil - calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm)) - calc-display-working-message t - ) + calc-float-format (float 8) + calc-angle-mode deg + calc-prefer-frac nil + calc-symbolic-mode nil + calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm)) + calc-display-working-message t + ) "List with Calc mode settings for use in `calc-eval' for table formulas. The list must contain alternating symbols (Calc modes variables and values). Don't remove any of the default settings, just change the values. Org-mode @@ -368,8 +377,8 @@ available parameters." "Vector of hline line numbers in the current table.") (defconst org-table-range-regexp - "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" - ;; 1 2 3 4 5 + "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" + ;; 1 2 3 4 5 "Regular expression for matching ranges in formulas.") (defconst org-table-range-regexp2 @@ -551,15 +560,18 @@ are found, lines will be split on whitespace into fields." (defvar org-table-last-column-widths) (defun org-table-export (&optional file format) "Export table to a file, with configurable format. -Such a file can be imported into a spreadsheet program like Excel. -FILE can be the output file name. If not given, it will be taken from -a TABLE_EXPORT_FILE property in the current entry or higher up in the -hierarchy, or the user will be prompted for a file name. -FORMAT can be an export format, of the same kind as it used when -`orgtbl-mode' sends a table in a different format. The default format can -be found in the variable `org-table-export-default-format', but the function -first checks if there is an export format specified in a TABLE_EXPORT_FORMAT -property, locally or anywhere up in the hierarchy." +Such a file can be imported into usual spreadsheet programs. + +FILE can be the output file name. If not given, it will be taken +from a TABLE_EXPORT_FILE property in the current entry or higher +up in the hierarchy, or the user will be prompted for a file +name. FORMAT can be an export format, of the same kind as it +used when `orgtbl-mode' sends a table in a different format. + +The command suggests a format depending on TABLE_EXPORT_FORMAT, +whether it is set locally or up in the hierarchy, then on the +extension of the given file name, and finally on the variable +`org-table-export-default-format'." (interactive) (unless (org-at-table-p) (error "No table at point")) @@ -569,9 +581,13 @@ property, locally or anywhere up in the hierarchy." (end (org-table-end)) (txt (buffer-substring-no-properties beg end)) (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t))) + (formats '("orgtbl-to-tsv" "orgtbl-to-csv" + "orgtbl-to-latex" "orgtbl-to-html" + "orgtbl-to-generic" "orgtbl-to-texinfo" + "orgtbl-to-orgtbl")) (format (or format (org-entry-get beg "TABLE_EXPORT_FORMAT" t))) - buf deffmt-readable) + buf deffmt-readable fileext) (unless file (setq file (read-file-name "Export table to: ")) (unless (or (not (file-exists-p file)) @@ -583,19 +599,16 @@ property, locally or anywhere up in the hierarchy." (equal (file-truename file) (file-truename (buffer-file-name)))) (error "Please specify a file name that is different from current")) + (setq fileext (concat (file-name-extension file) "$")) (unless format - (setq deffmt-readable org-table-export-default-format) + (setq deffmt-readable + (or (car (delq nil (mapcar (lambda(f) (if (string-match fileext f) f)) formats))) + org-table-export-default-format)) (while (string-match "\t" deffmt-readable) (setq deffmt-readable (replace-match "\\t" t t deffmt-readable))) (while (string-match "\n" deffmt-readable) (setq deffmt-readable (replace-match "\\n" t t deffmt-readable))) - (setq format (org-completing-read - "Format: " - '("orgtbl-to-tsv" "orgtbl-to-csv" - "orgtbl-to-latex" "orgtbl-to-html" - "orgtbl-to-generic" "orgtbl-to-texinfo" - "orgtbl-to-orgtbl") nil nil - deffmt-readable))) + (setq format (org-completing-read "Format: " formats nil nil deffmt-readable))) (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format) (let* ((transform (intern (match-string 1 format))) (params (if (match-end 2) @@ -695,7 +708,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (re-search-forward org-emph-re end t))) (goto-char beg) (setq raise (and org-use-sub-superscripts - (re-search-forward org-match-substring-regexp end t))) + (re-search-forward org-match-substring-regexp end t))) (goto-char beg) (setq dates (and org-display-custom-times (re-search-forward org-ts-regexp-both end t))) @@ -732,7 +745,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; Get the data fields by splitting the lines. (setq fields (mapcar (lambda (l) - (org-split-string l " *| *")) + (org-split-string l " *| *")) (delq nil (copy-sequence lines)))) ;; How many fields in the longest line? (condition-case nil @@ -764,7 +777,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (> (org-string-width xx) fmax)) (org-add-props xx nil 'help-echo - (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) + (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) (unless (> f1 1) (error "Cannot narrow field starting with wide link \"%s\"" @@ -833,7 +846,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 (eq major-mode 'org-mode))) + (when (and orgtbl-mode (not (derived-mode-p 'org-mode))) (goto-char org-table-aligned-begin-marker) (while (org-hide-wide-columns org-table-aligned-end-marker))) ;; Try to move to the old location @@ -1319,8 +1332,8 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." (while (< i ll) (if (>= (aref org-table-dlines i) line) (throw 'exit i)) - (setq i (1+ i))))) - nil)) + (setq i (1+ i))))) + nil)) (defun org-table-delete-column () "Delete a column from the table." @@ -1627,8 +1640,8 @@ with `org-table-paste-rectangle'." (if (org-region-active-p) (region-end) (point)) current-prefix-arg)) (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 - region cols - (rpl (if cut " " nil))) + region cols + (rpl (if cut " " nil))) (goto-char beg) (org-table-check-inside-data-field) (setq l01 (org-current-line) @@ -2088,22 +2101,23 @@ When NAMED is non-nil, look for a named equation." (defun org-table-store-formulas (alist) "Store the list of formulas below the current table." (setq alist (sort alist 'org-table-formula-less-p)) - (save-excursion - (goto-char (org-table-end)) - (if (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM:\\(.*\n?\\)") - (progn - ;; don't overwrite TBLFM, we might use text properties to store stuff - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 0))) - (org-indent-line-function) - (insert "#+TBLFM:")) - (insert " " - (mapconcat (lambda (x) - (concat - (if (equal (string-to-char (car x)) ?@) "" "$") - (car x) "=" (cdr x))) - alist "::") - "\n"))) + (let ((case-fold-search t)) + (save-excursion + (goto-char (org-table-end)) + (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)") + (progn + ;; don't overwrite TBLFM, we might use text properties to store stuff + (goto-char (match-beginning 3)) + (delete-region (match-beginning 3) (match-end 0))) + (org-indent-line) + (insert (or (match-string 2) "#+TBLFM:"))) + (insert " " + (mapconcat (lambda (x) + (concat + (if (equal (string-to-char (car x)) ?@) "" "$") + (car x) "=" (cdr x))) + alist "::") + "\n")))) (defsubst org-table-formula-make-cmp-string (a) (when (string-match "\\`$[<>]" a) @@ -2133,10 +2147,10 @@ When NAMED is non-nil, look for a named equation." (defun org-table-get-stored-formulas (&optional noerror) "Return an alist with the stored formulas directly after current table." (interactive) - (let (scol eq eq-alist strings string seen) + (let ((case-fold-search t) scol eq eq-alist strings string seen) (save-excursion (goto-char (org-table-end)) - (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") + (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)") (setq strings (org-split-string (org-match-string-no-properties 2) " *:: *")) (while (setq string (pop strings)) @@ -2164,8 +2178,9 @@ KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. For all numbers larger than LIMIT, shift them by DELTA." (save-excursion (goto-char (org-table-end)) - (when (looking-at "[ \t]*#\\+TBLFM:") - (let ((re (concat key "\\([0-9]+\\)")) + (when (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) + (let ((msg "The formulas in #+TBLFM have been updated") + (re (concat key "\\([0-9]+\\)")) (re2 (when remove (if (or (equal key "$") (equal key "$LR")) @@ -2177,7 +2192,7 @@ For all numbers larger than LIMIT, shift them by DELTA." (while (re-search-forward re2 (point-at-eol) t) (unless (save-match-data (org-in-regexp "remote([^)]+?)")) (if (equal (char-before (match-beginning 0)) ?.) - (error "Change makes TBLFM term %s invalid. Use undo to recover." + (error "Change makes TBLFM term %s invalid, use undo to recover" (match-string 0)) (replace-match ""))))) (while (re-search-forward re (point-at-eol) t) @@ -2185,10 +2200,11 @@ For all numbers larger than LIMIT, shift them by DELTA." (setq s (match-string 1) n (string-to-number s)) (cond ((setq a (assoc s replace)) - (replace-match (concat key (cdr a)) t t)) + (replace-match (concat key (cdr a)) t t) + (message msg)) ((and limit (> n limit)) - (replace-match (concat key (int-to-string (+ n delta))) - t t))))))))) + (replace-match (concat key (int-to-string (+ n delta))) t t) + (message msg))))))))) (defun org-table-get-specials () "Get the column names and local parameters for this table." @@ -2234,8 +2250,8 @@ For all numbers larger than LIMIT, shift them by DELTA." (setq v (pop fields1) col (1+ col)) (when (and (stringp field) (stringp v) (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field)) - (push (cons field v) org-table-local-parameters) - (push (list field line col) org-table-named-field-locations)))) + (push (cons field v) org-table-local-parameters) + (push (list field line col) org-table-named-field-locations)))) ;; Analyse the line types (goto-char beg) (setq org-table-current-begin-line (org-current-line) @@ -2275,7 +2291,7 @@ If yes, store the formula and apply it." (when org-table-formula-evaluate-inline (let* ((field (org-trim (or (org-table-get-field) ""))) named eq) - (when (string-match "^:?=\\(.*\\)" field) + (when (string-match "^:?=\\(.*[^=]\\)$" field) (setq named (equal (string-to-char field) ?:) eq (match-string 1 field)) (if (or (fboundp 'calc-eval) @@ -2292,8 +2308,8 @@ Will be filled automatically during use.") '((" " . "Unmarked: no special line, no automatic recalculation") ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") - ("!" . "Column name definition line. Reference in formula as $name.") - ("$" . "Parameter definition line name=value. Reference in formula as $name.") + ("!" . "Column name definition line. Reference in formula as $name.") + ("$" . "Parameter definition line name=value. Reference in formula as $name.") ("_" . "Names for values in row below this one.") ("^" . "Names for values in row above this one."))) @@ -2489,8 +2505,7 @@ not overwrite the stored one." (setq orig (or (get-text-property 1 :orig-formula formula) "?")) (while (> ndown 0) (setq fields (org-split-string - (org-no-properties - (buffer-substring (point-at-bol) (point-at-eol))) + (buffer-substring-no-properties (point-at-bol) (point-at-eol)) " *| *")) ;; replace fields with duration values if relevant (if duration @@ -2589,10 +2604,17 @@ not overwrite the stored one." duration-output-format) ev)) (or (fboundp 'calc-eval) (error "Calc does not seem to be installed, and is needed to evaluate the formula")) - (setq ev (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num)) + ;; "Inactivate" time-stamps so that Calc can handle them + (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form)) + (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) + form + (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num))) ev (if duration (org-table-time-seconds-to-string - (string-to-number ev) - duration-output-format) ev))) + (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) + (string-to-number (org-table-time-string-to-seconds ev)) + (string-to-number ev)) + duration-output-format) + ev))) (when org-table-formula-debug (with-output-to-temp-buffer "*Substitution History*" @@ -2666,7 +2688,7 @@ in the buffer and column1 and column2 are table column numbers." (if (equal r2 "") (setq r2 nil)) (if r1 (setq r1 (org-table-get-descriptor-line r1))) (if r2 (setq r2 (org-table-get-descriptor-line r2))) -; (setq r2 (or r2 r1) c2 (or c2 c1)) + ; (setq r2 (or r2 r1) c2 (or c2 c1)) (if (not r1) (setq r1 thisline)) (if (not r2) (setq r2 thisline)) (if (or (not c1) (= 0 c1)) (setq c1 col)) @@ -2881,7 +2903,7 @@ known that the table will be realigned a little later anyway." (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a)) (nth 2 a)))) (when (member name1 seen-fields) - (error "Several field/range formulas try to set %s" name1)) + (error "Several field/range formulas try to set %s" name1)) (push name1 seen-fields) (and (not a) @@ -2961,6 +2983,7 @@ with the prefix ARG." (throw 'exit t))) (error "No convergence after %d iterations" i)))) +;;;###autoload (defun org-table-recalculate-buffer-tables () "Recalculate all tables in the current buffer." (interactive) @@ -2969,27 +2992,28 @@ with the prefix ARG." (widen) (org-table-map-tables (lambda () (org-table-recalculate t)) t)))) +;;;###autoload (defun org-table-iterate-buffer-tables () "Iterate all tables in the buffer, to converge inter-table dependencies." - (interactive) - (let* ((imax 10) - (checksum (md5 (buffer-string))) - - c1 - (i imax)) - (save-excursion - (save-restriction - (widen) - (catch 'exit - (while (> i 0) - (setq i (1- i)) - (org-table-map-tables (lambda () (org-table-recalculate t)) t) - (if (equal checksum (setq c1 (md5 (buffer-string)))) - (progn - (message "Convergence after %d iterations" (- imax i)) - (throw 'exit t)) - (setq checksum c1))) - (error "No convergence after %d iterations" imax)))))) + (interactive) + (let* ((imax 10) + (checksum (md5 (buffer-string))) + + c1 + (i imax)) + (save-excursion + (save-restriction + (widen) + (catch 'exit + (while (> i 0) + (setq i (1- i)) + (org-table-map-tables (lambda () (org-table-recalculate t)) t) + (if (equal checksum (setq c1 (md5 (buffer-string)))) + (progn + (message "Convergence after %d iterations" (- imax i)) + (throw 'exit t)) + (setq checksum c1))) + (error "No convergence after %d iterations" imax)))))) (defun org-table-expand-lhs-ranges (equations) "Expand list of formulas. @@ -2999,7 +3023,7 @@ them to individual field equations for each field." (while (setq e (pop equations)) (setq lhs (car e) rhs (cdr e)) (cond - ((string-match "^@-?[-+I0-9]+\\$-?[0-9]+$" lhs) + ((string-match "^@-?[-+0-9]+\\$-?[0-9]+$" lhs) ;; This just refers to one fixed field (push e res)) ((string-match "^[a-zA-Z][_a-zA-Z0-9]*$" lhs) @@ -3143,7 +3167,7 @@ Parameters get priority." (defun org-table-edit-formulas () "Edit the formulas of the current table in a separate buffer." (interactive) - (when (save-excursion (beginning-of-line 1) (looking-at "[ \t]*#\\+TBLFM")) + (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM"))) (beginning-of-line 0)) (unless (org-at-table-p) (error "Not at a table")) (org-table-get-specials) @@ -3217,7 +3241,7 @@ Parameters get priority." Works for single references, but also for entire formulas and even the full TBLFM line." (let ((start 0)) - (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^)]*)\\)" s start) + (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^,)]*)\\)" s start) (cond ((match-end 3) ;; format match, just advance @@ -3268,8 +3292,8 @@ For example: AB -> 28." (let ((n 0)) (setq s (upcase s)) (while (> (length s) 0) - (setq n (+ (* n 26) (string-to-char s) (- ?A) 1) - s (substring s 1))) + (setq n (+ (* n 26) (string-to-char s) (- ?A) 1) + s (substring s 1))) n)) (defun org-number-to-letters (n) @@ -3285,26 +3309,28 @@ For example: 28 -> AB." "Convert a time string into numerical duration in seconds. S can be a string matching either -?HH:MM:SS or -?HH:MM. If S is a string representing a number, keep this number." - (let (hour minus min sec res) - (cond - ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s)) - (setq minus (< 0 (length (match-string 1 s))) - hour (string-to-number (match-string 2 s)) - min (string-to-number (match-string 3 s)) - sec (string-to-number (match-string 4 s))) - (if minus - (setq res (- (+ (* hour 3600) (* min 60) sec))) - (setq res (+ (* hour 3600) (* min 60) sec)))) - ((and (not (string-match org-ts-regexp-both s)) - (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s)) - (setq minus (< 0 (length (match-string 1 s))) - hour (string-to-number (match-string 2 s)) - min (string-to-number (match-string 3 s))) - (if minus - (setq res (- (+ (* hour 3600) (* min 60)))) - (setq res (+ (* hour 3600) (* min 60))))) - (t (setq res (string-to-number s)))) - (number-to-string res))) + (if (equal s "") + s + (let (hour minus min sec res) + (cond + ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s)) + (setq minus (< 0 (length (match-string 1 s))) + hour (string-to-number (match-string 2 s)) + min (string-to-number (match-string 3 s)) + sec (string-to-number (match-string 4 s))) + (if minus + (setq res (- (+ (* hour 3600) (* min 60) sec))) + (setq res (+ (* hour 3600) (* min 60) sec)))) + ((and (not (string-match org-ts-regexp-both s)) + (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s)) + (setq minus (< 0 (length (match-string 1 s))) + hour (string-to-number (match-string 2 s)) + min (string-to-number (match-string 3 s))) + (if minus + (setq res (- (+ (* hour 3600) (* min 60)))) + (setq res (+ (* hour 3600) (* min 60))))) + (t (setq res (string-to-number s)))) + (number-to-string res)))) (defun org-table-time-seconds-to-string (secs &optional output-format) "Convert a number of seconds to a time string. @@ -3570,7 +3596,7 @@ With prefix ARG, apply the new formulas to the table." (if (get-buffer-window (marker-buffer pos)) (select-window (get-buffer-window (marker-buffer pos))) (org-switch-to-buffer-other-window (get-buffer-window - (marker-buffer pos))))) + (marker-buffer pos))))) (goto-char pos) (org-table-force-dataline) (when dest @@ -3779,7 +3805,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." "Toggle the display of Row/Column numbers in tables." (interactive) (setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) - (message "Row/Column number display turned %s" + (message "Tables Row/Column numbers display turned %s" (if org-table-overlay-coordinates "on" "off")) (if (and (org-at-table-p) org-table-overlay-coordinates) (org-table-align)) @@ -3835,7 +3861,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." "Local variable used by `orgtbl-mode'.") (defconst orgtbl-line-start-regexp - "[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\|TBLNAME\\):\\)" + "[ \t]*\\(|\\|#\\+\\(tblfm\\|orgtbl\\|tblname\\):\\)" "Matches a line belonging to an orgtbl.") (defconst orgtbl-extra-font-lock-keywords @@ -3853,7 +3879,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 - ((eq major-mode 'org-mode) + ((derived-mode-p 'org-mode) ;; Exit without error, in case some hook functions calls this ;; by accident in org-mode. (message "Orgtbl-mode is not useful in org-mode, command ignored")) @@ -3975,37 +4001,37 @@ to execute outside of tables." ;; Special treatment needed for TAB and RET (org-defkey orgtbl-mode-map [(return)] - (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) + (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) (org-defkey orgtbl-mode-map "\C-m" - (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) + (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) (org-defkey orgtbl-mode-map [(tab)] - (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) + (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) (org-defkey orgtbl-mode-map "\C-i" - (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) + (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) (org-defkey orgtbl-mode-map [(shift tab)] - (orgtbl-make-binding 'org-table-previous-field 104 - [(shift tab)] [(tab)] "\C-i")) + (orgtbl-make-binding 'org-table-previous-field 104 + [(shift tab)] [(tab)] "\C-i")) (unless (featurep 'xemacs) (org-defkey orgtbl-mode-map [S-iso-lefttab] - (orgtbl-make-binding 'org-table-previous-field 107 - [S-iso-lefttab] [backtab] [(shift tab)] - [(tab)] "\C-i"))) + (orgtbl-make-binding 'org-table-previous-field 107 + [S-iso-lefttab] [backtab] [(shift tab)] + [(tab)] "\C-i"))) (org-defkey orgtbl-mode-map [backtab] - (orgtbl-make-binding 'org-table-previous-field 108 - [backtab] [S-iso-lefttab] [(shift tab)] - [(tab)] "\C-i")) + (orgtbl-make-binding 'org-table-previous-field 108 + [backtab] [S-iso-lefttab] [(shift tab)] + [(tab)] "\C-i")) (org-defkey orgtbl-mode-map "\M-\C-m" - (orgtbl-make-binding 'org-table-wrap-region 105 - "\M-\C-m" [(meta return)])) + (orgtbl-make-binding 'org-table-wrap-region 105 + "\M-\C-m" [(meta return)])) (org-defkey orgtbl-mode-map [(meta return)] - (orgtbl-make-binding 'org-table-wrap-region 106 - [(meta return)] "\M-\C-m")) + (orgtbl-make-binding 'org-table-wrap-region 106 + [(meta return)] "\M-\C-m")) (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) (org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region) @@ -4083,13 +4109,13 @@ to execute outside of tables." If it is a table to be sent away to a receiver, do it. With prefix arg, also recompute table." (interactive "P") - (let ((pos (point)) action consts-str consts cst const-str) + (let ((case-fold-search t) (pos (point)) action consts-str consts cst const-str) (save-excursion (beginning-of-line 1) (setq action (cond ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) ((looking-at "[ \t]*|") pos) - ((looking-at "[ \t]*#\\+TBLFM:") 'recalc)))) + ((looking-at "[ \t]*#\\+tblfm:") 'recalc)))) (cond ((integerp action) (goto-char action) @@ -4178,7 +4204,7 @@ overwritten, and the table is not marked as requiring realignment." (setq a (assoc last-input-event function-key-map)) (cdr a)) (vector last-input-event))) - 'self-insert-command))) + 'self-insert-command))) (call-interactively cmd) (if (and org-self-insert-cluster-for-undo (eq cmd 'self-insert-command)) @@ -4298,11 +4324,15 @@ this table." (params (plist-get dest :params)) (skip (plist-get params :skip)) (skipcols (plist-get params :skipcols)) + (no-escape (plist-get params :no-escape)) beg (lines (org-table-clean-before-export (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*")))) (i0 (if org-table-clean-did-remove-column 2 1)) + (lines (if no-escape lines + (mapcar (lambda(l) (replace-regexp-in-string + "\\([&%#_^]\\)" "\\\\\\1{}" l)) lines))) (table (mapcar (lambda (x) (if (string-match org-table-hline-regexp x) @@ -4324,7 +4354,7 @@ this table." (orgtbl-send-replace-tbl name txt)) (setq ntbl (1+ ntbl))) (message "Table converted and installed at %d receiver location%s" - ntbl (if (> ntbl 1) "s" "")) + ntbl (if (> ntbl 1) "s" "")) (if (> ntbl 0) ntbl nil)))) @@ -4344,12 +4374,13 @@ First element has index 0, or I0 if given." (defun orgtbl-toggle-comment () "Comment or uncomment the orgtbl at point." (interactive) - (let* ((re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) + (let* ((case-fold-search t) + (re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) (re2 (concat "^" orgtbl-line-start-regexp)) (commented (save-excursion (beginning-of-line 1) - (cond ((looking-at re1) t) - ((looking-at re2) nil) - (t (error "Not at an org table"))))) + (cond ((looking-at re1) t) + ((looking-at re2) nil) + (t (error "Not at an org table"))))) (re (if commented re1 re2)) beg end) (save-excursion @@ -4458,7 +4489,7 @@ PARAMS is a property list of parameters that can influence the conversion. For the generic converter, some parameters are obligatory: you need to specify either :lfmt, or all of (:lstart :lend :sep). -Valid parameters are +Valid parameters are: :splice When set to t, return only table body lines, don't wrap them into :tstart and :tend. Default is nil. When :splice @@ -4471,9 +4502,9 @@ Valid parameters are :sep Separator between two fields :remove-nil-lines Do not include lines that evaluate to nil. - Each in the following group may be either a string or a function of no arguments returning a string: + :tstart String to start the table. Ignored when :splice is t. :tend String to end the table. Ignored when :splice is t. :lstart String to start a new table line. @@ -4484,6 +4515,7 @@ of no arguments returning a string: Each in the following group may be a string, a function of one argument (the field or line) returning a string, or a plist mapping columns to either of the above: + :lfmt Format for entire line, with enough %s to capture all fields. If this is present, :lstart, :lend, and :sep are ignored. :llfmt Format for the entire last line, defaults to :lfmt. @@ -4491,14 +4523,14 @@ mapping columns to either of the above: %s for the original field value. For example, to wrap everything in dollars, you could use :fmt \"$%s$\". This may also be a property list with column numbers and - formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") - + formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") :hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt Same as above, specific for the header lines in the table. All lines before the first hline are treated as header. If any of these is not present, the data line value is used. This may be either a string or a function of two arguments: + :efmt Use this format to print numbers with exponentials. The format should have %s twice for inserting mantissa and exponent, for example \"%s\\\\times10^{%s}\". This @@ -4507,10 +4539,9 @@ This may be either a string or a function of two arguments: In addition to this, the parameters :skip and :skipcols are always handled directly by `orgtbl-send-table'. See manual." - (interactive) - (let* ((splicep (plist-get params :splice)) (hline (plist-get params :hline)) + (skipheadrule (plist-get params :skipheadrule)) (remove-nil-linesp (plist-get params :remove-nil-lines)) (remove-newlines (plist-get params :remove-newlines)) (*orgtbl-hline* hline) @@ -4556,7 +4587,7 @@ directly by `orgtbl-send-table'. See manual." (*orgtbl-sep* (or (plist-get params :hlsep) *orgtbl-sep*)) (*orgtbl-fmt* (or (plist-get params :hfmt) *orgtbl-fmt*))) (orgtbl-format-section 'hline)) - (if hline (push hline *orgtbl-rtn*)) + (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*)) (pop *orgtbl-table*))) ;; Now format the main section. @@ -4706,7 +4737,37 @@ provide ORGTBL directives for the generated table." :lstart "| " :lend " |")) (params (org-combine-plists params2 params))) - (orgtbl-to-generic table params))) + (with-temp-buffer + (insert (orgtbl-to-generic table params)) + (goto-char (point-min)) + (while (re-search-forward org-table-hline-regexp nil t) + (org-table-align)) + (buffer-substring 1 (buffer-size))))) + +(defun orgtbl-to-table.el (table params) + "Convert the orgtbl-mode TABLE into a table.el table." + (with-temp-buffer + (insert (orgtbl-to-orgtbl table params)) + (org-table-align) + (replace-regexp-in-string + "-|" "-+" + (replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size)))))) + +(defun orgtbl-to-unicode (table params) + "Convert the orgtbl-mode TABLE into a table with unicode characters. +You need the ascii-art-to-unicode.el package for this. You can download +it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." + (with-temp-buffer + (insert (orgtbl-to-table.el table params)) + (goto-char (point-min)) + (if (or (featurep 'ascii-art-to-unicode) + (require 'ascii-art-to-unicode nil t)) + (aa2u) + (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links)) + (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el" + "Link to ascii-art-to-unicode.el") org-stored-links)) + (error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) + (buffer-string))) (defun org-table-get-remote-range (name-or-id form) "Get a field value or a list of values in a range from table at ID. @@ -4722,7 +4783,7 @@ FORM is a field or range descriptor like \"@2$3\" or \"B3\" or The return value is either a single string for a single field, or a list of the fields in the rectangle ." (save-match-data - (let ((id-loc nil) + (let ((case-fold-search t) (id-loc nil) ;; Protect a bunch of variables from being overwritten ;; by the context of the remote table org-table-column-names org-table-column-name-regexp @@ -4741,7 +4802,7 @@ list of the fields in the rectangle ." (save-excursion (goto-char (point-min)) (if (re-search-forward - (concat "^[ \t]*#\\+TBLNAME:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") + (concat "^[ \t]*#\\+tblname:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") nil t) (setq buffer (current-buffer) loc (match-beginning 0)) (setq id-loc (org-id-find name-or-id 'marker)) diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el index 4409013589f..aa645d296e8 100644 --- a/lisp/org/org-taskjuggler.el +++ b/lisp/org/org-taskjuggler.el @@ -29,7 +29,7 @@ ;; ;; This library implements a TaskJuggler exporter for org-mode. ;; TaskJuggler uses a text format to define projects, tasks and -;; resources, so it is a natural fit for org-mode. It can produce all +;; resources, so it is a natural fit for org-mode. It can produce all ;; sorts of reports for tasks or resources in either HTML, CSV or PDF. ;; The current version of TaskJuggler requires KDE but the next ;; version is implemented in Ruby and should therefore run on any @@ -42,7 +42,7 @@ ;; ;; Instead the TaskJuggler exporter looks for a tree that defines the ;; tasks and a optionally tree that defines the resources for this -;; project. It then creates a TaskJuggler file based on these trees +;; project. It then creates a TaskJuggler file based on these trees ;; and the attributes defined in all the nodes. ;; ;; * Installation @@ -60,8 +60,8 @@ ;; ;; * Tasks ;; -;; Let's illustrate the usage with a small example. Create your tasks -;; as you usually do with org-mode. Assign efforts to each task using +;; Let's illustrate the usage with a small example. Create your tasks +;; as you usually do with org-mode. Assign efforts to each task using ;; properties (it's easiest to do this in the column view). You should ;; end up with something similar to the example by Peter Jones in ;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org. @@ -75,7 +75,7 @@ ;; * Resources ;; ;; Next you can define resources and assign those to work on specific -;; tasks. You can group your resources hierarchically. Tag the top +;; tasks. You can group your resources hierarchically. Tag the top ;; node of the resources with "taskjuggler_resource" (or whatever you ;; customized `org-export-taskjuggler-resource-tag' to). You can ;; optionally assign an identifier (named "resource_id") to the @@ -84,8 +84,8 @@ ;; picks the first word of the headline as the identifier as long as ;; it is unique, see the documentation of ;; `org-taskjuggler-get-unique-id'). Using that identifier you can -;; then allocate resources to tasks. This is again done with the -;; "allocate" property on the tasks. Do this in column view or when on +;; then allocate resources to tasks. This is again done with the +;; "allocate" property on the tasks. Do this in column view or when on ;; the task type ;; ;; C-c C-x p allocate RET <resource_id> RET @@ -110,13 +110,13 @@ ;; The exporter will handle dependencies that are defined in the tasks ;; either with the ORDERED attribute (see TODO dependencies in the Org ;; mode manual) or with the BLOCKER attribute (see org-depend.el) or -;; alternatively with a depends attribute. Both the BLOCKER and the +;; alternatively with a depends attribute. Both the BLOCKER and the ;; depends attribute can be either "previous-sibling" or a reference ;; to an identifier (named "task_id") which is defined for another -;; task in the project. BLOCKER and the depends attribute can define -;; multiple dependencies separated by either space or comma. You can +;; task in the project. BLOCKER and the depends attribute can define +;; multiple dependencies separated by either space or comma. You can ;; also specify optional attributes on the dependency by simply -;; appending it. The following examples should illustrate this: +;; appending it. The following examples should illustrate this: ;; ;; * Training material ;; :PROPERTIES: @@ -144,7 +144,7 @@ ;; org-global-properties-fixed ;; - What about property inheritance and org-property-inherit-p? ;; - Use TYPE_TODO as an way to assign resources -;; - Make sure multiple dependency definitions (i.e. BLOCKER on +;; - Make sure multiple dependency definitions (i.e. BLOCKER on ;; previous-sibling and on a specific task_id) in multiple ;; attributes are properly exported. ;; @@ -211,7 +211,7 @@ with `org-export-taskjuggler-project-tag'" hideresource 1 loadunit shortauto }" -"resourcereport \"Resource Graph\" { + "resourcereport \"Resource Graph\" { headline \"Resource Allocation Graph\" columns no, name, utilization, freeload, chart loadunit shortauto @@ -228,10 +228,10 @@ with `org-export-taskjuggler-project-tag'" workinghours wed, thu, fri off } " - "Default global properties for the project. Here you typically + "Default global properties for the project. Here you typically define global properties such as shifts, accounts, rates, -vacation, macros and flags. Any property that is allowed within -the TaskJuggler file can be inserted. You could for example +vacation, macros and flags. Any property that is allowed within +the TaskJuggler file can be inserted. You could for example include another TaskJuggler file. The global properties are inserted after the project declaration @@ -255,12 +255,12 @@ but before any resource and task declarations." "Export parts of the current buffer as a TaskJuggler file. The exporter looks for a tree with tag, property or todo that matches `org-export-taskjuggler-project-tag' and takes this as -the tasks for this project. The first node of this tree defines +the tasks for this project. The first node of this tree defines the project properties such as project name and project period. If there is a tree with tag, property or todo that matches `org-export-taskjuggler-resource-tag' this three is taken as -resources for the project. If no resources are specified, a -default resource is created and allocated to the project. Also +resources for the project. If no resources are specified, a +default resource is created and allocated to the project. Also the taskjuggler project will be created with default reports as defined in `org-export-taskjuggler-default-reports'." (interactive) @@ -352,7 +352,7 @@ with the TaskJuggler GUI." (defun org-taskjuggler-parent-is-ordered-p () "Return true if the parent of the current node has a property -\"ORDERED\". Return nil otherwise." +\"ORDERED\". Return nil otherwise." (save-excursion (and (org-up-heading-safe) (org-entry-get (point) "ORDERED")))) @@ -373,7 +373,7 @@ information, all the properties, etc." (defun org-taskjuggler-assign-task-ids (tasks) "Given a list of tasks return the same list assigning a unique id -and the full path to each task. Taskjuggler takes hierarchical ids. +and the full path to each task. Taskjuggler takes hierarchical ids. For that reason we have to make ids locally unique and we have to keep a path to the current task." (let ((previous-level 0) @@ -406,7 +406,7 @@ a path to the current task." (defun org-taskjuggler-compute-task-leafiness (tasks) "Figure out if each task is a leaf by looking at it's level, -and the level of its successor. If the successor is higher (ie +and the level of its successor. If the successor is higher (ie deeper), then it's not a leaf." (let (new-list) (while (car tasks) @@ -452,8 +452,8 @@ unique id to each resource." (and depends (org-taskjuggler-tokenize-dependencies depends)) (and blocker (org-taskjuggler-tokenize-dependencies blocker))) tasks)) - previous-sibling) - ; update previous sibling info + previous-sibling) + ; update previous sibling info (cond ((< previous-level level) (dotimes (tmp (- level previous-level)) @@ -466,11 +466,11 @@ unique id to each resource." (pop siblings)) (setq previous-sibling (car siblings)) (setcar siblings task))) - ; insert a dependency on previous sibling if the parent is - ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling" + ; insert a dependency on previous sibling if the parent is + ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling" (when (or (and previous-sibling parent-ordered) blocked-on-previous) (push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies)) - ; store dependency information + ; store dependency information (when dependencies (push (cons "depends" (mapconcat 'identity dependencies ", ")) task)) (setq previous-level level) @@ -480,7 +480,7 @@ unique id to each resource." "Split a dependency property value DEPENDENCIES into the individual dependencies and return them as a list while keeping the optional arguments (such as gapduration) for the -dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'." +dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'." (cond ((string-match "^ *$" dependencies) nil) ((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies) @@ -493,7 +493,7 @@ dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'." "For each dependency in DEPENDENCIES try to find a corresponding task with a matching property \"task_id\" in TASKS. Return a list containing the resolved links for all DEPENDENCIES -where a matching tasks was found. If the dependency is +where a matching tasks was found. If the dependency is \"previous-sibling\" it is ignored (as this is dealt with in `org-taskjuggler-resolve-dependencies'). If there is no matching task the dependency is ignored and a warning is displayed ." @@ -523,7 +523,7 @@ task the dependency is ignored and a warning is displayed ." (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)))))) (defun org-taskjuggler-find-task-with-id (id tasks) - "Find ID in tasks. If found return the path of task. Otherwise + "Find ID in tasks. If found return the path of task. Otherwise return nil." (let ((task-id (cdr (assoc "task_id" (car tasks)))) (path (cdr (assoc "path" (car tasks))))) @@ -541,10 +541,10 @@ finally add more underscore characters (\"_\")." (let* ((headline (cdr (assoc "headline" item))) (parts (split-string headline)) (id (org-taskjuggler-clean-id (downcase (pop parts))))) - ; try to add more parts of the headline to make it unique + ; try to add more parts of the headline to make it unique (while (and (member id unique-ids) (car parts)) (setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts)))))) - ; if its still not unique add "_" + ; if its still not unique add "_" (while (member id unique-ids) (setq id (concat id "_"))) id)) @@ -559,8 +559,8 @@ finally add more underscore characters (\"_\")." (replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id)))) (defun org-taskjuggler-open-project (project) - "Insert the beginning of a project declaration. All valid -attributes from the PROJECT alist are inserted. If no end date is + "Insert the beginning of a project declaration. All valid +attributes from the PROJECT alist are inserted. If no end date is specified it is calculated `org-export-taskjuggler-default-project-duration' days from now." (let* ((unique-id (cdr (assoc "unique-id" project))) @@ -580,9 +580,9 @@ with separator \"\n\"." (and filtered-items (mapconcat 'identity filtered-items "\n")))) (defun org-taskjuggler-get-attributes (item attributes) - "Return all attribute as a single formatted string. ITEM is an -alist representing either a resource or a task. ATTRIBUTES is a -list of symbols. Only entries from ITEM are considered that are + "Return all attribute as a single formatted string. ITEM is an +alist representing either a resource or a task. ATTRIBUTES is a +list of symbols. Only entries from ITEM are considered that are listed in ATTRIBUTES." (org-taskjuggler-filter-and-join (mapcar @@ -603,10 +603,10 @@ If the ATTRIBUTE is not in ITEM return nil." (t (org-taskjuggler-get-attribute (cdr item) attribute)))) (defun org-taskjuggler-open-resource (resource) - "Insert the beginning of a resource declaration. All valid -attributes from the RESOURCE alist are inserted. If the RESOURCE + "Insert the beginning of a resource declaration. All valid +attributes from the RESOURCE alist are inserted. If the RESOURCE defines a property \"resource_id\" it will be used as the id for -this resource. Otherwise it will use the ID property. If neither +this resource. Otherwise it will use the ID property. If neither is defined it will calculate a unique id for the resource using `org-taskjuggler-get-unique-id'." (let ((id (org-taskjuggler-clean-id @@ -622,7 +622,7 @@ is defined it will calculate a unique id for the resource using (defun org-taskjuggler-clean-effort (effort) "Translate effort strings into a format acceptable to taskjuggler, -i.e. REAL UNIT. A valid effort string can be anything that is +i.e. REAL UNIT. A valid effort string can be anything that is accepted by `org-duration-string-to-minutes´." (cond ((null effort) effort) diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index a3bde0fd7f6..92aaf1c7bb8 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -56,6 +56,22 @@ When 0, the user is prompted for a value." :version "24.1" :type 'number) +(defcustom org-timer-display 'mode-line + "When a timer is running, org-mode can display it in the mode +line and/or frame title. +Allowed values are: + +both displays in both mode line and frame title +mode-line displays only in mode line (default) +frame-title displays only in frame title +nil current timer is not displayed" + :group 'org-time + :type '(choice + (const :tag "Mode line" mode-line) + (const :tag "Frame title" frame-title) + (const :tag "Both" both) + (const :tag "None" nil))) + (defvar org-timer-start-hook nil "Hook run after relative timer is started.") @@ -66,7 +82,7 @@ When 0, the user is prompted for a value." "Hook run before relative timer is paused.") (defvar org-timer-continue-hook nil - "Hook run after relative timer is continued.") + "Hook run after relative timer is continued.") (defvar org-timer-set-hook nil "Hook run after countdown timer is set.") @@ -114,6 +130,7 @@ the region 0:00:00." (org-timer-secs-to-hms (or delta 0))) (run-hooks 'org-timer-start-hook)))) +;;;###autoload (defun org-timer-pause-or-continue (&optional stop) "Pause or continue the relative timer. With prefix arg STOP, stop it entirely." @@ -140,6 +157,7 @@ With prefix arg STOP, stop it entirely." (org-timer-set-mode-line 'pause) (message "Timer paused at %s" (org-timer-value-string))))) +;;;###autoload (defun org-timer-stop () "Stop the relative timer." (interactive) @@ -181,7 +199,7 @@ it in the buffer." (defun org-timer-change-times-in-region (beg end delta) "Change all h:mm:ss time in region by a DELTA." (interactive - "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ") + "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ") (let ((re "[-+]?[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}") p) (unless (string-match "\\S-" delta) (save-excursion @@ -224,7 +242,7 @@ it in the buffer." ;; Else, start a new list. (t (beginning-of-line) - (org-indent-line-function) + (org-indent-line) (insert "- ") (org-timer (when arg '(4))) (insert ":: "))))) @@ -270,32 +288,54 @@ If the integer is negative, the string will start with \"-\"." (defun org-timer-set-mode-line (value) "Set the mode-line display of the relative timer. VALUE can be `on', `off', or `pause'." - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-timer-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-timer-mode-line-string)))) + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-timer-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-timer-mode-line-string))))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (or (memq 'org-timer-mode-line-string frame-title-format) + (setq frame-title-format + (append frame-title-format '(org-timer-mode-line-string))))) (cond ((equal value 'off) (when org-timer-mode-line-timer (cancel-timer org-timer-mode-line-timer) (setq org-timer-mode-line-timer nil)) - (setq global-mode-string - (delq 'org-timer-mode-line-string global-mode-string)) + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (setq global-mode-string + (delq 'org-timer-mode-line-string global-mode-string))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (setq frame-title-format + (delq 'org-timer-mode-line-string frame-title-format))) (force-mode-line-update)) ((equal value 'pause) (when org-timer-mode-line-timer (cancel-timer org-timer-mode-line-timer) (setq org-timer-mode-line-timer nil))) ((equal value 'on) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-timer-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-timer-mode-line-string)))) + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-timer-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-timer-mode-line-string))))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (or (memq 'org-timer-mode-line-string frame-title-format) + (setq frame-title-format + (append frame-title-format '(org-timer-mode-line-string))))) (org-timer-update-mode-line) (when org-timer-mode-line-timer - (cancel-timer org-timer-mode-line-timer)) - (setq org-timer-mode-line-timer - (run-with-timer 1 1 'org-timer-update-mode-line))))) + (cancel-timer org-timer-mode-line-timer) + (setq org-timer-mode-line-timer nil)) + (when org-timer-display + (setq org-timer-mode-line-timer + (run-with-timer 1 1 'org-timer-update-mode-line)))))) (defun org-timer-update-mode-line () "Update the timer time in the mode line." @@ -358,48 +398,48 @@ replace any running timer." (number-to-string org-timer-default-timer)))))) (if (not (string-match "[0-9]+" minutes)) (org-timer-show-remaining-time) - (let* ((mins (string-to-number (match-string 0 minutes))) - (secs (* mins 60)) - (hl (cond - ((string-match "Org Agenda" (buffer-name)) - (let* ((marker (or (get-text-property (point) 'org-marker) - (org-agenda-error))) - (hdmarker (or (get-text-property (point) 'org-hd-marker) - marker)) - (pos (marker-position marker))) - (with-current-buffer (marker-buffer marker) - (widen) - (goto-char pos) - (org-show-entry) - (or (ignore-errors (org-get-heading)) - (concat "File:" (file-name-nondirectory (buffer-file-name))))))) - ((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")))) - timer-set) - (if (or (and org-timer-current-timer - (or (equal opt '(16)) - (y-or-n-p "Replace current timer? "))) - (not org-timer-current-timer)) - (progn - (require 'org-clock) - (when org-timer-current-timer - (cancel-timer org-timer-current-timer)) - (setq org-timer-current-timer - (run-with-timer - secs nil `(lambda () - (setq org-timer-current-timer nil) - (org-notify ,(format "%s: time out" hl) t) - (setq org-timer-timer-is-countdown nil) - (org-timer-set-mode-line 'off) - (run-hooks 'org-timer-done-hook)))) - (run-hooks 'org-timer-set-hook) - (setq org-timer-timer-is-countdown t - org-timer-start-time - (time-add (current-time) (seconds-to-time (* mins 60)))) - (org-timer-set-mode-line 'on)) - (message "No timer set")))))) + (let* ((mins (string-to-number (match-string 0 minutes))) + (secs (* mins 60)) + (hl (cond + ((string-match "Org Agenda" (buffer-name)) + (let* ((marker (or (get-text-property (point) 'org-marker) + (org-agenda-error))) + (hdmarker (or (get-text-property (point) 'org-hd-marker) + marker)) + (pos (marker-position marker))) + (with-current-buffer (marker-buffer marker) + (widen) + (goto-char pos) + (org-show-entry) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))))) + ((derived-mode-p 'org-mode) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))) + (t (error "Not in an Org buffer")))) + timer-set) + (if (or (and org-timer-current-timer + (or (equal opt '(16)) + (y-or-n-p "Replace current timer? "))) + (not org-timer-current-timer)) + (progn + (require 'org-clock) + (when org-timer-current-timer + (cancel-timer org-timer-current-timer)) + (setq org-timer-current-timer + (run-with-timer + secs nil `(lambda () + (setq org-timer-current-timer nil) + (org-notify ,(format "%s: time out" hl) t) + (setq org-timer-timer-is-countdown nil) + (org-timer-set-mode-line 'off) + (run-hooks 'org-timer-done-hook)))) + (run-hooks 'org-timer-set-hook) + (setq org-timer-timer-is-countdown t + org-timer-start-time + (time-add (current-time) (seconds-to-time (* mins 60)))) + (org-timer-set-mode-line 'on)) + (message "No timer set")))))) (provide 'org-timer) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el new file mode 100644 index 00000000000..688947def52 --- /dev/null +++ b/lisp/org/org-version.el @@ -0,0 +1,27 @@ +;;; org-version.el --- autogenerated file, do not edit +;; +;;; Code: +;;;###autoload +(defun org-release () + "The release version of org-mode. + Inserted by installing org-mode or when a release is made." + (let ((org-release "7.9.2")) + org-release)) +;;;###autoload +(defun org-git-version () + "The Git version of org-mode. + Inserted by installing org-mode or when a release is made." + (let ((org-git-version "7.9.2-GNU-Emacs-24-3")) + org-git-version)) +;;;###autoload +(defconst org-odt-data-dir "/usr/share/emacs/etc/org" + "The location of ODT styles.") + +(provide 'org-version) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; coding: utf-8 +;; End: +;;; org-version.el ends here diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el index b6975ff1157..b919cd19fea 100644 --- a/lisp/org/org-vm.el +++ b/lisp/org/org-vm.el @@ -6,6 +6,10 @@ ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org ;; +;; Support for IMAP folders added +;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net> +;; Requires VM 8.2.0a or later. +;; ;; This file is part of GNU Emacs. ;; ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -42,11 +46,17 @@ (declare-function vm-su-message-id "ext:vm-summary" (m)) (declare-function vm-su-subject "ext:vm-summary" (m)) (declare-function vm-summarize "ext:vm-summary" (&optional display raise)) +(declare-function vm-imap-folder-p "ext:vm-save" ()) +(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer)) +(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec)) +(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec)) +(declare-function vm-imap-spec-for-account "ext:vm-imap" (account)) (defvar vm-message-pointer) (defvar vm-folder-directory) ;; Install the link type (org-add-link-type "vm" 'org-vm-open) +(org-add-link-type "vm-imap" 'org-vm-imap-open) (add-hook 'org-store-link-functions 'org-vm-store-link) ;; Implementation @@ -61,11 +71,11 @@ (save-excursion (vm-select-folder-buffer) (let* ((message (car vm-message-pointer)) - (folder buffer-file-name) - (subject (vm-su-subject message)) + (subject (vm-su-subject message)) (to (vm-get-header-contents message "To")) (from (vm-get-header-contents message "From")) - (message-id (vm-su-message-id message)) + (message-id (vm-su-message-id message)) + (link-type (if (vm-imap-folder-p) "vm-imap" "vm")) (date (vm-get-header-contents message "Date")) (date-ts (and date (format-time-string (org-time-stamp-format t) @@ -73,20 +83,24 @@ (date-ts-ia (and date (format-time-string (org-time-stamp-format t t) (date-to-time date)))) - desc link) - (org-store-link-props :type "vm" :from from :to to :subject subject + folder desc link) + (if (vm-imap-folder-p) + (let ((spec (vm-imap-find-spec-for-buffer (current-buffer)))) + (setq folder (vm-imap-folder-for-spec spec))) + (progn + (setq folder (abbreviate-file-name buffer-file-name)) + (if (and vm-folder-directory + (string-match (concat "^" (regexp-quote vm-folder-directory)) + folder)) + (setq folder (replace-match "" t t folder))))) + (setq message-id (org-remove-angle-brackets message-id)) + (org-store-link-props :type link-type :from from :to to :subject subject :message-id message-id) (when date (org-add-link-props :date date :date-timestamp date-ts :date-timestamp-inactive date-ts-ia)) - (setq message-id (org-remove-angle-brackets message-id)) - (setq folder (abbreviate-file-name folder)) - (if (and vm-folder-directory - (string-match (concat "^" (regexp-quote vm-folder-directory)) - folder)) - (setq folder (replace-match "" t t folder))) (setq desc (org-email-link-description)) - (setq link (org-make-link "vm:" folder "#" message-id)) + (setq link (concat (concat link-type ":") folder "#" message-id)) (org-add-link-props :link link :description desc) link)))) @@ -121,21 +135,46 @@ (setq folder (format "/%s@%s:%s" user host file)))))) (when folder (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) - (sit-for 0.1) (when article - (require 'vm-search) - (vm-select-folder-buffer) - (widen) - (let ((case-fold-search t)) - (goto-char (point-min)) - (if (not (re-search-forward - (concat "^" "message-id: *" (regexp-quote article)))) - (error "Could not find the specified message in this folder")) - (vm-isearch-update) - (vm-isearch-narrow) - (vm-preview-current-message) - (vm-summarize))))) + (org-vm-select-message (org-add-angle-brackets article))))) + +(defun org-vm-imap-open (path) + "Follow a VM link to an IMAP folder." + (require 'vm-imap) + (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path) + (let* ((account-name (match-string 1 path)) + (mailbox-name (match-string 2 path)) + (message-id (match-string 3 path)) + (account-spec (vm-imap-parse-spec-to-list + (vm-imap-spec-for-account account-name))) + (mailbox-spec (mapconcat 'identity + (append (butlast account-spec 4) + (cons mailbox-name + (last account-spec 3))) + ":"))) + (funcall (cdr (assq 'vm-imap org-link-frame-setup)) + mailbox-spec) + (when message-id + (org-vm-select-message (org-add-angle-brackets message-id)))))) + +(defun org-vm-select-message (message-id) + "Go to the message with message-id in the current folder." + (require 'vm-search) + (sit-for 0.1) + (vm-select-folder-buffer) + (widen) + (let ((case-fold-search t)) + (goto-char (point-min)) + (if (not (re-search-forward + (concat "^" "message-id: *" (regexp-quote message-id)))) + (error "Could not find the specified message in this folder")) + (vm-isearch-update) + (vm-isearch-narrow) + (vm-preview-current-message) + (vm-summarize))) (provide 'org-vm) + + ;;; org-vm.el ends here diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index 8a79ec0d765..724b07a288c 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -34,9 +34,9 @@ (require 'org) (defgroup org-wl nil - "Options concerning the Wanderlust link." - :tag "Org Startup" - :group 'org-link) + "Options concerning the Wanderlust link." + :tag "Org Startup" + :group 'org-link) (defcustom org-wl-link-to-refile-destination t "Create a link to the refile destination if the message is marked as refile." @@ -161,7 +161,7 @@ ENTITY is a message entity." "Store a link to a WL folder." (let* ((folder (wl-folder-get-entity-from-buffer)) (petname (wl-folder-get-petname folder)) - (link (org-make-link "wl:" folder))) + (link (concat "wl:" folder))) (save-excursion (beginning-of-line) (unless (and (wl-folder-buffer-group-p) @@ -246,7 +246,7 @@ ENTITY is a message entity." :subject subject :message-id message-id :message-id-no-brackets message-id-no-brackets) (setq desc (org-email-link-description)) - (setq link (org-make-link "wl:" folder-name "#" message-id-no-brackets)) + (setq link (concat "wl:" folder-name "#" message-id-no-brackets)) (org-add-link-props :link link :description desc))) (when date (org-add-link-props :date date :date-timestamp date-ts @@ -309,7 +309,7 @@ for namazu index." article)) (or (wl-summary-jump-to-msg (string-to-number article)) (error "No such message: %s" article))) - (wl-summary-redisplay)))))) + (wl-summary-redisplay)))))) (provide 'org-wl) diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el index a282fbf1808..ee549627a85 100644 --- a/lisp/org/org-xoxo.el +++ b/lisp/org/org-xoxo.el @@ -49,7 +49,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*" (with-current-buffer (get-buffer buffer) (let* ((pos (point)) (opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) + (org-infile-export-plist))) (filename (concat (file-name-as-directory (org-export-directory :xoxo opt-plist)) (file-name-sans-extension diff --git a/lisp/org/org.el b/lisp/org/org.el index f431c19bf51..cfd86513fbc 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -1,4 +1,5 @@ ;;; org.el --- Outline-based notes management and organizer + ;; Carstens outline-mode for keeping track of everything. ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. ;; @@ -6,7 +7,6 @@ ;; Maintainer: Bastien Guerry <bzg at gnu dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.8.11 ;; ;; This file is part of GNU Emacs. ;; @@ -75,8 +75,28 @@ (require 'gnus-sum)) (require 'calendar) +(require 'find-func) (require 'format-spec) +;; `org-outline-regexp' ought to be a defconst but is let-binding in +;; some places -- e.g. see the macro org-with-limited-levels. +;; +;; In Org buffers, the value of `outline-regexp' is that of +;; `org-outline-regexp'. The only function still directly relying on +;; `outline-regexp' is `org-overview' so that `org-cycle' can do its +;; job when `orgstruct-mode' is active. +(defvar org-outline-regexp "\\*+ " + "Regexp to match Org headlines.") + +(defvar org-outline-regexp-bol "^\\*+ " + "Regexp to match Org headlines. +This is similar to `org-outline-regexp' but additionally makes +sure that we are at the beginning of the line.") + +(defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" + "Matches an headline, putting stars and text into groups. +Stars are put in group 1 and the trimmed body in group 2.") + ;; Emacs 22 calendar compatibility: Make sure the new variables are available (when (fboundp 'defvaralias) (unless (boundp 'calendar-view-holidays-initially-flag) @@ -88,22 +108,6 @@ (unless (boundp 'diary-fancy-buffer) (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))) -(require 'outline) (require 'noutline) -;; Other stuff we need. -(require 'time-date) -(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) -(require 'easymenu) -(require 'overlay) - -(require 'org-macs) -(require 'org-entities) -(require 'org-compat) -(require 'org-faces) -(require 'org-list) -(require 'org-pcomplete) -(require 'org-src) -(require 'org-footnote) - (declare-function org-inlinetask-at-task-p "org-inlinetask" ()) (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) @@ -111,15 +115,7 @@ (declare-function org-at-clock-log-p "org-clock" ()) (declare-function org-clock-timestamps-up "org-clock" ()) (declare-function org-clock-timestamps-down "org-clock" ()) - -;; babel -(require 'ob) -(require 'ob-table) -(require 'ob-lob) -(require 'ob-ref) -(require 'ob-tangle) -(require 'ob-comint) -(require 'ob-keys) +(declare-function org-clock-sum-current-item "org-clock" (&optional tstart)) ;; load languages based on value of `org-babel-load-languages' (defvar org-babel-load-languages) @@ -169,11 +165,13 @@ requirements) is loaded." (const :tag "Fortran" fortran) (const :tag "Gnuplot" gnuplot) (const :tag "Haskell" haskell) + (const :tag "IO" io) (const :tag "Java" java) (const :tag "Javascript" js) - (const :tag "Latex" latex) + (const :tag "LaTeX" latex) (const :tag "Ledger" ledger) (const :tag "Lilypond" lilypond) + (const :tag "Lisp" lisp) (const :tag "Maxima" maxima) (const :tag "Matlab" matlab) (const :tag "Mscgen" mscgen) @@ -186,6 +184,7 @@ requirements) is loaded." (const :tag "Python" python) (const :tag "Ruby" ruby) (const :tag "Sass" sass) + (const :tag "Scala" scala) (const :tag "Scheme" scheme) (const :tag "Screen" screen) (const :tag "Shell Script" sh) @@ -205,38 +204,40 @@ identifier." :group 'org-id) ;;; Version - -(defconst org-version "7.8.11" - "The version number of the file org.el.") - +(require 'org-compat) +(org-check-version) ;;;###autoload -(defun org-version (&optional here) +(defun org-version (&optional here full message) "Show the org-mode version in the echo area. -With prefix arg HERE, insert it at point." +With prefix argument HERE, insert it at point. +When FULL is non-nil, use a verbose version string. +When MESSAGE is non-nil, display a message with the version." (interactive "P") - (let* ((origin default-directory) - (version org-version) - (git-version) - (dir (concat (file-name-directory (locate-library "org")) "../" ))) - (when (and (file-exists-p (expand-file-name ".git" dir)) - (executable-find "git")) - (unwind-protect - (progn - (cd dir) - (when (eql 0 (shell-command "git describe --abbrev=4 HEAD")) - (with-current-buffer "*Shell Command Output*" - (goto-char (point-min)) - (setq git-version (buffer-substring (point) (point-at-eol)))) - (subst-char-in-string ?- ?. git-version t) - (when (string-match "\\S-" - (shell-command-to-string - "git diff-index --name-only HEAD --")) - (setq git-version (concat git-version ".dirty"))) - (setq version (concat version " (" git-version ")")))) - (cd origin))) - (setq version (format "Org-mode version %s" version)) - (if here (insert version)) - (message version))) + (let* ((org-dir (ignore-errors (org-find-library-dir "org"))) + (org-install-dir (ignore-errors (org-find-library-dir "org-install.el"))) + (org-trash (or + (and (fboundp 'org-release) (fboundp 'org-git-version)) + (load (concat org-dir "org-version.el") + 'noerror 'nomessage 'nosuffix))) + (org-version (org-release)) + (git-version (org-git-version)) + (version (format "Org-mode version %s (%s @ %s)" + org-version + git-version + (if org-install-dir + (if (string= org-dir org-install-dir) + org-install-dir + (concat "mixed installation! " org-install-dir " and " org-dir)) + "org-install.el can not be found!"))) + (_version (if full version org-version))) + (if (org-called-interactively-p 'interactive) + (if here + (insert version) + (message version)) + (if message (message _version)) + _version))) + +(defconst org-version (org-version)) ;;; Compatibility constants @@ -497,7 +498,7 @@ frequently in plain text. Not all export backends support this, but HTML does. -This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." +This option can also be set with the #+OPTIONS line, e.g. \"^:nil\"." :group 'org-startup :group 'org-export-translation :version "24.1" @@ -673,6 +674,13 @@ Changes become only effective after restarting Emacs." :group 'org-keywords :type 'string) +(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\(" + org-scheduled-string "\\|" + org-deadline-string "\\|" + org-closed-string "\\|" + org-clock-string "\\)") + "Matches a line with planning or clock info.") + (defcustom org-comment-string "COMMENT" "Entries starting with this keyword will never be exported. An entry can be toggled between COMMENT and normal with @@ -691,7 +699,7 @@ An entry can be toggled between QUOTE and normal with :type 'string) (defconst org-repeat-re - "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)" + "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" "Regular expression for specifying repeated events. After a match, group 1 contains the repeat expression.") @@ -815,7 +823,7 @@ commands should be active." (function))) (defcustom org-speed-commands-user nil - "Alist of additional speed commands. + "Alist of additional speed commands. This list will be checked before `org-speed-commands-default' when the variable `org-use-speed-commands' is non-nil and when the cursor is at the beginning of a headline. @@ -826,15 +834,15 @@ to be called, or a form to be evaluated. An entry that is just a list with a single string will be interpreted as a descriptive headline that will be added when listing the speed commands in the Help buffer using the `?' speed command." - :group 'org-structure - :type '(repeat :value ("k" . ignore) - (choice :value ("k" . ignore) - (list :tag "Descriptive Headline" (string :tag "Headline")) - (cons :tag "Letter and Command" - (string :tag "Command letter") - (choice - (function) - (sexp)))))) + :group 'org-structure + :type '(repeat :value ("k" . ignore) + (choice :value ("k" . ignore) + (list :tag "Descriptive Headline" (string :tag "Headline")) + (cons :tag "Letter and Command" + (string :tag "Command letter") + (choice + (function) + (sexp)))))) (defgroup org-cycle nil "Options concerning visibility cycling in Org-mode." @@ -891,13 +899,11 @@ This can also be set in on a per-file basis with (defcustom org-cycle-global-at-bob nil "Cycle globally if cursor is at beginning of buffer and not at a headline. This makes it possible to do global cycling without having to use S-TAB or -\\[universal-argument] TAB. For this special case to work, the first line \ -of the buffer -must not be a headline - it may be empty or some other text. When used in -this way, `org-cycle-hook' is disables temporarily, to make sure the -cursor stays at the beginning of the buffer. -When this option is nil, don't do anything special at the beginning -of the buffer." +\\[universal-argument] TAB. For this special case to work, the first line +of the buffer must not be a headline -- it may be empty or some other text. +When used in this way, `org-cycle-hook' is disabled temporarily to make +sure the cursor stays at the beginning of the buffer. When this option is +nil, don't do anything special at the beginning of the buffer." :group 'org-cycle :type 'boolean) @@ -969,7 +975,7 @@ the values `folded', `children', or `subtree'." The function(s) in this hook must accept a single argument which indicates the new state that was set by the most recent `org-cycle' command. The argument is a symbol. After a global state change, it can have the values -`overview', `content', or `all'. After a local state change, it can have +`overview', `contents', or `all'. After a local state change, it can have the values `folded', `children', or `subtree'." :group 'org-cycle :type 'hook) @@ -1023,23 +1029,25 @@ indentation in a virtual way, i.e. at display time in Emacs." "Non-nil means `C-a' and `C-e' behave specially in headlines and items. When t, `C-a' will bring back the cursor to the beginning of the -headline text, i.e. after the stars and after a possible TODO keyword. -In an item, this will be the position after the bullet. -When the cursor is already at that position, another `C-a' will bring -it to the beginning of the line. - -`C-e' will jump to the end of the headline, ignoring the presence of tags -in the headline. A second `C-e' will then jump to the true end of the -line, after any tags. This also means that, when this variable is -non-nil, `C-e' also will never jump beyond the end of the heading of a -folded section, i.e. not after the ellipses. - -When set to the symbol `reversed', the first `C-a' or `C-e' works normally, -going to the true line boundary first. Only a directly following, identical -keypress will bring the cursor to the special positions. - -This may also be a cons cell where the behavior for `C-a' and `C-e' is -set separately." +headline text, i.e. after the stars and after a possible TODO +keyword. In an item, this will be the position after bullet and +check-box, if any. When the cursor is already at that position, +another `C-a' will bring it to the beginning of the line. + +`C-e' will jump to the end of the headline, ignoring the presence +of tags in the headline. A second `C-e' will then jump to the +true end of the line, after any tags. This also means that, when +this variable is non-nil, `C-e' also will never jump beyond the +end of the heading of a folded section, i.e. not after the +ellipses. + +When set to the symbol `reversed', the first `C-a' or `C-e' works +normally, going to the true line boundary first. Only a directly +following, identical keypress will bring the cursor to the +special positions. + +This may also be a cons cell where the behavior for `C-a' and +`C-e' is set separately." :group 'org-edit-structure :type '(choice (const :tag "off" nil) @@ -1274,7 +1282,8 @@ See also the variable `org-table-auto-blank-field'." (const :tag "on" t) (const :tag "on, optimized" optimized))) -(defcustom org-self-insert-cluster-for-undo t +(defcustom org-self-insert-cluster-for-undo (or (featurep 'xemacs) + (version<= emacs-version "24.1")) "Non-nil means cluster self-insert commands for undo when possible. If this is set, then, like in the Emacs command loop, 20 consecutive characters will be undone together. @@ -1311,9 +1320,12 @@ The 'linkkey' must be a word word, starting with a letter, followed by letters, numbers, '-' or '_'. If REPLACE is a string, the tag will simply be appended to create the link. -If the string contains \"%s\", the tag will be inserted there. Alternatively, -the placeholder \"%h\" will cause a url-encoded version of the tag to -be inserted at that point (see the function `url-hexify-string'). +If the string contains \"%s\", the tag will be inserted there. If the string +contains \"%h\", it will cause a url-encoded version of the tag to be inserted +at that point (see the function `url-hexify-string'). If the string contains +the specifier \"%(my-function)\", then the custom function `my-function' will +be invoked: this function takes the tag as its only argument and must return +a string. REPLACE may also be a function that will be called with the tag as the only argument to create the link, which should be returned as a string. @@ -1383,11 +1395,11 @@ Changing this variable requires a restart of Emacs to become effective." (const :tag "Footnotes" footnote))) (defcustom org-make-link-description-function nil - "Function to use to generate link descriptions from links. -If nil the link location will be used. This function must take -two parameters; the first is the link and the second the -description `org-insert-link' has generated, and should return the -description to use." + "Function to use for generating link descriptions from links. +When nil, the link location will be used. This function must take +two parameters: the first one is the link, the second one is the +description generated by `org-insert-link'. The function should +return the description to use." :group 'org-link :type 'function) @@ -1396,6 +1408,12 @@ description to use." :tag "Org Store Link" :group 'org-link) +(defcustom org-url-hexify-p t + "When non-nil, hexify URL when creating a link." + :type 'boolean + :version "24.3" + :group 'org-link-store) + (defcustom org-email-link-description-format "Email %c: %.30s" "Format of the description part of a link to an email or usenet message. The following %-escapes will be replaced by corresponding information: @@ -1429,46 +1447,6 @@ It should match if the message is from the user him/herself." :group 'org-link-store :type 'regexp) -(defcustom org-link-to-org-use-id 'create-if-interactive-and-no-custom-id - "Non-nil means storing a link to an Org file will use entry IDs. - -Note that before this variable is even considered, org-id must be loaded, -so please customize `org-modules' and turn it on. - -The variable can have the following values: - -t Create an ID if needed to make a link to the current entry. - -create-if-interactive - If `org-store-link' is called directly (interactively, as a user - command), do create an ID to support the link. But when doing the - job for remember, only use the ID if it already exists. The - purpose of this setting is to avoid proliferation of unwanted - IDs, just because you happen to be in an Org file when you - call `org-remember' that automatically and preemptively - creates a link. If you do want to get an ID link in a remember - template to an entry not having an ID, create it first by - explicitly creating a link to it, using `C-c C-l' first. - -create-if-interactive-and-no-custom-id - Like create-if-interactive, but do not create an ID if there is - a CUSTOM_ID property defined in the entry. This is the default. - -use-existing - Use existing ID, do not create one. - -nil Never use an ID to make a link, instead link using a text search for - the headline text." - :group 'org-link-store - :type '(choice - (const :tag "Create ID to make link" t) - (const :tag "Create if storing link interactively" - create-if-interactive) - (const :tag "Create if storing link interactively and no CUSTOM_ID is present" - create-if-interactive-and-no-custom-id) - (const :tag "Only use existing" use-existing) - (const :tag "Do not use ID to create link" nil))) - (defcustom org-context-in-file-links t "Non-nil means file links from `org-store-link' contain context. A search string will be added to the file name with :: as separator and @@ -1560,6 +1538,7 @@ in the search text." (defcustom org-link-frame-setup '((vm . vm-visit-folder-other-frame) + (vm-imap . vm-visit-imap-folder-other-frame) (gnus . org-gnus-no-new-news) (file . find-file-other-window) (wl . wl-other-frame)) @@ -1833,7 +1812,11 @@ For more examples, see the system specific constants (string :tag "Command") (sexp :tag "Lisp form"))))) - +(defcustom org-doi-server-url "http://dx.doi.org/" + "The URL of the DOI server." + :type 'string + :version "24.3" + :group 'org-link-follow) (defgroup org-refile nil "Options concerning refiling entries in Org-mode." @@ -1846,14 +1829,15 @@ This is just a default location to look for Org files. There is no need at all to put your files into this directory. It is only used in the following situations: -1. When a remember template specifies a target file that is not an +1. When a capture template specifies a target file that is not an absolute path. The path will then be interpreted relative to `org-directory' -2. When a remember note is filed away in an interactive way (when exiting the +2. When a capture note is filed away in an interactive way (when exiting the note buffer with `C-1 C-c C-c'. The user is prompted for an org file, with `org-directory' as the default path." :group 'org-refile :group 'org-remember + :group 'org-capture :type 'directory) (defcustom org-default-notes-file (convert-standard-filename "~/.notes") @@ -1862,6 +1846,7 @@ Used as a fall back file for org-remember.el and org-capture.el, for templates that do not specify a target file." :group 'org-refile :group 'org-remember + :group 'org-capture :type '(choice (const :tag "Default from remember-data-file" nil) file)) @@ -1891,6 +1876,7 @@ When nil, new notes will be filed to the end of a file or entry. This can also be a list with cons cells of regular expressions that are matched against file names, and values." :group 'org-remember + :group 'org-capture :group 'org-refile :type '(choice (const :tag "Reverse always" t) @@ -1967,11 +1953,11 @@ are used, equivalent to the value `((nil . (:level . 1))'." (const :tag "Current buffer" nil) (function) (variable) (file)) (choice :tag "Identify target headline by" - (cons :tag "Specific tag" (const :value :tag) (string)) - (cons :tag "TODO keyword" (const :value :todo) (string)) - (cons :tag "Regular expression" (const :value :regexp) (regexp)) - (cons :tag "Level number" (const :value :level) (integer)) - (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) + (cons :tag "Specific tag" (const :value :tag) (string)) + (cons :tag "TODO keyword" (const :value :todo) (string)) + (cons :tag "Regular expression" (const :value :regexp) (regexp)) + (cons :tag "Level number" (const :value :level) (integer)) + (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) (defcustom org-refile-target-verify-function nil "Function to verify if the headline at point should be a refile target. @@ -2093,9 +2079,9 @@ the special #+SEQ_TODO and #+TYP_TODO lines. Each keyword can optionally specify a character for fast state selection \(in combination with the variable `org-use-fast-todo-selection') -and specifiers for state change logging, using the same syntax -that is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says -that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" +and specifiers for state change logging, using the same syntax that +is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says that +the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" indicates to record a time stamp each time this state is selected. Each keyword may also specify if a timestamp or a note should be @@ -2109,7 +2095,7 @@ define X. You may omit any of the fast-selection key or X or /Y, so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid. For backward compatibility, this variable may also be just a list -of keywords - in this case the interpretation (sequence or type) will be +of keywords. In this case the interpretation (sequence or type) will be taken from the (otherwise obsolete) variable `org-todo-interpretation'." :group 'org-todo :group 'org-keywords @@ -2180,16 +2166,16 @@ selection scheme. When nil, fast selection is never used. -When the symbol `prefix', it will be used when `org-todo' is called with -a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t' -in an agenda buffer. +When the symbol `prefix', it will be used when `org-todo' is called +with a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and +`C-u t' in an agenda buffer. When t, fast selection is used by default. In this case, the prefix argument forces cycling instead. -In all cases, the special interface is only used if access keys have actually -been assigned by the user, i.e. if keywords in the configuration are followed -by a letter in parenthesis, like TODO(t)." +In all cases, the special interface is only used if access keys have +actually been assigned by the user, i.e. if keywords in the configuration +are followed by a letter in parenthesis, like TODO(t)." :group 'org-todo :type '(choice (const :tag "Never" nil) @@ -2321,9 +2307,9 @@ or `done', meaning any not-done or done state, respectively." :group 'org-tags :type '(repeat (cons (choice :tag "When changing to" - (const :tag "Not-done state" todo) - (const :tag "Done state" done) - (string :tag "State")) + (const :tag "Not-done state" todo) + (const :tag "Done state" done) + (string :tag "State")) (repeat (cons :tag "Tag action" (string :tag "Tag") @@ -2449,17 +2435,17 @@ agenda log mode depends on the format of these entries." :group 'org-todo :group 'org-progress :type '(list :greedy t - (cons (const :tag "Heading when closing an item" done) string) - (cons (const :tag - "Heading when changing todo state (todo sequence only)" - state) string) - (cons (const :tag "Heading when just taking a note" note) string) - (cons (const :tag "Heading when clocking out" clock-out) string) - (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) - (cons (const :tag "Heading when rescheduling" reschedule) string) - (cons (const :tag "Heading when changing deadline" redeadline) string) - (cons (const :tag "Heading when deleting a deadline" deldeadline) string) - (cons (const :tag "Heading when refiling" refile) string))) + (cons (const :tag "Heading when closing an item" done) string) + (cons (const :tag + "Heading when changing todo state (todo sequence only)" + state) string) + (cons (const :tag "Heading when just taking a note" note) string) + (cons (const :tag "Heading when clocking out" clock-out) string) + (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) + (cons (const :tag "Heading when rescheduling" reschedule) string) + (cons (const :tag "Heading when changing deadline" redeadline) string) + (cons (const :tag "Heading when deleting a deadline" deldeadline) string) + (cons (const :tag "Heading when refiling" refile) string))) (unless (assq 'note org-log-note-headings) (push '(note . "%t") org-log-note-headings)) @@ -2540,13 +2526,13 @@ through DONE. This variable forces taking a note anyway. nil Don't force a record time Record a time stamp -note Record a note +note Prompt for a note and add it with template `org-log-note-headings' This option can also be set with on a per-file-basis with + #+STARTUP: nologrepeat #+STARTUP: logrepeat #+STARTUP: lognoterepeat - #+STARTUP: nologrepeat You can have local logging settings for a subtree by setting the LOGGING property to one or more of these keywords." @@ -2647,9 +2633,9 @@ and by using a prefix arg to `S-up/down' to specify the exact number of minutes to shift." :group 'org-time :get #'(lambda (var) ; Make sure both elements are there - (if (integerp (default-value var)) - (list (default-value var) 5) - (default-value var))) + (if (integerp (default-value var)) + (list (default-value var) 5) + (default-value var))) :type '(list (integer :tag "when inserting times") (integer :tag "when modifying times"))) @@ -2731,8 +2717,8 @@ This affects the following situations: If you set this variable to the symbol `time', then also the following will work: -3. If the user gives a time, but no day. If the time is before now, - to will be interpreted as tomorrow. +3. If the user gives a time. + If the time is before now, it will be interpreted as tomorrow. Currently none of this works for ISO week specifications. @@ -2822,7 +2808,7 @@ This has influence for the following applications: the time given here, the day recognized as TODAY is actually yesterday. - When a date is read from the user and it is still before the time given here, the current date and time will be assumed to be yesterday, 23:59. - Also, timestamps inserted in remember templates follow this rule. + Also, timestamps inserted in capture templates follow this rule. IMPORTANT: This is a feature whose implementation is and likely will remain incomplete. Really, it is only here because past midnight seems to @@ -3031,7 +3017,7 @@ is better to limit inheritance to certain tags using the variables (const :tag "List them, indented with leading dots" indented))) (defcustom org-tags-sort-function nil - "When set, tags are sorted using this comparison function." + "When set, tags are sorted using this function as a comparator." :group 'org-tags :type '(choice (const :tag "No sorting" nil) @@ -3080,7 +3066,8 @@ and the clock summary: (org-minutes-to-hh:mm-string (- effort clocksum))))))" :group 'org-properties :version "24.1" - :type 'alist) + :type '(alist :key-type (string :tag "Property") + :value-type (function :tag "Function"))) (defcustom org-use-property-inheritance nil "Non-nil means properties apply also for sublevels. @@ -3256,8 +3243,8 @@ than all archive files of all agenda files will be added to the search scope." :group 'org-agenda :type '(set :greedy t - (const :tag "Agenda Archives" agenda-archives) - (repeat :inline t (file)))) + (const :tag "Agenda Archives" agenda-archives) + (repeat :inline t (file)))) (if (fboundp 'defvaralias) (defvaralias 'org-agenda-multi-occur-extra-files @@ -3325,8 +3312,8 @@ points to a file, `org-agenda-diary-entry' will be used instead." (defcustom org-format-latex-options '(:foreground default :background default :scale 1.0 - :html-foreground "Black" :html-background "Transparent" - :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) + :html-foreground "Black" :html-background "Transparent" + :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) "Options for creating images from LaTeX fragments. This is a property list with the following properties: :foreground the foreground color for images embedded in Emacs, e.g. \"Black\". @@ -3353,6 +3340,7 @@ When nil, just push out a message." :group 'org-latex :version "24.1" :type 'boolean) + (defcustom org-latex-to-mathml-jar-file nil "Value of\"%j\" in `org-latex-to-mathml-convert-command'. Use this to specify additional executable file say a jar file. @@ -3383,6 +3371,28 @@ When using MathToWeb as the converter, set this to (const :tag "None" nil) (string :tag "\nShell command"))) +(defcustom org-latex-create-formula-image-program 'dvipng + "Program to convert LaTeX fragments with. + +dvipng Process the LaTeX fragments to dvi file, then convert + dvi files to png files using dvipng. + This will also include processing of non-math environments. +imagemagick Convert the LaTeX fragments to pdf files and use imagemagick + to convert pdf files to png files" + :group 'org-latex + :version "24.1" + :type '(choice + (const :tag "dvipng" dvipng) + (const :tag "imagemagick" imagemagick))) + +(defcustom org-latex-preview-ltxpng-directory "ltxpng/" + "Path to store latex preview images. A relative path here creates many + directories relative to the processed org files paths. An absolute path + puts all preview images at the same place." + :group 'org-latex + :version "24.3" + :type 'string) + (defun org-format-latex-mathml-available-p () "Return t if `org-latex-to-mathml-convert-command' is usable." (save-match-data @@ -3560,6 +3570,15 @@ appear in the buffer without the initial #+TITLE: keyword." (const :tag "#+EMAIL" email) (const :tag "#+TITLE" title))) +(defcustom org-custom-properties nil + "List of properties (as strings) with a special meaning. +The default use of these custom properties is to let the user +hide them with `org-toggle-custom-properties-visibility'." + :group 'org-properties + :group 'org-appearance + :version "24.3" + :type '(repeat (string :tag "Property Name"))) + (defcustom org-fontify-done-headline nil "Non-nil means change the face of a headline if it is marked DONE. Normally, only the TODO/DONE keyword indicates the state of a headline. @@ -3608,7 +3627,7 @@ When nil, the \\name form remains in the buffer." "Regular expression for matching emphasis. After a match, the match groups contain these elements: 0 The match of the full regular expression, including the characters - before and after the proper match + before and after the proper match 1 The character before the proper match, or empty at beginning of line 2 The proper match, including the leading and trailing markers 3 The leading marker like * or /, indicating the type of highlighting @@ -3851,29 +3870,29 @@ This works for both table types.") (eval-and-compile (org-autoload "org-table" '(org-table-align org-table-begin org-table-blank-field - org-table-convert org-table-convert-region org-table-copy-down - org-table-copy-region org-table-create - org-table-create-or-convert-from-region - org-table-create-with-table.el org-table-current-dline - org-table-cut-region org-table-delete-column org-table-edit-field - org-table-edit-formulas org-table-end org-table-eval-formula - org-table-export org-table-field-info - org-table-get-stored-formulas org-table-goto-column - org-table-hline-and-move org-table-import org-table-insert-column - org-table-insert-hline org-table-insert-row org-table-iterate - org-table-justify-field-maybe org-table-kill-row - org-table-maybe-eval-formula org-table-maybe-recalculate-line - org-table-move-column org-table-move-column-left - org-table-move-column-right org-table-move-row - org-table-move-row-down org-table-move-row-up - org-table-next-field org-table-next-row org-table-paste-rectangle - org-table-previous-field org-table-recalculate - org-table-rotate-recalc-marks org-table-sort-lines org-table-sum - org-table-toggle-coordinate-overlays - org-table-toggle-formula-debugger org-table-wrap-region - orgtbl-mode turn-on-orgtbl org-table-to-lisp - orgtbl-to-generic orgtbl-to-tsv orgtbl-to-csv orgtbl-to-latex - orgtbl-to-orgtbl orgtbl-to-html orgtbl-to-texinfo))) + org-table-convert org-table-convert-region org-table-copy-down + org-table-copy-region org-table-create + org-table-create-or-convert-from-region + org-table-create-with-table.el org-table-current-dline + org-table-cut-region org-table-delete-column org-table-edit-field + org-table-edit-formulas org-table-end org-table-eval-formula + org-table-export org-table-field-info + org-table-get-stored-formulas org-table-goto-column + org-table-hline-and-move org-table-import org-table-insert-column + org-table-insert-hline org-table-insert-row org-table-iterate + org-table-justify-field-maybe org-table-kill-row + org-table-maybe-eval-formula org-table-maybe-recalculate-line + org-table-move-column org-table-move-column-left + org-table-move-column-right org-table-move-row + org-table-move-row-down org-table-move-row-up + org-table-next-field org-table-next-row org-table-paste-rectangle + org-table-previous-field org-table-recalculate + org-table-rotate-recalc-marks org-table-sort-lines org-table-sum + org-table-toggle-coordinate-overlays + org-table-toggle-formula-debugger org-table-wrap-region + orgtbl-mode turn-on-orgtbl org-table-to-lisp + orgtbl-to-generic orgtbl-to-tsv orgtbl-to-csv orgtbl-to-latex + orgtbl-to-orgtbl orgtbl-to-html orgtbl-to-texinfo))) (defun org-at-table-p (&optional table-type) "Return t if the cursor is inside an org-type table. @@ -3938,7 +3957,9 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (unless quietly (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))) (beginning-of-line 1) - (when (looking-at org-table-line-regexp) + (when (and (looking-at org-table-line-regexp) + ;; Exclude tables in src/example/verbatim/clocktable blocks + (not (org-in-block-p '("src" "example")))) (save-excursion (funcall function)) (or (looking-at org-table-line-regexp) (forward-char 1))) @@ -3957,13 +3978,13 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." org-table-clean-before-export)) (org-autoload "org-ascii" '(org-export-as-ascii org-export-ascii-preprocess - org-export-as-ascii-to-buffer org-replace-region-by-ascii - org-export-region-as-ascii)) + org-export-as-ascii-to-buffer org-replace-region-by-ascii + org-export-region-as-ascii)) (org-autoload "org-latex" '(org-export-as-latex-batch org-export-as-latex-to-buffer - org-replace-region-by-latex org-export-region-as-latex - org-export-as-latex org-export-as-pdf - org-export-as-pdf-and-open)) + org-replace-region-by-latex org-export-region-as-latex + org-export-as-latex org-export-as-pdf + org-export-as-pdf-and-open)) (org-autoload "org-html" '(org-export-as-html-and-open org-export-as-html-batch org-export-as-html-to-buffer @@ -3971,9 +3992,9 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." org-export-as-html)) (org-autoload "org-docbook" '(org-export-as-docbook-batch org-export-as-docbook-to-buffer - org-replace-region-by-docbook org-export-region-as-docbook - org-export-as-docbook-pdf org-export-as-docbook-pdf-and-open - org-export-as-docbook)) + org-replace-region-by-docbook org-export-region-as-docbook + org-export-as-docbook-pdf org-export-as-docbook-pdf-and-open + org-export-as-docbook)) (org-autoload "org-icalendar" '(org-export-icalendar-this-file org-export-icalendar-all-agenda-files @@ -3986,21 +4007,21 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (eval-and-compile (org-autoload "org-agenda" '(org-agenda org-agenda-list org-search-view - org-todo-list org-tags-view org-agenda-list-stuck-projects - org-diary org-agenda-to-appt - org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))) + org-todo-list org-tags-view org-agenda-list-stuck-projects + org-diary org-agenda-to-appt + org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))) ;; Autoload org-remember (eval-and-compile (org-autoload "org-remember" '(org-remember-insinuate org-remember-annotation - org-remember-apply-template org-remember org-remember-handler))) + org-remember-apply-template org-remember org-remember-handler))) (eval-and-compile (org-autoload "org-capture" '(org-capture org-capture-insert-template-here - org-capture-import-remember-templates))) + org-capture-import-remember-templates))) ;; Autoload org-clock.el @@ -4017,9 +4038,9 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (defvar org-clock-heading "" "The heading of the current clock entry.") (defun org-clock-is-active () - "Return non-nil if clock is currently running. + "Return non-nil if clock is currently running. The return value is actually the clock marker." - (marker-buffer org-clock-marker)) + (marker-buffer org-clock-marker)) (eval-and-compile (org-autoload @@ -4168,6 +4189,15 @@ Here are a few examples: Archive in file ~/org/archive.org (absolute path), under headlines \"From FILENAME\" where file name is the current file name. +\"~/org/datetree.org::datetree/* Finished Tasks\" + The \"datetree/\" string is special, signifying to archive + items to the datetree. Items are placed in either the CLOSED + date of the item, or the current date if there is no CLOSED date. + The heading will be a subentry to the current date. There doesn't + need to be a heading, but there always needs to be a slash after + datetree. For example, to store archived items directly in the + datetree, use \"~/org/datetree.org::datetree/\". + \"basement::** Finished Tasks\" Archive in file ./basement (relative path), as level 3 trees below the level 2 heading \"** Finished Tasks\". @@ -4225,6 +4255,25 @@ collapsed state." :group 'org-sparse-trees :type 'boolean) +(defcustom org-sparse-tree-default-date-type 'scheduled-or-deadline + "The default date type when building a sparse tree. +When this is nil, a date is a scheduled or a deadline timestamp. +Otherwise, these types are allowed: + + all: all timestamps + active: only active timestamps (<...>) + inactive: only inactive timestamps (<...) + scheduled: only scheduled timestamps + deadline: only deadline timestamps" + :type '(choice (const :tag "Scheduled or deadline" 'scheduled-or-deadline) + (const :tag "All timestamps" all) + (const :tag "Only active timestamps" active) + (const :tag "Only inactive timestamps" inactive) + (const :tag "Only scheduled timestamps" scheduled) + (const :tag "Only deadline timestamps" deadline)) + :version "24.3" + :group 'org-sparse-trees) + (defun org-cycle-hide-archived-subtrees (state) "Re-hide all archived subtrees after a visibility state change." (when (and (not org-cycle-open-archived-trees) @@ -4256,6 +4305,8 @@ collapsed state." (org-flag-subtree t) (org-end-of-subtree t)))))) +(declare-function outline-end-of-heading "outline" ()) +(declare-function outline-flag-region "outline" (from to flag)) (defun org-flag-subtree (flag) (save-excursion (org-back-to-heading t) @@ -4268,21 +4319,21 @@ collapsed state." (eval-and-compile (org-autoload "org-archive" - '(org-add-archive-files org-archive-subtree - org-archive-to-archive-sibling org-toggle-archive-tag - org-archive-subtree-default - org-archive-subtree-default-with-confirmation))) + '(org-add-archive-files org-archive-subtree + org-archive-to-archive-sibling org-toggle-archive-tag + org-archive-subtree-default + org-archive-subtree-default-with-confirmation))) ;; Autoload Column View Code -(declare-function org-columns-number-to-string "org-colview") -(declare-function org-columns-get-format-and-top-level "org-colview") -(declare-function org-columns-compute "org-colview") +(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf)) +(declare-function org-columns-get-format-and-top-level "org-colview" ()) +(declare-function org-columns-compute "org-colview" (property)) (org-autoload (if (featurep 'xemacs) "org-colview-xemacs" "org-colview") - '(org-columns-number-to-string org-columns-get-format-and-top-level - org-columns-compute org-agenda-columns org-columns-remove-overlays - org-columns org-insert-columns-dblock org-dblock-write:columnview)) + '(org-columns-number-to-string org-columns-get-format-and-top-level + org-columns-compute org-agenda-columns org-columns-remove-overlays + org-columns org-insert-columns-dblock org-dblock-write:columnview)) ;; Autoload ID code @@ -4291,19 +4342,19 @@ collapsed state." (declare-function org-id-locations-save "org-id") (defvar org-id-track-globally) (org-autoload "org-id" - '(org-id-get-create org-id-new org-id-copy org-id-get - org-id-get-with-outline-path-completion - org-id-get-with-outline-drilling org-id-store-link - org-id-goto org-id-find org-id-store-link)) + '(org-id-get-create org-id-new org-id-copy org-id-get + org-id-get-with-outline-path-completion + org-id-get-with-outline-drilling org-id-store-link + org-id-goto org-id-find org-id-store-link)) ;; Autoload Plotting Code (org-autoload "org-plot" - '(org-plot/gnuplot)) + '(org-plot/gnuplot)) ;;; Variables for pre-computed regular expressions, all buffer local -(defvar org-drawer-regexp nil +(defvar org-drawer-regexp "^[ \t]*:PROPERTIES:[ \t]*$" "Matches first line of a hidden block.") (make-variable-buffer-local 'org-drawer-regexp) (defvar org-todo-regexp nil @@ -4337,7 +4388,7 @@ TODO state, priority and tags.") Also put tags into group 4 if tags are present.") (make-variable-buffer-local 'org-todo-line-tags-regexp) (defvar org-ds-keyword-length 12 - "Maximum length of the Deadline and SCHEDULED keywords.") + "Maximum length of the DEADLINE and SCHEDULED keywords.") (make-variable-buffer-local 'org-ds-keyword-length) (defvar org-deadline-regexp nil "Matches the DEADLINE keyword.") @@ -4367,9 +4418,6 @@ Also put tags into group 4 if tags are present.") (defvar org-maybe-keyword-time-regexp nil "Matches a timestamp, possibly preceded by a keyword.") (make-variable-buffer-local 'org-maybe-keyword-time-regexp) -(defvar org-planning-or-clock-line-re nil - "Matches a line with planning or clock info.") -(make-variable-buffer-local 'org-planning-or-clock-line-re) (defvar org-all-time-keywords nil "List of time keywords.") (make-variable-buffer-local 'org-all-time-keywords) @@ -4467,9 +4515,9 @@ After a match, the following groups carry important information: ("entitiespretty" org-pretty-entities t) ("entitiesplain" org-pretty-entities nil)) "Variable associated with STARTUP options for org-mode. -Each element is a list of three items: The startup options as written -in the #+STARTUP line, the corresponding variable, and the value to -set this variable to if the option is found. An optional forth element PUSH +Each element is a list of three items: the startup options (as written +in the #+STARTUP line), the corresponding variable, and the value to set +this variable to if the option is found. An optional forth element PUSH means to push this value onto the list in the variable.") (defun org-update-property-plist (key val props) @@ -4500,7 +4548,7 @@ but the stars and the body are.") (defun org-set-regexps-and-options () "Precompute regular expressions for current buffer." - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (org-set-local 'org-todo-kwd-alist nil) (org-set-local 'org-todo-key-alist nil) (org-set-local 'org-todo-key-trigger nil) @@ -4571,7 +4619,7 @@ but the stars and the body are.") (mapcar (lambda (x) (org-split-string x ":")) (org-split-string value))))))) ((equal key "DRAWERS") - (setq drawers (org-split-string value splitre))) + (setq drawers (delete-dups (append org-drawers (org-split-string value splitre))))) ((equal key "CONSTANTS") (setq const (append const (org-split-string value splitre)))) ((equal key "STARTUP") @@ -4738,7 +4786,7 @@ but the stars and the body are.") (concat "^\\(\\*+\\)" "\\(?: +" org-todo-regexp "\\)?" "\\(?: +\\(\\[#.\\]\\)\\)?" - "\\(?: +\\(.*?\\)\\)?" + "\\(?: +\\(.*?\\)\\)??" (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?") "[ \t]*$") org-complex-heading-regexp-format @@ -4756,7 +4804,7 @@ but the stars and the body are.") org-todo-line-tags-regexp (concat "^\\(\\*+\\)" "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(.*?\\)\\)?" + "\\(?: +\\(.*?\\)\\)??" (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?") "[ \t]*$") org-deadline-regexp (concat "\\<" org-deadline-string) @@ -4788,12 +4836,6 @@ but the stars and the body are.") "\\|" org-closed-string "\\|" org-clock-string "\\)\\)?" " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") - org-planning-or-clock-line-re - (concat "^[ \t]*\\(" - org-scheduled-string "\\|" - org-deadline-string "\\|" - org-closed-string "\\|" - org-clock-string "\\)") org-all-time-keywords (mapcar (lambda (w) (substring w 0 -1)) (list org-scheduled-string org-deadline-string @@ -4866,14 +4908,14 @@ Respect keys that are already there." "Used in various places to store a window configuration.") (defvar org-finish-function nil "Function to be called when `C-c C-c' is used. -This is for getting out of special buffers like remember.") +This is for getting out of special buffers like capture.") ;; FIXME: Occasionally check by commenting these, to make sure ;; no other functions uses these, forgetting to let-bind them. -(defvar entry) +(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el (defvar org-last-state) -(defvar date) +(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el ;; Defined somewhere in this file, but used before definition. (defvar org-entities) ;; defined in org-entities.el @@ -4883,10 +4925,6 @@ This is for getting out of special buffers like remember.") ;;;; Define the Org-mode -(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22")) - - ;; We use a before-change function to check if a table might need ;; an update. (defvar org-table-may-need-update t @@ -4904,25 +4942,37 @@ This variable is set by `org-before-change-function'. (defvar org-inhibit-blocking nil) ; Dynamically-scoped param. (defvar org-table-buffer-is-an nil) -;; `org-outline-regexp' ought to be a defconst but is let-binding in -;; some places -- e.g. see the macro org-with-limited-levels. -;; -;; In Org buffers, the value of `outline-regexp' is that of -;; `org-outline-regexp'. The only function still directly relying on -;; `outline-regexp' is `org-overview' so that `org-cycle' can do its -;; job when `orgstruct-mode' is active. -(defvar org-outline-regexp "\\*+ " - "Regexp to match Org headlines.") -(defconst org-outline-regexp-bol "^\\*+ " - "Regexp to match Org headlines. -This is similar to `org-outline-regexp' but additionally makes -sure that we are at the beginning of the line.") +(defvar bidi-paragraph-direction) +(defvar buffer-face-mode-face) -(defconst org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Matches an headline, putting stars and text into groups. -Stars are put in group 1 and the trimmed body in group 2.") +(require 'outline) +(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) + (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22")) +(require 'noutline "noutline" 'noerror) ;; stock XEmacs does not have it -(defvar buffer-face-mode-face) +;; Other stuff we need. +(require 'time-date) +(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) +(require 'easymenu) +(require 'overlay) + +(require 'org-macs) +(require 'org-entities) +;; (require 'org-compat) moved higher up in the file before it is first used +(require 'org-faces) +(require 'org-list) +(require 'org-pcomplete) +(require 'org-src) +(require 'org-footnote) + +;; babel +(require 'ob) +(require 'ob-table) +(require 'ob-lob) +(require 'ob-ref) +(require 'ob-tangle) +(require 'ob-comint) +(require 'ob-keys) ;;;###autoload (define-derived-mode org-mode outline-mode "Org" @@ -4979,7 +5029,7 @@ The following commands are available: org-display-table 4 (vconcat (mapcar (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) - org-ellipsis))) + org-ellipsis))) (if (stringp org-ellipsis) org-ellipsis "...")))) (setq buffer-display-table org-display-table)) (org-set-regexps-and-options) @@ -4998,13 +5048,18 @@ The following commands are available: 'local) ;; Check for running clock before killing a buffer (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) - ;; Paragraphs and auto-filling - (org-set-autofill-regexps) - (setq indent-line-function 'org-indent-line-function) + ;; Indentation. + (org-set-local 'indent-line-function 'org-indent-line) + (org-set-local 'indent-region-function 'org-indent-region) + ;; Initialize radio targets. (org-update-radio-target-regexp) + ;; Filling and auto-filling. + (org-setup-filling) + ;; Comments. + (org-setup-comments-handling) ;; Beginning/end of defun - (org-set-local 'beginning-of-defun-function 'org-beginning-of-defun) - (org-set-local 'end-of-defun-function 'org-end-of-defun) + (org-set-local 'beginning-of-defun-function 'org-back-to-heading) + (org-set-local 'end-of-defun-function (lambda () (interactive) (org-end-of-subtree nil t))) ;; Next error for sparse trees (org-set-local 'next-error-function 'org-occur-next-match) ;; Make sure dependence stuff works reliably, even for users who set it @@ -5020,10 +5075,6 @@ The following commands are available: (remove-hook 'org-blocker-hook 'org-block-todo-from-checkboxes)) - ;; Comment characters - (org-set-local 'comment-start "#") - (org-set-local 'comment-padding " ") - ;; Align options lines (org-set-local 'align-mode-rules-list @@ -5076,7 +5127,9 @@ The following commands are available: (require 'org-indent) (org-indent-mode 1)) (unless org-inhibit-startup-visibility-stuff - (org-set-startup-visibility)))) + (org-set-startup-visibility))) + ;; Try to set org-hide correctly + (set-face-foreground 'org-hide (org-find-invisible-foreground))) (when (fboundp 'abbrev-table-put) (abbrev-table-put org-mode-abbrev-table @@ -5084,6 +5137,19 @@ The following commands are available: (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) + +(defun org-find-invisible-foreground () + (let ((candidates (remove + "unspecified-bg" + (list + (face-background 'default) + (face-background 'org-default) + (cdr (assoc 'background-color default-frame-alist)) + (cdr (assoc 'background-color initial-frame-alist)) + (cdr (assoc 'background-color window-system-default-frame-alist)) + (face-foreground 'org-hide))))) + (car (remove nil candidates)))) + (defun org-current-time () "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." (if (> (car org-time-stamp-rounding-minutes) 1) @@ -5115,19 +5181,19 @@ The following commands are available: (defconst org-non-link-chars "]\t\n\r<>") (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" - "shell" "elisp" "doi" "message")) + "shell" "elisp" "doi" "message")) (defvar org-link-types-re nil - "Matches a link that has a url-like prefix like \"http:\"") + "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil - "Matches a link with spaces, optional angular brackets around it.") + "Matches a link with spaces, optional angular brackets around it.") (defvar org-link-re-with-space2 nil - "Matches a link with spaces, optional angular brackets around it.") + "Matches a link with spaces, optional angular brackets around it.") (defvar org-link-re-with-space3 nil - "Matches a link with spaces, only for internal part in bracket links.") + "Matches a link with spaces, only for internal part in bracket links.") (defvar org-angle-link-re nil - "Matches link with angular brackets, spaces are allowed.") + "Matches link with angular brackets, spaces are allowed.") (defvar org-plain-link-re nil - "Matches plain link, without spaces.") + "Matches plain link, without spaces.") (defvar org-bracket-link-regexp nil "Matches a link in double brackets.") (defvar org-bracket-link-analytic-regexp nil @@ -5247,7 +5313,8 @@ This should be called after the variable `org-link-types' has changed." "Regular expression for fast time stamp matching.") (defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]" "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" +(defconst org-ts-regexp0 + "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" "Regular expression matching time strings for analysis. This one does not require the space after the date, so it can be used on a string that terminates immediately after the date.") @@ -5360,19 +5427,18 @@ will be prompted for." "Run through the buffer and add overlays to links." (catch 'exit (let (f) - (if (re-search-forward org-plain-link-re limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (setq f (get-text-property (match-beginning 0) 'face)) - (if (or (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) - nil - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'face 'org-link - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 0))) - t))))) + (when (re-search-forward (concat org-plain-link-re) limit t) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (setq f (get-text-property (match-beginning 0) 'face)) + (if (or (eq f 'org-tag) + (and (listp f) (memq 'org-tag f))) + nil + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'face 'org-link + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 0))) + t)))) (defun org-activate-code (limit) (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) @@ -5389,6 +5455,14 @@ will be prompted for." :group 'org-appearance :group 'org-babel) +(defcustom org-allow-promoting-top-level-subtree nil + "When non-nil, allow promoting a top level subtree. +The leading star of the top level headline will be replaced +by a #." + :type 'boolean + :version "24.1" + :group 'org-appearance) + (defun org-fontify-meta-lines-and-blocks (limit) (condition-case nil (org-fontify-meta-lines-and-blocks-1 limit) @@ -5398,7 +5472,7 @@ will be prompted for." "Fontify #+ lines and blocks, in the correct ways." (let ((case-fold-search t)) (if (re-search-forward - "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" + "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" limit t) (let ((beg (match-beginning 0)) (block-start (match-end 0)) @@ -5409,7 +5483,7 @@ will be prompted for." (dc3 (downcase (match-string 3))) end end1 quoting block-type ovl) (cond - ((member dc1 '("html:" "ascii:" "latex:" "docbook:")) + ((member dc1 '("+html:" "+ascii:" "+latex:" "+docbook:")) ;; a single line of backend-specific content (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (remove-text-properties (match-beginning 0) (match-end 0) @@ -5420,7 +5494,7 @@ will be prompted for." '(font-lock-fontified t face org-block)) ; for backend-specific code t) - ((and (match-end 4) (equal dc3 "begin")) + ((and (match-end 4) (equal dc3 "+begin")) ;; Truly a block (setq block-type (downcase (match-string 5)) quoting (member block-type org-protecting-blocks)) @@ -5463,7 +5537,7 @@ will be prompted for." (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) '(face org-block-end-line)) t)) - ((member dc1 '("title:" "author:" "email:" "date:")) + ((member dc1 '("+title:" "+author:" "+email:" "+date:")) (add-text-properties beg (match-end 3) (if (member (intern (substring dc1 0 -1)) org-hidden-keywords) @@ -5471,19 +5545,14 @@ will be prompted for." '(font-lock-fontified t face org-document-info-keyword))) (add-text-properties (match-beginning 6) (match-end 6) - (if (string-equal dc1 "title:") + (if (string-equal dc1 "+title:") '(font-lock-fontified t face org-document-title) '(font-lock-fontified t face org-document-info)))) - ((not (member (char-after beg) '(?\ ?\t))) - ;; just any other in-buffer setting, but not indented - (add-text-properties - beg (match-end 0) - '(font-lock-fontified t face org-meta-line)) - t) - ((or (member dc1 '("begin:" "end:" "caption:" "label:" - "orgtbl:" "tblfm:" "tblname:" "results:" - "call:" "header:" "headers:" "name:")) - (and (match-end 4) (equal dc3 "attr"))) + ((or (equal dc1 "+results") + (member dc1 '("+begin:" "+end:" "+caption:" "+label:" + "+orgtbl:" "+tblfm:" "+tblname:" "+results:" + "+call:" "+header:" "+headers:" "+name:")) + (and (match-end 4) (equal dc3 "+attr"))) (add-text-properties beg (match-end 0) '(font-lock-fontified t face org-meta-line)) @@ -5492,6 +5561,12 @@ will be prompted for." (add-text-properties beg (match-end 0) '(font-lock-fontified t face font-lock-comment-face))) + ((not (member (char-after beg) '(?\ ?\t))) + ;; just any other in-buffer setting, but not indented + (add-text-properties + beg (match-end 0) + '(font-lock-fontified t face org-meta-line)) + t) (t nil)))))) (defun org-strip-protective-commas (beg end) @@ -5505,7 +5580,7 @@ will be prompted for." "[^[:space:]]" end t) (goto-char (match-beginning 0)) (current-column)))) - (while (re-search-forward "^[ \t]*\\(,\\)\\([*]\\|#\\+\\)" end t) + (while (re-search-forward "^[ \t]*\\(,\\)\\([*]\\|#\\)" end t) (goto-char (match-beginning 1)) (when (= (current-column) front-line) (replace-match "" nil nil nil 1))))))) @@ -5667,8 +5742,7 @@ will be prompted for." ((equal org-export-with-sub-superscripts '{}) (list org-match-substring-with-braces-regexp)) (org-export-with-sub-superscripts - (list org-match-substring-regexp)) - (t nil))) + (list org-match-substring-regexp)))) (re-latex (if org-export-with-LaTeX-fragments (mapcar (lambda (x) (nth 1 x)) latexs))) @@ -5689,7 +5763,7 @@ will be prompted for." nil)) 'words))) ; FIXME )) - ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) + ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) (re-special (if org-export-with-special-strings (mapcar (lambda (x) (car x)) org-export-html-special-string-regexps))) @@ -5793,9 +5867,11 @@ it is installed to be used by font lock. This can be useful if something needs to be inserted at a specific position in the font-lock sequence.") (defun org-font-lock-hook (limit) + "Run `org-font-lock-hook' within LIMIT." (run-hook-with-args 'org-font-lock-hook limit)) (defun org-set-font-lock-defaults () + "Set font lock defaults for the current buffer." (let* ((em org-fontify-emphasized-text) (lk org-activate-links) (org-font-lock-extra-keywords @@ -5869,7 +5945,7 @@ needs to be inserted at a specific position in the font-lock sequence.") (0 (org-get-checkbox-statistics-face) t))) ;; Description list items '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)" - 1 'bold prepend) + 1 'org-list-dt prepend) ;; ARCHIVEd headings (list (concat org-outline-regexp-bol @@ -5887,7 +5963,6 @@ needs to be inserted at a specific position in the font-lock sequence.") org-comment-string "\\|" org-quote-string "\\)")) '(2 'org-special-keyword t)) - '("^#.*" (0 'font-lock-comment-face t)) ;; Blocks and meta lines '(org-fontify-meta-lines-and-blocks) ))) @@ -5911,6 +5986,30 @@ needs to be inserted at a specific position in the font-lock sequence.") (org-decompose-region (point-min) (point-max)) (message "Entities are displayed plain")))) +(defvar org-custom-properties-overlays nil + "List of overlays used for custom properties.") +(make-variable-buffer-local 'org-custom-properties-overlays) + +(defun org-toggle-custom-properties-visibility () + "Display or hide properties in `org-custom-properties'." + (interactive) + (if org-custom-properties-overlays + (progn (mapc 'delete-overlay org-custom-properties-overlays) + (setq org-custom-properties-overlays nil)) + (unless (not org-custom-properties) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward org-property-re nil t) + (mapc (lambda(p) + (when (equal p (substring (match-string 1) 1 -1)) + (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) + (overlay-put o 'invisible t) + (overlay-put o 'org-custom-property t) + (push o org-custom-properties-overlays)))) + org-custom-properties))))))) + (defun org-fontify-entities (limit) "Find an entity to fontify." (let (ee) @@ -5948,16 +6047,16 @@ needs to be inserted at a specific position in the font-lock sequence.") (defvar org-l nil) (defvar org-f nil) (defun org-get-level-face (n) - "Get the right face for match N in font-lock matching of headlines." - (setq org-l (- (match-end 2) (match-beginning 1) 1)) - (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) - (if org-cycle-level-faces - (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) - (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces))) - (cond - ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) - ((eq n 2) org-f) - (t (if org-level-color-stars-only nil org-f)))) + "Get the right face for match N in font-lock matching of headlines." + (setq org-l (- (match-end 2) (match-beginning 1) 1)) + (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) + (if org-cycle-level-faces + (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) + (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces))) + (cond + ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) + ((eq n 2) org-f) + (t (if org-level-color-stars-only nil org-f)))) (defun org-get-todo-face (kwd) @@ -6017,9 +6116,9 @@ If KWD is a number, get the corresponding match group." deactivate-mark buffer-file-name buffer-file-truename) (org-decompose-region beg end) (remove-text-properties beg end - '(mouse-face t keymap t org-linked-text t - invisible t intangible t - org-no-flyspell t org-emphasis t)) + '(mouse-face t keymap t org-linked-text t + invisible t intangible t + org-no-flyspell t org-emphasis t)) (org-remove-font-lock-display-properties beg end))) (defconst org-script-display '(((raise -0.3) (height 0.7)) @@ -6152,11 +6251,11 @@ in special contexts. org-inlinetask-min-level (1- org-inlinetask-min-level)))) (nstars (and limit-level - (if org-odd-levels-only - (and limit-level (1- (* limit-level 2))) - limit-level))) + (if org-odd-levels-only + (and limit-level (1- (* limit-level 2))) + limit-level))) (org-outline-regexp - (if (not (eq major-mode 'org-mode)) + (if (not (derived-mode-p 'org-mode)) outline-regexp (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))) (bob-special (and org-cycle-global-at-bob (not arg) (bobp) @@ -6402,7 +6501,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 (eq major-mode 'org-mode) org-cycle-include-plain-lists nil))) + (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil))) (cond ((integerp arg) (show-all) @@ -6612,7 +6711,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 (eq major-mode 'org-mode) (buffer-file-name)) + (if (and (derived-mode-p 'org-mode) (buffer-file-name)) (let ((file (expand-file-name (buffer-file-name)))) (unless (member file files) (push file files)))))) @@ -6628,7 +6727,7 @@ open and agenda-wise Org files." (defun org-cycle-hide-drawers (state) "Re-hide all drawers after a visibility state change." - (when (and (eq major-mode 'org-mode) + (when (and (derived-mode-p 'org-mode) (not (memq state '(overview folded contents)))) (save-excursion (let* ((globalp (memq state '(contents all))) @@ -6642,6 +6741,8 @@ open and agenda-wise Org files." (org-flag-drawer t)))))) (defun org-flag-drawer (flag) + "When FLAG is non-nil, hide the drawer we are within. +Otherwise make it visible." (save-excursion (beginning-of-line 1) (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") @@ -6829,7 +6930,7 @@ Optional arguments START and END can be used to limit the range." map)) (defconst org-goto-help -"Browse buffer copy, to find location or copy text. Just type for auto-isearch. + "Browse buffer copy, to find location or copy text. Just type for auto-isearch. RET=jump to location [Q]uit and return to previous location \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") @@ -6839,18 +6940,22 @@ RET=jump to location [Q]uit and return to previous location (defun org-goto (&optional alternative-interface) "Look up a different location in the current file, keeping current visibility. -When you want look-up or go to a different location in a document, the -fastest way is often to fold the entire buffer and then dive into the tree. -This method has the disadvantage, that the previous location will be folded, -which may not be what you want. - -This command works around this by showing a copy of the current buffer -in an indirect buffer, in overview mode. You can dive into the tree in -that copy, use org-occur and incremental search to find a location. -When pressing RET or `Q', the command returns to the original buffer in -which the visibility is still unchanged. After RET it will also jump to -the location selected in the indirect buffer and expose the headline -hierarchy above." +When you want look-up or go to a different location in a +document, the fastest way is often to fold the entire buffer and +then dive into the tree. This method has the disadvantage, that +the previous location will be folded, which may not be what you +want. + +This command works around this by showing a copy of the current +buffer in an indirect buffer, in overview mode. You can dive +into the tree in that copy, use org-occur and incremental search +to find a location. When pressing RET or `Q', the command +returns to the original buffer in which the visibility is still +unchanged. After RET it will also jump to the location selected +in the indirect buffer and expose the headline hierarchy above. + +With a prefix argument, use the alternative interface: e.g. if +`org-goto-interface' is 'outline use 'outline-path-completion." (interactive "P") (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) (org-refile-use-outline-path t) @@ -6945,12 +7050,12 @@ or nil." (defun org-goto-local-auto-isearch () "Start isearch." - (interactive) - (goto-char (point-min)) - (let ((keys (this-command-keys))) - (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) - (isearch-mode t) - (isearch-process-search-char (string-to-char keys))))) + (interactive) + (goto-char (point-min)) + (let ((keys (this-command-keys))) + (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) + (isearch-mode t) + (isearch-process-search-char (string-to-char keys))))) (defun org-goto-ret (&optional arg) "Finish `org-goto' by going to the new location." @@ -6995,8 +7100,9 @@ or nil." (defun org-tree-to-indirect-buffer (&optional arg) "Create indirect buffer and narrow it to current subtree. -With numerical prefix ARG, go up to this level and then take that tree. +With a numerical prefix ARG, go up to this level and then take that tree. If ARG is negative, go up that many levels. + If `org-indirect-buffer-display' is not `new-frame', the command removes the indirect buffer previously made with this command, to avoid proliferation of indirect buffers. However, when you call the command with a \ @@ -7018,7 +7124,7 @@ frame is not changed." (setq level (org-outline-level)) (if (< arg 0) (setq arg (+ level arg))) (while (> (setq level (org-outline-level)) arg) - (outline-up-heading 1 t))) + (org-up-heading-safe))) (setq beg (point) heading (org-get-heading)) (org-end-of-subtree t t) @@ -7434,6 +7540,8 @@ even level numbers will become the next higher odd number." (define-obsolete-function-alias 'org-get-legal-level 'org-get-valid-level "23.1"))) +(defvar org-called-with-limited-levels nil) ;; Dynamically bound in +;; ̀org-with-limited-levels' (defun org-promote () "Promote the current heading higher up the tree. If the region is active in `transient-mark-mode', promote all headings @@ -7441,14 +7549,19 @@ in the region." (org-back-to-heading t) (let* ((level (save-match-data (funcall outline-level))) (after-change-functions (remove 'flyspell-after-change-function - after-change-functions)) + after-change-functions)) (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) (diff (abs (- level (length up-head) -1)))) - (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) - (replace-match up-head nil t) + (cond ((and (= level 1) org-called-with-limited-levels + org-allow-promoting-top-level-subtree) + (replace-match "# " nil t)) + ((= level 1) + (error "Cannot promote to level 0. UNDO to recover if necessary")) + (t (replace-match up-head nil t))) ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation (- diff))) + (unless (= level 1) + (and org-auto-align-tags (org-set-tags nil t)) + (if org-adapt-indentation (org-fixup-indentation (- diff)))) (run-hooks 'org-after-promote-entry-hook))) (defun org-demote () @@ -7458,7 +7571,7 @@ in the region." (org-back-to-heading t) (let* ((level (save-match-data (funcall outline-level))) (after-change-functions (remove 'flyspell-after-change-function - after-change-functions)) + after-change-functions)) (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) (diff (abs (- level (length down-head) -1)))) (replace-match down-head nil t) @@ -7717,7 +7830,7 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (save-excursion (outline-end-of-heading) (setq folded (outline-invisible-p))) (condition-case nil - (org-forward-same-level (1- n) t) + (org-forward-heading-same-level (1- n) t) (error nil)) (org-end-of-subtree t t)) (org-back-over-empty-lines) @@ -7761,8 +7874,8 @@ the inserted text when done." (setq tree (or tree (and kill-ring (current-kill 0)))) (unless (org-kill-is-subtree-p tree) (error "%s" - (substitute-command-keys - "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) + (substitute-command-keys + "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) (org-with-limited-levels (let* ((visp (not (outline-invisible-p))) (txt tree) @@ -7778,8 +7891,7 @@ the inserted text when done." (- (match-end 1) (match-beginning 1))) ((and (bolp) (looking-at org-outline-regexp)) - (- (match-end 0) (point) 1)) - (t nil))) + (- (match-end 0) (point) 1)))) (previous-level (save-excursion (condition-case nil (progn @@ -7920,7 +8032,7 @@ If yes, remember the marker and the distance to BEG." (interactive) (let* ((case-fold-search t) (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*" - "^[ \t]*#\\+end_.*"))) + "^[ \t]*#\\+end_.*"))) (if blockp (narrow-to-region (car blockp) (cdr blockp)) (error "Not in a block")))) @@ -7961,7 +8073,7 @@ and still retain the repeater to cover future instances of the task." (if (not (and (integerp n) (> n 0))) (error "Invalid number of replications %s" n)) (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) - (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'" + (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'" shift))) (error "Invalid shift specification %s" shift)) (when doshift @@ -7979,7 +8091,7 @@ and still retain the repeater to cover future instances of the task." (setq end (point)) (setq template (buffer-substring beg end)) (when (and doshift - (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[dwmy][^<>\n]*>" template)) + (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template)) (delete-region beg end) (setq end beg) (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) @@ -8010,7 +8122,7 @@ and still retain the repeater to cover future instances of the task." (while (re-search-forward org-ts-regexp nil t) (save-excursion (goto-char (match-beginning 0)) - (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[dwmy]\\)") + (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") (delete-region (match-beginning 1) (match-end 1))))))) (setq task (buffer-string))) (insert task)) @@ -8231,8 +8343,7 @@ WITH-CASE, the sorting considers case as well." (cond ((= dcst ?a) 'string<) ((= dcst ?f) compare-func) - ((member dcst '(?p ?t ?s ?d ?c)) '<) - (t nil))))) + ((member dcst '(?p ?t ?s ?d ?c)) '<))))) (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting entries...done"))) @@ -8339,26 +8450,31 @@ C-c C-c Set tags / toggle checkbox" "Unconditionally turn on `orgstruct-mode'." (orgstruct-mode 1)) +(defvar org-fb-vars nil) +(make-variable-buffer-local 'org-fb-vars) (defun orgstruct++-mode (&optional arg) "Toggle `orgstruct-mode', the enhanced version of it. -In addition to setting orgstruct-mode, this also exports all indentation -and autofilling variables from org-mode into the buffer. It will also -recognize item context in multiline items. -Note that turning off orgstruct-mode will *not* remove the -indentation/paragraph settings. This can only be done by refreshing the -major mode, for example with \\[normal-mode]." +In addition to setting orgstruct-mode, this also exports all +indentation and autofilling variables from org-mode into the +buffer. It will also recognize item context in multiline items." (interactive "P") (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) (if (< arg 1) - (orgstruct-mode -1) + (progn (orgstruct-mode -1) + (mapc (lambda(v) + (org-set-local (car v) + (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v)))) + org-fb-vars)) (orgstruct-mode 1) + (setq org-fb-vars nil) (let (var val) (mapc (lambda (x) (when (string-match - "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" + "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)" (symbol-name (car x))) (setq var (car x) val (nth 1 x)) + (push (list var `(quote ,(eval var))) org-fb-vars) (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) org-local-vars) (org-set-local 'orgstruct-is-++ t)))) @@ -8414,6 +8530,9 @@ major mode, for example with \\[normal-mode]." cmd (orgstruct-make-binding fun nfunc key)) (org-defkey orgstruct-mode-map key cmd)) + ;; Prevent an error for users who forgot to make autoloads + (require 'org-element) + ;; Special treatment needed for TAB and RET (org-defkey orgstruct-mode-map [(tab)] (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) @@ -8422,21 +8541,21 @@ major mode, for example with \\[normal-mode]." (org-defkey orgstruct-mode-map "\M-\C-m" (orgstruct-make-binding 'org-insert-heading 105 - "\M-\C-m" [(meta return)])) + "\M-\C-m" [(meta return)])) (org-defkey orgstruct-mode-map [(meta return)] (orgstruct-make-binding 'org-insert-heading 106 - [(meta return)] "\M-\C-m")) + [(meta return)] "\M-\C-m")) (org-defkey orgstruct-mode-map [(shift meta return)] (orgstruct-make-binding 'org-insert-todo-heading 107 - [(meta return)] "\M-\C-m")) + [(meta return)] "\M-\C-m")) (org-defkey orgstruct-mode-map "\e\C-m" (orgstruct-make-binding 'org-insert-heading 108 - "\e\C-m" [?\e (return)])) + "\e\C-m" [?\e (return)])) (org-defkey orgstruct-mode-map [?\e (return)] (orgstruct-make-binding 'org-insert-heading 109 - [?\e (return)] "\e\C-m")) + [?\e (return)] "\e\C-m")) (org-defkey orgstruct-mode-map [?\e (shift return)] (orgstruct-make-binding 'org-insert-todo-heading 110 [?\e (return)] "\e\C-m")) @@ -8474,6 +8593,77 @@ to execute outside of tables." keys) '('orgstruct-error)))))))) +(defun org-contextualize-keys (alist contexts) + "Return valid elements in ALIST depending on CONTEXTS. + +`org-agenda-custom-commands' or `org-capture-templates' are the +values used for ALIST, and `org-agenda-custom-commands-contexts' +or `org-capture-templates-contexts' are the associated contexts +definitions." + (let ((contexts + ;; normalize contexts + (mapcar + (lambda(c) (cond ((listp (cadr c)) + (list (car c) (car c) (cadr c))) + ((string= "" (cadr c)) + (list (car c) (car c) (caddr c))) + (t c))) contexts)) + (a alist) c r s) + ;; loop over all commands or templates + (while (setq c (pop a)) + (let (vrules repl) + (cond + ((not (assoc (car c) contexts)) + (push c r)) + ((and (assoc (car c) contexts) + (setq vrules (org-contextualize-validate-key + (car c) contexts))) + (mapc (lambda (vr) + (when (not (equal (car vr) (cadr vr))) + (setq repl vr))) vrules) + (if (not repl) (push c r) + (push (cadr repl) s) + (push + (cons (car c) + (cdr (or (assoc (cadr repl) alist) + (error "Undefined key `%s' as contextual replacement for `%s'" + (cadr repl) (car c))))) + r)))))) + ;; Return limited ALIST, possibly with keys modified, and deduplicated + (delq + nil + (delete-dups + (mapcar (lambda (x) + (let ((tpl (car x))) + (when (not (delq + nil + (mapcar (lambda(y) + (equal y tpl)) s))) x))) + (reverse r)))))) + +(defun org-contextualize-validate-key (key contexts) + "Check CONTEXTS for agenda or capture KEY." + (let (r rr res) + (while (setq r (pop contexts)) + (mapc + (lambda (rr) + (when + (and (equal key (car r)) + (if (functionp rr) (funcall rr) + (or (and (eq (car rr) 'in-file) + (buffer-file-name) + (string-match (cdr rr) (buffer-file-name))) + (and (eq (car rr) 'in-mode) + (string-match (cdr rr) (symbol-name major-mode))) + (when (and (eq (car rr) 'not-in-file) + (buffer-file-name)) + (not (string-match (cdr rr) (buffer-file-name)))) + (when (eq (car rr) 'not-in-mode) + (not (string-match (cdr rr) (symbol-name major-mode))))))) + (push r res))) + (car (last r)))) + (delete-dups (delq nil res)))) + (defun org-context-p (&rest contexts) "Check if local context is any of CONTEXTS. Possible values in the list of contexts are `table', `headline', and `item'." @@ -8490,7 +8680,7 @@ Possible values in the list of contexts are `table', `headline', and `item'." (goto-char pos)))) (defun org-get-local-variables () - "Return a list of all local variables in an org-mode buffer." + "Return a list of all local variables in an Org mode buffer." (let (varlist) (with-current-buffer (get-buffer-create "*Org tmp*") (erase-buffer) @@ -8505,7 +8695,7 @@ Possible values in the list of contexts are `table', `headline', and `item'." (list x) (list (car x) (list 'quote (cdr x))))) (if (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" + "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" (symbol-name (car x))) x nil)) varlist)))) @@ -8547,7 +8737,9 @@ call CMD." (defun org-refresh-category-properties () "Refresh category text properties in the buffer." - (let ((def-cat (cond + (let ((case-fold-search t) + (inhibit-read-only t) + (def-cat (cond ((null org-category) (if buffer-file-name (file-name-sans-extension @@ -8593,6 +8785,8 @@ call CMD." (setq rpl (cdr as)) (cond ((symbolp rpl) (funcall rpl tag)) + ((string-match "%(\\([^)]+\\))" rpl) + (replace-match (funcall (intern-soft (match-string 1 rpl)) tag) t t rpl)) ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) ((string-match "%h" rpl) (replace-match (url-hexify-string (or tag "")) t t rpl)) @@ -8631,7 +8825,7 @@ Special properties are: this when inserting this link into an Org-mode buffer. In addition to these, any additional properties can be specified -and then used in remember templates.") +and then used in capture templates.") (defun org-add-link-type (type &optional follow export) "Add TYPE to the list of `org-link-types'. @@ -8665,7 +8859,8 @@ type. For a simple example of an export function, see `org-bbdb.el'." (setcdr (assoc type org-link-protocols) (list follow export)) (push (list type follow export) org-link-protocols))) -(defvar org-agenda-buffer-name) +(defvar org-agenda-buffer-name) ; Defined in org-agenda.el +(defvar org-link-to-org-use-id) ; Defined in org-id.el ;;;###autoload (defun org-store-link (arg) @@ -8727,17 +8922,24 @@ For file links, arg negates `org-context-in-file-links'." nil nil nil)))) (org-store-link-props :type "calendar" :date cd))) + ((eq major-mode 'help-mode) + (setq link (concat "help:" (save-excursion + (goto-char (point-min)) + (looking-at "^[^ ]+") + (match-string 0)))) + (org-store-link-props :type "help")) + ((eq major-mode 'w3-mode) (setq cpltxt (if (and (buffer-name) (not (string-match "Untitled" (buffer-name)))) (buffer-name) (url-view-url t)) - link (org-make-link (url-view-url t))) + link (url-view-url t)) (org-store-link-props :type "w3" :url (url-view-url t))) ((eq major-mode 'w3m-mode) (setq cpltxt (or w3m-current-title w3m-current-url) - link (org-make-link w3m-current-url)) + link w3m-current-url) (org-store-link-props :type "w3m" :url (url-view-url t))) ((setq search (run-hook-with-args-until-success @@ -8749,7 +8951,7 @@ For file links, arg negates `org-context-in-file-links'." ((eq major-mode 'image-mode) (setq cpltxt (concat "file:" (abbreviate-file-name buffer-file-name)) - link (org-make-link cpltxt)) + link cpltxt) (org-store-link-props :type "image" :file buffer-file-name)) ((eq major-mode 'dired-mode) @@ -8761,9 +8963,9 @@ For file links, arg negates `org-context-in-file-links'." ;; otherwise, no file so use current directory. default-directory)) (setq cpltxt (concat "file:" file) - link (org-make-link cpltxt)))) + link cpltxt))) - ((and (buffer-file-name (buffer-base-buffer)) (eq major-mode 'org-mode)) + ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) (setq custom-id (org-entry-get nil "CUSTOM_ID")) (cond ((org-in-regexp "<<\\(.*?\\)>>") @@ -8772,22 +8974,19 @@ For file links, arg negates `org-context-in-file-links'." (abbreviate-file-name (buffer-file-name (buffer-base-buffer))) "::" (match-string 1)) - link (org-make-link cpltxt))) + link cpltxt)) ((and (featurep 'org-id) (or (eq org-link-to-org-use-id t) - (and (eq org-link-to-org-use-id 'create-if-interactive) - (org-called-interactively-p 'any)) - (and (eq org-link-to-org-use-id - 'create-if-interactive-and-no-custom-id) - (org-called-interactively-p 'any) - (not custom-id)) - (and org-link-to-org-use-id - (org-entry-get nil "ID")))) + (and (org-called-interactively-p 'any) + (or (eq org-link-to-org-use-id 'create-if-interactive) + (and (eq org-link-to-org-use-id + 'create-if-interactive-and-no-custom-id) + (not custom-id)))) + (and org-link-to-org-use-id (org-entry-get nil "ID")))) ;; We can make a link using the ID. (setq link (condition-case nil (prog1 (org-id-store-link) - (setq desc (plist-get org-store-link-plist - :description))) + (setq desc (plist-get org-store-link-plist :description))) (error ;; probably before first headline, link to file only (concat "file:" @@ -8803,8 +9002,7 @@ For file links, arg negates `org-context-in-file-links'." (setq txt (cond ((org-at-heading-p) nil) ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))) - (t nil))) + (buffer-substring (region-beginning) (region-end))))) (when (or (null txt) (string-match "\\S-" txt)) (setq cpltxt (concat cpltxt "::" @@ -8815,7 +9013,7 @@ For file links, arg negates `org-context-in-file-links'." (org-heading-components))) "NONE")))) (if (string-match "::\\'" cpltxt) (setq cpltxt (substring cpltxt 0 -2))) - (setq link (org-make-link cpltxt))))) + (setq link cpltxt)))) ((buffer-file-name (buffer-base-buffer)) ;; Just link to this file here. @@ -8832,7 +9030,7 @@ For file links, arg negates `org-context-in-file-links'." (setq cpltxt (concat cpltxt "::" (org-make-org-heading-search-string txt)) desc "NONE"))) - (setq link (org-make-link cpltxt))) + (setq link cpltxt)) ((org-called-interactively-p 'interactive) (error "Cannot link to a buffer which is not visiting a file")) @@ -8938,10 +9136,6 @@ according to FMT (default from `org-email-link-description-format')." (reverse slines))) "\n"))))) (mapconcat 'identity (org-split-string s "[ \t]+") " "))) -(defun org-make-link (&rest strings) - "Concatenate STRINGS." - (apply 'concat strings)) - (defun org-make-link-string (link &optional description) "Make a link with brackets, consisting of LINK and DESCRIPTION." (unless (string-match "\\S-" link) @@ -8978,8 +9172,6 @@ according to FMT (default from `org-email-link-description-format')." "List of characters that should be escaped in link. This is the list that is used for internal purposes.") -(defvar org-url-encoding-use-url-hexify nil) - (defconst org-link-escape-chars-browser '(?\ ) "List of escapes for characters that are problematic in links. @@ -8992,25 +9184,24 @@ Optional argument TABLE is a list with characters that should be escaped. When nil, `org-link-escape-chars' is used. If optional argument MERGE is set, merge TABLE into `org-link-escape-chars'." - (if (and org-url-encoding-use-url-hexify (not table)) - (url-hexify-string text) - (cond - ((and table merge) - (mapc (lambda (defchr) - (unless (member defchr table) - (setq table (cons defchr table)))) org-link-escape-chars)) - ((null table) - (setq table org-link-escape-chars))) - (mapconcat - (lambda (char) - (if (or (member char table) - (< char 32) (= char 37) (> char 126)) - (mapconcat (lambda (sequence-element) - (format "%%%.2X" sequence-element)) - (or (encode-coding-char char 'utf-8) - (error "Unable to percent escape character: %s" - (char-to-string char))) "") - (char-to-string char))) text ""))) + (cond + ((and table merge) + (mapc (lambda (defchr) + (unless (member defchr table) + (setq table (cons defchr table)))) org-link-escape-chars)) + ((null table) + (setq table org-link-escape-chars))) + (mapconcat + (lambda (char) + (if (or (member char table) + (and (or (< char 32) (= char 37) (> char 126)) + org-url-hexify-p)) + (mapconcat (lambda (sequence-element) + (format "%%%.2X" sequence-element)) + (or (encode-coding-char char 'utf-8) + (error "Unable to percent escape character: %s" + (char-to-string char))) "") + (char-to-string char))) text "")) (defun org-link-unescape (str) "Unhex hexified Unicode strings as returned from the JavaScript function @@ -9083,6 +9274,14 @@ Note: this function also decodes single byte encodings like (setq s (replace-match "%40" t t s))) s) +(defun org-link-prettify (link) + "Return a human-readable representation of LINK. +The car of LINK must be a raw link the cdr of LINK must be either +a link description or nil." + (let ((desc (or (cadr link) "<no description>"))) + (concat (format "%-45s" (substring desc 0 (min (length desc) 40))) + "<" (car link) ">"))) + ;;;###autoload (defun org-insert-link-global () "Insert a link like Org-mode does. @@ -9091,6 +9290,38 @@ 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-all-links (&optional keep) + "Insert all links in `org-stored-links'." + (interactive "P") + (let ((links (copy-sequence org-stored-links)) l) + (while (setq l (if keep (pop links) (pop org-stored-links))) + (insert "- ") + (org-insert-link nil (car l) (cadr l)) + (insert "\n")))) + +(defun org-link-fontify-links-to-this-file () + "Fontify links to the current file in `org-stored-links'." + (let ((f (buffer-file-name)) a b) + (setq a (mapcar (lambda(l) + (let ((ll (car l))) + (when (and (string-match "^file:\\(.+\\)::" ll) + (equal f (expand-file-name (match-string 1 ll)))) + ll))) + org-stored-links)) + (when (featurep 'org-id) + (setq b (mapcar (lambda(l) + (let ((ll (car l))) + (when (and (string-match "^id:\\(.+\\)$" ll) + (equal f (expand-file-name + (or (org-id-find-id-file + (match-string 1 ll)) "")))) + ll))) + org-stored-links))) + (mapcar (lambda(l) + (put-text-property 0 (length l) 'face 'font-lock-comment-face l)) + (delq nil (append a b))))) + +(defvar org-link-links-in-this-file nil) (defun org-insert-link (&optional complete-file link-location default-description) "Insert a link. At the prompt, enter the link. @@ -9139,7 +9370,8 @@ be used as the default description." (desc region) tmphist ; byte-compile incorrectly complains about this (link link-location) - entry file all-prefixes) + (abbrevs org-link-abbrev-alist-local) + entry file all-prefixes auto-desc) (cond (link-location) ; specified by arg, just use it. ((org-in-regexp org-bracket-link-regexp 1) @@ -9160,15 +9392,17 @@ be used as the default description." (setq link (org-file-complete-link complete-file))) (t ;; Read link, with completion for stored links. - (with-output-to-temp-buffer "*Org Links*" - (princ "Insert a link. + (org-link-fontify-links-to-this-file) + (org-switch-to-buffer-other-window "*Org Links*") + (with-current-buffer "*Org Links*" + (erase-buffer) + (insert "Insert a link. Use TAB to complete link prefixes, then RET for type-specific completion support\n") (when org-stored-links - (princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") - (princ (mapconcat - (lambda (x) - (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x))) - (reverse org-stored-links) "\n")))) + (insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") + (insert (mapconcat 'org-link-prettify + (reverse org-stored-links) "\n"))) + (goto-char (point-min))) (let ((cw (selected-window))) (select-window (get-buffer-window "*Org Links*" 'visible)) (with-current-buffer "*Org Links*" (setq truncate-lines t)) @@ -9178,7 +9412,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support ;; Fake a link history, containing the stored links. (setq tmphist (append (mapcar 'car org-stored-links) org-insert-link-history)) - (setq all-prefixes (append (mapcar 'car org-link-abbrev-alist-local) + (setq all-prefixes (append (mapcar 'car abbrevs) (mapcar 'car org-link-abbrev-alist) org-link-types)) (unwind-protect @@ -9191,12 +9425,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (append (mapcar (lambda (x) (list (concat x ":"))) all-prefixes) - (mapcar 'car org-stored-links)) + (mapcar 'car org-stored-links) + (mapcar 'cadr org-stored-links)) nil nil nil 'tmphist - (car (car org-stored-links))))) + (caar org-stored-links)))) (if (not (string-match "\\S-" link)) (error "No link selected")) + (mapc (lambda(l) + (when (equal link (cadr l)) (setq link (car l) auto-desc t))) + org-stored-links) (if (or (member link all-prefixes) (and (equal ":" (substring link -1)) (member (substring link 0 -1) all-prefixes) @@ -9206,15 +9444,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (kill-buffer "*Org Links*")) (setq entry (assoc link org-stored-links)) (or entry (push link org-insert-link-history)) - (if (funcall (if (equal complete-file '(64)) 'not 'identity) - (not org-keep-stored-link-after-insertion)) - (setq org-stored-links (delq (assoc link org-stored-links) - org-stored-links))) (setq desc (or desc (nth 1 entry))))) + (if (funcall (if (equal complete-file '(64)) 'not 'identity) + (not org-keep-stored-link-after-insertion)) + (setq org-stored-links (delq (assoc link org-stored-links) + org-stored-links))) + (if (string-match org-plain-link-re link) ;; URL-like link, normalize the use of angular brackets. - (setq link (org-make-link (org-remove-angle-brackets link)))) + (setq link (org-remove-angle-brackets link))) ;; Check if we are linking to the current file with a search option ;; If yes, simplify the link by using only the search option. @@ -9258,10 +9497,17 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (setq desc path)))) (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 + (or (condition-case nil + (funcall org-make-link-description-function link desc) + (error (progn (message "Can't get link description from `%s'" + (symbol-name org-make-link-description-function)) + (sit-for 2) nil))) + (read-string "Description: " default-description))) + (if default-description (setq desc default-description) + (setq desc (or (and auto-desc desc) + (read-string "Description: " desc))))) - (setq desc (read-string "Description: " desc)) (unless (string-match "\\S-" desc) (setq desc nil)) (if remove (apply 'delete-region remove)) (insert (org-make-link-string link desc)))) @@ -9282,16 +9528,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (expand-file-name "."))))) (cond ((equal arg '(16)) - (setq link (org-make-link + (setq link (concat "file:" (abbreviate-file-name (expand-file-name file))))) ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) - (setq link (org-make-link "file:" (match-string 1 file)))) + (setq link (concat "file:" (match-string 1 file)))) ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") (expand-file-name file)) - (setq link (org-make-link + (setq link (concat "file:" (match-string 1 (expand-file-name file))))) - (t (setq link (org-make-link "file:" file))))) + (t (setq link (concat "file:" file))))) link)) (defun org-completing-read (&rest args) @@ -9446,24 +9692,24 @@ If the link is in hidden text, expose it." (defun org-translate-link-from-planner (type path) "Translate a link from Emacs Planner syntax so that Org can follow it. This is still an experimental function, your mileage may vary." - (cond - ((member type '("http" "https" "news" "ftp")) - ;; standard Internet links are the same. - nil) - ((and (equal type "irc") (string-match "^//" path)) - ;; Planner has two / at the beginning of an irc link, we have 1. - ;; We should have zero, actually.... - (setq path (substring path 1))) - ((and (equal type "lisp") (string-match "^/" path)) - ;; Planner has a slash, we do not. - (setq type "elisp" path (substring path 1))) - ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path) - ;; A typical message link. Planner has the id after the final slash, - ;; we separate it with a hash mark - (setq path (concat (match-string 1 path) "#" - (org-remove-angle-brackets (match-string 2 path))))) - ) - (cons type path)) + (cond + ((member type '("http" "https" "news" "ftp")) + ;; standard Internet links are the same. + nil) + ((and (equal type "irc") (string-match "^//" path)) + ;; Planner has two / at the beginning of an irc link, we have 1. + ;; We should have zero, actually.... + (setq path (substring path 1))) + ((and (equal type "lisp") (string-match "^/" path)) + ;; Planner has a slash, we do not. + (setq type "elisp" path (substring path 1))) + ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path) + ;; A typical message link. Planner has the id after the final slash, + ;; we separate it with a hash mark + (setq path (concat (match-string 1 path) "#" + (org-remove-angle-brackets (match-string 2 path))))) + ) + (cons type path)) (defun org-find-file-at-mouse (ev) "Open file link or URL at mouse." @@ -9518,6 +9764,7 @@ Functions in this hook must return t if they identify and follow a link at point. If they don't find anything interesting at point, they must return nil.") +(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el (defun org-open-at-point (&optional arg reference-buffer) "Open link at or after point. If there is no link at point, this function will search forward up to @@ -9529,197 +9776,213 @@ application the system uses for this file type." (interactive "P") ;; if in a code block, then open the block's results (unless (call-interactively #'org-babel-open-src-block-result) - (org-load-modules-maybe) - (move-marker org-open-link-marker (point)) - (setq org-window-config-before-follow-link (current-window-configuration)) - (org-remove-occur-highlights nil nil t) - (cond - ((and (org-at-heading-p) - (not (org-in-regexp - (concat org-plain-link-re "\\|" - org-bracket-link-regexp "\\|" - org-angle-link-re "\\|" - "[ \t]:[^ \t\n]+:[ \t]*$"))) - (not (get-text-property (point) 'org-linked-text))) - (or (org-offer-links-in-entry arg) - (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) - ((run-hook-with-args-until-success 'org-open-at-point-functions)) - ((org-at-timestamp-p t) (org-follow-timestamp-link)) - ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) - (not (org-in-regexp org-bracket-link-regexp))) - (org-footnote-action)) - (t - (let (type path link line search (pos (point))) - (catch 'match - (save-excursion - (skip-chars-forward "^]\n\r") - (when (org-in-regexp org-bracket-link-regexp 1) - (setq link (org-extract-attributes - (org-link-unescape (org-match-string-no-properties 1)))) - (while (string-match " *\n *" link) - (setq link (replace-match " " t t link))) - (setq link (org-link-expand-abbrev link)) - (cond - ((or (file-name-absolute-p link) - (string-match "^\\.\\.?/" link)) - (setq type "file" path link)) - ((string-match org-link-re-with-space3 link) - (setq type (match-string 1 link) path (match-string 2 link))) - (t (setq type "thisfile" path link))) - (throw 'match t))) - - (when (get-text-property (point) 'org-linked-text) - (setq type "thisfile" - pos (if (get-text-property (1+ (point)) 'org-linked-text) - (1+ (point)) (point)) - path (buffer-substring - (or (previous-single-property-change pos 'org-linked-text) - (point-min)) - (or (next-single-property-change pos 'org-linked-text) - (point-max)))) - (throw 'match t)) + (org-load-modules-maybe) + (move-marker org-open-link-marker (point)) + (setq org-window-config-before-follow-link (current-window-configuration)) + (org-remove-occur-highlights nil nil t) + (cond + ((and (org-at-heading-p) + (not (org-at-timestamp-p t)) + (not (org-in-regexp + (concat org-plain-link-re "\\|" + org-bracket-link-regexp "\\|" + org-angle-link-re "\\|" + "[ \t]:[^ \t\n]+:[ \t]*$"))) + (not (get-text-property (point) 'org-linked-text))) + (or (org-offer-links-in-entry arg) + (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) + ((run-hook-with-args-until-success 'org-open-at-point-functions)) + ((and (org-at-timestamp-p t) + (not (org-in-regexp org-bracket-link-regexp))) + (org-follow-timestamp-link)) + ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) + (not (org-in-regexp org-bracket-link-regexp))) + (org-footnote-action)) + (t + (let (type path link line search (pos (point))) + (catch 'match + (save-excursion + (skip-chars-forward "^]\n\r") + (when (org-in-regexp org-bracket-link-regexp 1) + (setq link (org-extract-attributes + (org-link-unescape (org-match-string-no-properties 1)))) + (while (string-match " *\n *" link) + (setq link (replace-match " " t t link))) + (setq link (org-link-expand-abbrev link)) + (cond + ((or (file-name-absolute-p link) + (string-match "^\\.\\.?/" link)) + (setq type "file" path link)) + ((string-match org-link-re-with-space3 link) + (setq type (match-string 1 link) path (match-string 2 link))) + ((string-match "^help:+\\(.+\\)" link) + (setq type "help" path (match-string 1 link))) + (t (setq type "thisfile" path link))) + (throw 'match t))) + + (when (get-text-property (point) 'org-linked-text) + (setq type "thisfile" + pos (if (get-text-property (1+ (point)) 'org-linked-text) + (1+ (point)) (point)) + path (buffer-substring + (or (previous-single-property-change pos 'org-linked-text) + (point-min)) + (or (next-single-property-change pos 'org-linked-text) + (point-max)))) + (throw 'match t)) - (save-excursion - (when (or (org-in-regexp org-angle-link-re) - (org-in-regexp org-plain-link-re)) - (setq type (match-string 1) - path (org-link-unescape (match-string 2))) - (throw 'match t))) - (save-excursion - (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) - (setq type "tags" + (save-excursion + (when (or (org-in-regexp org-angle-link-re) + (and (goto-char (car (org-in-regexp org-plain-link-re))) + (save-match-data (not (looking-back "\\[\\["))))) + (setq type (match-string 1) + path (org-link-unescape (match-string 2))) + (throw 'match t))) + (save-excursion + (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) + (setq type "tags" + path (match-string 1)) + (while (string-match ":" path) + (setq path (replace-match "+" t t path))) + (throw 'match t))) + (when (org-in-regexp "<\\([^><\n]+\\)>") + (setq type "tree-match" path (match-string 1)) - (while (string-match ":" path) - (setq path (replace-match "+" t t path))) (throw 'match t))) - (when (org-in-regexp "<\\([^><\n]+\\)>") - (setq type "tree-match" - path (match-string 1)) - (throw 'match t))) - (unless path - (error "No link found")) - - ;; switch back to reference buffer - ;; needed when if called in a temporary buffer through - ;; org-open-link-from-string - (with-current-buffer (or reference-buffer (current-buffer)) - - ;; Remove any trailing spaces in path - (if (string-match " +\\'" path) - (setq path (replace-match "" t t path))) - (if (and org-link-translation-function - (fboundp org-link-translation-function)) - ;; Check if we need to translate the link - (let ((tmp (funcall org-link-translation-function type path))) - (setq type (car tmp) path (cdr tmp)))) + (unless path + (error "No link found")) + + ;; switch back to reference buffer + ;; needed when if called in a temporary buffer through + ;; org-open-link-from-string + (with-current-buffer (or reference-buffer (current-buffer)) + + ;; Remove any trailing spaces in path + (if (string-match " +\\'" path) + (setq path (replace-match "" t t path))) + (if (and org-link-translation-function + (fboundp org-link-translation-function)) + ;; Check if we need to translate the link + (let ((tmp (funcall org-link-translation-function type path))) + (setq type (car tmp) path (cdr tmp)))) - (cond + (cond - ((assoc type org-link-protocols) - (funcall (nth 1 (assoc type org-link-protocols)) path)) - - ((equal type "mailto") - (let ((cmd (car org-link-mailto-program)) - (args (cdr org-link-mailto-program)) args1 - (address path) (subject "") a) - (if (string-match "\\(.*\\)::\\(.*\\)" path) - (setq address (match-string 1 path) - subject (org-link-escape (match-string 2 path)))) - (while args - (cond - ((not (stringp (car args))) (push (pop args) args1)) - (t (setq a (pop args)) - (if (string-match "%a" a) - (setq a (replace-match address t t a))) - (if (string-match "%s" a) - (setq a (replace-match subject t t a))) - (push a args1)))) - (apply cmd (nreverse args1)))) - - ((member type '("http" "https" "ftp" "news")) - (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path) - (org-link-escape - path org-link-escape-chars-browser) - path)))) - - ((string= type "doi") - (browse-url (concat "http://dx.doi.org/" (if (org-string-match-p "[[:nonascii:] ]" path) + ((assoc type org-link-protocols) + (funcall (nth 1 (assoc type org-link-protocols)) path)) + + ((equal type "help") + (let ((f-or-v (intern path))) + (cond ((fboundp f-or-v) + (describe-function f-or-v)) + ((boundp f-or-v) + (describe-variable f-or-v)) + (t (error "Not a known function or variable"))))) + + ((equal type "mailto") + (let ((cmd (car org-link-mailto-program)) + (args (cdr org-link-mailto-program)) args1 + (address path) (subject "") a) + (if (string-match "\\(.*\\)::\\(.*\\)" path) + (setq address (match-string 1 path) + subject (org-link-escape (match-string 2 path)))) + (while args + (cond + ((not (stringp (car args))) (push (pop args) args1)) + (t (setq a (pop args)) + (if (string-match "%a" a) + (setq a (replace-match address t t a))) + (if (string-match "%s" a) + (setq a (replace-match subject t t a))) + (push a args1)))) + (apply cmd (nreverse args1)))) + + ((member type '("http" "https" "ftp" "news")) + (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path) + (org-link-escape + path org-link-escape-chars-browser) + path)))) + + ((string= type "doi") + (browse-url (concat org-doi-server-url (if (org-string-match-p "[[:nonascii:] ]" path) (org-link-escape path org-link-escape-chars-browser) path)))) - ((member type '("message")) - (browse-url (concat type ":" path))) - - ((string= type "tags") - (org-tags-view arg path)) - - ((string= type "tree-match") - (org-occur (concat "\\[" (regexp-quote path) "\\]"))) - - ((string= type "file") - (if (string-match "::\\([0-9]+\\)\\'" path) - (setq line (string-to-number (match-string 1 path)) - path (substring path 0 (match-beginning 0))) - (if (string-match "::\\(.+\\)\\'" path) - (setq search (match-string 1 path) - path (substring path 0 (match-beginning 0))))) - (if (string-match "[*?{]" (file-name-nondirectory path)) - (dired path) - (org-open-file path arg line search))) - - ((string= type "shell") - (let ((cmd path)) - (if (or (and (not (string= org-confirm-shell-link-not-regexp "")) - (string-match org-confirm-shell-link-not-regexp cmd)) - (not org-confirm-shell-link-function) - (funcall org-confirm-shell-link-function - (format "Execute \"%s\" in shell? " - (org-add-props cmd nil - 'face 'org-warning)))) - (progn - (message "Executing %s" cmd) - (shell-command cmd)) - (error "Abort")))) - - ((string= type "elisp") - (let ((cmd path)) - (if (or (and (not (string= org-confirm-elisp-link-not-regexp "")) - (string-match org-confirm-elisp-link-not-regexp cmd)) - (not org-confirm-elisp-link-function) - (funcall org-confirm-elisp-link-function - (format "Execute \"%s\" as elisp? " - (org-add-props cmd nil - 'face 'org-warning)))) - (message "%s => %s" cmd - (if (equal (string-to-char cmd) ?\() - (eval (read cmd)) - (call-interactively (read cmd)))) - (error "Abort")))) - - ((and (string= type "thisfile") - (run-hook-with-args-until-success - 'org-open-link-functions path))) - - ((string= type "thisfile") - (if arg - (switch-to-buffer-other-window - (org-get-buffer-for-internal-link (current-buffer))) - (org-mark-ring-push)) - (let ((cmd `(org-link-search - ,path - ,(cond ((equal arg '(4)) ''occur) - ((equal arg '(16)) ''org-occur) - (t nil)) - ,pos))) - (condition-case nil (let ((org-link-search-inhibit-query t)) - (eval cmd)) - (error (progn (widen) (eval cmd)))))) - - (t - (browse-url-at-point))))))) - (move-marker org-open-link-marker nil) - (run-hook-with-args 'org-follow-link-hook))) + ((member type '("message")) + (browse-url (concat type ":" path))) + + ((string= type "tags") + (org-tags-view arg path)) + + ((string= type "tree-match") + (org-occur (concat "\\[" (regexp-quote path) "\\]"))) + + ((string= type "file") + (if (string-match "::\\([0-9]+\\)\\'" path) + (setq line (string-to-number (match-string 1 path)) + path (substring path 0 (match-beginning 0))) + (if (string-match "::\\(.+\\)\\'" path) + (setq search (match-string 1 path) + path (substring path 0 (match-beginning 0))))) + (if (string-match "[*?{]" (file-name-nondirectory path)) + (dired path) + (org-open-file path arg line search))) + + ((string= type "shell") + (let ((buf (generate-new-buffer "*Org Shell Output")) + (cmd path)) + (if (or (and (not (string= org-confirm-shell-link-not-regexp "")) + (string-match org-confirm-shell-link-not-regexp cmd)) + (not org-confirm-shell-link-function) + (funcall org-confirm-shell-link-function + (format "Execute \"%s\" in shell? " + (org-add-props cmd nil + 'face 'org-warning)))) + (progn + (message "Executing %s" cmd) + (shell-command cmd buf) + (if (featurep 'midnight) + (setq clean-buffer-list-kill-buffer-names + (cons buf clean-buffer-list-kill-buffer-names)))) + (error "Abort")))) + + ((string= type "elisp") + (let ((cmd path)) + (if (or (and (not (string= org-confirm-elisp-link-not-regexp "")) + (string-match org-confirm-elisp-link-not-regexp cmd)) + (not org-confirm-elisp-link-function) + (funcall org-confirm-elisp-link-function + (format "Execute \"%s\" as elisp? " + (org-add-props cmd nil + 'face 'org-warning)))) + (message "%s => %s" cmd + (if (equal (string-to-char cmd) ?\() + (eval (read cmd)) + (call-interactively (read cmd)))) + (error "Abort")))) + + ((and (string= type "thisfile") + (run-hook-with-args-until-success + 'org-open-link-functions path))) + + ((string= type "thisfile") + (if arg + (switch-to-buffer-other-window + (org-get-buffer-for-internal-link (current-buffer))) + (org-mark-ring-push)) + (let ((cmd `(org-link-search + ,path + ,(cond ((equal arg '(4)) ''occur) + ((equal arg '(16)) ''org-occur)) + ,pos))) + (condition-case nil (let ((org-link-search-inhibit-query t)) + (eval cmd)) + (error (progn (widen) (eval cmd)))))) + + (t (browse-url-at-point))))))) + (move-marker org-open-link-marker nil) + (run-hook-with-args 'org-follow-link-hook))) (defun org-offer-links-in-entry (&optional nth zero) "Offer links in the current entry and follow the selected link. @@ -9903,6 +10166,22 @@ visibility around point, thus ignoring pos (match-beginning 0)))) ;; There is an exact target for this (goto-char pos)) + ((save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (format "^[ \t]*#\\+TARGET: %s" (regexp-quote s0)) nil t) + (setq type 'dedicated pos (match-beginning 0)))) + ;; Found an invisible target. + (goto-char pos)) + ((save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t) + (setq type 'dedicated pos (match-beginning 0)))) + ;; Found an element with a matching #+name affiliated keyword. + (goto-char pos)) ((and (string-match "^(\\(.*\\))$" s0) (save-excursion (goto-char (point-min)) @@ -9919,12 +10198,12 @@ visibility around point, thus ignoring ((string-match "^/\\(.*\\)/$" s) ;; A regular expression (cond - ((eq major-mode 'org-mode) + ((derived-mode-p '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 (eq major-mode 'org-mode) org-link-search-must-match-exact-headline) + ((and (derived-mode-p 'org-mode) org-link-search-must-match-exact-headline) (and (equal (string-to-char s) ?*) (setq s (substring s 1))) (goto-char (point-min)) (cond @@ -9992,7 +10271,7 @@ visibility around point, thus ignoring (goto-char (match-beginning 1)) (goto-char pos) (error "No match")))))) - (and (eq major-mode 'org-mode) + (and (derived-mode-p 'org-mode) (not stealth) (org-show-context 'link-search)) type)) @@ -10073,8 +10352,8 @@ to read." (or pos (point)) (or buffer (current-buffer))) (message "%s" - (substitute-command-keys - "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) + (substitute-command-keys + "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) (defun org-mark-ring-goto (&optional n) "Jump to the previous position in the mark ring. @@ -10110,18 +10389,24 @@ onto the ring." ;;; Following specific links (defun org-follow-timestamp-link () + "Open an agenda view for the time-stamp date/range at point." (cond ((org-at-date-range-p t) (let ((org-agenda-start-on-weekday) (t1 (match-string 1)) - (t2 (match-string 2))) - (setq t1 (time-to-days (org-time-string-to-time t1)) - t2 (time-to-days (org-time-string-to-time t2))) - (org-agenda-list nil t1 (1+ (- t2 t1))))) + (t2 (match-string 2)) tt1 tt2) + (setq tt1 (time-to-days (org-time-string-to-time t1)) + tt2 (time-to-days (org-time-string-to-time t2))) + (let ((org-agenda-buffer-tmp-name + (format "*Org Agenda(a:%s)" + (concat (substring t1 0 10) "--" (substring t2 0 10))))) + (org-agenda-list nil tt1 (1+ (- tt2 tt1)))))) ((org-at-timestamp-p t) - (org-agenda-list nil (time-to-days (org-time-string-to-time - (substring (match-string 1) 0 10))) - 1)) + (let ((org-agenda-buffer-tmp-name + (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10)))) + (org-agenda-list nil (time-to-days (org-time-string-to-time + (substring (match-string 1) 0 10))) + 1))) (t (error "This should not happen")))) @@ -10170,9 +10455,9 @@ If the file does not exist, an error is thrown." (dfile (downcase file)) ;; reconstruct the original file: link from the PATH, LINE and SEARCH args (link (cond ((and (eq line nil) - (eq search nil)) - file) - (line + (eq search nil)) + file) + (line (concat file "::" (number-to-string line))) (search (concat file "::" search)))) @@ -10192,8 +10477,8 @@ If the file does not exist, an error is thrown." (t (setq cmd (or (and remp (cdr (assoc 'remote apps))) (and dirp (cdr (assoc 'directory apps))) - ; first, try matching against apps-dlink - ; if we get a match here, store the match data for later + ; first, try matching against apps-dlink + ; if we get a match here, store the match data for later (let ((match (assoc-default dlink apps-dlink 'string-match))) (if match @@ -10201,8 +10486,8 @@ If the file does not exist, an error is thrown." match) (progn (setq in-emacs (or in-emacs line search)) nil))) ; if we have no match in apps-dlink, - ; always open the file in emacs if line or search - ; is given (for backwards compatibility) + ; always open the file in emacs if line or search + ; is given (for backwards compatibility) (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) 'string-match) (cdr (assoc ext apps)) @@ -10263,7 +10548,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 (eq major-mode 'org-mode) (eq old-mode 'org-mode) + (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode) (or (not (equal old-buffer (current-buffer))) (not (equal old-pos (point)))) (org-mark-ring-push old-pos old-buffer)))) @@ -10328,8 +10613,7 @@ on the system \"/user@host:\"." (tramp-handle-file-remote-p file)) ((and (boundp 'ange-ftp-name-format) (string-match (car ange-ftp-name-format) file)) - t) - (t nil))) + t))) ;;;; Refiling @@ -10587,7 +10871,7 @@ such as the file name." (interactive "P") (let* ((bfn (buffer-file-name (buffer-base-buffer))) (case-fold-search nil) - (path (and (eq major-mode 'org-mode) (org-get-outline-path)))) + (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))) (if current (setq path (append path (save-excursion (org-back-to-heading t) @@ -10634,7 +10918,7 @@ RFLOC can be a refile location obtained in a different way. See also `org-refile-use-outline-path' and `org-completion-use-ido'. If you are using target caching (see `org-refile-use-cache'), -You have to clear the target cache in order to find new targets. +you have to clear the target cache in order to find new targets. This can be done with a 0 prefix (`C-0 C-c C-w') or a triple prefix argument (`C-u C-u C-u C-c C-w')." @@ -10741,7 +11025,9 @@ prefix argument (`C-u C-u C-u C-c C-w')." org-log-refile) (unless (eq org-log-refile 'note) (save-excursion (org-add-log-note)))) - (and org-auto-align-tags (org-set-tags nil t)) + (and org-auto-align-tags + (let ((org-loop-over-headlines-in-active-region nil)) + (org-set-tags nil t))) (bookmark-set "org-refile-last-stored") ;; If we are refiling for capture, make sure that the ;; last-capture pointers point here @@ -10775,7 +11061,7 @@ this is used for the GOTO interface." (let ((org-refile-targets org-refile-targets) (org-refile-use-outline-path org-refile-use-outline-path) excluded-entries) - (when (and (eq major-mode 'org-mode) + (when (and (derived-mode-p 'org-mode) (not org-refile-use-cache) (not no-exclude)) (org-map-tree @@ -10842,6 +11128,7 @@ this is used for the GOTO interface." (org-refile-new-child parent-target child))) (error "Invalid target location"))))) +(declare-function org-string-nw-p "org-macs.el" (s)) (defun org-refile-check-position (refile-pointer) "Check if the refile pointer matches the readline to which it points." (let* ((file (nth 1 refile-pointer)) @@ -10916,8 +11203,7 @@ this is used for the GOTO interface." rtn)) ((eq flag 'lambda) ;; exact match? - (assoc string thetable))) - )) + (assoc string thetable))))) args))) ;;;; Dynamic blocks @@ -10925,20 +11211,20 @@ this is used for the GOTO interface." (defun org-find-dblock (name) "Find the first dynamic block with name NAME in the buffer. If not found, stay at current position and return nil." - (let (pos) + (let ((case-fold-search t) pos) (save-excursion (goto-char (point-min)) - (setq pos (and (re-search-forward (concat "^[ \t]*#\\+BEGIN:[ \t]+" name "\\>") - nil t) + (setq pos (and (re-search-forward + (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t) (match-beginning 0)))) (if pos (goto-char pos)) pos)) (defconst org-dblock-start-re - "^[ \t]*#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" + "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" "Matches the start line of a dynamic block, with parameters.") -(defconst org-dblock-end-re "^[ \t]*#\\+END\\([: \t\r\n]\\|$\\)" +(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" "Matches the end of a dynamic block.") (defun org-create-dblock (plist) @@ -11027,15 +11313,15 @@ the correct writing function." (when (and indent (> indent 0)) (setq indent (make-string indent ?\ )) (save-excursion - (org-beginning-of-dblock) - (forward-line 1) - (while (not (looking-at org-dblock-end-re)) - (insert indent) - (beginning-of-line 2)) - (when (looking-at org-dblock-end-re) - (and (looking-at "[ \t]+") - (replace-match "")) - (insert indent))))))) + (org-beginning-of-dblock) + (forward-line 1) + (while (not (looking-at org-dblock-end-re)) + (insert indent) + (beginning-of-line 2)) + (when (looking-at org-dblock-end-re) + (and (looking-at "[ \t]+") + (replace-match "")) + (insert indent))))))) (defun org-beginning-of-dblock () "Find the beginning of the dynamic block at point. @@ -11051,11 +11337,12 @@ Error if there is no such block at point." (goto-char pos) (error "Not in a dynamic block")))) +;;;###autoload (defun org-update-all-dblocks () "Update all dynamic blocks in the buffer. This function can be used in a hook." (interactive) - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (org-map-dblocks 'org-update-dblock))) @@ -11069,46 +11356,68 @@ This function can be used in a hook." "BEGIN:" "END:" "ORGTBL" "TBLFM:" "TBLNAME:" "BEGIN_EXAMPLE" "END_EXAMPLE" + "BEGIN_VERBATIM" "END_VERBATIM" "BEGIN_QUOTE" "END_QUOTE" "BEGIN_VERSE" "END_VERSE" "BEGIN_CENTER" "END_CENTER" "BEGIN_SRC" "END_SRC" "BEGIN_RESULT" "END_RESULT" + "BEGIN_lstlisting" "END_lstlisting" "NAME:" "RESULTS:" "HEADER:" "HEADERS:" - "CATEGORY:" "COLUMNS:" "PROPERTY:" + "COLUMNS:" "PROPERTY:" "CAPTION:" "LABEL:" "SETUPFILE:" "INCLUDE:" "BIND:" "MACRO:")) +(defconst org-options-keywords + '("TITLE:" "AUTHOR:" "EMAIL:" "DATE:" + "DESCRIPTION:" "KEYWORDS:" "LANGUAGE:" "OPTIONS:" + "EXPORT_SELECT_TAGS:" "EXPORT_EXCLUDE_TAGS:" + "LINK_UP:" "LINK_HOME:" "LINK:" "TODO:" + "XSLT:" "MATHJAX:" "CATEGORY:" "SEQ_TODO:" "TYP_TODO:" + "PRIORITIES:" "DRAWERS:" "STARTUP:" "TAGS:" "STYLE:" + "FILETAGS:" "ARCHIVE:" "INFOJS_OPT:")) + +(defconst org-additional-option-like-keywords-for-flyspell + (delete-dups + (split-string + (mapconcat (lambda(k) + (replace-regexp-in-string + "_\\|:" " " + (concat k " " (downcase k) " " (upcase k)))) + (append org-options-keywords org-additional-option-like-keywords) + " ") + " +" t))) + (defcustom org-structure-template-alist '( - ("s" "#+begin_src ?\n\n#+end_src" - "<src lang=\"?\">\n\n</src>") - ("e" "#+begin_example\n?\n#+end_example" - "<example>\n?\n</example>") - ("q" "#+begin_quote\n?\n#+end_quote" - "<quote>\n?\n</quote>") + ("s" "#+BEGIN_SRC ?\n\n#+END_SRC" + "<src lang=\"?\">\n\n</src>") + ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" + "<example>\n?\n</example>") + ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" + "<quote>\n?\n</quote>") ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" - "<verse>\n?\n</verse>") + "<verse>\n?\n</verse>") ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" - "<center>\n?\n</center>") + "<center>\n?\n</center>") ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX" - "<literal style=\"latex\">\n?\n</literal>") - ("L" "#+latex: " - "<literal style=\"latex\">?</literal>") - ("h" "#+begin_html\n?\n#+end_html" - "<literal style=\"html\">\n?\n</literal>") - ("H" "#+html: " - "<literal style=\"html\">?</literal>") - ("a" "#+begin_ascii\n?\n#+end_ascii") - ("A" "#+ascii: ") - ("i" "#+index: ?" - "#+index: ?") - ("I" "#+include %file ?" - "<include file=%file markup=\"?\">") + "<literal style=\"latex\">\n?\n</literal>") + ("L" "#+LaTeX: " + "<literal style=\"latex\">?</literal>") + ("h" "#+BEGIN_HTML\n?\n#+END_HTML" + "<literal style=\"html\">\n?\n</literal>") + ("H" "#+HTML: " + "<literal style=\"html\">?</literal>") + ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII") + ("A" "#+ASCII: ") + ("i" "#+INDEX: ?" + "#+INDEX: ?") + ("I" "#+INCLUDE: %file ?" + "<include file=%file markup=\"?\">") ) "Structure completion elements. This is a list of abbreviation keys and values. The value gets inserted @@ -11119,8 +11428,7 @@ of the `?` in the template. There are two templates for each key, the first uses the original Org syntax, the second uses Emacs Muse-like syntax tags. These Muse-like tags become the default when the /org-mtags.el/ module has been loaded. See also the -variable `org-mtags-prefer-muse-templates'. -This is an experimental feature, it is undecided if it is going to stay in." +variable `org-mtags-prefer-muse-templates'." :group 'org-completion :type '(repeat (string :tag "Key") @@ -11205,14 +11513,14 @@ nil or a string to be used for the todo mark." ) (defvar org-agenda-headline-snapshot-before-repeat) (defun org-current-effective-time () - "Return current time adjusted for `org-extend-today-until' variable" + "Return current time adjusted for `org-extend-today-until' variable." (let* ((ct (org-current-time)) - (dct (decode-time ct)) - (ct1 - (if (and org-use-effective-time - (< (nth 2 dct) org-extend-today-until)) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) - ct))) + (dct (decode-time ct)) + (ct1 + (if (and org-use-effective-time + (< (nth 2 dct) org-extend-today-until)) + (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) + ct))) ct1)) (defun org-todo-yesterday (&optional arg) @@ -11310,54 +11618,54 @@ For calling through lisp, arg is also interpreted in the following way: ((and (equal arg '(4)) (or (not org-use-fast-todo-selection) (not org-todo-key-trigger))) - ;; Read a state with completion - (org-icompleting-read - "State: " (mapcar (lambda(x) (list x)) - org-todo-keywords-1) - nil t)) - ((eq arg 'right) - (if this - (if tail (car tail) nil) - (car org-todo-keywords-1))) - ((eq arg 'left) - (if (equal member org-todo-keywords-1) - nil - (if this - (nth (- (length org-todo-keywords-1) - (length tail) 2) - org-todo-keywords-1) - (org-last org-todo-keywords-1)))) - ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) - (setq arg nil))) ; hack to fall back to cycling - (arg - ;; user or caller requests a specific state - (cond - ((equal arg "") nil) - ((eq arg 'none) nil) - ((eq arg 'done) (or done-word (car org-done-keywords))) - ((eq arg 'nextset) - (or (car (cdr (member head org-todo-heads))) - (car org-todo-heads))) - ((eq arg 'previousset) - (let ((org-todo-heads (reverse org-todo-heads))) - (or (car (cdr (member head org-todo-heads))) - (car org-todo-heads)))) - ((car (member arg org-todo-keywords-1))) - ((stringp arg) - (error "State `%s' not valid in this file" arg)) - ((nth (1- (prefix-numeric-value arg)) - org-todo-keywords-1)))) - ((null member) (or head (car org-todo-keywords-1))) - ((equal this final-done-word) nil) ;; -> make empty - ((null tail) nil) ;; -> first entry - ((memq interpret '(type priority)) - (if (eq this-command last-command) - (car tail) - (if (> (length tail) 0) - (or done-word (car org-done-keywords)) - nil))) - (t - (car tail)))) + ;; Read a state with completion + (org-icompleting-read + "State: " (mapcar (lambda(x) (list x)) + org-todo-keywords-1) + nil t)) + ((eq arg 'right) + (if this + (if tail (car tail) nil) + (car org-todo-keywords-1))) + ((eq arg 'left) + (if (equal member org-todo-keywords-1) + nil + (if this + (nth (- (length org-todo-keywords-1) + (length tail) 2) + org-todo-keywords-1) + (org-last org-todo-keywords-1)))) + ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) + (setq arg nil))) ; hack to fall back to cycling + (arg + ;; user or caller requests a specific state + (cond + ((equal arg "") nil) + ((eq arg 'none) nil) + ((eq arg 'done) (or done-word (car org-done-keywords))) + ((eq arg 'nextset) + (or (car (cdr (member head org-todo-heads))) + (car org-todo-heads))) + ((eq arg 'previousset) + (let ((org-todo-heads (reverse org-todo-heads))) + (or (car (cdr (member head org-todo-heads))) + (car org-todo-heads)))) + ((car (member arg org-todo-keywords-1))) + ((stringp arg) + (error "State `%s' not valid in this file" arg)) + ((nth (1- (prefix-numeric-value arg)) + org-todo-keywords-1)))) + ((null member) (or head (car org-todo-keywords-1))) + ((equal this final-done-word) nil) ;; -> make empty + ((null tail) nil) ;; -> first entry + ((memq interpret '(type priority)) + (if (eq this-command last-command) + (car tail) + (if (> (length tail) 0) + (or done-word (car org-done-keywords)) + nil))) + (t + (car tail)))) (org-state (or (run-hook-with-args-until-success 'org-todo-get-default-hook org-state org-last-state) @@ -11913,7 +12221,7 @@ This function is run automatically after each state change to a DONE state." (aa (assoc org-last-state org-todo-kwd-alist)) (interpret (nth 1 aa)) (head (nth 2 aa)) - (whata '(("d" . day) ("m" . month) ("y" . year))) + (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year))) (msg "Entry repeats: ") (org-log-done nil) (org-todo-log-states nil) @@ -11949,10 +12257,12 @@ This function is run automatically after each state change to a DONE state." (setq type (if (match-end 1) org-scheduled-string (if (match-end 3) org-deadline-string "Plain:")) ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0)))) - (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts) + (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts) (setq n (string-to-number (match-string 2 ts)) what (match-string 3 ts)) (if (equal what "w") (setq n (* n 7) what "d")) + (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))) + (error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n)) ;; Preparation, see if we need to modify the start date for the change (when (match-end 1) (setq time (save-match-data (org-time-string-to-time ts))) @@ -11978,7 +12288,7 @@ This function is run automatically after each state change to a DONE state." ;; rematch, so that we have everything in place for the real shift (org-at-timestamp-p t) (setq ts (match-string 1)) - (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts)))) + (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)))) (org-timestamp-change n (cdr (assoc what whata))) (setq msg (concat msg type " " org-last-changed-timestamp " ")))) (setq org-log-post-message msg) @@ -11997,7 +12307,7 @@ of `org-todo-keywords-1'." (cond ((null arg) org-not-done-regexp) ((equal arg '(4)) (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): " - (mapcar 'list org-todo-keywords-1)))) + (mapcar 'list org-todo-keywords-1)))) (concat "\\(" (mapconcat 'identity (org-split-string kwd "|") "\\|") "\\)\\>"))) @@ -12025,7 +12335,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (let* ((old-date (org-entry-get nil "DEADLINE")) (repeater (and old-date (string-match - "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?" + "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" old-date) (match-string 1 old-date)))) (if remove @@ -12073,7 +12383,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (let* ((old-date (org-entry-get nil "SCHEDULED")) (repeater (and old-date (string-match - "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?" + "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" old-date) (match-string 1 old-date)))) (if remove @@ -12281,8 +12591,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (let* ((org-log-into-drawer (org-log-into-drawer)) (drawer (cond ((stringp org-log-into-drawer) org-log-into-drawer) - (org-log-into-drawer "LOGBOOK") - (t nil)))) + (org-log-into-drawer "LOGBOOK")))) (save-restriction (save-excursion (when findpos @@ -12304,9 +12613,9 @@ EXTRA is additional text that will be inserted into the notes buffer." (goto-char (1- (match-beginning 0)))))) (insert "\n:" drawer ":\n:END:") (beginning-of-line 0) - (org-indent-line-function) + (org-indent-line) (beginning-of-line 2) - (org-indent-line-function) + (org-indent-line) (end-of-line 0))) ((and org-log-state-notes-insert-after-drawers (save-excursion @@ -12386,7 +12695,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (note (cdr (assq org-log-note-purpose org-log-note-headings))) lines ind bul) (kill-buffer (current-buffer)) - (while (string-match "\\`#.*\n[ \t\n]*" txt) + (while (string-match "\\`# .*\n[ \t\n]*" txt) (setq txt (replace-match "" t t txt))) (if (string-match "\\s-+\\'" txt) (setq txt (replace-match "" t t txt))) @@ -12471,7 +12780,8 @@ POS may also be a marker." (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2) (replace-match "")))))) -(defun org-sparse-tree (&optional arg) +(defvar org-ts-type nil) +(defun org-sparse-tree (&optional arg type) "Create a sparse tree, prompt for the details. This command can create sparse trees. You first need to select the type of match used to create the tree: @@ -12481,15 +12791,27 @@ T Show entries with a specific TODO keyword. m Show entries selected by a tags/property match. p Enter a property name and its value (both with completion on existing names/values) and show entries with that property. -r Show entries matching a regular expression (`/' can be used as well) -d Show deadlines due within `org-deadline-warning-days'. +r Show entries matching a regular expression (`/' can be used as well). b Show deadlines and scheduled items before a date. -a Show deadlines and scheduled items after a date." +a Show deadlines and scheduled items after a date. +d Show deadlines due within `org-deadline-warning-days'. +D Show deadlines and scheduled items between a date range." (interactive "P") - (let (ans kwd value) - (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range") + (let (ans kwd value ts-type) + (setq type (or type org-sparse-tree-default-date-type)) + (setq org-ts-type type) + (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range\n [c]ycle through date types: %s" + (cond ((eq type 'all) "all timestamps") + ((eq type 'scheduled) "only scheduled") + ((eq type 'deadline) "only deadline") + ((eq type 'active) "only active timestamps") + ((eq type 'inactive) "only inactive timestamps") + ((eq type 'scheduled-or-deadline) "scheduled/deadline") + (t "scheduled/deadline"))) (setq ans (read-char-exclusive)) (cond + ((equal ans ?c) + (org-sparse-tree arg (cadr (member type '(scheduled-or-deadline all scheduled deadline active inactive))))) ((equal ans ?d) (call-interactively 'org-check-deadlines)) ((equal ans ?b) @@ -12506,9 +12828,9 @@ a Show deadlines and scheduled items after a date." (call-interactively 'org-match-sparse-tree)) ((member ans '(?p ?P)) (setq kwd (org-icompleting-read "Property: " - (mapcar 'list (org-buffer-property-keys)))) + (mapcar 'list (org-buffer-property-keys)))) (setq value (org-icompleting-read "Value: " - (mapcar 'list (org-property-values kwd)))) + (mapcar 'list (org-property-values kwd)))) (unless (string-match "\\`{.*}\\'" value) (setq value (concat "\"" value "\""))) (org-match-sparse-tree arg (concat kwd "=" value))) @@ -12693,10 +13015,12 @@ from the `before-change-functions' in the current buffer." (interactive) (org-priority 'down)) -(defun org-priority (&optional action) - "Change the priority of an item by ARG. +(defun org-priority (&optional action show) + "Change the priority of an item. ACTION can be `set', `up', `down', or a character." - (interactive) + (interactive "P") + (if (equal action '(4)) + (org-show-priority) (unless org-enable-priority-commands (error "Priority commands are disabled")) (setq action (or action 'set)) @@ -12773,7 +13097,21 @@ ACTION can be `set', `up', `down', or a character." (org-preserve-lc (org-set-tags nil 'align))) (if remove (message "Priority removed") - (message "Priority of current item set to %s" news)))) + (message "Priority of current item set to %s" news))))) + +(defun org-show-priority () + "Show the priority of the current item. +This priority is composed of the main priority given with the [#A] cookies, +and by additional input from the age of a schedules or deadline entry." + (interactive) + (let ((pri (if (eq major-mode 'org-agenda-mode) + (org-get-at-bol 'priority) + (save-excursion + (save-match-data + (beginning-of-line) + (and (looking-at org-heading-regexp) + (org-get-priority (match-string 0)))))))) + (message "Priority is %d" (if pri pri -1000)))) (defun org-get-priority (s) "Find priority cookie and return priority." @@ -12896,7 +13234,8 @@ headlines matching this string." ;; eval matcher only when the todo condition is OK (and (or (not todo-only) (member todo org-not-done-keywords)) - (let ((case-fold-search t)) (eval matcher))) + (let ((case-fold-search t) (org-trust-scanner-tags t)) + (eval matcher))) ;; Call the skipper, but return t if it does not skip, ;; so that the `and' form continues evaluating @@ -12935,8 +13274,7 @@ headlines matching this string." (make-string (1- level) ?.) "") (org-get-heading)) category - tags-list - ) + tags-list) priority (org-get-priority txt)) (goto-char lspos) (setq marker (org-agenda-new-marker)) @@ -12993,7 +13331,7 @@ MATCH can contain positive and negative selection of tags, like If optional argument TODO-ONLY is non-nil, only select lines that are also TODO lines." (interactive "P") - (org-prepare-agenda-buffers (list (current-buffer))) + (org-agenda-prepare-buffers (list (current-buffer))) (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) (defalias 'org-tags-sparse-tree 'org-match-sparse-tree) @@ -13014,7 +13352,7 @@ also TODO lines." (defun org-global-tags-completion-table (&optional files) "Return the list of all tags in all agenda buffer/files. -Optional FILES argument is a list of files to which can be used +Optional FILES argument is a list of files which can be used instead of the agenda files." (save-excursion (org-uniquify @@ -13034,19 +13372,18 @@ instead of the agenda files." (defun org-make-tags-matcher (match) "Create the TAGS/TODO matcher form for the selection string MATCH. -The variable `todo-only' is scoped dynamically into this function; it will be -set to t if the matcher restricts matching to TODO entries, +The variable `todo-only' is scoped dynamically into this function. +It will be set to t if the matcher restricts matching to TODO entries, otherwise will not be touched. Returns a cons of the selection string MATCH and the constructed -lisp form implementing the matcher. The matcher is to be -evaluated at an Org entry, with point on the headline, -and returns t if the entry matches the -selection string MATCH. The returned lisp form references -two variables with information about the entry, which must be -bound around the form's evaluation: todo, the TODO keyword at the -entry (or nil of none); and tags-list, the list of all tags at the -entry including inherited ones. Additionally, the category +lisp form implementing the matcher. The matcher is to be evaluated +at an Org entry, with point on the headline, and returns t if the +entry matches the selection string MATCH. The returned lisp form +references two variables with information about the entry, which +must be bound around the form's evaluation: todo, the TODO keyword +at the entry (or nil of none); and tags-list, the list of all tags +at the entry including inherited ones. Additionally, the category of the entry (if any) must be specified as the text property 'org-category on the headline. @@ -13226,7 +13563,7 @@ epoch to the beginning of today (00:00)." ((string= s "<today>") (org-time-today)) ((string= s "<tomorrow>") (+ 86400.0 (org-time-today))) ((string= s "<yesterday>") (- (org-time-today) 86400.0)) - ((string-match "^<\\([-+][0-9]+\\)\\([dwmy]\\)>$" s) + ((string-match "^<\\([-+][0-9]+\\)\\([hdwmy]\\)>$" s) (+ (org-time-today) (* (string-to-number (match-string 1 s)) (cdr (assoc (match-string 2 s) @@ -13357,7 +13694,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (defun org-set-tags-command (&optional arg just-align) "Call the set-tags command for the current entry." (interactive "P") - (if (org-at-heading-p) + (if (or (org-at-heading-p) (and arg (org-before-first-heading-p))) (org-set-tags arg just-align) (save-excursion (org-back-to-heading t) @@ -13376,8 +13713,7 @@ If DATA is nil or the empty string, any tags will be removed." (concat ":" (mapconcat 'identity (org-split-string data ":+") ":") ":")) ((listp data) - (concat ":" (mapconcat 'identity data ":") ":")) - (t nil))) + (concat ":" (mapconcat 'identity data ":") ":")))) (when data (save-excursion (org-back-to-heading t) @@ -13410,94 +13746,104 @@ If DATA is nil or the empty string, any tags will be removed." "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." (interactive "P") - (let* ((re org-outline-regexp-bol) - (current (org-get-tags-string)) - (col (current-column)) - (org-setting-tags t) - table current-tags inherited-tags ; computed below when needed - tags p0 c0 c1 rpl di tc level) - (if arg - (save-excursion - (goto-char (point-min)) - (let ((buffer-invisibility-spec (org-inhibit-invisibility))) - (while (re-search-forward re nil t) - (org-set-tags nil t) - (end-of-line 1))) - (message "All tags realigned to column %d" org-tags-column)) - (if just-align - (setq tags current) - ;; Get a new set of tags from the user - (save-excursion - (setq table (append org-tag-persistent-alist - (or org-tag-alist (org-get-buffer-tags)) - (and - org-complete-tags-always-offer-all-agenda-tags - (org-global-tags-completion-table - (org-agenda-files)))) - org-last-tags-completion-table table - current-tags (org-split-string current ":") - inherited-tags (nreverse - (nthcdr (length current-tags) - (nreverse (org-get-tags-at)))) - tags - (if (or (eq t org-use-fast-tag-selection) - (and org-use-fast-tag-selection - (delq nil (mapcar 'cdr table)))) - (org-fast-tag-selection - current-tags inherited-tags table - (if org-fast-tag-selection-include-todo - org-todo-key-alist)) - (let ((org-add-colon-after-tag-completion (< 1 (length table)))) - (org-trim - (org-icompleting-read "Tags: " - 'org-tags-completion-function - nil nil current 'org-tags-history)))))) - (while (string-match "[-+&]+" tags) - ;; No boolean logic, just a list - (setq tags (replace-match ":" t t tags)))) - - (setq tags (replace-regexp-in-string "[,]" ":" tags)) - - (if org-tags-sort-function - (setq tags (mapconcat 'identity - (sort (org-split-string - tags (org-re "[^[:alnum:]_@#%]+")) - org-tags-sort-function) ":"))) - - (if (string-match "\\`[\t ]*\\'" tags) - (setq tags "") - (unless (string-match ":$" tags) (setq tags (concat tags ":"))) - (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) - - ;; Insert new tags at the correct column - (beginning-of-line 1) - (setq level (or (and (looking-at org-outline-regexp) - (- (match-end 0) (point) 1)) - 1)) - (cond - ((and (equal current "") (equal tags ""))) - ((re-search-forward - (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") - (point-at-eol) t) - (if (equal tags "") - (setq rpl "") - (goto-char (match-beginning 0)) - (setq c0 (current-column) - ;; compute offset for the case of org-indent-mode active - di (if org-indent-mode - (* (1- org-indent-indentation-per-level) (1- level)) - 0) - p0 (if (equal (char-before) ?*) (1+ (point)) (point)) - tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) - c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags)))) - rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) - (replace-match rpl t t) - (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) - tags) - (t (error "Tags alignment failed"))) - (org-move-to-column col) - (unless just-align - (run-hooks 'org-after-tags-change-hook))))) + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + ;; We don't use ARG and JUST-ALIGN here these args are not + ;; useful when looping over headlines + `(org-set-tags) + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (let* ((re org-outline-regexp-bol) + (current (unless arg (org-get-tags-string))) + (col (current-column)) + (org-setting-tags t) + table current-tags inherited-tags ; computed below when needed + tags p0 c0 c1 rpl di tc level) + (if arg + (save-excursion + (goto-char (point-min)) + (let ((buffer-invisibility-spec (org-inhibit-invisibility))) + (while (re-search-forward re nil t) + (org-set-tags nil t) + (end-of-line 1))) + (message "All tags realigned to column %d" org-tags-column)) + (if just-align + (setq tags current) + ;; Get a new set of tags from the user + (save-excursion + (setq table (append org-tag-persistent-alist + (or org-tag-alist (org-get-buffer-tags)) + (and + org-complete-tags-always-offer-all-agenda-tags + (org-global-tags-completion-table + (org-agenda-files)))) + org-last-tags-completion-table table + current-tags (org-split-string current ":") + inherited-tags (nreverse + (nthcdr (length current-tags) + (nreverse (org-get-tags-at)))) + tags + (if (or (eq t org-use-fast-tag-selection) + (and org-use-fast-tag-selection + (delq nil (mapcar 'cdr table)))) + (org-fast-tag-selection + current-tags inherited-tags table + (if org-fast-tag-selection-include-todo + org-todo-key-alist)) + (let ((org-add-colon-after-tag-completion (< 1 (length table)))) + (org-trim + (org-icompleting-read "Tags: " + 'org-tags-completion-function + nil nil current 'org-tags-history)))))) + (while (string-match "[-+&]+" tags) + ;; No boolean logic, just a list + (setq tags (replace-match ":" t t tags)))) + + (setq tags (replace-regexp-in-string "[,]" ":" tags)) + + (if org-tags-sort-function + (setq tags (mapconcat 'identity + (sort (org-split-string + tags (org-re "[^[:alnum:]_@#%]+")) + org-tags-sort-function) ":"))) + + (if (string-match "\\`[\t ]*\\'" tags) + (setq tags "") + (unless (string-match ":$" tags) (setq tags (concat tags ":"))) + (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) + + ;; Insert new tags at the correct column + (beginning-of-line 1) + (setq level (or (and (looking-at org-outline-regexp) + (- (match-end 0) (point) 1)) + 1)) + (cond + ((and (equal current "") (equal tags ""))) + ((re-search-forward + (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") + (point-at-eol) t) + (if (equal tags "") + (setq rpl "") + (goto-char (match-beginning 0)) + (setq c0 (current-column) + ;; compute offset for the case of org-indent-mode active + di (if org-indent-mode + (* (1- org-indent-indentation-per-level) (1- level)) + 0) + p0 (if (equal (char-before) ?*) (1+ (point)) (point)) + tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) + c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags)))) + rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) + (replace-match rpl t t) + (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) + tags) + (t (error "Tags alignment failed"))) + (org-move-to-column col) + (unless just-align + (run-hooks 'org-after-tags-change-hook)))))) (defun org-change-tag-in-region (beg end tag off) "Add or remove TAG for each entry in the region. @@ -13505,7 +13851,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 (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (org-get-buffer-tags) (org-global-tags-completion-table)))) (org-icompleting-read @@ -13524,7 +13870,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 (eq major-mode 'org-mode) (org-at-heading-p)) + (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p)) (and agendap m)) (setq buf (if agendap (marker-buffer m) (current-buffer)) pos (if agendap m (point))) @@ -13683,8 +14029,7 @@ Returns the new tags string, or nil to not change the current settings." ((not (assoc tg table)) (org-get-todo-face tg)) ((member tg current) c-face) - ((member tg inherited) i-face) - (t nil)))) + ((member tg inherited) i-face)))) (if (and (= cnt 0) (not ingroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 (length tg)) ?\ )) @@ -13919,7 +14264,7 @@ a *different* entry, you cannot use these techniques." (if (not scope) (progn - (org-prepare-agenda-buffers + (org-agenda-prepare-buffers (list (buffer-file-name (current-buffer)))) (setq res (org-scan-tags func matcher todo-only start-level))) ;; Get the right scope @@ -13935,7 +14280,7 @@ a *different* entry, you cannot use these techniques." (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) + (org-agenda-prepare-buffers scope) (while (setq file (pop scope)) (with-current-buffer (org-find-base-buffer-visiting file) (save-excursion @@ -13951,7 +14296,7 @@ a *different* entry, you cannot use these techniques." (defconst org-special-properties '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY" - "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM") + "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM" "CLOCKSUM_T") "The special properties valid in Org-mode. These are properties that are not defined in the property drawer, @@ -13991,10 +14336,15 @@ Being in this list makes sure that they are offered for completion.") "Matches an entire clock drawer.") (defsubst org-re-property (property) - "Return a regexp matching PROPERTY. -Match group 1 will be set to the value " + "Return a regexp matching a PROPERTY line. +Match group 1 will be set to the value." (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)")) +(defsubst org-re-property-keyword (property) + "Return a regexp matching a PROPERTY line, possibly with no +value for the property." + (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)?")) + (defun org-property-action () "Do an action on properties." (interactive) @@ -14013,10 +14363,17 @@ Match group 1 will be set to the value " (call-interactively 'org-compute-property-at-point)) (t (error "No such property action %c" c))))) -(defun org-set-effort (&optional value) +(defun org-inc-effort () + "Increment the value of the effort property in the current entry." + (interactive) + (org-set-effort nil t)) + +(defun org-set-effort (&optional value increment) "Set the effort property of the current entry. -With numerical prefix arg, use the nth allowed value, 0 stands for the 10th -allowed value." +With numerical prefix arg, use the nth allowed value, 0 stands for the +10th allowed value. + +When INCREMENT is non-nil, set the property to the next allowed value." (interactive "P") (if (equal value 0) (setq value 10)) (let* ((completion-ignore-case t) @@ -14030,6 +14387,9 @@ allowed value." ((and allowed (integerp value)) (or (car (nth (1- value) allowed)) (car (org-last allowed)))) + ((and allowed increment) + (or (caadr (member (list cur) allowed)) + (error "Allowed effort values are not set"))) (allowed (message "Select 1-9,0, [RET%s]: %s" (if cur (concat "=" cur) "") @@ -14046,7 +14406,7 @@ allowed value." (let (org-completion-use-ido org-completion-use-iswitchb) (org-completing-read (concat "Effort " (if (and cur (string-match "\\S-" cur)) - (concat "[" cur "]") "") + (concat "[" cur "]") "") ": ") existing nil nil "" nil cur)))))) (unless (equal (org-entry-get nil prop) val) @@ -14066,13 +14426,16 @@ allowed value." (defun org-get-property-block (&optional beg end force) "Return the (beg . end) range of the body of the property drawer. -BEG and END can be beginning and end of subtree, if not given -they will be found. -If the drawer does not exist and FORCE is non-nil, create the drawer." +BEG and END are the beginning and end of the current subtree, or of +the part before the first headline. If they are not given, they will +be found. If the drawer does not exist and FORCE is non-nil, create +the drawer." (catch 'exit (save-excursion - (let* ((beg (or beg (progn (org-back-to-heading t) (point)))) - (end (or end (progn (outline-next-heading) (point))))) + (let* ((beg (or beg (and (org-before-first-heading-p) (point-min)) + (progn (org-back-to-heading t) (point)))) + (end (or end (and (not (outline-next-heading)) (point-max)) + (point)))) (goto-char beg) (if (re-search-forward org-property-start-re end t) (setq beg (1+ (match-end 0))) @@ -14089,7 +14452,7 @@ If the drawer does not exist and FORCE is non-nil, create the drawer." (or force (throw 'exit nil)) (goto-char beg) (setq end beg) - (org-indent-line-function) + (org-indent-line) (insert ":END:\n")) (cons beg end))))) @@ -14110,14 +14473,15 @@ things up because then unnecessary parsing is avoided." (let ((clockstr (substring org-clock-string 0 -1)) (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) (case-fold-search nil) - beg end range props sum-props key key1 value string clocksum) + beg end range props sum-props key key1 value string clocksum clocksumt) (save-excursion (when (condition-case nil - (and (eq major-mode 'org-mode) (org-back-to-heading t)) + (and (derived-mode-p 'org-mode) (org-back-to-heading t)) (error nil)) (setq beg (point)) (setq sum-props (get-text-property (point) 'org-summaries)) - (setq clocksum (get-text-property (point) :org-clock-minutes)) + (setq clocksum (get-text-property (point) :org-clock-minutes) + clocksumt (get-text-property (point) :org-clock-minutes-today)) (outline-next-heading) (setq end (point)) (when (memq which '(all special)) @@ -14152,11 +14516,10 @@ things up because then unnecessary parsing is avoided." (substring (org-match-string-no-properties 1) 0 -1)) string (if (equal key clockstr) - (org-no-properties - (org-trim - (buffer-substring - (match-beginning 3) (goto-char - (point-at-eol))))) + (org-trim + (buffer-substring-no-properties + (match-beginning 3) (goto-char + (point-at-eol)))) (substring (org-match-string-no-properties 3) 1 -1))) ;; Get the correct property name from the key. This is @@ -14177,8 +14540,7 @@ things up because then unnecessary parsing is avoided." ;; no need to search further if match is found (throw 'match t)) (when (or (equal key "CLOCK") (not (assoc key props))) - (push (cons key string) props)))))) - ) + (push (cons key string) props))))))) (when (memq which '(all standard)) ;; Get the standard properties, like :PROP: ... @@ -14195,14 +14557,19 @@ things up because then unnecessary parsing is avoided." (if clocksum (push (cons "CLOCKSUM" (org-columns-number-to-string (/ (float clocksum) 60.) - 'add_times)) + 'add_times)) + props)) + (if clocksumt + (push (cons "CLOCKSUM_T" + (org-columns-number-to-string (/ (float clocksumt) 60.) + 'add_times)) props)) (unless (assoc "CATEGORY" props) (push (cons "CATEGORY" (org-get-category)) props)) (append sum-props (nreverse props))))))) (defun org-entry-get (pom property &optional inherit literal-nil) - "Get value of PROPERTY for entry at point-or-marker POM. + "Get value of PROPERTY for entry or content at point-or-marker POM. If INHERIT is non-nil and the entry does not have the property, then also check higher levels of the hierarchy. If INHERIT is the symbol `selective', use inheritance only if the setting @@ -14222,13 +14589,11 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy." ;; We need a special property. Use `org-entry-properties' to ;; retrieve it, but specify the wanted property (cdr (assoc property (org-entry-properties nil 'special property))) - (let ((range (unless (org-before-first-heading-p) - (org-get-property-block))) - (props (list (or (assoc property org-file-properties) - (assoc property org-global-properties) - (assoc property org-global-properties-fixed)))) - val) - (flet ((ap (key) + (let* ((range (org-get-property-block)) + (props (list (or (assoc property org-file-properties) + (assoc property org-global-properties) + (assoc property org-global-properties-fixed)))) + (ap (lambda (key) (when (re-search-forward (org-re-property key) (cdr range) t) (setq props @@ -14237,12 +14602,13 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy." (if (match-end 1) (org-match-string-no-properties 1) "") props))))) - (when (and range (goto-char (car range))) - (ap property) - (goto-char (car range)) - (while (ap (concat property "+"))) - (setq val (cdr (assoc property props))) - (when val (if literal-nil val (org-not-nil val)))))))))) + val) + (when (and range (goto-char (car range))) + (funcall ap property) + (goto-char (car range)) + (while (funcall ap (concat property "+"))) + (setq val (cdr (assoc property props))) + (when val (if literal-nil val (org-not-nil val))))))))) (defun org-property-or-variable-value (var &optional inherit) "Check if there is a property fixing the value of VAR. @@ -14337,24 +14703,25 @@ Note that also `org-entry-get' calls this function, if the INHERIT flag is set.") (defun org-entry-get-with-inheritance (property &optional literal-nil) - "Get entry property, and search higher levels if not present. + "Get PROPERTY of entry or content at point, search higher levels if needed. The search will stop at the first ancestor which has the property defined. If the value found is \"nil\", return nil to show that the property should be considered as undefined (this is the meaning of nil here). However, if LITERAL-NIL is set, return the string value \"nil\" instead." (move-marker org-entry-property-inherited-from nil) (let (tmp) - (unless (org-before-first-heading-p) - (save-excursion - (save-restriction - (widen) - (catch 'ex - (while t - (when (setq tmp (org-entry-get nil property nil 'literal-nil)) - (org-back-to-heading t) - (move-marker org-entry-property-inherited-from (point)) - (throw 'ex tmp)) - (or (org-up-heading-safe) (throw 'ex nil))))))) + (save-excursion + (save-restriction + (widen) + (catch 'ex + (while t + (when (setq tmp (org-entry-get nil property nil 'literal-nil)) + (or (ignore-errors (org-back-to-heading t)) + (goto-char (point-min))) + (move-marker org-entry-property-inherited-from (point)) + (throw 'ex tmp)) + (or (ignore-errors (org-up-heading-safe)) + (throw 'ex nil)))))) (setq tmp (or tmp (cdr (assoc property org-file-properties)) (cdr (assoc property org-global-properties)) @@ -14384,7 +14751,7 @@ and the new value.") (org-set-tags nil 'align)) ((equal property "PRIORITY") (org-priority (if (and value (stringp value) (string-match "\\S-" value)) - (string-to-char value) ?\ )) + (string-to-char value) ?\ )) (org-set-tags nil 'align)) ((equal property "SCHEDULED") (if (re-search-forward org-scheduled-time-regexp end t) @@ -14408,17 +14775,17 @@ and the new value.") (setq range (org-get-property-block beg end 'force)) (goto-char (car range)) (if (re-search-forward - (org-re-property property) (cdr range) t) + (org-re-property-keyword property) (cdr range) t) (progn (delete-region (match-beginning 0) (match-end 0)) (goto-char (match-beginning 0))) (goto-char (cdr range)) (insert "\n") (backward-char 1) - (org-indent-line-function)) + (org-indent-line)) (insert ":" property ":") (and value (insert " " value)) - (org-indent-line-function))))) + (org-indent-line))))) (run-hook-with-args 'org-property-changed-functions property value))) (defun org-buffer-property-keys (&optional include-specials include-defaults include-columns) @@ -14484,11 +14851,10 @@ formats in the current buffer." (defun org-insert-property-drawer () "Insert a property drawer into the current entry." - (interactive) (org-back-to-heading t) (looking-at org-outline-regexp) (let ((indent (if org-adapt-indentation - (- (match-end 0)(match-beginning 0)) + (- (match-end 0) (match-beginning 0)) 0)) (beg (point)) (re (concat "^[ \t]*" org-keyword-time-regexp)) @@ -14522,6 +14888,71 @@ formats in the current buffer." (hide-entry)) (org-flag-drawer t)))) +(defun org-insert-drawer (&optional arg drawer) + "Insert a drawer at point. + +Optional argument DRAWER, when non-nil, is a string representing +drawer's name. Otherwise, the user is prompted for a name. + +If a region is active, insert the drawer around that region +instead. + +Point is left between drawer's boundaries." + (interactive "P") + (let* ((logbook (if (stringp org-log-into-drawer) org-log-into-drawer + "LOGBOOK")) + ;; SYSTEM-DRAWERS is a list of drawer names that are used + ;; internally by Org. They are meant to be inserted + ;; automatically. + (system-drawers `("CLOCK" ,logbook "PROPERTIES")) + ;; Remove system drawers from list. Note: For some reason, + ;; `org-completing-read' ignores the predicate while + ;; `completing-read' handles it fine. + (drawer (if arg "PROPERTIES" + (or drawer + (completing-read + "Drawer: " org-drawers + (lambda (d) (not (member d system-drawers)))))))) + (cond + ;; With C-u, fall back on `org-insert-property-drawer' + (arg (org-insert-property-drawer)) + ;; With an active region, insert a drawer at point. + ((not (org-region-active-p)) + (progn + (unless (bolp) (insert "\n")) + (insert (format ":%s:\n\n:END:\n" drawer)) + (forward-line -2))) + ;; Otherwise, insert the drawer at point + (t + (let ((rbeg (region-beginning)) + (rend (copy-marker (region-end)))) + (unwind-protect + (progn + (goto-char rbeg) + (beginning-of-line) + (when (save-excursion + (re-search-forward org-outline-regexp-bol rend t)) + (error "Drawers cannot contain headlines")) + ;; Position point at the beginning of the first + ;; non-blank line in region. Insert drawer's opening + ;; there, then indent it. + (org-skip-whitespace) + (beginning-of-line) + (insert ":" drawer ":\n") + (forward-line -1) + (indent-for-tab-command) + ;; Move point to the beginning of the first blank line + ;; after the last non-blank line in region. Insert + ;; drawer's closing, then indent it. + (goto-char rend) + (skip-chars-backward " \r\t\n") + (insert "\n:END:") + (deactivate-mark t) + (indent-for-tab-command) + (unless (eolp) (insert "\n"))) + ;; Clear marker, whatever the outcome of insertion is. + (set-marker rend nil))))))) + (defvar org-property-set-functions-alist nil "Property set function alist. Each entry should have the following format: @@ -14595,10 +15026,10 @@ in the current file." (interactive (list nil nil)) (let* ((property (or property (org-read-property-name))) (value (or value (org-read-property-value property))) - (fn (assoc property org-properties-postprocess-alist))) + (fn (cdr (assoc property org-properties-postprocess-alist)))) (setq org-last-set-property property) ;; Possibly postprocess the inserted value: - (when fn (setq value (funcall (cadr fn) value))) + (when fn (setq value (funcall fn value))) (unless (equal (org-entry-get nil property) value) (org-entry-put nil property value)))) @@ -14716,7 +15147,7 @@ completion." (error "Only one allowed value for this property")) (org-at-property-p) (replace-match (concat " :" key ": " nval) t t) - (org-indent-line-function) + (org-indent-line) (beginning-of-line 1) (skip-chars-forward " \t") (run-hook-with-args 'org-property-changed-functions key nval))) @@ -14835,13 +15266,20 @@ Return the position where this entry starts, or nil if there is no such entry." (defun org-time-stamp (arg &optional inactive) "Prompt for a date/time and insert a time stamp. -If the user specifies a time like HH:MM, or if this command is called -with a prefix argument, the time stamp will contain date and time. -Otherwise, only the date will be included. All parts of a date not -specified by the user will be filled in from the current date/time. -So if you press just return without typing anything, the time stamp -will represent the current date/time. If there is already a timestamp -at the cursor, it will be modified." +If the user specifies a time like HH:MM or if this command is +called with at least one prefix argument, the time stamp contains +the date and the time. Otherwise, only the date is be included. + +All parts of a date not specified by the user is filled in from +the current date/time. So if you just press return without +typing anything, the time stamp will represent the current +date/time. + +If there is already a timestamp at the cursor, it will be +modified. + +With two universal prefix arguments, insert an active timestamp +with the current time without prompting the user." (interactive "P") (let* ((ts nil) (default-time @@ -14859,7 +15297,7 @@ at the cursor, it will be modified." (save-match-data (beginning-of-line) (when (re-search-forward - "\\([.+-]+[0-9]+[dwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?" + "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" (save-excursion (progn (end-of-line) (point))) t) (match-string 0))))) org-time-was-given org-end-time-was-given time) @@ -14869,14 +15307,14 @@ at the cursor, it will be modified." (memq this-command '(org-time-stamp org-time-stamp-inactive))) (insert "--") (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil - default-time default-input))) + (org-read-date arg 'totime nil nil + default-time default-input inactive))) (org-insert-time-stamp time (or org-time-was-given arg) inactive)) ((org-at-timestamp-p t) (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time default-input))) + (org-read-date arg 'totime nil nil default-time default-input inactive))) (when (org-at-timestamp-p t) ; just to get the match data -; (setq inactive (eq (char-after (match-beginning 0)) ?\[)) + ; (setq inactive (eq (char-after (match-beginning 0)) ?\[)) (replace-match "") (setq org-last-changed-timestamp (org-insert-time-stamp @@ -14887,9 +15325,11 @@ at the cursor, it will be modified." (concat (substring org-last-inserted-timestamp 0 -1) " " repeater ">")))) (message "Timestamp updated")) + ((equal arg '(16)) + (org-insert-time-stamp (current-time) t)) (t (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time default-input))) + (org-read-date arg 'totime nil nil default-time default-input inactive))) (org-insert-time-stamp time (or org-time-was-given arg) inactive nil nil (list org-end-time-was-given)))))) @@ -14935,9 +15375,10 @@ So these are more for recording a certain time/date." (defvar org-read-date-final-answer nil) (defvar org-read-date-analyze-futurep nil) (defvar org-read-date-analyze-forced-year nil) +(defvar org-read-date-inactive) (defun org-read-date (&optional org-with-time to-time from-string prompt - default-time default-input) + default-time default-input inactive) "Read a date, possibly a time, and make things smooth for the user. The prompt will suggest to enter an ISO date, but you can also enter anything which will at least partially be understood by `parse-time-string'. @@ -14960,7 +15401,7 @@ mean next year. For details, see the manual. A few examples: etc. Furthermore you can specify a relative date by giving, as the *first* thing -in the input: a plus/minus sign, a number and a letter [dwmy] to indicate +in the input: a plus/minus sign, a number and a letter [hdwmy] to indicate change in days weeks, months, years. With a single plus or minus, the date is relative to today. With a double plus or minus, it is relative to the date in DEFAULT-TIME. E.g. @@ -14979,11 +15420,11 @@ If you don't like the calendar, turn it off with With optional argument TO-TIME, the date will immediately be converted to an internal time. -With an optional argument WITH-TIME, the prompt will suggest to also -insert a time. Note that when WITH-TIME is not set, you can still -enter a time, and this function will inform the calling routine about -this change. The calling routine may then choose to change the format -used to insert the time stamp into the buffer to include the time. +With an optional argument ORG-WITH-TIME, the prompt will suggest to +also insert a time. Note that when ORG-WITH-TIME is not set, you can +still enter a time, and this function will inform the calling routine +about this change. The calling routine may then choose to change the +format used to insert the time stamp into the buffer to include the time. With optional argument FROM-STRING, read from this string instead from the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is the time/date that is used for everything that is not specified by the @@ -15018,6 +15459,7 @@ user." (save-excursion (save-window-excursion (calendar) + (org-eval-in-calendar '(setq cursor-type nil) t) (unwind-protect (progn (calendar-forward-day (- (time-to-days org-def) @@ -15084,6 +15526,7 @@ user." (unwind-protect (progn (use-local-map map) + (setq org-read-date-inactive inactive) (add-hook 'post-command-hook 'org-read-date-display) (setq org-ans0 (read-string prompt default-input 'org-read-date-history nil)) @@ -15154,7 +15597,9 @@ user." (and (boundp 'org-time-was-given) org-time-was-given)) (cdr fmts) (car fmts))) - (txt (concat "=> " (format-time-string fmt (apply 'encode-time f))))) + (txt (format-time-string fmt (apply 'encode-time f))) + (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt)) + (txt (concat "=> " txt))) (when (and org-end-time-was-given (string-match org-plain-time-of-day-regexp txt)) (setq txt (concat (substring txt 0 (match-end 0)) "-" @@ -15182,11 +15627,11 @@ user." (setq ans (replace-match "" t t ans) deltan (car delta) deltaw (nth 1 delta) - deltadef (nth 2 delta))) + deltadef (nth 2 delta))) - ;; Check if there is an iso week date in there - ;; If yes, store the info and postpone interpreting it until the rest - ;; of the parsing is done + ;; Check if there is an iso week date in there. If yes, store the + ;; info and postpone interpreting it until the rest of the parsing + ;; is done. (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) (setq iso-year (if (match-end 1) (org-small-year-to-year @@ -15219,7 +15664,7 @@ user." day (string-to-number (match-string 1 ans)) month (string-to-number (match-string 2 ans)) ans (replace-match (format "%04d-%02d-%02d\\5" year month day) - t nil ans))) + t nil ans))) ;; Help matching american dates, like 5/30 or 5/30/7 (when (string-match @@ -15313,15 +15758,15 @@ user." iso-date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list iso-week day year)))) -; FIXME: Should we also push ISO weeks into the future? -; (when (and org-read-date-prefer-future -; (not iso-year) -; (< (calendar-absolute-from-gregorian iso-date) -; (time-to-days (current-time)))) -; (setq year (1+ year) -; iso-date (calendar-gregorian-from-absolute -; (calendar-absolute-from-iso -; (list iso-week day year))))) + ; FIXME: Should we also push ISO weeks into the future? + ; (when (and org-read-date-prefer-future + ; (not iso-year) + ; (< (calendar-absolute-from-gregorian iso-date) + ; (time-to-days (current-time)))) + ; (setq year (1+ year) + ; iso-date (calendar-gregorian-from-absolute + ; (calendar-absolute-from-iso + ; (list iso-week day year))))) (setq month (car iso-date) year (nth 2 iso-date) day (nth 1 iso-date))) @@ -15335,7 +15780,6 @@ user." ((equal deltaw "m") (setq month (+ month deltan))) ((equal deltaw "y") (setq year (+ year deltan))))) ((and wday (not (nth 3 tl))) - (setq futurep nil) ;; Weekday was given, but no day, so pick that day in the week ;; on or after the derived date. (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) @@ -15375,7 +15819,7 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to (concat "\\`[ \t]*\\([-+]\\{0,2\\}\\)" "\\([0-9]+\\)?" - "\\([dwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" + "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" "\\([ \t]\\|$\\)") s) (or (> (match-end 1) (match-beginning 1)) (match-end 4))) (let* ((dir (if (> (match-end 1) (match-beginning 1)) @@ -15409,14 +15853,15 @@ user function argument order change dependent on argument order." (list arg2 arg1 arg3)) ((eq calendar-date-style 'iso) (list arg2 arg3 arg1))) - (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1 - (if (org-bound-and-true-p european-calendar-style) - (list arg2 arg1 arg3) - (list arg1 arg2 arg3))))) + (org-no-warnings ;; european-calendar-style is obsolete as of version 23.1 + (if (org-bound-and-true-p european-calendar-style) + (list arg2 arg1 arg3) + (list arg1 arg2 arg3))))) (defun org-eval-in-calendar (form &optional keepdate) "Eval FORM in the calendar window and return to current window. -Also, store the cursor date in variable org-ans2." +When KEEPDATE is non-nil, update `org-ans2' from the cursor date, +otherwise stick to the current value of `org-ans2'." (let ((sf (selected-frame)) (sw (selected-window))) (select-window (get-buffer-window "*Calendar*" t)) @@ -15492,7 +15937,7 @@ The command returns the inserted time stamp." t1 w1 with-hm tf time str w2 (off 0)) (save-match-data (setq t1 (org-parse-time-string ts t)) - (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)?\\'" ts) + (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) (setq off (- (match-end 0) (match-beginning 0))))) (setq end (- end off)) (setq w1 (- end beg) @@ -15563,7 +16008,7 @@ Don't touch the rest." ((<= org-deadline-warning-days 0) ;; 0 or negative, enforce this value no matter what (- org-deadline-warning-days)) - ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\| \\)" ts) + ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts) ;; lead time is specified. (floor (* (string-to-number (match-string 1 ts)) (cdr (assoc (match-string 2 ts) @@ -15604,16 +16049,34 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s (org-occur regexp nil callback) org-warn-days))) +(defsubst org-re-timestamp (type) + "Return a regexp for timestamp TYPE. +Allowed values for TYPE are: + + all: all timestamps + active: only active timestamps (<...>) + inactive: only inactive timestamps ([...]) + scheduled: only scheduled timestamps + deadline: only deadline timestamps + +When TYPE is nil, fall back on returning a regexp that matches +both scheduled and deadline timestamps." + (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9>
\n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)") + ((eq type 'active) org-ts-regexp) + ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^
\n>]*?\\)\\]") + ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) + ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) + ((eq type 'scheduled-or-deadline) + (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>")))) + (defun org-check-before-date (date) "Check if there are deadlines or scheduled entries before DATE." (interactive (list (org-read-date))) (let ((case-fold-search nil) - (regexp (concat "\\<\\(" org-deadline-string - "\\|" org-scheduled-string - "\\) *<\\([^>]+\\)>")) + (regexp (org-re-timestamp org-ts-type)) (callback (lambda () (time-less-p - (org-time-string-to-time (match-string 2)) + (org-time-string-to-time (match-string 1)) (org-time-string-to-time date))))) (message "%d entries before %s" (org-occur regexp nil callback) date))) @@ -15622,13 +16085,11 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s "Check if there are deadlines or scheduled entries after DATE." (interactive (list (org-read-date))) (let ((case-fold-search nil) - (regexp (concat "\\<\\(" org-deadline-string - "\\|" org-scheduled-string - "\\) *<\\([^>]+\\)>")) + (regexp (org-re-timestamp org-ts-type)) (callback (lambda () (not (time-less-p - (org-time-string-to-time (match-string 2)) + (org-time-string-to-time (match-string 1)) (org-time-string-to-time date)))))) (message "%d entries after %s" (org-occur regexp nil callback) date))) @@ -15638,12 +16099,10 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s (interactive (list (org-read-date nil nil nil "Range starts") (org-read-date nil nil nil "Range end"))) (let ((case-fold-search nil) - (regexp (concat "\\<\\(" org-deadline-string - "\\|" org-scheduled-string - "\\) *<\\([^>]+\\)>")) + (regexp (org-re-timestamp org-ts-type)) (callback (lambda () - (let ((match (match-string 2))) + (let ((match (match-string 1))) (and (not (time-less-p (org-time-string-to-time match) @@ -15732,6 +16191,7 @@ days in order to avoid rounding problems." (apply 'format fmt (nreverse l)))) (defun org-time-string-to-time (s &optional buffer pos) + "Convert a timestamp string into internal time." (condition-case errdata (apply 'encode-time (org-parse-time-string s)) (error (error "Bad timestamp `%s'%s\nError was: %s" @@ -15741,6 +16201,7 @@ days in order to avoid rounding problems." (cdr errdata))))) (defun org-time-string-to-seconds (s) + "Convert a timestamp string to a number of seconds." (org-float-time (org-time-string-to-time s))) (defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos) @@ -15754,7 +16215,7 @@ The variable date is bound by the calendar when this is called." (if (org-diary-sexp-entry (match-string 1 s) "" date) daynr (+ daynr 1000))) - ((and daynr (string-match "\\+[0-9]+[dwmy]" s)) + ((and daynr (string-match "\\+[0-9]+[hdwmy]" s)) (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr (time-to-days (current-time))) (match-string 0 s) prefer show-all)) @@ -15817,8 +16278,7 @@ D may be an absolute day number, or a calendar-type list (month day year)." (stringp (cdr result))) (cdr result)) ((and (consp result) (stringp (car result))) result) - (result entry) - (t nil)))) + (result entry)))) (defun org-diary-to-ical-string (frombuf) "Get iCalendar entries from diary entries in buffer FROMBUF. @@ -15865,7 +16325,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." (if (<= cday sday) (throw 'exit sday)) - (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change) + (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change) (setq dn (string-to-number (match-string 1 change)) dw (cdr (assoc (match-string 2 change) a1))) (error "Invalid change specifier: %s" change)) @@ -15988,22 +16448,22 @@ With prefix ARG, change that many days." (and ans (boundp 'org-ts-what) (setq org-ts-what - (cond - ((= pos (match-beginning 0)) 'bracket) - ;; Point is considered to be "on the bracket" whether - ;; it's really on it or right after it. - ((or (= pos (1- (match-end 0))) - (= pos (match-end 0))) 'bracket) - ((org-pos-in-match-range pos 2) 'year) - ((org-pos-in-match-range pos 3) 'month) - ((org-pos-in-match-range pos 7) 'hour) - ((org-pos-in-match-range pos 8) 'minute) - ((or (org-pos-in-match-range pos 4) - (org-pos-in-match-range pos 5)) 'day) - ((and (> pos (or (match-end 8) (match-end 5))) - (< pos (match-end 0))) - (- pos (or (match-end 8) (match-end 5)))) - (t 'day)))) + (cond + ((= pos (match-beginning 0)) 'bracket) + ;; Point is considered to be "on the bracket" whether + ;; it's really on it or right after it. + ((= pos (1- (match-end 0))) 'bracket) + ((= pos (match-end 0)) 'after) + ((org-pos-in-match-range pos 2) 'year) + ((org-pos-in-match-range pos 3) 'month) + ((org-pos-in-match-range pos 7) 'hour) + ((org-pos-in-match-range pos 8) 'minute) + ((or (org-pos-in-match-range pos 4) + (org-pos-in-match-range pos 5)) 'day) + ((and (> pos (or (match-end 8) (match-end 5))) + (< pos (match-end 0))) + (- pos (or (match-end 8) (match-end 5)))) + (t 'day)))) ans)) (defun org-toggle-timestamp-type () @@ -16020,6 +16480,8 @@ With prefix ARG, change that many days." (message "Timestamp is now %sactive" (if (equal (char-after beg) ?<) "" "in"))))) +(defvar org-clock-history) ; defined in org-clock.el +(defvar org-clock-adjust-closest nil) ; defined in org-clock.el (defun org-timestamp-change (n &optional what updown) "Change the date in the time stamp at point. The date will be changed by N times WHAT. WHAT can be `day', `month', @@ -16030,7 +16492,7 @@ in the timestamp determines what will be changed." (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) org-ts-what extra rem - ts time time0) + ts time time0 fixnext clrgx) (if (not (org-at-timestamp-p t)) (error "Not at a timestamp")) (if (and (not what) (eq org-ts-what 'bracket)) @@ -16049,7 +16511,7 @@ in the timestamp determines what will be changed." ts (match-string 0)) (replace-match "") (if (string-match - "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)*\\)[]>]" + "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" ts) (setq extra (match-string 1 ts))) (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) @@ -16112,6 +16574,39 @@ in the timestamp determines what will be changed." (t origin)))) ;; Update clock if on a CLOCK line. (org-clock-update-time-maybe) + ;; Maybe adjust the closest clock in `org-clock-history' + (when org-clock-adjust-closest + (if (not (and (org-at-clock-log-p) + (< 1 (length (delq nil (mapcar (lambda(m) (marker-position m)) + org-clock-history)))))) + (message "No clock to adjust") + (cond ((save-excursion ; fix previous clock? + (re-search-backward org-ts-regexp0 nil t) + (org-looking-back (concat org-clock-string " \\["))) + (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$"))) + ((save-excursion ; fix next clock? + (re-search-backward org-ts-regexp0 nil t) + (looking-at (concat org-ts-regexp0 "\\] =>"))) + (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0)))) + (save-window-excursion + ;; Find closest clock to point, adjust the previous/next one in history + (let* ((p (save-excursion (org-back-to-heading t))) + (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history)) + (clfixnth + (+ fixnext (- (length cl) (or (length (member (apply #'min cl) cl)) 100)))) + (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history)))) + (if (not clfixpos) + (message "No clock to adjust") + (save-excursion + (org-goto-marker-or-bmk clfixpos) + (org-show-subtree) + (when (re-search-forward clrgx nil t) + (goto-char (match-beginning 1)) + (let (org-clock-adjust-closest) + (org-timestamp-change n org-ts-what updown)) + (message "Clock adjusted in %s for heading: %s" + (file-name-nondirectory (buffer-file-name)) + (org-get-heading t t))))))))) ;; Try to recenter the calendar window, if any. (if (and org-calendar-follow-timestamp-change (get-buffer-window "*Calendar*" t) @@ -16243,7 +16738,7 @@ effort string \"2hours\" is equivalent to 120 minutes." :type '(alist :key-type (string :tag "Modifier") :value-type (number :tag "Minutes"))) -(defun org-duration-string-to-minutes (s) +(defun org-duration-string-to-minutes (s &optional output-to-string) "Convert a duration string S to minutes. A bare number is interpreted as minutes, modifiers can be set by @@ -16252,15 +16747,16 @@ customizing `org-effort-durations' (which see). Entries containing a colon are interpreted as H:MM by `org-hh:mm-string-to-minutes'." (let ((result 0) - (re (concat "\\([0-9]+\\) *\\(" + (re (concat "\\([0-9.]+\\) *\\(" (regexp-opt (mapcar 'car org-effort-durations)) "\\)"))) (while (string-match re s) (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations)) (string-to-number (match-string 1 s)))) (setq s (replace-match "" nil t s))) + (setq result (floor result)) (incf result (org-hh:mm-string-to-minutes s)) - result)) + (if output-to-string (number-to-string result) result))) ;;;; Files @@ -16268,7 +16764,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 (lambda () (eq major-mode 'org-mode))) + (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) (when (featurep 'org-id) (org-id-locations-save)) (message "Saving all Org-mode buffers... done")) @@ -16292,7 +16788,7 @@ changes from another. I believe the procedure must be like this: (save-window-excursion (mapc (lambda (b) - (when (and (with-current-buffer b (eq major-mode 'org-mode)) + (when (and (with-current-buffer b (derived-mode-p 'org-mode)) (with-current-buffer b buffer-file-name)) (org-pop-to-buffer-same-window b) (revert-buffer t 'no-confirm))) @@ -16344,17 +16840,17 @@ If EXCLUDE-TMP is non-nil, ignore temporary buffers." (filter (cond ((eq predicate 'files) - (lambda (b) (with-current-buffer b (eq major-mode 'org-mode)))) + (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode)))) ((eq predicate 'export) (lambda (b) (string-match "\*Org .*Export" (buffer-name b)))) ((eq predicate 'agenda) (lambda (b) (with-current-buffer b - (and (eq major-mode 'org-mode) + (and (derived-mode-p 'org-mode) (setq bfn (buffer-file-name b)) (member (file-truename bfn) agenda-files))))) (t (lambda (b) (with-current-buffer b - (or (eq major-mode 'org-mode) + (or (derived-mode-p 'org-mode) (string-match "\*Org .*Export" (buffer-name b))))))))) (delq nil @@ -16571,7 +17067,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (with-current-buffer buf (save-buffer))) (kill-buffer buf)))) -(defun org-prepare-agenda-buffers (files) +(defun org-agenda-prepare-buffers (files) "Create buffers for all agenda files, protect archived trees and comments." (interactive) (let ((pa '(:org-archived t)) @@ -16579,7 +17075,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (pall '(:org-archived t :org-comment t)) (inhibit-read-only t) (rea (concat ":" org-archive-tag ":")) - bmp file re) + bmp file re) (save-excursion (save-restriction (while (setq file (pop files)) @@ -16657,7 +17153,7 @@ an embedded LaTeX fragment, let texmathp do its job. (interactive) (let (p) (cond - ((not (eq major-mode 'org-mode)) ad-do-it) + ((not (derived-mode-p 'org-mode)) ad-do-it) ((eq this-command 'cdlatex-math-symbol) (setq ad-return-value t texmathp-why '("cdlatex-math-symbol in org-mode" . 0))) @@ -16806,11 +17302,12 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (narrow-to-region beg end) (goto-char beg) (org-format-latex - (concat "ltxpng/" (file-name-sans-extension - (file-name-nondirectory - buffer-file-name))) - default-directory 'overlays msg at 'forbuffer 'dvipng) - (message msg "done. Use `C-c C-c' to remove images."))))) + (concat org-latex-preview-ltxpng-directory (file-name-sans-extension + (file-name-nondirectory + buffer-file-name))) + default-directory 'overlays msg at 'forbuffer + org-latex-create-formula-image-program) + (message msg "done. Use `C-c C-c' to remove images."))))) (defvar org-latex-regexps '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) @@ -16873,7 +17370,8 @@ Some of the options can be changed using the variable '(org-protected t)))) (add-text-properties (match-beginning n) (match-end n) '(org-protected t)))) - ((eq processing-type 'dvipng) + ((or (eq processing-type 'dvipng) + (eq processing-type 'imagemagick)) ;; Process to an image (setq txt (match-string n) beg (match-beginning n) end (match-end n) @@ -16894,17 +17392,25 @@ Some of the options can be changed using the variable (unless checkdir ; make sure the directory exists (setq checkdir t) (or (file-directory-p todir) (make-directory todir t))) - - (unless executables-checked - (org-check-external-command - "latex" "needed to convert LaTeX fragments to images") - (org-check-external-command - "dvipng" "needed to convert LaTeX fragments to images") - (setq executables-checked t)) - - (unless (file-exists-p movefile) - (org-create-formula-image - txt movefile opt forbuffer)) + (cond + ((eq processing-type 'dvipng) + (unless executables-checked + (org-check-external-command + "latex" "needed to convert LaTeX fragments to images") + (org-check-external-command + "dvipng" "needed to convert LaTeX fragments to images") + (setq executables-checked t)) + (unless (file-exists-p movefile) + (org-create-formula-image-with-dvipng + txt movefile opt forbuffer))) + ((eq processing-type 'imagemagick) + (unless executables-checked + (org-check-external-command + "convert" "you need to install imagemagick") + (setq executables-checked t)) + (unless (file-exists-p movefile) + (org-create-formula-image-with-imagemagick + txt movefile opt forbuffer)))) (if overlays (progn (mapc (lambda (o) @@ -16959,7 +17465,7 @@ write the results in to that file. When invoked as an interactive command, prompt for LATEX-FRAG, with initial value set to the current active region and echo the results for user inspection." - (interactive (list (let ((frag (when (region-active-p) + (interactive (list (let ((frag (when (org-region-active-p) (buffer-substring-no-properties (region-beginning) (region-end))))) (read-string "LaTeX Fragment: " frag nil frag)))) @@ -17040,7 +17546,7 @@ inspection." latex-frag))) ;; This function borrows from Ganesh Swami's latex2png.el -(defun org-create-formula-image (string tofile options buffer) +(defun org-create-formula-image-with-dvipng (string tofile options buffer) "This calls dvipng." (require 'org-latex) (let* ((tmpdir (if (featurep 'xemacs) @@ -17082,11 +17588,11 @@ inspection." (progn (message "Failed to create dvi file from %s" texfile) nil) (condition-case nil (if (featurep 'xemacs) - (call-process "dvipng" nil nil nil - "-fg" fg "-bg" bg - "-T" "tight" - "-o" pngfile - dvifile) + (call-process "dvipng" nil nil nil + "-fg" fg "-bg" bg + "-T" "tight" + "-o" pngfile + dvifile) (call-process "dvipng" nil nil nil "-fg" fg "-bg" bg "-D" dpi @@ -17102,8 +17608,115 @@ inspection." nil) ;; Use the requested file name and clean up (copy-file pngfile tofile 'replace) - (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png") do - (delete-file (concat texfilebase e))) + (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do + (if (file-exists-p (concat texfilebase e)) + (delete-file (concat texfilebase e)))) + pngfile)))) + +(defvar org-latex-to-pdf-process) ;; Defined in org-latex.el +(defun org-create-formula-image-with-imagemagick (string tofile options buffer) + "This calls convert, which is included into imagemagick." + (require 'org-latex) + (let* ((tmpdir (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory)) + (texfilebase (make-temp-name + (expand-file-name "orgtex" tmpdir))) + (texfile (concat texfilebase ".tex")) + (pdffile (concat texfilebase ".pdf")) + (pngfile (concat texfilebase ".png")) + (fnh (if (featurep 'xemacs) + (font-height (face-font 'default)) + (face-attribute 'default :height nil))) + (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) + (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) + (fg (or (plist-get options (if buffer :foreground :html-foreground)) + "black")) + (bg (or (plist-get options (if buffer :background :html-background)) + "white"))) + (if (eq fg 'default) (setq fg (org-latex-color :foreground)) + (setq fg (org-latex-color-format fg))) + (if (eq bg 'default) (setq bg (org-latex-color :background)) + (setq bg (org-latex-color-format + (if (string= bg "Transparent")(setq bg "white"))))) + (with-temp-file texfile + (insert (org-splice-latex-header + org-format-latex-header + org-export-latex-default-packages-alist + org-export-latex-packages-alist t + org-format-latex-header-extra)) + (insert "\n\\begin{document}\n" + "\\definecolor{fg}{rgb}{" fg "}\n" + "\\definecolor{bg}{rgb}{" bg "}\n" + "\n\\pagecolor{bg}\n" + "\n{\\color{fg}\n" + string + "\n}\n" + "\n\\end{document}\n" ) + (require 'org-latex) + (org-export-latex-fix-inputenc)) + (let ((dir default-directory) cmd cmds latex-frags-cmds) + (condition-case nil + (progn + (cd tmpdir) + (setq cmds org-latex-to-pdf-process) + (while cmds + (setq latex-frags-cmds (pop cmds)) + (if (listp latex-frags-cmds) + (setq cmds nil) + (setq latex-frags-cmds (list (car org-latex-to-pdf-process))))) + (while latex-frags-cmds + (setq cmd (pop latex-frags-cmds)) + (while (string-match "%b" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument texfile)) + t t cmd))) + (while (string-match "%f" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument (file-name-nondirectory texfile))) + t t cmd))) + (while (string-match "%o" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument (file-name-directory texfile))) + t t cmd))) + (setq cmd (split-string cmd)) + (eval (append (list 'call-process (pop cmd) nil nil nil) cmd)))) + (error nil)) + (cd dir)) + (if (not (file-exists-p pdffile)) + (progn (message "Failed to create pdf file from %s" texfile) nil) + (condition-case nil + (if (featurep 'xemacs) + (call-process "convert" nil nil nil + "-density" "96" + "-trim" + "-antialias" + pdffile + "-quality" "100" + ;; "-sharpen" "0x1.0" + pngfile) + (call-process "convert" nil nil nil + "-density" dpi + "-trim" + "-antialias" + pdffile + "-quality" "100" + ; "-sharpen" "0x1.0" + pngfile)) + (error nil)) + (if (not (file-exists-p pngfile)) + (if org-format-latex-signal-error + (error "Failed to create png file from %s" texfile) + (message "Failed to create png file from %s" texfile) + nil) + ;; Use the requested file name and clean up + (copy-file pngfile tofile 'replace) + (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do + (if (file-exists-p (concat texfilebase e)) + (delete-file (concat texfilebase e)))) pngfile)))) (defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) @@ -17166,7 +17779,7 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." (if newline (concat pkg "\n") pkg)) (defun org-dvipng-color (attr) - "Return an rgb color specification for dvipng." + "Return a RGB color specification for dvipng." (apply 'format "rgb %s %s %s" (mapcar 'org-normalize-color (if (featurep 'xemacs) @@ -17176,6 +17789,23 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." ((eq attr :background) 'background)))) (color-values (face-attribute 'default attr nil)))))) +(defun org-latex-color (attr) + "Return a RGB color for the LaTeX color package." + (apply 'format "%s,%s,%s" + (mapcar 'org-normalize-color + (if (featurep 'xemacs) + (color-rgb-components + (face-property 'default + (cond ((eq attr :foreground) 'foreground) + ((eq attr :background) 'background)))) + (color-values (face-attribute 'default attr nil)))))) + +(defun org-latex-color-format (color-name) + "Convert COLOR-NAME to a RGB color value." + (apply 'format "%s,%s,%s" + (mapcar 'org-normalize-color + (color-values color-name)))) + (defun org-normalize-color (value) "Return string to be used as color value for an RGB component." (format "%g" (/ value 65535.0))) @@ -17200,6 +17830,14 @@ INCLUDE-LINKED is passed to `org-display-inline-images'." (length org-inline-image-overlays)) (message "No images to display inline")))) +(defun org-redisplay-inline-images () + "Refresh the display of inline images." + (interactive) + (if (not org-inline-image-overlays) + (org-toggle-inline-images) + (org-toggle-inline-images) + (org-toggle-inline-images))) + (defun org-display-inline-images (&optional include-linked refresh beg end) "Display inline images. Normally only links without a description part are inlined, because this @@ -17238,10 +17876,13 @@ BEG and END default to the buffer boundaries." (overlay-put ov 'face 'default) (overlay-put ov 'org-image-overlay t) (overlay-put ov 'modification-hooks - (list 'org-display-inline-modification-hook)) + (list 'org-display-inline-remove-overlay)) (push ov org-inline-image-overlays))))))))) -(defun org-display-inline-modification-hook (ov after beg end &optional len) +(define-obsolete-function-alias + 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") + +(defun org-display-inline-remove-overlay (ov after beg end &optional len) "Remove inline-display overlay if a corresponding region is modified." (let ((inhibit-modification-hooks t)) (when (and ov after) @@ -17261,38 +17902,42 @@ BEG and END default to the buffer boundaries." (define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree) (define-key org-mode-map [remap show-subtree] 'org-show-subtree) (define-key org-mode-map [remap outline-forward-same-level] - 'org-forward-same-level) + 'org-forward-heading-same-level) (define-key org-mode-map [remap outline-backward-same-level] - 'org-backward-same-level) + 'org-backward-heading-same-level) (define-key org-mode-map [remap show-branches] 'org-kill-note-or-show-branches) (define-key org-mode-map [remap outline-promote] 'org-promote-subtree) (define-key org-mode-map [remap outline-demote] 'org-demote-subtree) (define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret) -;; Outline functions from `outline-mode-prefix-map' -;; that can not be remapped in Org: +;; Outline functions from `outline-mode-prefix-map' that can not +;; be remapped in Org: +;; ;; - the column "key binding" shows whether the Outline function is still ;; available in Org mode on the same key that it has been bound to in ;; Outline mode: ;; - "overridden": key used for a different functionality in Org mode ;; - else: key still bound to the same Outline function in Org mode +;; ;; | Outline function | key binding | Org replacement | ;; |------------------------------------+-------------+-----------------------| ;; | `outline-next-visible-heading' | `C-c C-n' | still same function | ;; | `outline-previous-visible-heading' | `C-c C-p' | still same function | +;; | `outline-up-heading' | `C-c C-u' | still same function | +;; | `outline-move-subtree-up' | overridden | better: org-shiftup | +;; | `outline-move-subtree-down' | overridden | better: org-shiftdown | +;; | `show-entry' | overridden | no replacement | ;; | `show-children' | `C-c C-i' | visibility cycling | +;; | `show-branches' | `C-c C-k' | still same function | +;; | `show-subtree' | overridden | visibility cycling | +;; | `show-all' | overridden | no replacement | ;; | `hide-subtree' | overridden | visibility cycling | -;; | `outline-up-heading' | `C-c C-u' | still same function | ;; | `hide-body' | overridden | no replacement | -;; | `show-all' | overridden | no replacement | ;; | `hide-entry' | overridden | visibility cycling | -;; | `show-entry' | overridden | no replacement | ;; | `hide-leaves' | overridden | no replacement | ;; | `hide-sublevels' | overridden | no replacement | ;; | `hide-other' | overridden | no replacement | -;; | `outline-move-subtree-up' | `C-c C-^' | better: org-shiftup | -;; | `outline-move-subtree-down' | overridden | better: org-shiftdown | ;; Make `C-c C-x' a prefix key (org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap)) @@ -17375,7 +18020,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup) (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown)) - ;; All the other keys +;; All the other keys (org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. (org-defkey org-mode-map "\C-c\C-r" 'org-reveal) @@ -17385,11 +18030,20 @@ BEG and END default to the buffer boundaries." (if (boundp 'narrow-map) (org-defkey narrow-map "b" 'org-narrow-to-block) (org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block)) -(org-defkey org-mode-map "\C-c\C-f" 'org-forward-same-level) -(org-defkey org-mode-map "\C-c\C-b" 'org-backward-same-level) +(if (boundp 'narrow-map) + (org-defkey narrow-map "e" 'org-narrow-to-element) + (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element)) +(org-defkey org-mode-map "\C-\M-t" 'org-transpose-element) +(org-defkey org-mode-map "\M-}" 'org-forward-element) +(org-defkey org-mode-map "\M-{" 'org-backward-element) +(org-defkey org-mode-map "\C-c\C-^" 'org-up-element) +(org-defkey org-mode-map "\C-c\C-_" 'org-down-element) +(org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level) +(org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level) (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default) +(org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer) (org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag) (org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling) (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) @@ -17411,6 +18065,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) (org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link) (org-defkey org-mode-map "\C-c\C-l" 'org-insert-link) +(org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links) (org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point) (org-defkey org-mode-map "\C-c%" 'org-mark-ring-push) (org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto) @@ -17454,6 +18109,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) (org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) (org-defkey org-mode-map "\C-c@" 'org-mark-subtree) +(org-defkey org-mode-map "\M-h" 'org-mark-element) (org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree) ;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree) @@ -17464,18 +18120,22 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays) (org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in) +(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-in-last) +(org-defkey org-mode-map "\C-c\C-x\C-z" 'org-resolve-clocks) (org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out) (org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto) -(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel) +(org-defkey org-mode-map "\C-c\C-x\C-q" 'org-clock-cancel) (org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display) (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) (org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images) +(org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images) (org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities) (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) (org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) +(org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort) (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) (org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) @@ -17506,8 +18166,8 @@ BEG and END default to the buffer boundaries." ("Outline Navigation") ("n" . (org-speed-move-safe 'outline-next-visible-heading)) ("p" . (org-speed-move-safe 'outline-previous-visible-heading)) - ("f" . (org-speed-move-safe 'org-forward-same-level)) - ("b" . (org-speed-move-safe 'org-backward-same-level)) + ("f" . (org-speed-move-safe 'org-forward-heading-same-level)) + ("b" . (org-speed-move-safe 'org-backward-heading-same-level)) ("u" . (org-speed-move-safe 'outline-up-heading)) ("j" . org-goto) ("g" . (org-refile t)) @@ -17515,6 +18175,7 @@ BEG and END default to the buffer boundaries." ("c" . org-cycle) ("C" . org-shifttab) (" " . org-display-outline-path) + (":" . org-columns) ("Outline Structure Editing") ("U" . org-shiftmetaup) ("D" . org-shiftmetadown) @@ -17528,17 +18189,22 @@ BEG and END default to the buffer boundaries." ("w" . org-refile) ("a" . org-archive-subtree-default-with-confirmation) ("." . org-mark-subtree) + ("#" . org-toggle-comment) ("Clock Commands") ("I" . org-clock-in) ("O" . org-clock-out) ("Meta Data Editing") ("t" . org-todo) + ("," . (org-priority)) ("0" . (org-priority ?\ )) ("1" . (org-priority ?A)) ("2" . (org-priority ?B)) ("3" . (org-priority ?C)) (";" . org-set-tags-command) ("e" . org-set-effort) + ("E" . org-inc-effort) + ("W" . (lambda(m) (interactive "sMinutes before warning: ") + (org-entry-put (point) "APPT_WARNTIME" m))) ("Agenda Views etc") ("v" . org-agenda) ("/" . org-sparse-tree) @@ -17594,7 +18260,10 @@ If not, return to the original position and throw an error." (defvar org-table-auto-blank-field) ; defined in org-table.el (defvar org-speed-command nil) -(defun org-speed-command-default-hook (keys) +(define-obsolete-function-alias + 'org-speed-command-default-hook 'org-speed-command-activate "24.3") + +(defun org-speed-command-activate (keys) "Hook for activating single-letter speed commands. `org-speed-commands-default' specifies a minimal command set. Use `org-speed-commands-user' for further customization." @@ -17604,7 +18273,10 @@ Use `org-speed-commands-user' for further customization." (cdr (assoc keys (append org-speed-commands-user org-speed-commands-default))))) -(defun org-babel-speed-command-hook (keys) +(define-obsolete-function-alias + 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3") + +(defun org-babel-speed-command-activate (keys) "Hook for activating single-letter code block commands." (when (and (bolp) (looking-at org-babel-src-block-regexp)) (cdr (assoc keys org-babel-key-bindings)))) @@ -17623,8 +18295,9 @@ and return nil or a valid handler as appropriate. Handler could be one of an interactive command, a function, or a form. Set `org-use-speed-commands' to non-nil value to enable this -hook. The default setting is `org-speed-command-default-hook'." +hook. The default setting is `org-speed-command-activate'." :group 'org-structure + :version "24.1" :type 'hook) (defun org-self-insert-command (N) @@ -17658,7 +18331,7 @@ overwritten, and the table is not marked as requiring realignment." (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) ;; got extra space, this field does not determine column width (let (org-table-may-need-update) (org-table-blank-field)) - ;; no extra space, this field may determine column width + ;; no extra space, this field may determine column width (org-table-blank-field))) t) (eq N 1) @@ -17707,29 +18380,31 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." ;; (and (not invisible-at-point) invisible-before-point ;; (memq kind '(insert delete))) ))) - - (when (or (memq invisible-at-point '(outline org-hide-block)) - (memq invisible-before-point '(outline org-hide-block))) + (when (or (memq invisible-at-point '(outline org-hide-block t)) + (memq invisible-before-point '(outline org-hide-block t))) (if (eq org-catch-invisible-edits 'error) (error "Editing in invisible areas is prohibited - make visible first")) - ;; Make the area visible - (save-excursion - (if invisible-before-point - (goto-char (previous-single-char-property-change - (point) 'invisible))) - (org-cycle)) - (cond - ((eq org-catch-invisible-edits 'show) - ;; That's it, we do the edit after showing - (message - "Unfolding invisible region around point before editing") - (sit-for 1)) - ((and (eq org-catch-invisible-edits 'smart) - border-and-ok-direction) - (message "Unfolding invisible region around point before editing")) - (t - ;; Don't do the edit, make the user repeat it in full visibility - (error "Edit in invisible region aborted, repeat to confirm with text visible"))))))) + (if (and org-custom-properties-overlays + (y-or-n-p "Display invisible properties in this buffer? ")) + (org-toggle-custom-properties-visibility) + ;; Make the area visible + (save-excursion + (if invisible-before-point + (goto-char (previous-single-char-property-change + (point) 'invisible))) + (org-cycle)) + (cond + ((eq org-catch-invisible-edits 'show) + ;; That's it, we do the edit after showing + (message + "Unfolding invisible region around point before editing") + (sit-for 1)) + ((and (eq org-catch-invisible-edits 'smart) + border-and-ok-direction) + (message "Unfolding invisible region around point before editing")) + (t + ;; Don't do the edit, make the user repeat it in full visibility + (error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) (defun org-fix-tags-on-the-fly () (when (and (equal (char-after (point-at-bol)) ?*) @@ -18007,27 +18682,31 @@ individual commands for more information." (defun org-shiftmetaup (&optional arg) "Move subtree up or kill table row. Calls `org-move-subtree-up' or `org-table-kill-row' or -`org-move-item-up' depending on context. See the individual commands -for more information." +`org-move-item-up' or `org-timestamp-up', depending on context. +See the individual commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-shiftmetaup-hook)) ((org-at-table-p) (call-interactively 'org-table-kill-row)) ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) ((org-at-item-p) (call-interactively 'org-move-item-up)) + ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) + (call-interactively 'org-timestamp-up))) (t (org-modifier-cursor-error)))) (defun org-shiftmetadown (&optional arg) "Move subtree down or insert table row. Calls `org-move-subtree-down' or `org-table-insert-row' or -`org-move-item-down', depending on context. See the individual -commands for more information." +`org-move-item-down' or `org-timestamp-up', depending on context. +See the individual commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-shiftmetadown-hook)) ((org-at-table-p) (call-interactively 'org-table-insert-row)) ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) ((org-at-item-p) (call-interactively 'org-move-item-down)) + ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) + (call-interactively 'org-timestamp-down))) (t (org-modifier-cursor-error)))) (defsubst org-hidden-tree-error () @@ -18064,14 +18743,16 @@ See the individual commands for more information." (t (call-interactively 'backward-word)))) (defun org-metaright (&optional arg) - "Demote subtree or move table column to right. -Calls `org-do-demote' or `org-table-move-column', depending on context. + "Demote a subtree, a list item or move table column to right. +In front of a drawer or a block keyword, indent it correctly. With no specific context, calls the Emacs default `forward-word'. See the individual commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metaright-hook)) ((org-at-table-p) (call-interactively 'org-table-move-column)) + ((org-at-drawer-p) (call-interactively 'org-indent-drawer)) + ((org-at-block-p) (call-interactively 'org-indent-block)) ((org-with-limited-levels (or (org-at-heading-p) (and (org-region-active-p) @@ -18119,6 +18800,20 @@ this function returns t, nil otherwise." (throw 'exit t)))) nil)))) +(autoload 'org-element-at-point "org-element") + +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-context "org-element" ()) +(declare-function org-element-contents "org-element" (element)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-paragraph-parser "org-element" (limit)) +(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion)) +(declare-function org-element-nested-p "org-element" (elem-a elem-b)) +(declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) +(declare-function org-element--parse-objects "org-element" (beg end acc restriction)) +(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) + (defun org-metaup (&optional arg) "Move subtree up or move table row up. Calls `org-move-subtree-up' or `org-table-move-row' or @@ -18127,10 +18822,19 @@ for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metaup-hook)) + ((org-region-active-p) + (let* ((a (min (region-beginning) (region-end))) + (b (1- (max (region-beginning) (region-end)))) + (c (save-excursion (goto-char a) + (move-beginning-of-line 0))) + (d (save-excursion (goto-char a) + (move-end-of-line 0) (point)))) + (transpose-regions a b c d) + (goto-char c))) ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) ((org-at-item-p) (call-interactively 'org-move-item-up)) - (t (transpose-lines 1) (beginning-of-line -1)))) + (t (org-drag-element-backward)))) (defun org-metadown (&optional arg) "Move subtree down or move table row down. @@ -18140,10 +18844,19 @@ commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metadown-hook)) + ((org-region-active-p) + (let* ((a (min (region-beginning) (region-end))) + (b (max (region-beginning) (region-end))) + (c (save-excursion (goto-char b) + (move-beginning-of-line 1))) + (d (save-excursion (goto-char b) + (move-end-of-line 1) (1+ (point))))) + (transpose-regions a b c d) + (goto-char d))) ((org-at-table-p) (call-interactively 'org-table-move-row)) ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) ((org-at-item-p) (call-interactively 'org-move-item-down)) - (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0)))) + (t (org-drag-element-forward)))) (defun org-shiftup (&optional arg) "Increase item in timestamp or increase priority of current headline. @@ -18329,17 +19042,17 @@ Depending on context, this does one of the following: (defun org-copy-visible (beg end) "Copy the visible parts of the region." - (interactive "r") - (let (snippets s) - (save-excursion - (save-restriction + (interactive "r") + (let (snippets s) + (save-excursion + (save-restriction (narrow-to-region beg end) (setq s (goto-char (point-min))) (while (not (= (point) (point-max))) (goto-char (org-find-invisible)) (push (buffer-substring s (point)) snippets) (setq s (goto-char (org-find-visible)))))) - (kill-new (apply 'concat (nreverse snippets))))) + (kill-new (apply 'concat (nreverse snippets))))) (defun org-copy-special () "Copy region in table or copy current subtree. @@ -18394,7 +19107,7 @@ When in an #+include line, visit the include file. Otherwise call ((or (org-at-table-p) (save-excursion (beginning-of-line 1) - (looking-at "[ \t]*#\\+TBLFM:"))) + (let ((case-fold-search )) (looking-at "[ \t]*#\\+tblfm:")))) (call-interactively 'org-table-edit-formulas)) (t (call-interactively 'ffap)))) @@ -18480,7 +19193,7 @@ This command does many different things, depending on context: (org-footnote-at-definition-p)) (call-interactively 'org-footnote-action)) ((org-at-item-checkbox-p) - ;; Cursor at a checkbox: repair list and update checkboxes. Send + ;; Cursor at a checkbox: repair list and update checkboxes. Send ;; list only if at top item. (let* ((cbox (match-string 1)) (struct (org-list-struct)) @@ -18548,10 +19261,12 @@ This command does many different things, depending on context: (beginning-of-line 1) (save-excursion (org-update-dblock))) ((save-excursion - (beginning-of-line 1) - (looking-at "[ \t]*#\\+\\([A-Z]+\\)")) + (let ((case-fold-search t)) + (beginning-of-line 1) + (looking-at "[ \t]*#\\+\\([a-z]+\\)"))) (cond - ((equal (match-string 1) "TBLFM") + ((or (equal (match-string 1) "TBLFM") + (equal (match-string 1) "tblfm")) ;; Recalculate the table before this line (save-excursion (beginning-of-line 1) @@ -18593,35 +19308,41 @@ Also updates the keyword regular expressions." Calls `org-table-next-row' or `newline', depending on context. See the individual commands for more information." (interactive) - (cond - ((bobp) (if indent (newline-and-indent) (newline))) - ((org-at-table-p) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-row)) - ;; when `newline-and-indent' is called within a list, make sure - ;; text moved stays inside the item. - ((and (org-in-item-p) indent) - (if (and (org-at-item-p) (>= (point) (match-end 0))) - (progn - (save-match-data (newline)) - (org-indent-line-to (length (match-string 0)))) - (let ((ind (org-get-indentation))) - (newline) - (if (org-looking-back org-list-end-re) - (org-indent-line-function) - (org-indent-line-to ind))))) - ((and org-return-follows-link - (let ((tprop (get-text-property (point) 'face))) - (or (eq tprop 'org-link) - (and (listp tprop) (memq 'org-link tprop))))) - (call-interactively 'org-open-at-point)) - ((and (org-at-heading-p) - (looking-at - (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))) - (org-show-entry) - (end-of-line 1) - (newline)) - (t (if indent (newline-and-indent) (newline))))) + (let (org-ts-what) + (cond + ((or (bobp) (org-in-src-block-p)) + (if indent (newline-and-indent) (newline))) + ((org-at-table-p) + (org-table-justify-field-maybe) + (call-interactively 'org-table-next-row)) + ;; when `newline-and-indent' is called within a list, make sure + ;; text moved stays inside the item. + ((and (org-in-item-p) indent) + (if (and (org-at-item-p) (>= (point) (match-end 0))) + (progn + (save-match-data (newline)) + (org-indent-line-to (length (match-string 0)))) + (let ((ind (org-get-indentation))) + (newline) + (if (org-looking-back org-list-end-re) + (org-indent-line) + (org-indent-line-to ind))))) + ((and org-return-follows-link + (org-at-timestamp-p t) + (not (eq org-ts-what 'after))) + (org-follow-timestamp-link)) + ((and org-return-follows-link + (let ((tprop (get-text-property (point) 'face))) + (or (eq tprop 'org-link) + (and (listp tprop) (memq 'org-link tprop))))) + (call-interactively 'org-open-at-point)) + ((and (org-at-heading-p) + (looking-at + (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))) + (org-show-entry) + (end-of-line 1) + (newline)) + (t (if indent (newline-and-indent) (newline)))))) (defun org-return-indent () "Goto next table row or insert a newline and indent. @@ -18741,7 +19462,7 @@ argument ARG, change each line in region into an item." ((not org-adapt-indentation) 0) ((not (outline-previous-heading)) 0) (t (length (match-string 0)))))) - ;; Level of first heading. Further headings will be + ;; Level of first heading. Further headings will be ;; compared to it to determine hierarchy in the list. (ref-level (org-reduced-level (org-outline-level)))) (while (< (point) end) @@ -18792,13 +19513,18 @@ argument ARG, change each line in region into an item." "Convert headings to normal text, or items or text to headings. If there is no active region, only the current line is considered. -If the first non blank line is an headline, remove the stars from -all headlines in the region. +With a \\[universal-argument] prefix, convert the whole list at +point into heading. + +In a region: -If it is a plain list item, turn all plain list items into headings. +- If the first non blank line is an headline, remove the stars + from all headlines in the region. -If it is a normal line, turn each and every normal line (i.e. not -an heading or an item) in the region into a heading. +- If it is a normal line turn each and every normal line (i.e. not an + heading or an item) in the region into a heading. + +- If it is a plain list item, turn all plain list items into headings. When converting a line into a heading, the number of stars is chosen such that the lines become children of the current entry. However, @@ -18812,11 +19538,18 @@ stars to add." (lambda (pos) (save-excursion (goto-char pos) + (while (org-at-comment-p) (forward-line)) (skip-chars-forward " \r\t\n") (point-at-bol))))) - beg end) - ;; Determine boundaries of changes. If region ends at a bol, do - ;; not consider the last line to be in the region. + beg end toggled) + ;; Determine boundaries of changes. If a universal prefix has + ;; been given, put the list in a region. If region ends at a bol, + ;; do not consider the last line to be in the region. + + (when (and current-prefix-arg (org-at-item-p)) + (if (equal current-prefix-arg '(4)) (setq current-prefix-arg 1)) + (org-mark-element)) + (if (org-region-active-p) (setq beg (funcall skip-blanks (region-beginning)) end (copy-marker (save-excursion @@ -18833,7 +19566,8 @@ stars to add." ((org-at-heading-p) (while (< (point) end) (when (org-at-heading-p t) - (looking-at org-outline-regexp) (replace-match "")) + (looking-at org-outline-regexp) (replace-match "") + (setq toggled t)) (forward-line))) ;; Case 2. Started at an item: change items into headlines. ;; One star will be added by `org-list-to-subtree'. @@ -18861,7 +19595,8 @@ stars to add." (org-list-to-subtree (org-list-parse-list t) '(:istart (concat stars add-stars (funcall get-stars depth)) - :icount (concat stars add-stars (funcall get-stars depth)))))))) + :icount (concat stars add-stars (funcall get-stars depth))))))) + (setq toggled t)) (forward-line)))) ;; Case 3. Started at normal text: make every line an heading, ;; skipping headlines and items. @@ -18877,10 +19612,11 @@ stars to add." (t "*"))) ; inside heading, oddeven (rpl (concat stars add-stars " "))) (while (< (point) end) - (when (and (not (org-at-heading-p)) (not (org-at-item-p)) + (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p))) (looking-at "\\([ \t]*\\)\\(\\S-\\)")) - (replace-match (concat rpl (match-string 2)))) - (forward-line))))))))) + (replace-match (concat rpl (match-string 2))) (setq toggled t)) + (forward-line))))))) + (unless toggled (message "Cannot toggle heading from here")))) (defun org-meta-return (&optional arg) "Insert a new heading or wrap a region in a table. @@ -18889,12 +19625,19 @@ See the individual commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metareturn-hook)) + ((or (org-at-drawer-p) (org-at-property-p)) + (newline-and-indent)) ((org-at-table-p) (call-interactively 'org-table-wrap-region)) (t (call-interactively 'org-insert-heading)))) ;;; Menu entries +(defsubst org-in-subtree-not-table-p () + "Are we in a subtree and not in a table?" + (and (not (org-before-first-heading-p)) + (not (org-at-table-p)))) + ;; Define the Org-mode menus (easy-menu-define org-tbl-menu org-mode-map "Tbl menu" '("Tbl" @@ -18977,23 +19720,25 @@ See the individual commands for more information." "--" ["Jump" org-goto t]) ("Edit Structure" - ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] - ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] + ["Refile Subtree" org-refile (org-in-subtree-not-table-p)] "--" - ["Copy Subtree" org-copy-special (not (org-at-table-p))] - ["Cut Subtree" org-cut-special (not (org-at-table-p))] + ["Move Subtree Up" org-shiftmetaup (org-in-subtree-not-table-p)] + ["Move Subtree Down" org-shiftmetadown (org-in-subtree-not-table-p)] + "--" + ["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)] + ["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)] ["Paste Subtree" org-paste-special (not (org-at-table-p))] "--" ["Clone subtree, shift time" org-clone-subtree-with-time-shift t] "--" ["Copy visible text" org-copy-visible t] "--" - ["Promote Heading" org-metaleft (not (org-at-table-p))] - ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] - ["Demote Heading" org-metaright (not (org-at-table-p))] - ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] + ["Promote Heading" org-metaleft (org-in-subtree-not-table-p)] + ["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)] + ["Demote Heading" org-metaright (org-in-subtree-not-table-p)] + ["Demote Subtree" org-shiftmetaright (org-in-subtree-not-table-p)] "--" - ["Sort Region/Children" org-sort (not (org-at-table-p))] + ["Sort Region/Children" org-sort t] "--" ["Convert to odd levels" org-convert-to-odd-levels t] ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) @@ -19004,11 +19749,11 @@ See the individual commands for more information." ["Footnote new/jump" org-footnote-action t] ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"]) ("Archive" - ["Archive (default method)" org-archive-subtree-default t] + ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)] "--" - ["Move Subtree to Archive file" org-advertized-archive-subtree t] - ["Toggle ARCHIVE tag" org-toggle-archive-tag t] - ["Move subtree to Archive sibling" org-archive-to-archive-sibling t] + ["Move Subtree to Archive file" org-advertized-archive-subtree (org-in-subtree-not-table-p)] + ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)] + ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)] ) "--" ("Hyperlinks" @@ -19059,23 +19804,23 @@ See the individual commands for more information." ["Go to the inbox of a feed..." org-feed-goto-inbox t] ["Customize feeds" (customize-variable 'org-feed-alist) t]) ("TAGS and Properties" - ["Set Tags" org-set-tags-command t] + ["Set Tags" org-set-tags-command (not (org-before-first-heading-p))] ["Change tag in region" org-change-tag-in-region (org-region-active-p)] "--" - ["Set property" org-set-property t] + ["Set property" org-set-property (not (org-before-first-heading-p))] ["Column view of properties" org-columns t] ["Insert Column View DBlock" org-insert-columns-dblock t]) ("Dates and Scheduling" - ["Timestamp" org-time-stamp t] - ["Timestamp (inactive)" org-time-stamp-inactive t] + ["Timestamp" org-time-stamp (not (org-before-first-heading-p))] + ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))] ("Change Date" - ["1 Day Later" org-shiftright t] - ["1 Day Earlier" org-shiftleft t] - ["1 ... Later" org-shiftup t] - ["1 ... Earlier" org-shiftdown t]) + ["1 Day Later" org-shiftright (org-at-timestamp-p)] + ["1 Day Earlier" org-shiftleft (org-at-timestamp-p)] + ["1 ... Later" org-shiftup (org-at-timestamp-p)] + ["1 ... Earlier" org-shiftdown (org-at-timestamp-p)]) ["Compute Time Range" org-evaluate-time-range t] - ["Schedule Item" org-schedule t] - ["Deadline" org-deadline t] + ["Schedule Item" org-schedule (not (org-before-first-heading-p))] + ["Deadline" org-deadline (not (org-before-first-heading-p))] "--" ["Custom time format" org-toggle-time-stamp-overlays :style radio :selected org-display-custom-times] @@ -19175,7 +19920,7 @@ information about your Org-mode version and configuration." (let ((reporter-prompt-for-summary-p "Bug report subject: ")) (reporter-submit-bug-report "emacs-orgmode@gnu.org" - (org-version) + (org-version nil 'full) (let (list) (save-window-excursion (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) @@ -19224,8 +19969,8 @@ Your bug report will be posted to the Org-mode mailing list. (save-excursion (while bl (set-buffer (pop bl)) - (if (eq major-mode 'org-mode) (setq bl nil))) - (when (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq bl nil))) + (when (derived-mode-p 'org-mode) (easy-menu-change '("Org") "File List for Agenda" (append @@ -19256,25 +20001,25 @@ Your bug report will be posted to the Org-mode mailing list. With prefix arg UNCOMPILED, load the uncompiled versions." (interactive "P") (require 'find-func) - (let* ((file-re "^\\(org\\|orgtbl\\)\\(\\.el\\|-.*\\.el\\)") - (dir-org (file-name-directory (org-find-library-name "org"))) + (let* ((file-re "^org\\(-.*\\)?\\.el") + (dir-org (file-name-directory (org-find-library-dir "org"))) (dir-org-contrib (ignore-errors - (file-name-directory - (org-find-library-name "org-contribdir")))) + (file-name-directory + (org-find-library-dir "org-contribdir")))) (babel-files (mapcar (lambda (el) (concat "ob" (when el (format "-%s" el)) ".el")) (append (list nil "comint" "eval" "exp" "keys" - "lob" "ref" "table" "tangle") + "lob" "ref" "table" "tangle") (delq nil (mapcar (lambda (lang) (when (cdr lang) (symbol-name (car lang)))) org-babel-load-languages))))) (files - (append (directory-files dir-org t file-re) - babel-files - (and dir-org-contrib - (directory-files dir-org-contrib t file-re)))) + (append babel-files + (and dir-org-contrib + (directory-files dir-org-contrib t file-re)) + (directory-files dir-org t file-re))) (remove-re (concat (if (featurep 'xemacs) "org-colview" "org-colview-xemacs") "\\'"))) @@ -19288,10 +20033,11 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (when (featurep (intern (file-name-nondirectory f))) (if (and (not uncompiled) (file-exists-p (concat f ".elc"))) - (load (concat f ".elc") nil nil t) - (load (concat f ".el") nil nil t)))) - files)) - (org-version)) + (load (concat f ".elc") nil nil 'nosuffix) + (load (concat f ".el") nil nil 'nosuffix)))) + files) + (load (concat dir-org "org-version.el") 'noerror nil 'nosuffix)) + (org-version nil 'full 'message)) ;;;###autoload (defun org-customize () @@ -19527,7 +20273,7 @@ N may optionally be the number of spaces to remove." (setq template (replace-regexp-in-string (concat "%" (regexp-quote (car entry))) - (cdr entry) template t t))) + (or (cdr entry) "") template t t))) template)) (defun org-base-buffer (buffer) @@ -19616,6 +20362,14 @@ and end of string." "Is S an ID created by UUIDGEN?" (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s))) +(defun org-in-src-block-p nil + "Whether point is in a code source block." + (let (ov) + (when (setq ov (overlays-at (point))) + (memq 'org-block-background + (overlay-properties + (car ov)))))) + (defun org-context () "Return a list of contexts of the current cursor position. If several contexts apply, all are returned. @@ -19634,8 +20388,10 @@ contexts are: :table in an org-mode table :table-special on a special filed in a table :table-table in a table.el table +:clocktable in a clocktable +:src-block in a source block :link on a hyperlink -:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE. +:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT, QUOTE. :target on a <<target>> :radio-target on a <<<radio-target>>> :latex-fragment on a LaTeX fragment @@ -19646,6 +20402,7 @@ faces as a help to recognize the following contexts: :table-special, :link, and :keyword." (let* ((f (get-text-property (point) 'face)) (faces (if (listp f) f (list f))) + (case-fold-search t) (p (point)) clist o) ;; First the large context (cond @@ -19680,6 +20437,24 @@ and :keyword." (push (list :table-table) clist))) (goto-char p) + (let ((case-fold-search t)) + ;; New the "medium" contexts: clocktables, source blocks + (cond ((org-in-clocktable-p) + (push (list :clocktable + (and (or (looking-at "#\\+BEGIN: clocktable") + (search-backward "#+BEGIN: clocktable" nil t)) + (match-beginning 0)) + (and (re-search-forward "#\\+END:?" nil t) + (match-end 0))) clist)) + ((org-in-src-block-p) + (push (list :src-block + (and (or (looking-at "#\\+BEGIN_SRC") + (search-backward "#+BEGIN_SRC" nil t)) + (match-beginning 0)) + (and (search-forward "#+END_SRC" nil t) + (match-beginning 0))) clist)))) + (goto-char p) + ;; Now the small context (cond ((org-at-timestamp-p) @@ -19826,18 +20601,18 @@ block from point." ;; Emacs 23 (add-hook 'occur-mode-find-occurrence-hook (lambda () - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (org-reveal)))) ;; Emacs 22 (defadvice occur-mode-goto-occurrence (after org-occur-reveal activate) - (and (eq major-mode 'org-mode) (org-reveal))) + (and (derived-mode-p 'org-mode) (org-reveal))) (defadvice occur-mode-goto-occurrence-other-window (after org-occur-reveal activate) - (and (eq major-mode 'org-mode) (org-reveal))) + (and (derived-mode-p 'org-mode) (org-reveal))) (defadvice occur-mode-display-occurrence (after org-occur-reveal activate) - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (let ((pos (occur-mode-find-occurrence))) (with-current-buffer (marker-buffer pos) (save-excursion @@ -19910,7 +20685,7 @@ Taken from `reduce' in cl-seq.el with all keyword arguments but Returns the number of empty lines passed." (let ((pos (point))) (if (cdr (assoc 'heading org-blank-before-new-entry)) - (skip-chars-backward " \t\n\r") + (skip-chars-backward " \t\n\r") (unless (eobp) (forward-line -1))) (beginning-of-line 2) @@ -19954,32 +20729,6 @@ ones and overrule settings in the other lists." (setq rtn (plist-put rtn p v)))) rtn)) -(defun org-move-line-down (arg) - "Move the current line down. With prefix argument, move it past ARG lines." - (interactive "p") - (let ((col (current-column)) - beg end pos) - (beginning-of-line 1) (setq beg (point)) - (beginning-of-line 2) (setq end (point)) - (beginning-of-line (+ 1 arg)) - (setq pos (move-marker (make-marker) (point))) - (insert (delete-and-extract-region beg end)) - (goto-char pos) - (org-move-to-column col))) - -(defun org-move-line-up (arg) - "Move the current line up. With prefix argument, move it past ARG lines." - (interactive "p") - (let ((col (current-column)) - beg end pos) - (beginning-of-line 1) (setq beg (point)) - (beginning-of-line 2) (setq end (point)) - (beginning-of-line (- arg)) - (setq pos (move-marker (make-marker) (point))) - (insert (delete-and-extract-region beg end)) - (goto-char pos) - (org-move-to-column col))) - (defun org-replace-escapes (string table) "Replace %-escapes in STRING with values in TABLE. TABLE is an association list with keys like \"%a\" and string values. @@ -20078,34 +20827,24 @@ which make use of the date at the cursor." (message "Entry marked for action; press `k' at desired date in agenda or calendar")) -(defun org-mark-subtree () +(defun org-mark-subtree (&optional up) "Mark the current subtree. -This puts point at the start of the current subtree, and mark at the end. - -If point is in an inline task, mark that task instead." - (interactive) - (let ((inline-task-p - (and (featurep 'org-inlinetask) - (org-inlinetask-in-task-p))) - (beg)) - ;; Get beginning of subtree - (cond - (inline-task-p (org-inlinetask-goto-beginning)) - ((org-at-heading-p) (beginning-of-line)) - (t (org-with-limited-levels (outline-previous-visible-heading 1)))) - (setq beg (point)) - ;; Get end of it - (if inline-task-p - (org-inlinetask-goto-end) - (org-end-of-subtree)) - ;; Mark zone - (push-mark (point) nil t) - (goto-char beg))) +This puts point at the start of the current subtree, and mark at +the end. If a numeric prefix UP is given, move up into the +hierarchy of headlines by UP levels before marking the subtree." + (interactive "P") + (org-with-limited-levels + (cond ((org-at-heading-p) (beginning-of-line)) + ((org-before-first-heading-p) (error "Not in a subtree")) + (t (outline-previous-visible-heading 1)))) + (when up (while (and (> up 0) (org-up-heading-safe)) (decf up))) + (if (org-called-interactively-p 'any) + (call-interactively 'org-mark-element) + (org-mark-element))) -;;; Paragraph filling stuff. -;; We want this to be just right, so use the full arsenal. +;;; Indentation -(defun org-indent-line-function () +(defun org-indent-line () "Indent line depending on context." (interactive) (let* ((pos (point)) @@ -20117,283 +20856,475 @@ If point is in an inline task, mark that task instead." (inline-re (and inline-task-p (org-inlinetask-outline-regexp))) column) - (beginning-of-line 1) - (cond - ;; Comments - ((looking-at "# ") (setq column 0)) - ;; Headings - ((looking-at org-outline-regexp) (setq column 0)) - ;; Included files - ((looking-at "#\\+include:") (setq column 0)) - ;; Footnote definition - ((looking-at org-footnote-definition-re) (setq column 0)) - ;; Literal examples - ((looking-at "[ \t]*:\\( \\|$\\)") - (setq column (org-get-indentation))) ; do nothing - ;; Lists - ((ignore-errors (goto-char (org-in-item-p))) - (setq column (if itemp - (org-get-indentation) - (org-list-item-body-column (point)))) - (goto-char pos)) - ;; Drawers - ((and (looking-at "[ \t]*:END:") - (save-excursion (re-search-backward org-drawer-regexp nil t))) - (save-excursion - (goto-char (1- (match-beginning 1))) - (setq column (current-column)))) - ;; Special blocks - ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") - (save-excursion - (re-search-backward - (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) - (setq column (org-get-indentation (match-string 0)))) - ((and (not (looking-at "[ \t]*#\\+begin_")) - (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) - (save-excursion - (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) - (setq column - (cond ((equal (downcase (match-string 1)) "src") - ;; src blocks: let `org-edit-src-exit' handle them - (org-get-indentation)) - ((equal (downcase (match-string 1)) "example") - (max (org-get-indentation) - (org-get-indentation (match-string 0)))) - (t - (org-get-indentation (match-string 0)))))) - ;; This line has nothing special, look at the previous relevant - ;; line to compute indentation - (t - (beginning-of-line 0) - (while (and (not (bobp)) - (not (looking-at org-drawer-regexp)) - ;; When point started in an inline task, do not move - ;; above task starting line. - (not (and inline-task-p (looking-at inline-re))) - ;; Skip drawers, blocks, empty lines, verbatim, - ;; comments, tables, footnotes definitions, lists, - ;; inline tasks. - (or (and (looking-at "[ \t]*:END:") - (re-search-backward org-drawer-regexp nil t)) - (and (looking-at "[ \t]*#\\+end_") - (re-search-backward "[ \t]*#\\+begin_"nil t)) - (looking-at "[ \t]*[\n:#|]") - (looking-at org-footnote-definition-re) - (and (ignore-errors (goto-char (org-in-item-p))) - (goto-char - (org-list-get-top-point (org-list-struct)))) - (and (not inline-task-p) - (featurep 'org-inlinetask) - (org-inlinetask-in-task-p) - (or (org-inlinetask-goto-beginning) t)))) - (beginning-of-line 0)) + (if (and orgstruct-is-++ (eq pos (point))) + (let ((indent-line-function (cadadr (assoc 'indent-line-function org-fb-vars)))) + (indent-according-to-mode)) + (beginning-of-line 1) (cond - ;; There was an heading above. - ((looking-at "\\*+[ \t]+") - (if (not org-adapt-indentation) - (setq column 0) - (goto-char (match-end 0)) + ;; Headings + ((looking-at org-outline-regexp) (setq column 0)) + ;; Included files + ((looking-at "#\\+include:") (setq column 0)) + ;; Footnote definition + ((looking-at org-footnote-definition-re) (setq column 0)) + ;; Literal examples + ((looking-at "[ \t]*:\\( \\|$\\)") + (setq column (org-get-indentation))) ; do nothing + ;; Lists + ((ignore-errors (goto-char (org-in-item-p))) + (setq column (if itemp + (org-get-indentation) + (org-list-item-body-column (point)))) + (goto-char pos)) + ;; Drawers + ((and (looking-at "[ \t]*:END:") + (save-excursion (re-search-backward org-drawer-regexp nil t))) + (save-excursion + (goto-char (1- (match-beginning 1))) (setq column (current-column)))) - ;; A drawer had started and is unfinished - ((looking-at org-drawer-regexp) - (goto-char (1- (match-beginning 1))) - (setq column (current-column))) - ;; Else, nothing noticeable found: get indentation and go on. - (t (setq column (org-get-indentation)))))) - ;; Now apply indentation and move cursor accordingly - (goto-char pos) - (if (<= (current-column) (current-indentation)) - (org-indent-line-to column) - (save-excursion (org-indent-line-to column))) - ;; Special polishing for properties, see `org-property-format' - (setq column (current-column)) - (beginning-of-line 1) - (if (looking-at - "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") - (replace-match (concat (match-string 1) - (format org-property-format - (match-string 2) (match-string 3))) - t t)) - (org-move-to-column column))) - -(defvar org-adaptive-fill-regexp-backup adaptive-fill-regexp - "Variable to store copy of `adaptive-fill-regexp'. -Since `adaptive-fill-regexp' is set to never match, we need to -store a backup of its value before entering `org-mode' so that -the functionality can be provided as a fall-back.") - -(defun org-set-autofill-regexps () + ;; Special blocks + ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") + (save-excursion + (re-search-backward + (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) + (setq column (org-get-indentation (match-string 0)))) + ((and (not (looking-at "[ \t]*#\\+begin_")) + (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) + (save-excursion + (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) + (setq column + (cond ((equal (downcase (match-string 1)) "src") + ;; src blocks: let `org-edit-src-exit' handle them + (org-get-indentation)) + ((equal (downcase (match-string 1)) "example") + (max (org-get-indentation) + (org-get-indentation (match-string 0)))) + (t + (org-get-indentation (match-string 0)))))) + ;; This line has nothing special, look at the previous relevant + ;; line to compute indentation + (t + (beginning-of-line 0) + (while (and (not (bobp)) + (not (looking-at org-drawer-regexp)) + ;; When point started in an inline task, do not move + ;; above task starting line. + (not (and inline-task-p (looking-at inline-re))) + ;; Skip drawers, blocks, empty lines, verbatim, + ;; comments, tables, footnotes definitions, lists, + ;; inline tasks. + (or (and (looking-at "[ \t]*:END:") + (re-search-backward org-drawer-regexp nil t)) + (and (looking-at "[ \t]*#\\+end_") + (re-search-backward "[ \t]*#\\+begin_"nil t)) + (looking-at "[ \t]*[\n:#|]") + (looking-at org-footnote-definition-re) + (and (ignore-errors (goto-char (org-in-item-p))) + (goto-char + (org-list-get-top-point (org-list-struct)))) + (and (not inline-task-p) + (featurep 'org-inlinetask) + (org-inlinetask-in-task-p) + (or (org-inlinetask-goto-beginning) t)))) + (beginning-of-line 0)) + (cond + ;; There was an heading above. + ((looking-at "\\*+[ \t]+") + (if (not org-adapt-indentation) + (setq column 0) + (goto-char (match-end 0)) + (setq column (current-column)))) + ;; A drawer had started and is unfinished + ((looking-at org-drawer-regexp) + (goto-char (1- (match-beginning 1))) + (setq column (current-column))) + ;; Else, nothing noticeable found: get indentation and go on. + (t (setq column (org-get-indentation)))))) + ;; Now apply indentation and move cursor accordingly + (goto-char pos) + (if (<= (current-column) (current-indentation)) + (org-indent-line-to column) + (save-excursion (org-indent-line-to column))) + ;; Special polishing for properties, see `org-property-format' + (setq column (current-column)) + (beginning-of-line 1) + (if (looking-at + "\\([ \t]*\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") + (replace-match (concat (match-string 1) + (format org-property-format + (match-string 2) (match-string 3))) + t t)) + (org-move-to-column column)))) + +(defun org-indent-drawer () + "Indent the drawer at point." + (interactive) + (let ((p (point)) + (e (and (save-excursion (re-search-forward ":END:" nil t)) + (match-end 0))) + (folded + (save-excursion + (end-of-line) + (when (overlays-at (point)) + (member 'invisible (overlay-properties + (car (overlays-at (point))))))))) + (when folded (org-cycle)) + (indent-for-tab-command) + (while (and (move-beginning-of-line 2) (< (point) e)) + (indent-for-tab-command)) + (goto-char p) + (when folded (org-cycle))) + (message "Drawer at point indented")) + +(defun org-indent-block () + "Indent the block at point." + (interactive) + (let ((p (point)) + (case-fold-search t) + (e (and (save-excursion (re-search-forward "#\\+end_?\\(?:[a-z]+\\)?" nil t)) + (match-end 0))) + (folded + (save-excursion + (end-of-line) + (when (overlays-at (point)) + (member 'invisible (overlay-properties + (car (overlays-at (point))))))))) + (when folded (org-cycle)) + (indent-for-tab-command) + (while (and (move-beginning-of-line 2) (< (point) e)) + (indent-for-tab-command)) + (goto-char p) + (when folded (org-cycle))) + (message "Block at point indented")) + +(defun org-indent-region (start end) + "Indent region." + (interactive "r") + (save-excursion + (let ((line-end (org-current-line end))) + (goto-char start) + (while (< (org-current-line) line-end) + (cond ((org-in-src-block-p) (org-src-native-tab-command-maybe)) + (t (call-interactively 'org-indent-line))) + (move-beginning-of-line 2))))) + + +;;; Filling + +;; We use our own fill-paragraph and auto-fill functions. + +;; `org-fill-paragraph' relies on adaptive filling and context +;; checking. Appropriate `fill-prefix' is computed with +;; `org-adaptive-fill-function'. + +;; `org-auto-fill-function' takes care of auto-filling. It calls +;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with +;; `org-adaptive-fill-function' value. Internally, +;; `org-comment-line-break-function' breaks the line. + +;; `org-setup-filling' installs filling and auto-filling related +;; variables during `org-mode' initialization. + +(defun org-setup-filling () (interactive) - ;; In the paragraph separator we include headlines, because filling - ;; text in a line directly attached to a headline would otherwise - ;; fill the headline as well. - (org-set-local 'comment-start-skip "^#+[ \t]*") - (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|#]") - ;; The paragraph starter includes hand-formatted lists. - (org-set-local - 'paragraph-start - (concat - "\f" "\\|" - "[ ]*$" "\\|" - org-outline-regexp "\\|" - "[ \t]*#" "\\|" - (org-item-re) "\\|" - "[ \t]*[:|]" "\\|" - "\\$\\$" "\\|" - "\\\\\\(begin\\|end\\|[][]\\)")) - ;; Inhibit auto-fill for headers, tables and fixed-width lines. - ;; But only if the user has not turned off tables or fixed-width regions - (org-set-local - 'auto-fill-inhibit-regexp - (concat org-outline-regexp - "\\|#\\+" - "\\|[ \t]*" org-keyword-time-regexp - (if (or org-enable-table-editor org-enable-fixed-width-editor) - (concat - "\\|[ \t]*[" - (if org-enable-table-editor "|" "") - (if org-enable-fixed-width-editor ":" "") - "]")))) - ;; We use our own fill-paragraph function, to make sure that tables - ;; and fixed-width regions are not wrapped. That function will pass - ;; through to `fill-paragraph' when appropriate. - (org-set-local 'fill-paragraph-function 'org-fill-paragraph) ;; Prevent auto-fill from inserting unwanted new items. - (if (boundp 'fill-nobreak-predicate) - (org-set-local 'fill-nobreak-predicate - (if (memq 'org-fill-item-nobreak-p fill-nobreak-predicate) - fill-nobreak-predicate - (cons 'org-fill-item-nobreak-p fill-nobreak-predicate)))) - ;; Adaptive filling: To get full control, first make sure that - ;; `adaptive-fill-regexp' never matches. Then install our own matcher. - (unless (local-variable-p 'adaptive-fill-regexp (current-buffer)) - (org-set-local 'org-adaptive-fill-regexp-backup - adaptive-fill-regexp)) - (org-set-local 'adaptive-fill-regexp "\000") + (when (boundp 'fill-nobreak-predicate) + (org-set-local + 'fill-nobreak-predicate + (org-uniquify + (append fill-nobreak-predicate + '(org-fill-paragraph-separate-nobreak-p + org-fill-line-break-nobreak-p))))) + (org-set-local 'fill-paragraph-function 'org-fill-paragraph) + (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) - (org-set-local 'adaptive-fill-function - 'org-adaptive-fill-function) - (org-set-local - 'align-mode-rules-list - '((org-in-buffer-settings - (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") - (modes . '(org-mode)))))) + (org-set-local 'comment-line-break-function 'org-comment-line-break-function)) -(defun org-fill-item-nobreak-p () +(defvar org-element-paragraph-separate) ; org-element.el +(defun org-fill-paragraph-separate-nobreak-p () "Non-nil when a line break at point would insert a new item." - (and (looking-at (org-item-re)) (org-list-in-valid-context-p))) + (looking-at (substring org-element-paragraph-separate 1))) -(defun org-fill-paragraph (&optional justify) - "Re-align a table, pass through to fill-paragraph if no table." - (let ((table-p (org-at-table-p)) - (table.el-p (org-at-table.el-p)) - (itemp (org-in-item-p))) - (cond ((and (equal (char-after (point-at-bol)) ?*) - (save-excursion (goto-char (point-at-bol)) - (looking-at org-outline-regexp))) - t) ; skip headlines - (table.el-p t) ; skip table.el tables - (table-p (org-table-align) t) ; align Org tables - (itemp ; align text in items - (let* ((struct (save-excursion (goto-char itemp) - (org-list-struct))) - (parents (org-list-parents-alist struct)) - (children (org-list-get-children itemp struct parents)) - beg end prev next prefix) - ;; Determine in which part of item point is: before - ;; first child, after last child, between two - ;; sub-lists, or simply in item if there's no child. - (cond - ((not children) - (setq prefix (make-string (org-list-item-body-column itemp) ?\ ) - beg itemp - end (org-list-get-item-end itemp struct))) - ((< (point) (setq next (car children))) - (setq prefix (make-string (org-list-item-body-column itemp) ?\ ) - beg itemp - end next)) - ((> (point) (setq prev (car (last children)))) - (setq beg (org-list-get-item-end prev struct) - end (org-list-get-item-end itemp struct) - prefix (save-excursion - (goto-char beg) - (skip-chars-forward " \t") - (make-string (current-column) ?\ )))) - (t (catch 'exit - (while (setq next (pop children)) - (if (> (point) next) - (setq prev next) - (setq beg (org-list-get-item-end prev struct) - end next - prefix (save-excursion - (goto-char beg) - (skip-chars-forward " \t") - (make-string (current-column) ?\ ))) - (throw 'exit nil)))))) - ;; Use `fill-paragraph' with buffer narrowed to item - ;; without any child, and with our computed PREFIX. - (flet ((fill-context-prefix (from to &optional flr) prefix)) - (save-restriction - (narrow-to-region beg end) - (save-excursion (fill-paragraph justify)))) t)) - ;; Special case where point is not in a list but is on - ;; a paragraph adjacent to a list: make sure this paragraph - ;; doesn't get merged with the end of the list by narrowing - ;; buffer first. - ((save-excursion (forward-paragraph -1) - (setq itemp (org-in-item-p))) - (let ((struct (save-excursion (goto-char itemp) - (org-list-struct)))) - (save-restriction - (narrow-to-region (org-list-get-bottom-point struct) - (save-excursion (forward-paragraph 1) - (point))) - (fill-paragraph justify) t))) - ;; Else simply call `fill-paragraph'. - (t nil)))) - -;; For reference, this is the default value of adaptive-fill-regexp -;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" +(defun org-fill-line-break-nobreak-p () + "Non-nil when a line break at point would create an Org line break." + (save-excursion + (skip-chars-backward "[ \t]") + (skip-chars-backward "\\\\") + (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)"))) +(declare-function message-in-body-p "message" ()) +(defvar org-element--affiliated-re) ; From org-element.el (defun org-adaptive-fill-function () - "Return a fill prefix for org-mode files." - (let (itemp) + "Compute a fill prefix for the current line. +Return fill prefix, as a string, or nil if current line isn't +meant to be filled." + (org-with-wide-buffer + (unless (and (derived-mode-p 'message-mode) (not (message-in-body-p))) + ;; FIXME: This is really the job of orgstruct++-mode + (let* ((p (line-beginning-position)) + (element (save-excursion (beginning-of-line) + (org-element-at-point))) + (type (org-element-type element)) + (post-affiliated + (save-excursion + (goto-char (org-element-property :begin element)) + (while (looking-at org-element--affiliated-re) (forward-line)) + (point)))) + (unless (< p post-affiliated) + (case type + (comment (looking-at "[ \t]*# ?") (match-string 0)) + (footnote-definition "") + ((item plain-list) + (make-string (org-list-item-body-column post-affiliated) ? )) + (paragraph + ;; Fill prefix is usually the same as the current line, + ;; except if the paragraph is at the beginning of an item. + (let ((parent (org-element-property :parent element))) + (cond ((eq (org-element-type parent) 'item) + (make-string (org-list-item-body-column + (org-element-property :begin parent)) + ? )) + ((save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0)) + (t "")))) + (comment-block + ;; Only fill contents if P is within block boundaries. + (let* ((cbeg (save-excursion (goto-char post-affiliated) + (forward-line) + (point))) + (cend (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (when (and (>= p cbeg) (< p cend)) + (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0) + "")))))))))) + +(declare-function message-goto-body "message" ()) +(defvar message-cite-prefix-regexp) ; From message.el +(defvar org-element-all-objects) ; From org-element.el +(defun org-fill-paragraph (&optional justify) + "Fill element at point, when applicable. + +This function only applies to comment blocks, comments, example +blocks and paragraphs. Also, as a special case, re-align table +when point is at one. + +If JUSTIFY is non-nil (interactively, with prefix argument), +justify as well. If `sentence-end-double-space' is non-nil, then +period followed by one space does not end a sentence, so don't +break a line there. The variable `fill-column' controls the +width for filling. + +For convenience, when point is at a plain list, an item or +a footnote definition, try to fill the first paragraph within." + ;; Falls back on message-fill-paragraph when necessary + (interactive) + (if (and (derived-mode-p 'message-mode) + (or (not (message-in-body-p)) + (save-excursion (move-beginning-of-line 1) + (looking-at message-cite-prefix-regexp)))) + (let ((fill-paragraph-function + (cadadr (assoc 'fill-paragraph-function org-fb-vars))) + (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars))) + (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars))) + (paragraph-separate + (cadadr (assoc 'paragraph-separate org-fb-vars)))) + (fill-paragraph nil)) (save-excursion - (cond - ;; Comment line - ((looking-at "#[ \t]+") - (match-string-no-properties 0)) - ;; Plain list item - ((org-at-item-p) - (make-string (org-list-item-body-column (point-at-bol)) ?\ )) - ;; Point is in a list after `backward-paragraph': original - ;; point wasn't in the list, or filling would have been taken - ;; care of by `org-auto-fill-function', but the list and the - ;; real paragraph are not separated by a blank line. Thus, move - ;; point after the list to go back to real paragraph and - ;; determine fill-prefix. - ((setq itemp (org-in-item-p)) - (goto-char itemp) - (let* ((struct (org-list-struct)) - (bottom (org-list-get-bottom-point struct))) - (goto-char bottom) - (make-string (org-get-indentation) ?\ ))) - ;; Other text - ((looking-at org-adaptive-fill-regexp-backup) - (match-string-no-properties 0)))))) + ;; Move to end of line in order to get the first paragraph + ;; within a plain list or a footnote definition. + (end-of-line) + (let ((element (org-element-at-point))) + ;; First check if point is in a blank line at the beginning of + ;; the buffer. In that case, ignore filling. + (if (< (point) (org-element-property :begin element)) t + (case (org-element-type element) + ;; Align Org tables, leave table.el tables as-is. + (table-row (org-table-align) t) + (table + (when (eq (org-element-property :type element) 'org) + (org-table-align)) + t) + (paragraph + ;; Paragraphs may contain `line-break' type objects. + (let ((beg (max (point-min) + (org-element-property :contents-begin element))) + (end (min (point-max) + (org-element-property :contents-end element)))) + ;; Do nothing if point is at an affiliated keyword. + (if (< (point) beg) t + (when (derived-mode-p 'message-mode) + ;; In `message-mode', do not fill following + ;; citation in current paragraph nor text before + ;; message body. + (let ((body-start (save-excursion (message-goto-body)))) + (when body-start (setq beg (max body-start beg)))) + (when (save-excursion + (re-search-forward + (concat "^" message-cite-prefix-regexp) end t)) + (setq end (match-beginning 0)))) + ;; Fill paragraph, taking line breaks into + ;; consideration. For that, slice the paragraph + ;; using line breaks as separators, and fill the + ;; parts in reverse order to avoid messing with + ;; markers. + (save-excursion + (goto-char end) + (mapc + (lambda (pos) + (fill-region-as-paragraph pos (point) justify) + (goto-char pos)) + ;; Find the list of ending positions for line + ;; breaks in the current paragraph. Add paragraph + ;; beginning to include first slice. + (nreverse + (cons + beg + (org-element-map + (org-element--parse-objects + beg end nil org-element-all-objects) + 'line-break + (lambda (lb) (org-element-property :end lb))))))) + t))) + ;; Contents of `comment-block' type elements should be + ;; filled as plain text, but only if point is within block + ;; markers. + (comment-block + (let* ((case-fold-search t) + (beg (save-excursion + (goto-char (org-element-property :begin element)) + (re-search-forward "^[ \t]*#\\+begin_comment" nil t) + (forward-line) + (point))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (re-search-backward "^[ \t]*#\\+end_comment" nil t) + (line-beginning-position)))) + (when (and (>= (point) beg) (< (point) end)) + (fill-region-as-paragraph + (save-excursion + (end-of-line) + (re-search-backward "^[ \t]*$" beg 'move) + (line-beginning-position)) + (save-excursion + (beginning-of-line) + (re-search-forward "^[ \t]*$" end 'move) + (line-beginning-position)) + justify))) + t) + ;; Fill comments. + (comment (fill-comment-paragraph justify)) + ;; Ignore every other element. + (otherwise t))))))) (defun org-auto-fill-function () "Auto-fill function." - (let (itemp prefix) - ;; When in a list, compute an appropriate fill-prefix and make - ;; sure it will be used by `do-auto-fill'. - (if (setq itemp (org-in-item-p)) - (progn - (setq prefix (make-string (org-list-item-body-column itemp) ?\ )) - (flet ((fill-context-prefix (from to &optional flr) prefix)) - (do-auto-fill))) - ;; Else just use `do-auto-fill'. - (do-auto-fill)))) + ;; Check if auto-filling is meaningful. + (let ((fc (current-fill-column))) + (when (and fc (> (current-column) fc)) + (let ((fill-prefix (org-adaptive-fill-function))) + (when fill-prefix (do-auto-fill)))))) + +(defun org-comment-line-break-function (&optional soft) + "Break line at point and indent, continuing comment if within one. +The inserted newline is marked hard if variable +`use-hard-newlines' is true, unless optional argument SOFT is +non-nil." + (if soft (insert-and-inherit ?\n) (newline 1)) + (save-excursion (forward-char -1) (delete-horizontal-space)) + (delete-horizontal-space) + (indent-to-left-margin) + (insert-before-markers-and-inherit fill-prefix)) + + +;;; Comments + +;; Org comments syntax is quite complex. It requires the entire line +;; to be just a comment. Also, even with the right syntax at the +;; beginning of line, some some elements (i.e. verse-block or +;; example-block) don't accept comments. Usual Emacs comment commands +;; cannot cope with those requirements. Therefore, Org replaces them. + +;; Org still relies on `comment-dwim', but cannot trust +;; `comment-only-p'. So, `comment-region-function' and +;; `uncomment-region-function' both point +;; to`org-comment-or-uncomment-region'. Eventually, +;; `org-insert-comment' takes care of insertion of comments at the +;; beginning of line. + +;; `org-setup-comments-handling' install comments related variables +;; during `org-mode' initialization. + +(defun org-setup-comments-handling () + (interactive) + (org-set-local 'comment-use-syntax nil) + (org-set-local 'comment-start "# ") + (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)") + (org-set-local 'comment-insert-comment-function 'org-insert-comment) + (org-set-local 'comment-region-function 'org-comment-or-uncomment-region) + (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region)) + +(defun org-insert-comment () + "Insert an empty comment above current line. +If the line is empty, insert comment at its beginning." + (beginning-of-line) + (if (looking-at "\\s-*$") (replace-match "") (open-line 1)) + (org-indent-line) + (insert "# ")) + +(defvar comment-empty-lines) ; From newcomment.el. +(defun org-comment-or-uncomment-region (beg end &rest ignore) + "Comment or uncomment each non-blank line in the region. +Uncomment each non-blank line between BEG and END if it only +contains commented lines. Otherwise, comment them." + (save-restriction + ;; Restrict region + (narrow-to-region (save-excursion (goto-char beg) + (skip-chars-forward " \r\t\n" end) + (line-beginning-position)) + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n" beg) + (line-end-position))) + (let ((uncommentp + ;; UNCOMMENTP is non-nil when every non blank line between + ;; BEG and END is a comment. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) + (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'comment) + (goto-char (min (point-max) + (org-element-property + :end element))))))) + (eobp)))) + (if uncommentp + ;; Only blank lines and comments in region: uncomment it. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") + (replace-match "" nil nil nil 1)) + (forward-line))) + ;; Comment each line in region. + (let ((min-indent (point-max))) + ;; First find the minimum indentation across all lines. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) (not (zerop min-indent))) + (unless (looking-at "[ \t]*$") + (setq min-indent (min min-indent (current-indentation)))) + (forward-line))) + ;; Then loop over all lines. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) + (org-move-to-column min-indent t) + (insert comment-start)) + (forward-line)))))))) + ;;; Other stuff. @@ -20620,7 +21551,8 @@ depending on context." (if (or (eq org-ctrl-k-protect-subtree 'error) (not (y-or-n-p "Kill hidden subtree along with headline? "))) (error "C-k aborted - would kill hidden subtree"))) - (call-interactively 'kill-line)) + (call-interactively + (if (and (boundp 'visual-line-mode) visual-line-mode) 'kill-visual-line 'kill-line))) ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) (kill-region (point) (match-beginning 1)) (org-set-tags nil t)) @@ -20683,7 +21615,7 @@ interactive command with similar behavior." end) (if (and subtreep org-yank-adjusted-subtrees) (org-paste-subtree nil nil 'for-yank) - (call-interactively command)) + (call-interactively command)) (setq end (point)) (goto-char beg) @@ -20712,7 +21644,7 @@ interactive command with similar behavior." (org-paste-subtree nil nil 'for-yank) (push-mark beg 'nomsg))) (t - (call-interactively command)))))) + (call-interactively command)))))) (defun org-yank-folding-would-swallow-text (beg end) "Would hide-subtree at BEG swallow any text after END?" @@ -20756,13 +21688,6 @@ This version does not only check the character property, but also (error (error "Before first headline at position %d in buffer %s" (point) (current-buffer))))) -(defun org-beginning-of-defun () - "Go to the beginning of the subtree, i.e. back to the heading." - (org-back-to-heading)) -(defun org-end-of-defun () - "Go to the end of the subtree." - (org-end-of-subtree nil t)) - (defun org-before-first-heading-p () "Before first heading?" (save-excursion @@ -20774,12 +21699,24 @@ This version does not only check the character property, but also ;; Compatibility alias with Org versions < 7.8.03 (defalias 'org-on-heading-p 'org-at-heading-p) +(defun org-at-comment-p nil + "Is cursor in a line starting with a # character?" + (save-excursion + (beginning-of-line) + (looking-at "^#"))) + (defun org-at-drawer-p nil - "Whether point is at a drawer." + "Is cursor at a drawer keyword?" (save-excursion (move-beginning-of-line 1) (looking-at org-drawer-regexp))) +(defun org-at-block-p nil + "Is cursor at a block keyword?" + (save-excursion + (move-beginning-of-line 1) + (looking-at org-block-regexp))) + (defun org-point-at-end-of-empty-headline () "If point is at the end of an empty headline, return t, else nil. If the heading only contains a TODO keyword, it is still still considered @@ -20927,18 +21864,19 @@ If there is no such heading, return nil." nil (point))))) -(defun org-end-of-subtree (&optional invisible-OK to-heading) +(defun org-end-of-subtree (&optional invisible-ok to-heading) + "Goto to the end of a subtree." ;; This contains an exact copy of the original function, but it uses ;; `org-back-to-heading', to make it work also in invisible - ;; trees. And is uses an invisible-OK argument. + ;; trees. And is uses an invisible-ok argument. ;; Under Emacs this is not needed, but the old outline.el needs this fix. ;; Furthermore, when used inside Org, finding the end of a large subtree ;; with many children and grandchildren etc, this can be much faster ;; than the outline version. - (org-back-to-heading invisible-OK) + (org-back-to-heading invisible-ok) (let ((first t) (level (funcall outline-level))) - (if (and (eq major-mode 'org-mode) (< level 1000)) + (if (and (derived-mode-p 'org-mode) (< level 1000)) ;; A true heading (not a plain list item), in Org-mode ;; This means we can easily find the end by looking ;; only for the right number of stars. Using a regexp to do @@ -20963,7 +21901,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 (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (progn (org-end-of-subtree nil t) (unless (eobp) (backward-char 1))) @@ -20988,11 +21926,11 @@ clocking lines, and drawers." (and (re-search-forward "[^\n]" nil t) (backward-char 1)) (point))) -(defun org-forward-same-level (arg &optional invisible-ok) +(defun org-forward-heading-same-level (arg &optional invisible-ok) "Move forward to the arg'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. -Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil -it wil also look at invisible ones." +Normally this only looks at visible headings, but when INVISIBLE-OK is +non-nil it will also look at invisible ones." (interactive "p") (org-back-to-heading invisible-ok) (org-at-heading-p) @@ -21010,7 +21948,7 @@ it wil also look at invisible ones." (setq arg (1- arg))) (beginning-of-line 1))) -(defun org-backward-same-level (arg &optional invisible-ok) +(defun org-backward-heading-same-level (arg &optional invisible-ok) "Move backward to the arg'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading." (interactive "p") @@ -21028,6 +21966,211 @@ Stop at the first and last subheadings of a superior heading." (if (< l level) (setq arg 1))) (setq arg (1- arg))))) +;;;###autoload +(defun org-forward-element () + "Move forward by one element. +Move to the next element at the same level, when possible." + (interactive) + (cond ((eobp) (error "Cannot move further down")) + ((org-with-limited-levels (org-at-heading-p)) + (let ((origin (point))) + (org-forward-heading-same-level 1) + (unless (org-with-limited-levels (org-at-heading-p)) + (goto-char origin) + (error "Cannot move further down")))) + (t + (let* ((elem (org-element-at-point)) + (end (org-element-property :end elem)) + (parent (org-element-property :parent elem))) + (if (and parent (= (org-element-property :contents-end parent) end)) + (goto-char (org-element-property :end parent)) + (goto-char end)))))) + +;;;###autoload +(defun org-backward-element () + "Move backward by one element. +Move to the previous element at the same level, when possible." + (interactive) + (cond ((bobp) (error "Cannot move further up")) + ((org-with-limited-levels (org-at-heading-p)) + ;; At an headline, move to the previous one, if any, or stay + ;; here. + (let ((origin (point))) + (org-backward-heading-same-level 1) + (unless (org-with-limited-levels (org-at-heading-p)) + (goto-char origin) + (error "Cannot move further up")))) + (t + (let* ((trail (org-element-at-point 'keep-trail)) + (elem (car trail)) + (prev-elem (nth 1 trail)) + (beg (org-element-property :begin elem))) + (cond + ;; Move to beginning of current element if point isn't + ;; there already. + ((/= (point) beg) (goto-char beg)) + (prev-elem (goto-char (org-element-property :begin prev-elem))) + ((org-before-first-heading-p) (goto-char (point-min))) + (t (org-back-to-heading))))))) + +;;;###autoload +(defun org-up-element () + "Move to upper element." + (interactive) + (if (org-with-limited-levels (org-at-heading-p)) + (unless (org-up-heading-safe) (error "No surrounding element")) + (let* ((elem (org-element-at-point)) + (parent (org-element-property :parent elem))) + (if parent (goto-char (org-element-property :begin parent)) + (if (org-with-limited-levels (org-before-first-heading-p)) + (error "No surrounding element") + (org-with-limited-levels (org-back-to-heading))))))) + +;;;###autoload +(defvar org-element-greater-elements) +(defun org-down-element () + "Move to inner element." + (interactive) + (let ((element (org-element-at-point))) + (cond + ((memq (org-element-type element) '(plain-list table)) + (goto-char (org-element-property :contents-begin element)) + (forward-char)) + ((memq (org-element-type element) org-element-greater-elements) + ;; If contents are hidden, first disclose them. + (when (org-element-property :hiddenp element) (org-cycle)) + (goto-char (or (org-element-property :contents-begin element) + (error "No content for this element")))) + (t (error "No inner element"))))) + +;;;###autoload +(defun org-drag-element-backward () + "Move backward element at point." + (interactive) + (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up) + (let* ((trail (org-element-at-point 'keep-trail)) + (elem (car trail)) + (prev-elem (nth 1 trail))) + ;; Error out if no previous element or previous element is + ;; a parent of the current one. + (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) + (error "Cannot drag element backward") + (let ((pos (point))) + (org-element-swap-A-B prev-elem elem) + (goto-char (+ (org-element-property :begin prev-elem) + (- pos (org-element-property :begin elem))))))))) + +;;;###autoload +(defun org-drag-element-forward () + "Move forward element at point." + (interactive) + (let* ((pos (point)) + (elem (org-element-at-point))) + (when (= (point-max) (org-element-property :end elem)) + (error "Cannot drag element forward")) + (goto-char (org-element-property :end elem)) + (let ((next-elem (org-element-at-point))) + (when (or (org-element-nested-p elem next-elem) + (and (eq (org-element-type next-elem) 'headline) + (not (eq (org-element-type elem) 'headline)))) + (goto-char pos) + (error "Cannot drag element forward")) + ;; Compute new position of point: it's shifted by NEXT-ELEM + ;; body's length (without final blanks) and by the length of + ;; blanks between ELEM and NEXT-ELEM. + (let ((size-next (- (save-excursion + (goto-char (org-element-property :end next-elem)) + (skip-chars-backward " \r\t\n") + (forward-line) + ;; Small correction if buffer doesn't end + ;; with a newline character. + (if (and (eolp) (not (bolp))) (1+ (point)) (point))) + (org-element-property :begin next-elem))) + (size-blank (- (org-element-property :end elem) + (save-excursion + (goto-char (org-element-property :end elem)) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))))) + (org-element-swap-A-B elem next-elem) + (goto-char (+ pos size-next size-blank)))))) + +;;;###autoload +(defun org-mark-element () + "Put point at beginning of this element, mark at end. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next element after the +ones already marked." + (interactive) + (let (deactivate-mark) + (if (and (org-called-interactively-p 'any) + (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active))) + (set-mark + (save-excursion + (goto-char (mark)) + (goto-char (org-element-property :end (org-element-at-point))))) + (let ((element (org-element-at-point))) + (end-of-line) + (push-mark (org-element-property :end element) t t) + (goto-char (org-element-property :begin element)))))) + +;;;###autoload +(defun org-narrow-to-element () + "Narrow buffer to current element." + (interactive) + (let ((elem (org-element-at-point))) + (cond + ((eq (car elem) 'headline) + (narrow-to-region + (org-element-property :begin elem) + (org-element-property :end elem))) + ((memq (car elem) org-element-greater-elements) + (narrow-to-region + (org-element-property :contents-begin elem) + (org-element-property :contents-end elem))) + (t + (narrow-to-region + (org-element-property :begin elem) + (org-element-property :end elem)))))) + +;;;###autoload +(defun org-transpose-element () + "Transpose current and previous elements, keeping blank lines between. +Point is moved after both elements." + (interactive) + (org-skip-whitespace) + (let ((end (org-element-property :end (org-element-at-point)))) + (org-drag-element-backward) + (goto-char end))) + +;;;###autoload +(defun org-unindent-buffer () + "Un-indent the visible part of the buffer. +Relative indentation (between items, inside blocks, etc.) isn't +modified." + (interactive) + (unless (eq major-mode 'org-mode) + (error "Cannot un-indent a buffer not in Org mode")) + (let* ((parse-tree (org-element-parse-buffer 'greater-element)) + unindent-tree ; For byte-compiler. + (unindent-tree + (function + (lambda (contents) + (mapc + (lambda (element) + (if (memq (org-element-type element) '(headline section)) + (funcall unindent-tree (org-element-contents element)) + (save-excursion + (save-restriction + (narrow-to-region + (org-element-property :begin element) + (org-element-property :end element)) + (org-do-remove-indentation))))) + (reverse contents)))))) + (funcall unindent-tree (org-element-contents parse-tree)))) + (defun org-show-subtree () "Show everything after this heading at deeper levels." (interactive) @@ -21059,12 +22202,10 @@ Show the heading too, if it is currently invisible." (defun org-make-options-regexp (kwds &optional extra) "Make a regular expression for keyword lines." (concat - "^" - "#?[ \t]*\\+\\(" + "^#\\+\\(" (mapconcat 'regexp-quote kwds "\\|") (if extra (concat "\\|" extra)) - "\\):[ \t]*" - "\\(.*\\)")) + "\\):[ \t]*\\(.*\\)")) ;; Make isearch reveal the necessary context (defun org-isearch-end () @@ -21136,7 +22277,7 @@ Show the heading too, if it is currently invisible." '(progn (add-hook 'imenu-after-jump-hook (lambda () - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (org-show-context 'org-goto)))))) (defun org-link-display-format (link) @@ -21144,11 +22285,11 @@ Show the heading too, if it is currently invisible." if no description is present" (save-match-data (if (string-match org-bracket-link-analytic-regexp link) - (replace-match (if (match-end 5) - (match-string 5 link) - (concat (match-string 1 link) - (match-string 3 link))) - nil t link) + (replace-match (if (match-end 5) + (match-string 5 link) + (concat (match-string 1 link) + (match-string 3 link))) + nil t link) link))) (defun org-toggle-link-display () @@ -21167,9 +22308,9 @@ if no description is present" (defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1) "Overlay marking the agenda restriction line in speedbar.") (overlay-put org-speedbar-restriction-lock-overlay - 'face 'org-agenda-restriction-lock) + 'face 'org-agenda-restriction-lock) (overlay-put org-speedbar-restriction-lock-overlay - 'help-echo "Agendas are currently limited to this item.") + 'help-echo "Agendas are currently limited to this item.") (org-detach-overlay org-speedbar-restriction-lock-overlay) (defun org-speedbar-set-agenda-restriction () @@ -21197,7 +22338,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 (eq major-mode 'org-mode) + (unless (derived-mode-p '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"))) @@ -21214,7 +22355,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 (eq major-mode 'org-mode) (org-show-context 'org-goto)))))) + (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto)))))) ;;; Fixes and Hacks for problems with other packages @@ -21228,7 +22369,9 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (not (get-text-property pos 'org-no-flyspell)) (not (member word org-todo-keywords-1)) (not (member word org-all-time-keywords)) - (not (member word org-additional-option-like-keywords))))) + (not (member word org-options-keywords)) + (not (member word (mapcar 'car org-startup-options))) + (not (member word org-additional-option-like-keywords-for-flyspell))))) (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region." @@ -21257,12 +22400,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 (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (org-show-context)))) (defun org-bookmark-jump-unhide () "Unhide the current position, to show the bookmark location." - (and (eq major-mode 'org-mode) + (and (derived-mode-p 'org-mode) (or (outline-invisible-p) (save-excursion (goto-char (max (point-min) (1- (point)))) (outline-invisible-p))) diff --git a/lisp/proced.el b/lisp/proced.el index be6cae2ef08..ec41ce65ef5 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1784,7 +1784,7 @@ supported but discouraged. It will be removed in a future version of Emacs." process-alist)))) (unless (and signal process-alist) - ;; Discouraged usge (supported for backward compatibility): + ;; Discouraged usage (supported for backward compatibility): ;; The new calling sequence separates more cleanly between the parts ;; of the code required for interactive and noninteractive calls so that ;; the command can be used more flexibly in noninteractive ways, too. diff --git a/lisp/profiler.el b/lisp/profiler.el index 5fc74573262..5e605957833 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -24,19 +24,21 @@ ;;; Code: -(eval-when-compile - (require 'cl-lib)) +(require 'cl-lib) (defgroup profiler nil "Emacs profiler." :group 'lisp :prefix "profiler-") -(defcustom profiler-sample-interval 1 - "Default sample interval in millisecond." +(defconst profiler-version "24.3") + +(defcustom profiler-sampling-interval 1000000 + "Default sampling interval in nanoseconds." :type 'integer :group 'profiler) + ;;; Utilities (defun profiler-ensure-string (object) @@ -49,6 +51,23 @@ (t (format "%s" object)))) +(defun profiler-format-percent (number divisor) + (concat (number-to-string (/ (* number 100) divisor)) "%")) + +(defun profiler-format-number (number) + "Format NUMBER in human readable string." + (if (and (integerp number) (> number 0)) + (cl-loop with i = (% (1+ (floor (log10 number))) 3) + for c in (append (number-to-string number) nil) + if (= i 0) + collect ?, into s + and do (setq i 3) + collect c into s + do (cl-decf i) + finally return + (apply 'string (if (eq (car s) ?,) (cdr s) s))) + (profiler-ensure-string number))) + (defun profiler-format (fmt &rest args) (cl-loop for (width align subfmt) in fmt for arg in args @@ -74,27 +93,10 @@ into frags finally return (apply #'concat frags))) -(defun profiler-format-percent (number divisor) - (concat (number-to-string (/ (* number 100) divisor)) "%")) - -(defun profiler-format-nbytes (nbytes) - "Format NBYTES in humarn readable string." - (if (and (integerp nbytes) (> nbytes 0)) - (cl-loop with i = (% (1+ (floor (log10 nbytes))) 3) - for c in (append (number-to-string nbytes) nil) - if (= i 0) - collect ?, into s - and do (setq i 3) - collect c into s - do (cl-decf i) - finally return - (apply 'string (if (eq (car s) ?,) (cdr s) s))) - (profiler-ensure-string nbytes))) - ;;; Entries -(defun profiler-entry-format (entry) +(defun profiler-format-entry (entry) "Format ENTRY in human readable string. ENTRY would be a function name of a function itself." (cond ((memq (car-safe entry) '(closure lambda)) @@ -106,76 +108,117 @@ function name of a function itself." (t (format "#<unknown 0x%x>" (sxhash entry))))) -;;; Log data structure +(defun profiler-fixup-entry (entry) + (if (symbolp entry) + entry + (profiler-format-entry entry))) + + +;;; Backtraces + +(defun profiler-fixup-backtrace (backtrace) + (apply 'vector (mapcar 'profiler-fixup-entry backtrace))) + + +;;; Logs ;; The C code returns the log in the form of a hash-table where the keys are ;; vectors (of size profiler-max-stack-depth, holding truncated ;; backtraces, where the first element is the top of the stack) and ;; the values are integers (which count how many times this backtrace ;; has been seen, multiplied by a "weight factor" which is either the -;; sample-interval or the memory being allocated). -;; We extend it by adding a few other entries to the hash-table, most notably: -;; - Key `type' has a value indicating the kind of log (`memory' or `cpu'). -;; - Key `timestamp' has a value giving the time when the log was obtained. -;; - Key `diff-p' indicates if this log represents a diff between two logs. - -(defun profiler-log-timestamp (log) (gethash 'timestamp log)) -(defun profiler-log-type (log) (gethash 'type log)) -(defun profiler-log-diff-p (log) (gethash 'diff-p log)) - -(defun profiler-log-diff (log1 log2) - "Compare LOG1 with LOG2 and return a diff log. Both logs must -be same type." - (unless (eq (profiler-log-type log1) - (profiler-log-type log2)) - (error "Can't compare different type of logs")) +;; sampling-interval or the memory being allocated). + +(defun profiler-compare-logs (log1 log2) + "Compare LOG1 with LOG2 and return diff." (let ((newlog (make-hash-table :test 'equal))) ;; Make a copy of `log1' into `newlog'. (maphash (lambda (backtrace count) (puthash backtrace count newlog)) log1) - (puthash 'diff-p t newlog) (maphash (lambda (backtrace count) - (when (vectorp backtrace) - (puthash backtrace (- (gethash backtrace log1 0) count) - newlog))) + (puthash backtrace (- (gethash backtrace log1 0) count) + newlog)) log2) newlog)) -(defun profiler-log-fixup-entry (entry) - (if (symbolp entry) - entry - (profiler-entry-format entry))) - -(defun profiler-log-fixup-backtrace (backtrace) - (mapcar 'profiler-log-fixup-entry backtrace)) - -(defun profiler-log-fixup (log) - "Fixup LOG so that the log could be serialized into file." +(defun profiler-fixup-log (log) (let ((newlog (make-hash-table :test 'equal))) (maphash (lambda (backtrace count) - (puthash (if (not (vectorp backtrace)) - backtrace - (profiler-log-fixup-backtrace backtrace)) + (puthash (profiler-fixup-backtrace backtrace) count newlog)) log) newlog)) -(defun profiler-log-write-file (log filename &optional confirm) - "Write LOG into FILENAME." + +;;; Profiles + +(cl-defstruct (profiler-profile (:type vector) + (:constructor profiler-make-profile)) + (tag 'profiler-profile) + (version profiler-version) + ;; - `type' has a value indicating the kind of profile (`memory' or `cpu'). + ;; - `log' indicates the profile log. + ;; - `timestamp' has a value giving the time when the profile was obtained. + ;; - `diff-p' indicates if this profile represents a diff between two profiles. + type log timestamp diff-p) + +(defun profiler-compare-profiles (profile1 profile2) + "Compare PROFILE1 with PROFILE2 and return diff." + (unless (eq (profiler-profile-type profile1) + (profiler-profile-type profile2)) + (error "Can't compare different type of profiles")) + (profiler-make-profile + :type (profiler-profile-type profile1) + :timestamp (current-time) + :diff-p t + :log (profiler-compare-logs + (profiler-profile-log profile1) + (profiler-profile-log profile2)))) + +(defun profiler-fixup-profile (profile) + "Fixup PROFILE so that the profile could be serialized into file." + (profiler-make-profile + :type (profiler-profile-type profile) + :timestamp (profiler-profile-timestamp profile) + :diff-p (profiler-profile-diff-p profile) + :log (profiler-fixup-log (profiler-profile-log profile)))) + +(defun profiler-write-profile (profile filename &optional confirm) + "Write PROFILE into file FILENAME." (with-temp-buffer (let (print-level print-length) - (print (profiler-log-fixup log) (current-buffer))) + (print (profiler-fixup-profile profile) + (current-buffer))) (write-file filename confirm))) -(defun profiler-log-read-file (filename) - "Read log from FILENAME." +(defun profiler-read-profile (filename) + "Read profile from file FILENAME." + ;; FIXME: tag and version check (with-temp-buffer (insert-file-contents filename) (goto-char (point-min)) (read (current-buffer)))) +(defun profiler-cpu-profile () + "Return CPU profile." + (when (and (fboundp 'profiler-cpu-running-p) + (fboundp 'profiler-cpu-log) + (profiler-cpu-running-p)) + (profiler-make-profile + :type 'cpu + :timestamp (current-time) + :log (profiler-cpu-log)))) + +(defun profiler-memory-profile () + "Return memory profile." + (when (profiler-memory-running-p) + (profiler-make-profile + :type 'memory + :timestamp (current-time) + :log (profiler-memory-log)))) + -;;; Calltree data structure +;;; Calltrees (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree)) entry @@ -202,7 +245,6 @@ be same type." (defun profiler-calltree-find (tree entry) "Return a child tree of ENTRY under TREE." - ;; OPTIMIZED (let (result (children (profiler-calltree-children tree))) ;; FIXME: Use `assoc'. (while (and children (null result)) @@ -224,19 +266,18 @@ be same type." ;; get a meaningful call-tree. (maphash (lambda (backtrace count) - (when (vectorp backtrace) - (let ((node tree) - (max (length backtrace))) - (dotimes (i max) - (let ((entry (aref backtrace (if reverse i (- max i 1))))) - (when entry - (let ((child (profiler-calltree-find node entry))) - (unless child - (setq child (profiler-make-calltree - :entry entry :parent node)) - (push child (profiler-calltree-children node))) - (cl-incf (profiler-calltree-count child) count) - (setq node child)))))))) + (let ((node tree) + (max (length backtrace))) + (dotimes (i max) + (let ((entry (aref backtrace (if reverse i (- max i 1))))) + (when entry + (let ((child (profiler-calltree-find node entry))) + (unless child + (setq child (profiler-make-calltree + :entry entry :parent node)) + (push child (profiler-calltree-children node))) + (cl-incf (profiler-calltree-count child) count) + (setq node child))))))) log)) (defun profiler-calltree-compute-percentages (tree) @@ -281,18 +322,18 @@ be same type." :type 'string :group 'profiler) -(defvar profiler-report-sample-line-format - '((60 left) - (14 right ((9 right) +(defvar profiler-report-cpu-line-format + '((50 left) + (24 right ((19 right) (5 right))))) (defvar profiler-report-memory-line-format '((55 left) - (19 right ((14 right profiler-format-nbytes) + (19 right ((14 right profiler-format-number) (5 right))))) -(defvar-local profiler-report-log nil - "The current profiler log.") +(defvar-local profiler-report-profile nil + "The current profile.") (defvar-local profiler-report-reversed nil "True if calltree is rendered in bottom-up. Do not touch this @@ -313,7 +354,7 @@ this variable directly.") 'mouse-face 'highlight 'help-echo "mouse-2 or RET jumps to definition")) (t - (profiler-entry-format entry))))) + (profiler-format-entry entry))))) (propertize string 'profiler-entry entry))) (defun profiler-report-make-name-part (tree) @@ -332,12 +373,12 @@ this variable directly.") (concat " " escaped))) (defun profiler-report-line-format (tree) - (let ((diff-p (profiler-log-diff-p profiler-report-log)) + (let ((diff-p (profiler-profile-diff-p profiler-report-profile)) (name-part (profiler-report-make-name-part tree)) (count (profiler-calltree-count tree)) (count-percent (profiler-calltree-count-percent tree))) - (profiler-format (cl-ecase (profiler-log-type profiler-report-log) - (cpu profiler-report-sample-line-format) + (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile) + (cpu profiler-report-cpu-line-format) (memory profiler-report-memory-line-format)) name-part (if diff-p @@ -378,27 +419,35 @@ this variable directly.") (define-key map "B" 'profiler-report-render-reversed-calltree) (define-key map "A" 'profiler-report-ascending-sort) (define-key map "D" 'profiler-report-descending-sort) - (define-key map "=" 'profiler-report-compare-log) - (define-key map (kbd "C-x C-w") 'profiler-report-write-log) + (define-key map "=" 'profiler-report-compare-profile) + (define-key map (kbd "C-x C-w") 'profiler-report-write-profile) (define-key map "q" 'quit-window) map)) -(defun profiler-report-make-buffer-name (log) +(defun profiler-report-make-buffer-name (profile) (format "*%s-Profiler-Report %s*" - (cl-ecase (profiler-log-type log) (cpu 'CPU) (memory 'Memory)) - (format-time-string "%Y-%m-%d %T" (profiler-log-timestamp log)))) + (cl-ecase (profiler-profile-type profile) (cpu 'CPU) (memory 'Memory)) + (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile)))) -(defun profiler-report-setup-buffer (log) - "Make a buffer for LOG and return it." - (let* ((buf-name (profiler-report-make-buffer-name log)) +(defun profiler-report-setup-buffer-1 (profile) + "Make a buffer for PROFILE and return it." + (let* ((buf-name (profiler-report-make-buffer-name profile)) (buffer (get-buffer-create buf-name))) (with-current-buffer buffer (profiler-report-mode) - (setq profiler-report-log log + (setq profiler-report-profile profile profiler-report-reversed nil profiler-report-order 'descending)) buffer)) +(defun profiler-report-setup-buffer (profile) + "Make a buffer for PROFILE with rendering the profile and +return it." + (let ((buffer (profiler-report-setup-buffer-1 profile))) + (with-current-buffer buffer + (profiler-report-render-calltree)) + buffer)) + (define-derived-mode profiler-report-mode special-mode "Profiler-Report" "Profiler Report Mode." (setq buffer-read-only t @@ -408,12 +457,12 @@ this variable directly.") ;;; Report commands -(defun profiler-report-calltree-at-point () - (get-text-property (point) 'calltree)) +(defun profiler-report-calltree-at-point (&optional point) + (get-text-property (or point (point)) 'calltree)) (defun profiler-report-move-to-entry () - (let ((point (next-single-property-change (line-beginning-position) - 'profiler-entry))) + (let ((point (next-single-property-change + (line-beginning-position) 'profiler-entry))) (if point (goto-char point) (back-to-indentation)))) @@ -446,7 +495,7 @@ this variable directly.") t)))))) (defun profiler-report-collapse-entry () - "Collpase entry at point." + "Collapse entry at point." (interactive) (save-excursion (beginning-of-line) @@ -493,15 +542,16 @@ otherwise collapse." (describe-function entry))))) (cl-defun profiler-report-render-calltree-1 - (log &key reverse (order 'descending)) - (let ((calltree (profiler-calltree-build profiler-report-log - :reverse reverse))) + (profile &key reverse (order 'descending)) + (let ((calltree (profiler-calltree-build + (profiler-profile-log profile) + :reverse reverse))) (setq header-line-format - (cl-ecase (profiler-log-type log) + (cl-ecase (profiler-profile-type profile) (cpu (profiler-report-header-line-format - profiler-report-sample-line-format - "Function" (list "Time (ms)" "%"))) + profiler-report-cpu-line-format + "Function" (list "CPU samples" "%"))) (memory (profiler-report-header-line-format profiler-report-memory-line-format @@ -517,7 +567,7 @@ otherwise collapse." (profiler-report-move-to-entry)))) (defun profiler-report-rerender-calltree () - (profiler-report-render-calltree-1 profiler-report-log + (profiler-report-render-calltree-1 profiler-report-profile :reverse profiler-report-reversed :order profiler-report-order)) @@ -545,28 +595,31 @@ otherwise collapse." (setq profiler-report-order 'descending) (profiler-report-rerender-calltree)) -(defun profiler-report-log (log) - (let ((buffer (profiler-report-setup-buffer log))) - (with-current-buffer buffer - (profiler-report-render-calltree)) - (pop-to-buffer buffer))) +(defun profiler-report-profile (profile) + (switch-to-buffer (profiler-report-setup-buffer profile))) + +(defun profiler-report-profile-other-window (profile) + (switch-to-buffer-other-window (profiler-report-setup-buffer profile))) + +(defun profiler-report-profile-other-frame (profile) + (switch-to-buffer-other-frame (profiler-report-setup-buffer profile))) -(defun profiler-report-compare-log (buffer) - "Compare the current profiler log with another." +(defun profiler-report-compare-profile (buffer) + "Compare the current profile with another." (interactive (list (read-buffer "Compare to: "))) - (let* ((log1 (with-current-buffer buffer profiler-report-log)) - (log2 profiler-report-log) - (diff-log (profiler-log-diff log1 log2))) - (profiler-report-log diff-log))) + (let* ((profile1 (with-current-buffer buffer profiler-report-profile)) + (profile2 profiler-report-profile) + (diff-profile (profiler-compare-profiles profile1 profile2))) + (profiler-report-profile diff-profile))) -(defun profiler-report-write-log (filename &optional confirm) - "Write the current profiler log into FILENAME." +(defun profiler-report-write-profile (filename &optional confirm) + "Write the current profile into file FILENAME." (interactive - (list (read-file-name "Write log: " default-directory) + (list (read-file-name "Write profile: " default-directory) (not current-prefix-arg))) - (profiler-log-write-file profiler-report-log - filename - confirm)) + (profiler-write-profile profiler-report-profile + filename + confirm)) ;;; Profiler commands @@ -584,13 +637,13 @@ Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started." nil t nil nil "cpu"))))) (cl-ecase mode (cpu - (profiler-cpu-start profiler-sample-interval) + (profiler-cpu-start profiler-sampling-interval) (message "CPU profiler started")) (mem (profiler-memory-start) (message "Memory profiler started")) (cpu+mem - (profiler-cpu-start profiler-sample-interval) + (profiler-cpu-start profiler-sampling-interval) (profiler-memory-start) (message "CPU and memory profiler started")))) @@ -606,48 +659,58 @@ Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started." (t "No"))))) (defun profiler-reset () - "Reset profiler log." + "Reset profiler logs." (interactive) (when (fboundp 'profiler-cpu-log) (ignore (profiler-cpu-log))) (ignore (profiler-memory-log)) t) -(defun profiler--report-cpu () - (let ((log (if (fboundp 'profiler-cpu-log) (profiler-cpu-log)))) - (when log - (puthash 'type 'cpu log) - (puthash 'timestamp (current-time) log) - (profiler-report-log log)))) +(defun profiler-report-cpu () + (let ((profile (profiler-cpu-profile))) + (when profile + (profiler-report-profile-other-window profile)))) -(defun profiler--report-memory () - (let ((log (profiler-memory-log))) - (when log - (puthash 'type 'memory log) - (puthash 'timestamp (current-time) log) - (profiler-report-log log)))) +(defun profiler-report-memory () + (let ((profile (profiler-memory-profile))) + (when profile + (profiler-report-profile-other-window profile)))) (defun profiler-report () "Report profiling results." (interactive) - (profiler--report-cpu) - (profiler--report-memory)) + (profiler-report-cpu) + (profiler-report-memory)) + +;;;###autoload +(defun profiler-find-profile (filename) + "Open profile FILENAME." + (interactive + (list (read-file-name "Find profile: " default-directory))) + (profiler-report-profile (profiler-read-profile filename))) + +;;;###autoload +(defun profiler-find-profile-other-window (filename) + "Open profile FILENAME." + (interactive + (list (read-file-name "Find profile: " default-directory))) + (profiler-report-profile-other-window (profiler-read-profile filename))) ;;;###autoload -(defun profiler-find-log (filename) - "Read a profiler log from FILENAME and report it." +(defun profiler-find-profile-other-frame (filename) + "Open profile FILENAME." (interactive - (list (read-file-name "Find log: " default-directory))) - (profiler-report-log (profiler-log-read-file filename))) + (list (read-file-name "Find profile: " default-directory))) + (profiler-report-profile-other-frame(profiler-read-profile filename))) ;;; Profiling helpers -;; (cl-defmacro with-sample-profiling ((&key interval) &rest body) +;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body) ;; `(unwind-protect ;; (progn ;; (ignore (profiler-cpu-log)) -;; (profiler-cpu-start ,interval) +;; (profiler-cpu-start ,sampling-interval) ;; ,@body) ;; (profiler-cpu-stop) ;; (profiler--report-cpu))) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 4b77c6dab1a..7bddbff9596 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -329,16 +329,23 @@ that form should be displayed.") "Prepend (var value) pair to hide-ifdef-env." (setq hide-ifdef-env (cons (cons var value) hide-ifdef-env))) +(declare-function semantic-c-hideif-lookup "semantic/bovine/c" (var)) +(declare-function semantic-c-hideif-defined "semantic/bovine/c" (var)) (defun hif-lookup (var) - ;; (message "hif-lookup %s" var) - (let ((val (assoc var hide-ifdef-env))) - (if val - (cdr val) - hif-undefined-symbol))) + (or (when (bound-and-true-p semantic-c-takeover-hideif) + (semantic-c-hideif-lookup var)) + (let ((val (assoc var hide-ifdef-env))) + (if val + (cdr val) + hif-undefined-symbol)))) (defun hif-defined (var) - (if (assoc var hide-ifdef-env) 1 0)) + (cond + ((bound-and-true-p semantic-c-takeover-hideif) + (semantic-c-hideif-defined var)) + ((assoc var hide-ifdef-env) 1) + (t 0))) ;;===%%SF%% evaluation (End) === diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e99e6bda4b8..b3b3b0181d7 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -499,17 +499,16 @@ The type returned can be `comment', `string' or `paren'." (defconst python-syntax-propertize-function (syntax-propertize-rules ((rx - ;; Match even number of backslashes. - (or (not (any ?\\ ?\' ?\")) point) (* ?\\ ?\\) - ;; Match single or triple quotes of any kind. - (group (or "\"" "\"\"\"" "'" "'''"))) - (1 (ignore (python-syntax-stringify)))) - ((rx - ;; Match odd number of backslashes. - (or (not (any ?\\)) point) ?\\ (* ?\\ ?\\) - ;; Followed by even number of equal quotes. - (group (or "\"\"" "\"\"\"\"" "''" "''''"))) - (1 (ignore (python-syntax-stringify)))))) + (and + ;; Match even number of backslashes. + (or (not (any ?\\ ?\' ?\")) point + ;; Quotes might be preceded by a escaped quote. + (and (or (not (any ?\\)) point) ?\\ + (* ?\\ ?\\) (any ?\' ?\"))) + (* ?\\ ?\\) + ;; Match single or triple quotes of any kind. + (group (or "\"" "\"\"\"" "'" "'''")))) + (0 (ignore (python-syntax-stringify)))))) (defsubst python-syntax-count-quotes (quote-char &optional point limit) "Count number of quotes around point (max is 3). @@ -525,11 +524,7 @@ is used to limit the scan." (defun python-syntax-stringify () "Put `syntax-table' property correctly on single/triple quotes." - (let* ((num-quotes - (let ((n (length (match-string-no-properties 1)))) - ;; This corrects the quote count when matching odd number - ;; of backslashes followed by even number of quotes. - (or (and (= 1 (logand n 1)) n) (1- n)))) + (let* ((num-quotes (length (match-string-no-properties 1))) (ppss (prog2 (backward-char num-quotes) (syntax-ppss) @@ -1866,31 +1861,45 @@ When MSG is non-nil messages the first line of STRING." (string-match "\n[ \t].*\n?$" string)) (comint-send-string process "\n"))))) +;; Shell output catching stolen from gud-gdb +(defvar python-shell-fetch-lines-in-progress nil) +(defvar python-shell-fetch-lines-string nil) +(defvar python-shell-fetched-lines nil) + +(defun python-shell-fetch-lines-filter (string) + "Filter used to read the list of lines output by a command. +STRING is the output to filter." + (setq string (concat python-shell-fetch-lines-string string)) + (while (string-match "\n" string) + (push (substring string 0 (match-beginning 0)) + python-shell-fetched-lines) + (setq string (substring string (match-end 0)))) + (if (equal (string-match comint-prompt-regexp string) 0) + (progn + (setq python-shell-fetch-lines-in-progress nil) + string) + (progn + (setq python-shell-fetch-lines-string string) + ""))) + (defun python-shell-send-string-no-output (string &optional process msg) "Send STRING to PROCESS and inhibit output. When MSG is non-nil messages the first line of STRING. Return the output." - (let* ((output-buffer "") - (process (or process (python-shell-get-or-create-process))) - (comint-preoutput-filter-functions - (append comint-preoutput-filter-functions - '(ansi-color-filter-apply - (lambda (string) - (setq output-buffer (concat output-buffer string)) - "")))) - (inhibit-quit t)) + (let ((process (or process (python-shell-get-or-create-process))) + (comint-preoutput-filter-functions + '(python-shell-fetch-lines-filter)) + (python-shell-fetch-lines-in-progress t) + (inhibit-quit t)) (or (with-local-quit (python-shell-send-string string process msg) - (accept-process-output process) - (replace-regexp-in-string - (if (> (length python-shell-prompt-output-regexp) 0) - (format "\n*%s$\\|^%s\\|\n$" - python-shell-prompt-regexp - (or python-shell-prompt-output-regexp "")) - (format "\n*$\\|^%s\\|\n$" - python-shell-prompt-regexp)) - "" output-buffer)) + (while python-shell-fetch-lines-in-progress + (accept-process-output process)) + (prog1 + (mapconcat #'identity + (reverse python-shell-fetched-lines) "\n") + (setq python-shell-fetched-lines nil))) (with-current-buffer (process-buffer process) (comint-interrupt-subjob))))) @@ -2258,32 +2267,100 @@ inferior python process is updated properly." This is the function used by `python-fill-paragraph-function' to fill comments." :type 'symbol - :group 'python - :safe 'symbolp) + :group 'python) (defcustom python-fill-string-function 'python-fill-string "Function to fill strings. This is the function used by `python-fill-paragraph-function' to fill strings." :type 'symbol - :group 'python - :safe 'symbolp) + :group 'python) (defcustom python-fill-decorator-function 'python-fill-decorator "Function to fill decorators. This is the function used by `python-fill-paragraph-function' to fill decorators." :type 'symbol - :group 'python - :safe 'symbolp) + :group 'python) (defcustom python-fill-paren-function 'python-fill-paren "Function to fill parens. This is the function used by `python-fill-paragraph-function' to fill parens." :type 'symbol + :group 'python) + +(defcustom python-fill-docstring-style 'pep-257 + "Style used to fill docstrings. +This affects `python-fill-string' behavior with regards to +triple quotes positioning. + +Possible values are DJANGO, ONETWO, PEP-257, PEP-257-NN, +SYMMETRIC, and NIL. A value of NIL won't care about quotes +position and will treat docstrings a normal string, any other +value may result in one of the following docstring styles: + +DJANGO: + + \"\"\" + Process foo, return bar. + \"\"\" + + \"\"\" + Process foo, return bar. + + If processing fails throw ProcessingError. + \"\"\" + +ONETWO: + + \"\"\"Process foo, return bar.\"\"\" + + \"\"\" + Process foo, return bar. + + If processing fails throw ProcessingError. + + \"\"\" + +PEP-257: + + \"\"\"Process foo, return bar.\"\"\" + + \"\"\"Process foo, return bar. + + If processing fails throw ProcessingError. + + \"\"\" + +PEP-257-NN: + + \"\"\"Process foo, return bar.\"\"\" + + \"\"\"Process foo, return bar. + + If processing fails throw ProcessingError. + \"\"\" + +SYMMETRIC: + + \"\"\"Process foo, return bar.\"\"\" + + \"\"\" + Process foo, return bar. + + If processing fails throw ProcessingError. + \"\"\"" + :type '(choice + (const :tag "Don't format docstrings" nil) + (const :tag "Django's coding standards style." django) + (const :tag "One newline and start and Two at end style." onetwo) + (const :tag "PEP-257 with 2 newlines at end of string." pep-257) + (const :tag "PEP-257 with 1 newline at end of string." pep-257-nn) + (const :tag "Symmetric style." symmetric)) :group 'python - :safe 'symbolp) + :safe (lambda (val) + (memq val '(django onetwo pep-257 pep-257-nn symmetric nil)))) (defun python-fill-paragraph-function (&optional justify) "`fill-paragraph-function' handling multi-line strings and possibly comments. @@ -2293,18 +2370,19 @@ the string's indentation. Optional argument JUSTIFY defines if the paragraph should be justified." (interactive "P") (save-excursion - (back-to-indentation) (cond ;; Comments - ((funcall python-fill-comment-function justify)) + ((python-syntax-context 'comment) + (funcall python-fill-comment-function justify)) ;; Strings/Docstrings - ((save-excursion (skip-chars-forward "\"'uUrR") - (python-syntax-context 'string)) + ((save-excursion (or (python-syntax-context 'string) + (equal (string-to-syntax "|") + (syntax-after (point))))) (funcall python-fill-string-function justify)) ;; Decorators ((equal (char-after (save-excursion (back-to-indentation) - (point-marker))) ?@) + (point))) ?@) (funcall python-fill-decorator-function justify)) ;; Parens ((or (python-syntax-context 'paren) @@ -2323,43 +2401,72 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (defun python-fill-string (&optional justify) "String fill function for `python-fill-paragraph-function'. JUSTIFY should be used (if applicable) as in `fill-paragraph'." - (let ((marker (point-marker)) - (string-start-marker - (progn - (skip-chars-forward "\"'uUrR") - (goto-char (python-syntax-context 'string)) - (skip-chars-forward "\"'uUrR") - (point-marker))) - (reg-start (line-beginning-position)) - (string-end-marker - (progn - (while (python-syntax-context 'string) - (goto-char (1+ (point-marker)))) - (skip-chars-backward "\"'") - (point-marker))) - (reg-end (line-end-position)) - (fill-paragraph-function)) + (let* ((marker (point-marker)) + (str-start-pos + (let ((m (make-marker))) + (setf (marker-position m) + (or (python-syntax-context 'string) + (and (equal (string-to-syntax "|") + (syntax-after (point))) + (point)))) m)) + (num-quotes (python-syntax-count-quotes + (char-after str-start-pos) str-start-pos)) + (str-end-pos + (save-excursion + (goto-char (+ str-start-pos num-quotes)) + (or (re-search-forward (rx (syntax string-delimiter)) nil t) + (goto-char (point-max))) + (point-marker))) + (multi-line-p + ;; Docstring styles may vary for oneliners and multi-liners. + (> (count-matches "\n" str-start-pos str-end-pos) 0)) + (delimiters-style + (case python-fill-docstring-style + ;; delimiters-style is a cons cell with the form + ;; (START-NEWLINES . END-NEWLINES). When any of the sexps + ;; is NIL means to not add any newlines for start or end + ;; of docstring. See `python-fill-docstring-style' for a + ;; graphic idea of each style. + (django (cons 1 1)) + (onetwo (and multi-line-p (cons 1 2))) + (pep-257 (and multi-line-p (cons nil 2))) + (pep-257-nn (and multi-line-p (cons nil 1))) + (symmetric (and multi-line-p (cons 1 1))))) + (docstring-p (save-excursion + ;; Consider docstrings those strings which + ;; start on a line by themselves. + (python-nav-beginning-of-statement) + (and (= (point) str-start-pos)))) + (fill-paragraph-function)) (save-restriction - (narrow-to-region reg-start reg-end) - (save-excursion - (goto-char string-start-marker) - (delete-region (point-marker) (progn - (skip-syntax-forward "> ") - (point-marker))) - (goto-char string-end-marker) - (delete-region (point-marker) (progn - (skip-syntax-backward "> ") - (point-marker))) - (save-excursion - (goto-char marker) - (fill-paragraph justify)) - ;; If there is a newline in the docstring lets put triple - ;; quote in it's own line to follow pep 8 - (when (save-excursion - (re-search-backward "\n" string-start-marker t)) - (newline) - (newline-and-indent)) - (fill-paragraph justify)))) t) + (narrow-to-region str-start-pos str-end-pos) + (fill-paragraph justify)) + (save-excursion + (when (and docstring-p python-fill-docstring-style) + ;; Add the number of newlines indicated by the selected style + ;; at the start of the docstring. + (goto-char (+ str-start-pos num-quotes)) + (delete-region (point) (progn + (skip-syntax-forward "> ") + (point))) + (and (car delimiters-style) + (or (newline (car delimiters-style)) t) + ;; Indent only if a newline is added. + (indent-according-to-mode)) + ;; Add the number of newlines indicated by the selected style + ;; at the end of the docstring. + (goto-char (if (not (= str-end-pos (point-max))) + (- str-end-pos num-quotes) + str-end-pos)) + (delete-region (point) (progn + (skip-syntax-backward "> ") + (point))) + (and (cdr delimiters-style) + ;; Add newlines only if string ends. + (not (= str-end-pos (point-max))) + (or (newline (cdr delimiters-style)) t) + ;; Again indent only if a newline is added. + (indent-according-to-mode))))) t) (defun python-fill-decorator (&optional justify) "Decorator fill function for `python-fill-paragraph-function'. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 86ffdf535a0..8c4167b6724 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -5148,7 +5148,7 @@ This sets up the appropriate Verilog mode environment, removes whitespace with \\[verilog-delete-trailing-whitespace] on all command-line files, and saves the buffers." (unless noninteractive - (error "Use verilog-batch-delete-trailing-whitepace only with --batch")) ;; Otherwise we'd mess up buffer modes + (error "Use verilog-batch-delete-trailing-whitespace only with --batch")) ;; Otherwise we'd mess up buffer modes (verilog-batch-execute-func `verilog-delete-trailing-whitespace)) (defun verilog-batch-diff-auto () @@ -12161,7 +12161,7 @@ Limitations: Interface names must be resolvable to filenames. See `verilog-auto-inst'. As with other autos, any inputs/outputs declared in the module -will suppress the AUTO from redeclarating an inputs/outputs by +will suppress the AUTO from redeclaring an input/output by the same name. An example: diff --git a/lisp/replace.el b/lisp/replace.el index 82edb0037fb..e714015fccf 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -62,6 +62,10 @@ no default value.") (defvar query-replace-interactive nil "Non-nil means `query-replace' uses the last search string. That becomes the \"string to replace\".") +(make-obsolete-variable 'query-replace-interactive + "use `M-n' to pull the last incremental search string +to the minibuffer that reads the string to replace, or invoke replacements +from Isearch by using a key sequence like `C-s C-s M-%'." "24.3") (defcustom query-replace-from-history-variable 'query-replace-history "History list to use for the FROM argument of `query-replace' commands. @@ -142,7 +146,8 @@ wants to replace FROM with TO." (if regexp-flag (read-regexp prompt nil query-replace-from-history-variable) (read-from-minibuffer - prompt nil nil nil query-replace-from-history-variable nil t))))) + prompt nil nil nil query-replace-from-history-variable + (car (if regexp-flag regexp-search-ring search-ring)) t))))) (if (and (zerop (length from)) query-replace-defaults) (cons (car query-replace-defaults) (query-replace-compile-replacement @@ -231,9 +236,11 @@ what to do with it. For directions, type \\[help-command] at that time. In Transient Mark mode, if the mark is active, operate on the contents of the region. Otherwise, operate from point to the end of the buffer. -If `query-replace-interactive' is non-nil, the last incremental search -string is used as FROM-STRING--you don't have to specify it with the -minibuffer. +Use \\<minibuffer-local-map>\\[next-history-element] \ +to pull the last incremental search string to the minibuffer +that reads FROM-STRING, or invoke replacements from +incremental search with a key sequence like `C-s C-s M-%' +to use its current search string as the string to replace. Matching is independent of case if `case-fold-search' is non-nil and FROM-STRING has no uppercase letters. Replacement transfers the case @@ -279,9 +286,11 @@ what to do with it. For directions, type \\[help-command] at that time. In Transient Mark mode, if the mark is active, operate on the contents of the region. Otherwise, operate from point to the end of the buffer. -If `query-replace-interactive' is non-nil, the last incremental search -regexp is used as REGEXP--you don't have to specify it with the -minibuffer. +Use \\<minibuffer-local-map>\\[next-history-element] \ +to pull the last incremental search regexp to the minibuffer +that reads REGEXP, or invoke replacements from +incremental search with a key sequence like `C-M-s C-M-s C-M-%' +to use its current search regexp as the regexp to replace. Matching is independent of case if `case-fold-search' is non-nil and REGEXP has no uppercase letters. Replacement transfers the case @@ -364,9 +373,9 @@ In interactive use, `\\#' in itself stands for `replace-count'. In Transient Mark mode, if the mark is active, operate on the contents of the region. Otherwise, operate from point to the end of the buffer. -If `query-replace-interactive' is non-nil, the last incremental search -regexp is used as REGEXP--you don't have to specify it with the -minibuffer. +Use \\<minibuffer-local-map>\\[next-history-element] \ +to pull the last incremental search regexp to the minibuffer +that reads REGEXP. Preserves case in each replacement if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. @@ -417,19 +426,16 @@ of the region. Otherwise, operate from point to the end of the buffer. Non-interactively, TO-STRINGS may be a list of replacement strings. -If `query-replace-interactive' is non-nil, the last incremental search -regexp is used as REGEXP--you don't have to specify it with the minibuffer. +Use \\<minibuffer-local-map>\\[next-history-element] \ +to pull the last incremental search regexp to the minibuffer +that reads REGEXP. A prefix argument N says to use each replacement string N times before rotating to the next. Fourth and fifth arg START and END specify the region to operate on." (interactive - (let* ((from (if query-replace-interactive - (car regexp-search-ring) - (read-from-minibuffer "Map query replace (regexp): " - nil nil nil - query-replace-from-history-variable - nil t))) + (let* ((from (read-regexp "Map query replace (regexp): " nil + query-replace-from-history-variable)) (to (read-from-minibuffer (format "Query replace %s with (space-separated strings): " (query-replace-descr from)) @@ -475,9 +481,9 @@ Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. Fourth and fifth arg START and END specify the region to operate on. -If `query-replace-interactive' is non-nil, the last incremental search -string is used as FROM-STRING--you don't have to specify it with the -minibuffer. +Use \\<minibuffer-local-map>\\[next-history-element] \ +to pull the last incremental search string to the minibuffer +that reads FROM-STRING. This function is usually the wrong thing to use in a Lisp program. What you probably want is a loop like this: @@ -540,8 +546,9 @@ When using those Lisp features interactively in the replacement text, TO-STRING is actually made a list instead of a string. Use \\[repeat-complex-command] after this command for details. -If `query-replace-interactive' is non-nil, the last incremental search -regexp is used as REGEXP--you don't have to specify it with the minibuffer. +Use \\<minibuffer-local-map>\\[next-history-element] \ +to pull the last incremental search regexp to the minibuffer +that reads REGEXP. This function is usually the wrong thing to use in a Lisp program. What you probably want is a loop like this: diff --git a/lisp/subr.el b/lisp/subr.el index 8dfe78d8c75..72bedc69c3c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2182,8 +2182,16 @@ by doing (clear-string STRING)." (set (make-local-variable 'post-self-insert-hook) nil) (add-hook 'after-change-functions hide-chars-fun nil 'local)) (unwind-protect - (let ((enable-recursive-minibuffers t)) - (read-string prompt nil t default)) ; t = "no history" + (let ((enable-recursive-minibuffers t) + (map minibuffer-local-map) + result) + (define-key map "\C-u" ; bug#12570 + (lambda () (interactive) (delete-minibuffer-contents))) + (setq result + ;; t = no history. + (read-from-minibuffer prompt nil map nil t default)) + (if (and (equal "" result) default) default + result)) (when (buffer-live-p minibuf) (with-current-buffer minibuf ;; Not sure why but it seems that there might be cases where the @@ -3170,7 +3178,7 @@ in which case `save-window-excursion' cannot help." (set-window-hscroll window 0) ;; Don't try this with NOFORCE non-nil! (set-window-start window (point-min) t) - ;; This hould not be necessary. + ;; This should not be necessary. (set-window-point window (point-min)) ;; Run `temp-buffer-show-hook', with the chosen window selected. (with-selected-window window diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 9cd69d84250..2622a8215b8 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -518,12 +518,13 @@ MODE should be an integer which is a file mode value." (progress-reporter-done progress-reporter) (message "Warning: premature EOF parsing tar file")) (goto-char (point-min)) - (let ((inhibit-read-only t) + (let ((buffer-file-truename nil) ; avoid changing dir mtime by lock_file + (inhibit-read-only t) (total-summaries (mapconcat 'tar-header-block-summarize tar-parse-info "\n"))) - (insert total-summaries "\n")) - (goto-char (point-min)) - (restore-buffer-modified-p modified))) + (insert total-summaries "\n") + (goto-char (point-min)) + (restore-buffer-modified-p modified)))) (defvar tar-mode-map (let ((map (make-keymap))) diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index 3a875f0dfa3..72013c5b241 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -4,8 +4,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 -;; Package: reftex ;; This file is part of GNU Emacs. @@ -27,21 +25,21 @@ ;;; Code: (eval-when-compile (require 'cl)) -(provide 'reftex-auc) + (require 'reftex) -;;; - -(declare-function TeX-argument-insert "ext:tex" (name optional &optional prefix)) -(declare-function TeX-argument-prompt "ext:tex" (optional prompt default &optional complete)) -(declare-function multi-prompt "ext:multi-prompt" - (separator - unique prompt table - &optional mp-predicate require-match initial history)) -(declare-function LaTeX-add-index-entries "ext:tex" (&rest entries) t) + +(declare-function TeX-argument-prompt "ext:tex" + (optional prompt default &optional complete)) +(declare-function TeX-argument-insert "ext:tex" + (name optional &optional prefix)) (declare-function LaTeX-add-labels "ext:tex" (&rest entries) t) +(declare-function LaTeX-add-index-entries "ext:tex" (&rest entries) t) (declare-function LaTeX-bibitem-list "ext:tex" () t) (declare-function LaTeX-index-entry-list "ext:tex" () t) (declare-function LaTeX-label-list "ext:tex" () t) +(declare-function multi-prompt "ext:multi-prompt" + (separator unique prompt table &optional + mp-predicate require-match initial history)) (defun reftex-plug-flag (which) ;; Tell if a certain flag is set in reftex-plug-into-AUCTeX @@ -76,14 +74,15 @@ What is being used depends upon `reftex-plug-into-AUCTeX'." (let (items) (cond ((and (not definition) (reftex-plug-flag 3)) - (setq items (list (or (reftex-citation t) "")))) + (setq items (or (reftex-citation t) (list "")))) (t (setq prompt (concat (if optional "(Optional) " "") (if prompt prompt "Add key") " (default none): ")) (setq items (multi-prompt "," t prompt (LaTeX-bibitem-list))))) (apply 'LaTeX-add-bibitems items) - (TeX-argument-insert (mapconcat 'identity items ",") optional))) + (TeX-argument-insert (mapconcat 'identity items reftex-cite-key-separator) + optional))) (defun reftex-arg-index-tag (optional &optional prompt &rest args) @@ -223,4 +222,6 @@ of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See (defun reftex-notice-new-section () (reftex-notice-new 1 'force)) +(provide 'reftex-auc) + ;;; reftex-auc.el ends here diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 229d12b2906..52fa6dbf9d2 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -4,8 +4,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 -;; Package: reftex ;; This file is part of GNU Emacs. @@ -129,9 +127,10 @@ (let* ((re (if item - (concat "\\\\bibitem\\(\\[[^]]*\\]\\)?{" (regexp-quote key) "}") - (concat "@[a-zA-Z]+[ \t\n\r]*[{(][ \t\n\r]*" (regexp-quote key) - "[, \t\r\n}]"))) + (concat "\\\\bibitem[ \t]*\\(\\[[^]]*\\]\\)?[ \t]*{" + (regexp-quote key) "}") + (concat "@\\(?:\\w\\|\\s_\\)+[ \t\n\r]*[{(][ \t\n\r]*" + (regexp-quote key) "[, \t\r\n}]"))) (buffer-conf (current-buffer)) file buf pos oldpos) @@ -229,7 +228,13 @@ buffer (not reftex-keep-temporary-buffers)))) (if (not buffer1) (message "No such BibTeX file %s (ignored)" buffer) - (message "Scanning bibliography database %s" buffer1)) + (message "Scanning bibliography database %s" buffer1) + (unless (verify-visited-file-modtime buffer1) + (when (y-or-n-p + (format "File %s changed on disk. Reread from disk? " + (file-name-nondirectory + (buffer-file-name buffer1)))) + (with-current-buffer buffer1 (revert-buffer t t))))) (set-buffer buffer1) (reftex-with-special-syntax-for-bib @@ -238,8 +243,8 @@ (while (re-search-forward first-re nil t) (catch 'search-again (setq key-point (point)) - (unless (re-search-backward - "\\(\\`\\|[\n\r]\\)[ \t]*@\\([a-zA-Z]+\\)[ \t\n\r]*[{(]" nil t) + (unless (re-search-backward "\\(\\`\\|[\n\r]\\)[ \t]*\ +@\\(\\(?:\\w\\|\\s_\\)+\\)[ \t\n\r]*[{(]" nil t) (throw 'search-again nil)) (setq start-point (point)) (goto-char (match-end 0)) @@ -451,7 +456,8 @@ (setq names (replace-match " " nil t names))) (split-string names "\n"))) -(defun reftex-parse-bibtex-entry (entry &optional from to) +(defun reftex-parse-bibtex-entry (entry &optional from to raw) + ; if RAW is non-nil, keep double quotes/curly braces delimiting fields (let (alist key start field) (save-excursion (save-restriction @@ -463,41 +469,56 @@ (erase-buffer) (insert entry)) (widen) - (narrow-to-region from to)) + (if (and from to) (narrow-to-region from to))) (goto-char (point-min)) - (if (re-search-forward - "@\\(\\w+\\)[ \t\n\r]*[{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t) + (if (re-search-forward "@\\(\\(?:\\w\\|\\s_\\)+\\)[ \t\n\r]*\ +\[{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t) (setq alist (list (cons "&type" (downcase (reftex-match-string 1))) (cons "&key" (reftex-match-string 2))))) - (while (re-search-forward "\\(\\w+\\)[ \t\n\r]*=[ \t\n\r]*" nil t) + (while (re-search-forward "\\(\\(?:\\w\\|-\\)+\\)[ \t\n\r]*=[ \t\n\r]*" + nil t) (setq key (downcase (reftex-match-string 1))) (cond ((= (following-char) ?{) - (forward-char 1) - (setq start (point)) - (condition-case nil - (up-list 1) - (error nil))) + (cond + (raw + (setq start (point)) + (forward-char 1)) + (t + (forward-char 1) + (setq start (point)) + (condition-case nil + (up-list 1) + (error nil))))) ((= (following-char) ?\") - (forward-char 1) - (setq start (point)) + (cond + (raw + (setq start (point)) + (forward-char 1)) + (t + (forward-char 1) + (setq start (point)))) (while (and (search-forward "\"" nil t) (= ?\\ (char-after (- (point) 2)))))) (t (setq start (point)) (re-search-forward "[ \t]*[\n\r,}]" nil 1))) - (setq field (buffer-substring-no-properties start (1- (point)))) + ;; extract field value, ignore trailing comma if in RAW mode + (let ((stop (if (and raw (not (= (char-after (1- (point))) ?,))) + (point) + (1- (point))) )) + (setq field (buffer-substring-no-properties start stop))) ;; remove extra whitespace (while (string-match "[\n\t\r]\\|[ \t][ \t]+" field) (setq field (replace-match " " nil t field))) ;; remove leading garbage - (if (string-match "^[ \t{]+" field) + (if (string-match (if raw "^[ \t]+" "^[ \t{]+") field) (setq field (replace-match "" nil t field))) ;; remove trailing garbage - (if (string-match "[ \t}]+$" field) + (if (string-match (if raw "[ \t]+$" "[ \t}]+$") field) (setq field (replace-match "" nil t field))) (push (cons key field) alist)))) alist)) @@ -638,15 +659,13 @@ While entering the regexp, completion on knows citation keys is possible. (insert-entries selected-entries) entry string cite-view) - (when (stringp selected-entries) - (error selected-entries)) (unless selected-entries (error "Quit")) (if (stringp selected-entries) ;; Nonexistent entry - (setq selected-entries nil - insert-entries (list (list selected-entries - (cons "&key" selected-entries)))) + (setq insert-entries (list (list selected-entries + (cons "&key" selected-entries))) + selected-entries nil) ;; It makes sense to compute the cite-view strings. (setq cite-view t)) @@ -654,7 +673,8 @@ While entering the regexp, completion on knows citation keys is possible. ;; All keys go into a single command - we need to trick a little ;; FIXME: Unfortunately, this means that commenting does not work right. (pop selected-entries) - (let ((concat-keys (mapconcat 'car selected-entries ","))) + (let ((concat-keys (mapconcat 'car selected-entries + reftex-cite-key-separator))) (setq insert-entries (list (list concat-keys (cons "&key" concat-keys)))))) @@ -675,8 +695,9 @@ While entering the regexp, completion on knows citation keys is possible. (equal arg '(4)))) (let ((start 0) (nth 0) value) (while (setq start (string-match "\\[\\]" string start)) - (setq value (read-string (format "Optional argument %d: " - (setq nth (1+ nth))))) + (setq value (save-match-data + (read-string (format "Optional argument %d: " + (setq nth (1+ nth)))))) (setq string (replace-match (concat "[" value "]") t t string)) (setq start (1+ start))))) ;; Should we cleanup empty optional arguments? @@ -725,7 +746,7 @@ While entering the regexp, completion on knows citation keys is possible. (forward-char 1))) ;; Return the citation key - (car (car selected-entries)))) + (mapcar 'car selected-entries))) (defun reftex-figure-out-cite-format (arg &optional no-insert format-key) ;; Check if there is already a cite command at point and change cite format @@ -744,9 +765,13 @@ While entering the regexp, completion on knows citation keys is possible. (if (or (not arg) (not (listp arg))) (setq format (concat - (if (member (preceding-char) '(?\{ ?,)) "" ",") + (if (member (preceding-char) '(?\{ ?,)) + "" + reftex-cite-key-separator) "%l" - (if (member (following-char) '(?\} ?,)) "" ","))) + (if (member (following-char) '(?\} ?,)) + "" + reftex-cite-key-separator))) (setq format "%l"))) (t ;; Figure out the correct format @@ -1114,7 +1139,7 @@ While entering the regexp, completion on knows citation keys is possible. (save-restriction (widen) (goto-char (point-min)) - (while (re-search-forward "^[^%\n\r]*\\\\\\(bibentry\\|[a-zA-Z]*cite[a-zA-Z]*\\)\\(\\[[^\\]]*\\]\\)?{\\([^}]+\\)}" nil t) + (while (re-search-forward "\\(?:^\\|\\=\\)[^%\n\r]*?\\\\\\(bibentry\\|[a-zA-Z]*cite[a-zA-Z]*\\)\\(\\[[^\\]]*\\]\\)?{\\([^}]+\\)}" nil t) (setq kk (match-string-no-properties 3)) (while (string-match "%.*\n?" kk) (setq kk (replace-match "" t t kk))) @@ -1125,18 +1150,35 @@ While entering the regexp, completion on knows citation keys is possible. (reftex-kill-temporary-buffers) keys)) +(defun reftex-get-string-refs (alist) + "Return a list of BibTeX @string references that appear as values in ALIST." + (reftex-remove-if (lambda (x) (string-match "^\\([\"{]\\|[0-9]+$\\)" x)) + ;; get list of values, discard keys + (mapcar 'cdr + ;; remove &key and &type entries + (reftex-remove-if (lambda (pair) + (string-match "^&" (car pair))) + alist)))) + (defun reftex-create-bibtex-file (bibfile) "Create a new BibTeX database file with all entries referenced in document. -The command prompts for a filename and writes the collected entries to -that file. Only entries referenced in the current document with -any \\cite-like macros are used. -The sequence in the new file is the same as it was in the old database." +The command prompts for a filename and writes the collected +entries to that file. Only entries referenced in the current +document with any \\cite-like macros are used. The sequence in +the new file is the same as it was in the old database. + +Entries referenced from other entries must appear after all +referencing entries. + +You can define strings to be used as header or footer for the +created files in the variables `reftex-create-bibtex-header' or +`reftex-create-bibtex-footer' respectively." (interactive "FNew BibTeX file: ") (let ((keys (reftex-all-used-citation-keys)) (files (reftex-get-bibfile-list)) - file key entries beg end entry) + file key entries beg end entry string-keys string-entries) (save-current-buffer - (while (setq file (pop files)) + (dolist (file files) (set-buffer (reftex-get-file-buffer-force file 'mark)) (reftex-with-special-syntax-for-bib (save-excursion @@ -1156,14 +1198,54 @@ The sequence in the new file is the same as it was in the old database." (when (member key keys) (setq entry (buffer-substring beg end) entries (cons entry entries) - keys (delete key keys))))))))) + keys (delete key keys)) + + ;; check for crossref entries + (let* ((attr-list (reftex-parse-bibtex-entry nil beg end)) + (xref-key (cdr (assoc "crossref" attr-list)))) + (if xref-key (pushnew xref-key keys))) + ;; check for string references + (let* ((raw-fields (reftex-parse-bibtex-entry nil beg end t)) + (string-fields (reftex-get-string-refs raw-fields))) + (dolist (skey string-fields) + (unless (member skey string-keys) + (push skey string-keys))))))))))) + ;; second pass: grab @string references + (if string-keys + (save-current-buffer + (dolist (file files) + (set-buffer (reftex-get-file-buffer-force file 'mark)) + (reftex-with-special-syntax-for-bib + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*@[Ss][Tt][Rr][Ii][Nn][Gg][ \t]*{[ \t]*\\([^ \t\r\n]+\\)" + nil t) + (setq key (match-string 1) + beg (match-beginning 0) + end (progn + (goto-char (match-beginning 1)) + (condition-case nil + (up-list 1) + (error (goto-char (match-end 0)))) + (point))) + (when (member key string-keys) + (setq entry (buffer-substring beg end) + string-entries (cons entry string-entries) + string-keys (delete key string-keys)))))))))) (find-file-other-window bibfile) (if (> (buffer-size) 0) (unless (yes-or-no-p (format "Overwrite non-empty file %s? " bibfile)) (error "Abort"))) (erase-buffer) + (if reftex-create-bibtex-header (insert reftex-create-bibtex-header "\n\n")) + (insert (mapconcat 'identity (reverse string-entries) "\n\n")) + (if string-entries (insert "\n\n\n")) (insert (mapconcat 'identity (reverse entries) "\n\n")) + (if reftex-create-bibtex-footer (insert "\n\n" reftex-create-bibtex-footer)) (goto-char (point-min)) (save-buffer) (message "%d entries extracted and copied to new database" diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el index b1e426c5566..7d102e5a802 100644 --- a/lisp/textmodes/reftex-dcr.el +++ b/lisp/textmodes/reftex-dcr.el @@ -4,8 +4,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 -;; Package: reftex ;; This file is part of GNU Emacs. @@ -27,10 +25,10 @@ ;;; Code: (eval-when-compile (require 'cl)) -(provide 'reftex-dcr) -(provide 'reftex-vcr) + +(declare-function bibtex-beginning-of-entry "bibtex" ()) + (require 'reftex) -;;; (defun reftex-view-crossref (&optional arg auto-how fail-quietly) "View cross reference of macro at point. Point must be on the KEY @@ -229,6 +227,7 @@ If it is a \\cite, show the BibTeX database entry. If there is no such macro at point, search forward to find one. With argument, actually select the window showing the cross reference." (interactive "e") + ;; Make sure the referencing macro stays visible in the original window. (mouse-set-point ev) (reftex-view-crossref current-prefix-arg)) @@ -348,15 +347,14 @@ will display info in the echo area." (message "Automatic display of crossref information was turned on"))) (defun reftex-start-itimer-once () - (and (featurep 'xemacs) reftex-mode + (and (featurep 'xemacs) + reftex-mode (not (itimer-live-p reftex-auto-view-crossref-timer)) (setq reftex-auto-view-crossref-timer (start-itimer "RefTeX Idle Timer" 'reftex-view-crossref-when-idle reftex-idle-time nil t)))) -(declare-function bibtex-beginning-of-entry "bibtex" ()) - (defun reftex-view-crossref-from-bibtex (&optional arg) "View location in a LaTeX document which cites the BibTeX entry at point. Since BibTeX files can be used by many LaTeX documents, this function @@ -481,4 +479,6 @@ Calling this function several times find successive citation locations." (move-marker reftex-global-search-marker nil) (error "All files processed")))) +(provide 'reftex-dcr) + ;;; reftex-dcr.el ends here diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index d836bbb6cb8..ebe0aae73f8 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -4,8 +4,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 -;; Package: reftex ;; This file is part of GNU Emacs. @@ -407,7 +405,7 @@ Also checks if buffers visiting the files are in read-only mode." (when flist (if wrapp (unless isearch-forward - (setq flist (last flist))) + (setq flist (last flist))) (unless isearch-forward (setq flist (reverse flist))) (while (not (string= (car flist) cb)) @@ -437,7 +435,8 @@ With no argument, this command toggles (with-current-buffer crt-buf (when reftex-mode (if (boundp 'multi-isearch-next-buffer-function) - (set (make-local-variable 'multi-isearch-next-buffer-function) + (set (make-local-variable + 'multi-isearch-next-buffer-function) 'reftex-isearch-switch-to-next-file) (set (make-local-variable 'isearch-wrap-function) 'reftex-isearch-wrap-function) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 1d15dfbed7e..5b884dd8480 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -4,8 +4,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 -;; Package: reftex ;; This file is part of GNU Emacs. @@ -27,9 +25,9 @@ ;;; Code: (eval-when-compile (require 'cl)) -(provide 'reftex-index) +(declare-function texmathp "ext:texmathp" ()) + (require 'reftex) -;;; ;; START remove for XEmacs release (defvar mark-active) @@ -37,8 +35,6 @@ (defvar TeX-master) ;; END remove for XEmacs release -(declare-function texmathp "ext:texmathp" ()) - (defun reftex-index-selection-or-word (&optional arg phrase) "Put selection or the word near point into the default index macro. This uses the information in `reftex-index-default-macro' to make an index @@ -52,9 +48,7 @@ which is part of AUCTeX, the string is first processed with the (interactive "P") (let* ((use-default (not (equal arg '(16)))) ; check for double prefix ;; check if we have an active selection - (active (if (featurep 'xemacs) - (and zmacs-regions (region-exists-p)) ; XEmacs - (and transient-mark-mode mark-active))) ; Emacs + (active (reftex-region-active-p)) (beg (if active (region-beginning) (save-excursion @@ -1244,7 +1238,11 @@ This gets refreshed in every phrases command.") map) "Keymap used for *toc* buffer.") - +(defvar reftex-index-phrases-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\" "." table) + table) + "Syntax table for RefTeX Index Phrases mode.") (defun reftex-index-phrase-selection-or-word (arg) "Add current selection or word at point to the phrases buffer. @@ -1264,6 +1262,7 @@ You get a chance to edit the entry in the phrases buffer - finish with "Switch to the phrases buffer, initialize if empty." (interactive) (reftex-access-scan-info) + (set-marker reftex-index-return-marker (point)) (let* ((master (reftex-TeX-master-file)) (name (concat (file-name-sans-extension master) reftex-index-phrase-file-extension))) @@ -1371,6 +1370,7 @@ For more information see the RefTeX User Manual. Here are all local bindings. \\{reftex-index-phrases-mode-map}" + :syntax-table reftex-index-phrases-syntax-table (set (make-local-variable 'font-lock-defaults) reftex-index-phrases-font-lock-defaults) (easy-menu-add reftex-index-phrases-menu reftex-index-phrases-mode-map) @@ -2093,5 +2093,6 @@ Does not do a save-excursion." reftex-index-phrases-macro-data "\n")))) (reftex-select-with-char prompt help delay))) +(provide 'reftex-index) ;;; reftex-index.el ends here diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index c6526d1b6ce..791b5d7b945 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -4,8 +4,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 -;; Package: reftex ;; This file is part of GNU Emacs. @@ -27,7 +25,7 @@ ;;; Code: (eval-when-compile (require 'cl)) -(provide 'reftex-parse) + (require 'reftex) (defmacro reftex-with-special-syntax (&rest body) @@ -241,8 +239,17 @@ of master file." ((match-end 3) ;; It is a section - (setq bound (point)) + ;; Use the beginning as bound and not the end + ;; (i.e. (point)) because the section command might + ;; be the start of the current environment to be + ;; found by `reftex-label-info'. + (setq bound (match-beginning 0)) + ;; The section regexp matches a character at the end + ;; we are not interested in. Especially if it is the + ;; backslash of a following macro we want to find in + ;; the next parsing iteration. + (when (eq (char-before) ?\\) (backward-char)) ;; Insert in List (setq toc-entry (reftex-section-info file)) (when toc-entry @@ -1072,4 +1079,6 @@ of master file." nrest (- nrest i)))) string)) +(provide 'reftex-parse) + ;;; reftex-parse.el ends here diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index 1882e7dde56..9b9f1a0f68f 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -4,8 +4,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 -;; Package: reftex ;; This file is part of GNU Emacs. @@ -27,10 +25,9 @@ ;;; Code: (eval-when-compile (require 'cl)) -(provide 'reftex-ref) + (require 'reftex) (require 'reftex-parse) -;;; (defun reftex-label-location (&optional bound) "Return the environment or macro which determines the label type at point. @@ -413,27 +410,54 @@ When called with 2 C-u prefix args, disable magic word recognition." (interactive) - ;; check for active recursive edits + ;; Check for active recursive edits (reftex-check-recursive-edit) - ;; Ensure access to scanning info and rescan buffer if prefix are is '(4) + ;; Ensure access to scanning info and rescan buffer if prefix is '(4) (reftex-access-scan-info current-prefix-arg) - (unless type - ;; guess type from context - (if (and reftex-guess-label-type - (setq type (reftex-guess-label-type))) - (setq cut (cdr type) - type (car type)) - (setq type (reftex-query-label-type)))) - - (let* ((reftex-refstyle - (cond ((reftex-typekey-check type reftex-vref-is-default) "\\vref") - ((reftex-typekey-check type reftex-fref-is-default) "\\fref") - (t "\\ref"))) - (reftex-format-ref-function reftex-format-ref-function) - (form "\\ref{%s}") - label labels sep sep1) + (let ((reftex-refstyle (when (and (boundp 'reftex-refstyle) reftex-refstyle) + reftex-refstyle)) + (reftex-format-ref-function reftex-format-ref-function) + (form "\\ref{%s}") + label labels sep sep1 style-alist) + + (unless reftex-refstyle + (if reftex-ref-macro-prompt + (progn + ;; Build a temporary list which handles more easily. + (dolist (elt reftex-ref-style-alist) + (when (member (car elt) (reftex-ref-style-list)) + (mapc (lambda (x) + (add-to-list 'style-alist (cons (cadr x) (car x)) t)) + (nth 2 elt)))) + ;; Prompt the user for the macro. + (let ((key (reftex-select-with-char + "" (concat "SELECT A REFERENCE FORMAT\n\n" + (mapconcat + (lambda (x) + (format "[%c] %s %s" (car x) + (if (> (car x) 31) " " "") + (cdr x))) + style-alist "\n"))))) + (setq reftex-refstyle (cdr (assoc key style-alist))) + (unless reftex-refstyle + (error "No reference macro associated with key `%c'" key)))) + ;; Get the first macro from `reftex-ref-style-alist' which + ;; matches the first entry in the list of active styles. + (setq reftex-refstyle + (or (caar (nth 2 (assoc (car (reftex-ref-style-list)) + reftex-ref-style-alist))) + ;; Use the first entry in r-r-s-a as a last resort. + (caar (nth 2 (car reftex-ref-style-alist))))))) + + (unless type + ;; Guess type from context + (if (and reftex-guess-label-type + (setq type (reftex-guess-label-type))) + (setq cut (cdr type) + type (car type)) + (setq type (reftex-query-label-type)))) ;; Have the user select a label (set-marker reftex-select-return-marker (point)) @@ -472,17 +496,13 @@ When called with 2 C-u prefix args, disable magic word recognition." (member (preceding-char) '(?\ ?\t ?\n ?~))) (setq form (substring form 1))) ;; do we have a special format? - (setq reftex-format-ref-function - (cond - ((string= reftex-refstyle "\\vref") 'reftex-format-vref) - ((string= reftex-refstyle "\\fref") 'reftex-format-fref) - ((string= reftex-refstyle "\\Fref") 'reftex-format-Fref) - (t reftex-format-ref-function))) + (unless (string= reftex-refstyle "\\ref") + (setq reftex-format-ref-function 'reftex-format-special)) ;; ok, insert the reference (if sep1 (insert sep1)) (insert (if reftex-format-ref-function - (funcall reftex-format-ref-function label form) + (funcall reftex-format-ref-function label form reftex-refstyle) (format form label label))) ;; take out the initial ~ for good (and (= ?~ (string-to-char form)) @@ -791,34 +811,31 @@ When called with 2 C-u prefix args, disable magic word recognition." (run-hooks 'reftex-display-copied-context-hook) (setq buffer-read-only t)))))) -(defun reftex-varioref-vref () - "Insert a reference using the `\\vref' macro from the varioref package." - (interactive) - (let ((reftex-format-ref-function 'reftex-format-vref)) - (reftex-reference))) -(defun reftex-fancyref-fref () - "Insert a reference using the `\\fref' macro from the fancyref package." - (interactive) - (let ((reftex-format-ref-function 'reftex-format-fref) - ;;(reftex-guess-label-type nil) ;FIXME do we want this???? - ) - (reftex-reference))) -(defun reftex-fancyref-Fref () - "Insert a reference using the `\\Fref' macro from the fancyref package." - (interactive) - (let ((reftex-format-ref-function 'reftex-format-Fref) - ;;(reftex-guess-label-type nil) ;FIXME do we want this???? - ) - (reftex-reference))) - -(defun reftex-format-vref (label fmt) - (while (string-match "\\\\ref{" fmt) - (setq fmt (replace-match "\\vref{" t t fmt))) - (format fmt label label)) -(defun reftex-format-Fref (label def-fmt) - (format "\\Fref{%s}" label)) -(defun reftex-format-fref (label def-fmt) - (format "\\fref{%s}" label)) +;; Generate functions for direct insertion of specific referencing +;; macros. The functions are named `reftex-<package>-<macro>', +;; e.g. `reftex-varioref-vref'. +(dolist (elt reftex-ref-style-alist) + (when (stringp (nth 1 elt)) + (dolist (item (nth 2 elt)) + (let ((macro (car item)) + (package (nth 1 elt))) + (eval `(defun ,(intern (format "reftex-%s-%s" package + (substring macro 1 (length macro)))) () + ,(format "Insert a reference using the `%s' macro from the %s \ +package.\n\nThis is a generated function." + macro package) + (interactive) + (let ((reftex-refstyle ,macro)) + (reftex-reference)))))))) + +(defun reftex-format-special (label fmt refstyle) + "Apply selected reference style to format FMT and add LABEL. +Replace any occurrences of \"\\ref\" with REFSTYLE." + ;; Replace instances of \ref in `fmt' with the special reference + ;; style selected by the user. + (while (string-match "\\(\\\\ref\\)[ \t]*{" fmt) + (setq fmt (replace-match refstyle t t fmt 1))) + (format fmt label)) (defun reftex-goto-label (&optional other-window) "Prompt for a label (with completion) and jump to the location of this label. @@ -847,5 +864,6 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window." (goto-char where)) (reftex-unhighlight 0))) +(provide 'reftex-ref) ;;; reftex-ref.el ends here diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index 1a400436311..68355f9b16f 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -4,8 +4,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 -;; Package: reftex ;; This file is part of GNU Emacs. @@ -27,9 +25,8 @@ ;;; Code: (eval-when-compile (require 'cl)) -(provide 'reftex-sel) + (require 'reftex) -;;; ;; Common bindings in reftex-select-label-mode-map ;; and reftex-select-bib-mode-map. @@ -86,8 +83,8 @@ (loop for x in '(("b" . reftex-select-jump-to-previous) ("z" . reftex-select-jump) - ("v" . reftex-select-toggle-varioref) - ("V" . reftex-select-toggle-fancyref) + ("v" . reftex-select-cycle-ref-style-forward) + ("V" . reftex-select-cycle-ref-style-backward) ("m" . reftex-select-mark) ("u" . reftex-select-unmark) ("," . reftex-select-mark-comma) @@ -511,6 +508,7 @@ During a selection process, these are the local bindings. (defvar last-data) (defvar call-back) (defvar help-string) +(defvar reftex-refstyle) ;; The selection commands @@ -604,23 +602,28 @@ Useful for large TOC's." (setq reftex-last-follow-point -1) (setq cb-flag (not cb-flag))) -(defvar reftex-refstyle) ; from reftex-reference +(defun reftex-select-cycle-ref-style-internal (&optional reverse) + "Cycle through macros used for referencing. +Cycle in reverse order if optional argument REVERSE is non-nil." + (let (list) + (dolist (style (reftex-ref-style-list)) + (mapc (lambda (x) (add-to-list 'list (car x) t)) + (nth 2 (assoc style reftex-ref-style-alist)))) + (when reverse + (setq list (reverse list))) + (setq reftex-refstyle (or (cadr (member reftex-refstyle list)) (car list)))) + (force-mode-line-update)) -(defun reftex-select-toggle-varioref () - "Toggle the macro used for referencing the label between \\ref and \\vref." +(defun reftex-select-cycle-ref-style-forward () + "Cycle forward through macros used for referencing." (interactive) - (if (string= reftex-refstyle "\\ref") - (setq reftex-refstyle "\\vref") - (setq reftex-refstyle "\\ref")) - (force-mode-line-update)) -(defun reftex-select-toggle-fancyref () - "Toggle the macro used for referencing the label between \\ref and \\vref." + (reftex-select-cycle-ref-style-internal)) + +(defun reftex-select-cycle-ref-style-backward () + "Cycle backward through macros used for referencing." (interactive) - (setq reftex-refstyle - (cond ((string= reftex-refstyle "\\ref") "\\fref") - ((string= reftex-refstyle "\\fref") "\\Fref") - (t "\\ref"))) - (force-mode-line-update)) + (reftex-select-cycle-ref-style-internal t)) + (defun reftex-select-show-insertion-point () "Show the point from where selection was started in another window." (interactive) @@ -721,7 +724,7 @@ Useful for large TOC's." (if sep (format "*%c%d* " sep (decf cnt)) (format "*%d* " (decf cnt))))) - reftex-select-marked) + reftex-select-marked) (message "Entry no longer marked"))) (defun reftex-select-help () @@ -731,4 +734,6 @@ Useful for large TOC's." (princ help-string)) (reftex-enlarge-to-fit "*RefTeX Help*" t)) +(provide 'reftex-sel) + ;;; reftex-sel.el ends here diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 519236a3621..4f73322d3f5 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -4,8 +4,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 -;; Package: reftex ;; This file is part of GNU Emacs. @@ -372,14 +370,14 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (error t))))) (defun reftex-re-enlarge () - ;; Enlarge window to a remembered size. - (if reftex-toc-split-windows-horizontally - (enlarge-window-horizontally - (max 0 (- (or reftex-last-window-width (window-width)) - (window-width)))) - (enlarge-window - (max 0 (- (or reftex-last-window-height (window-height)) - (window-height)))))) + "Enlarge window to a remembered size." + (let ((count (if reftex-toc-split-windows-horizontally + (- (or reftex-last-window-width (window-width)) + (window-width)) + (- (or reftex-last-window-height (window-height)) + (window-height))))) + (when (> count 0) + (enlarge-window count reftex-toc-split-windows-horizontally)))) (defun reftex-toc-dframe-p (&optional frame error) ;; Check if FRAME is the dedicated TOC frame. diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 3470ef9f3c1..df3d729adca 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -4,8 +4,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 -;; Package: reftex ;; This file is part of GNU Emacs. @@ -207,6 +205,11 @@ distribution. Mixed-case symbols are convenience aliases.") (?p . "(%2a %y\\nocite{%l})"))) (locally "Full info in parenthesis" "(%2a %y, %j %v, %P, %e: %b, %u, %s %<)") + (context + "ConTeXt bib module" + ((?\C-m . "\\cite[%l]") + (?s . "\\cite[][%l]") + (?n . "\\nocite[%l]"))) ) "Builtin versions of the citation format. The following conventions are valid for all alist entries: @@ -239,7 +242,7 @@ distribution. Mixed-case symbols are convenience aliases.") "LaTeX label and citation support." :tag "RefTeX" :link '(url-link :tag "Home Page" - "http://staff.science.uva.nl/~dominik/Tools/reftex/") + "http://www.gnu.org/software/auctex/reftex.html") :link '(emacs-commentary-link :tag "Commentary in reftex.el" "reftex.el") :link '(custom-manual "(reftex)Top") :prefix "reftex-" @@ -261,8 +264,8 @@ by whitespace." (defcustom reftex-max-section-depth 12 "Maximum depth of section levels in document structure. -Standard LaTeX needs default is 7, but there are packages for which this -needs to be larger." +The default in standard LaTeX is 7, but there are packages for +which this needs to be larger." :group 'reftex-table-of-contents-browser :type 'integer) @@ -329,7 +332,7 @@ recentering will work for any TOC window created during the session. Value 'frame (the default) means, turn automatic recentering on only while the dedicated TOC frame does exist, and do the recentering only in that frame. So -when creating that frame (with \"d\" key in an ordinary TOC window), the +when creating that frame (with `d' key in an ordinary TOC window), the automatic recentering is turned on. When the frame gets destroyed, automatic recentering is turned off again. @@ -383,8 +386,8 @@ This flag can be toggled from within the *toc* buffer with the `i' key." (defcustom reftex-toc-confirm-promotion 2 "Non-nil means, promotion/demotion commands first prompt for confirmation. -When nil, the command is executed immediately. When this is an integer -N, ask for confirmation only if N or more section commands are going to be +If nil, the command is executed immediately. If this is an integer N, +ask for confirmation only if N or more section commands are going to be changed." :group 'reftex-table-of-contents-browser :type '(choice @@ -408,7 +411,7 @@ This flag can be toggled from within the *toc* buffer with the `f' key." (defcustom reftex-revisit-to-follow nil "Non-nil means, follow-mode will revisit files if necessary. -When nil, follow-mode will be suspended for stuff in unvisited files." +If nil, follow-mode will be suspended for stuff in unvisited files." :group 'reftex-table-of-contents-browser :group 'reftex-referencing-labels :type 'boolean) @@ -452,8 +455,8 @@ of options." (defcustom reftex-label-alist nil "Alist with information on environments for \\label-\\ref use. -This docstring is easier to understand after reading the configuration -examples in `reftex.el'. Looking at the builtin defaults in the constant +This doc string is easier to understand after reading the configuration +examples in the manual. Looking at the builtin defaults in the constant `reftex-label-alist-builtin' may also be instructive. Set this variable to define additions and changes to the default. The only @@ -481,12 +484,11 @@ ENV-OR-MACRO Special names: `section' for section labels, `any' to define a group which contains all labels. - This may also be a function to do local parsing and identify point - to be in a non-standard label environment. The function must take - an argument BOUND and limit backward searches to this value. It - should return either nil or a cons cell (FUNCTION . POSITION) with - the function symbol and the position where the special environment - starts. See the Info documentation for an example. + This may also be a function to do local parsing and identify point to + be in a non-standard label environment. The function must take an + argument BOUND and limit backward searches to this value. It should + return either nil or the position where the special environment starts. + See the Info documentation for an example. Finally this may also be nil if the entry is only meant to change some settings associated with the type indicator character (see below). @@ -500,7 +502,7 @@ TYPE-KEY `equation' and `eqnarray'). If the type indicator is nil and the macro has a label argument {*}, the macro defines neutral labels just like \\label. In this case - the reminder of this entry is ignored. + the remainder of this entry is ignored. LABEL-PREFIX Label prefix string, like \"tab:\". @@ -516,8 +518,8 @@ LABEL-PREFIX Example: In a file `intro.tex', \"eq:%f:\" will become \"eq:intro:\"). REFERENCE-FORMAT - Format string for reference insert in buffer. `%s' will be replaced by - the label. + Format string for reference insertion in buffer. `%s' will be replaced + by the label. When the format starts with `~', the `~' will only be inserted if there is not already a whitespace before point. @@ -533,7 +535,7 @@ CONTEXT-METHOD - If an integer, use the nth argument of the macro. As a special case, 1000 means to get text after the last macro argument. - If a string, use as regexp to search *backward* from the label. Context - is then the text following the end of the match. E.g. putting this to + is then the text following the end of the match. E.g. setting this to \"\\\\\\\\caption[[{]\" will use the caption in a figure or table environment. \"\\\\\\\\begin{eqnarray}\\\\|\\\\\\\\\\\\\\\\\" works for eqnarrays. @@ -755,8 +757,7 @@ And here is the setup for RefTeX: 3. Tell RefTeX to use this function - (setq reftex-special-environment-functions '(my-detect-linguex-list)) -" + (setq reftex-special-environment-functions '(my-detect-linguex-list))" :group 'reftex-defining-label-environments :type 'hook) @@ -820,11 +821,13 @@ RefTeX's default function uses the variable `reftex-derive-label-parameters'." :type 'symbol) (defcustom reftex-translate-to-ascii-function 'reftex-latin1-to-ascii - "Filter function which will process a context string before it is used -to derive a label from it. The intended application is to convert ISO or -Mule characters into something valid in labels. The default function -removes the accents from Latin-1 characters. X-Symbol (>=2.6) sets this -variable to the much more general `x-symbol-translate-to-ascii'." + "Filter function to convert a string to ASCII. +The function is used to process a context string before it is +used to derive a label from it. The intended application is to +convert ISO or Mule characters into something valid in labels. +The default function removes the accents from Latin-1 characters. +X-Symbol (>=2.6) sets this variable to the much more general +`x-symbol-translate-to-ascii'." :group 'reftex-making-and-inserting-labels :type 'symbol) @@ -947,28 +950,79 @@ This is used to string together whole reference sets, like :group 'reftex-referencing-labels :type '(repeat (cons (character) (string)))) +(defcustom reftex-ref-style-alist + '(("Default" t + (("\\ref" ?\C-m) ("\\pageref" ?p))) + ("Varioref" "varioref" + (("\\vref" ?v) ("\\vpageref" ?g) ("\\Vref" ?V) ("\\Ref" ?R))) + ("Fancyref" "fancyref" + (("\\fref" ?f) ("\\Fref" ?F))) + ("Hyperref" "hyperref" + (("\\autoref" ?a) ("\\autopageref" ?u)))) + "Alist of reference styles. +Each element is a list of the style name, the name of the LaTeX +package associated with the style or t for any package, and an +alist of macros where the first entry of each item is the +reference macro and the second a key for selecting the macro when +the macro type is being prompted for. (See also +`reftex-ref-macro-prompt'.) The keys, represented as characters, +have to be unique." + :group 'reftex-referencing-labels + :type '(alist :key-type (string :tag "Style name") + :value-type (group (choice :tag "Package" + (const :tag "Any package" t) + (string :tag "Name")) + (repeat :tag "Macros" + (group (string :tag "Macro") + (character :tag "Key")))))) + +(defcustom reftex-ref-macro-prompt t + "If non-nil, `reftex-reference' prompts for the reference macro." + :group 'reftex-referencing-labels + :type 'boolean) + (defcustom reftex-vref-is-default nil - "Non-nil means, the varioref macro \\vref is used as default. -In the selection buffer, the `v' key toggles the reference macro between -`\\ref' and `\\vref'. The value of this variable determines the default -which is active when entering the selection process. -Instead of nil or t, this may also be a string of type letters indicating -the label types for which it should be true." + "Non-nil means, the varioref reference style is used as default. +The value of this variable determines the default which is active +when entering the selection process. Instead of nil or t, this +may also be a string of type letters indicating the label types +for which it should be true. + +This variable is obsolete, use `reftex-ref-style-default-list' +instead." :group 'reftex-referencing-labels :type `(choice :tag "\\vref is default macro" ,@reftex-tmp)) ;;;###autoload(put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) (defcustom reftex-fref-is-default nil - "Non-nil means, the fancyref macro \\fref is used as default. -In the selection buffer, the `V' key toggles the reference macro between -`\\ref', `\\fref' and `\\Fref'. The value of this variable determines -the default which is active when entering the selection process. -Instead of nil or t, this may also be a string of type letters indicating -the label types for which it should be true." + "Non-nil means, the fancyref reference style is used as default. +The value of this variable determines the default which is active +when entering the selection process. Instead of nil or t, this +may also be a string of type letters indicating the label types +for which it should be true. + +This variable is obsolete, use `reftex-ref-style-default-list' +instead." :group 'reftex-referencing-labels :type `(choice :tag "\\fref is default macro" ,@reftex-tmp)) ;;;###autoload(put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) +(defcustom reftex-ref-style-default-list '("Default") + "List of reference styles to be activated by default. +The order is significant and controls the order in which macros +can be cycled in the buffer for selecting a label. The entries +in the list have to match the respective reference style names +used in the variable `reftex-ref-style-alist'." + :group 'reftex-referencing-labels + :type `(set ,@(mapcar (lambda (x) (list 'const (car x))) + reftex-ref-style-alist))) + +;; Compatibility with obsolete variables. +(when reftex-vref-is-default + (add-to-list 'reftex-ref-style-default-list "Varioref")) +(when reftex-fref-is-default + (add-to-list 'reftex-ref-style-default-list "Fancyref")) + (defcustom reftex-level-indent 2 "Number of spaces to be used for indentation per section level." :group 'reftex-referencing-labels @@ -987,19 +1041,22 @@ a label type. If you set this variable to nil, RefTeX will always prompt." (defcustom reftex-format-ref-function nil "Function which produces the string to insert as a reference. -Normally should be nil, because the format to insert a reference can -already be specified in `reftex-label-alist'. -This hook also is used by the special commands to insert `\\vref' and `\\fref' -references, so even if you set this, your setting will be ignored by -the special commands. -The function will be called with two arguments, the LABEL and the DEFAULT -FORMAT, which normally is `~\\ref{%s}'. The function should return the -string to insert into the buffer." +Normally should be nil, because the format to insert a reference +can already be specified in `reftex-label-alist'. + +This hook also is used by the special commands to insert +e.g. `\\vref' and `\\fref' references, so even if you set this, +your setting will be ignored by the special commands. + +The function will be called with three arguments, the LABEL, the +DEFAULT FORMAT, which normally is `~\\ref{%s}' and the REFERENCE +STYLE. The function should return the string to insert into the +buffer." :group 'reftex-referencing-labels - :type 'function) + :type '(choice (const nil) function)) (defcustom reftex-select-label-mode-hook nil - "Mode hook for reftex-select-label-mode." + "Mode hook for `reftex-select-label-mode'." :group 'reftex-referencing-labels :type 'hook) @@ -1009,7 +1066,8 @@ string to insert into the buffer." "Support for referencing bibliographic data with BibTeX." :group 'reftex) -(defcustom reftex-bibliography-commands '("bibliography" "nobibliography") +(defcustom reftex-bibliography-commands + '("bibliography" "nobibliography" "setupbibtex\\[.*?database=") "LaTeX commands which specify the BibTeX databases to use with the document." :group 'reftex-citation-support :type '(repeat string)) @@ -1114,7 +1172,7 @@ E.g.: (setq reftex-cite-format 'natbib)" (defcustom reftex-cite-prompt-optional-args 'maybe "Non-nil means, prompt for empty optional arguments in cite macros. -When an entry in `reftex-cite-format' ist given with square brackets to +When an entry in `reftex-cite-format' is given with square brackets to indicate optional arguments (for example \\cite[][]{%l}), RefTeX can prompt for values. Possible values are: @@ -1189,13 +1247,28 @@ The function will be called with two arguments, the CITATION KEY and the DEFAULT FORMAT, which is taken from `reftex-cite-format'. The function should return the string to insert into the buffer." :group 'reftex-citation-support - :type 'function) + :type '(choice (const nil) function)) (defcustom reftex-select-bib-mode-hook nil "Mode hook for reftex-select-bib-mode." :group 'reftex-citation-support :type 'hook) +(defcustom reftex-cite-key-separator "," + "String to be used for separating several keys in a \\cite macro." + :group 'reftex-citation-support + :type 'string) + +(defcustom reftex-create-bibtex-header nil + "Header to insert in BibTeX files generated by RefTeX." + :group 'reftex-citation-support + :type 'string) + +(defcustom reftex-create-bibtex-footer nil + "Footer to insert in BibTeX files generated by RefTeX." + :group 'reftex-citation-support + :type 'string) + ;; Index Support Configuration (defgroup reftex-index-support nil @@ -1223,7 +1296,9 @@ These correspond to the makeindex keywords LEVEL ENCAP ACTUAL QUOTE ESCAPE." (string :tag "ESCAPE char "))) (defcustom reftex-index-macros nil - "Macros which define index entries. The structure is + "Macros which define index entries. + +The structure is \(MACRO INDEX-TAG KEY PREFIX EXCLUDE REPEAT) @@ -1456,7 +1531,7 @@ This flag can be toggled from within the *Index* buffer with the `f' key." This is used when `reftex-view-crossref' is called with point in an argument of a macro. Note that crossref viewing for citations, references (both ways) and index entries is hard-coded. This variable -is only to configure additional structures for which crossreference +is only to configure additional structures for which cross-reference viewing can be useful. Each entry has the structure \(MACRO-RE SEARCH-RE HIGHLIGHT). @@ -1499,15 +1574,17 @@ entries and for BibTeX database files with live associated buffers." :type 'boolean) (defcustom reftex-cache-cite-echo t - "Non-nil means, the information displayed in the echo area for cite macros -is cached and even saved along with the parsing information. The cache -survives document scans. In order to clear it, use M-x reftex-reset-mode." + "Non-nil means, echoed information for cite macros is cached. +The information displayed in the echo area for cite macros is +cached and even saved along with the parsing information. The +cache survives document scans. In order to clear it, use M-x +reftex-reset-mode <RET>." :group 'reftex-viewing-cross-references :type 'boolean) (defcustom reftex-display-copied-context-hook nil - "Normal Hook which is run before context is displayed anywhere. Designed -for X-Symbol, but may have other uses as well." + "Normal hook which is run before context is displayed anywhere. +Designed for X-Symbol, but may have other uses as well." :group 'reftex-viewing-cross-references :group 'reftex-referencing-labels :type 'hook) @@ -1690,7 +1767,7 @@ The file MASTER.rel in the same directory as MASTER.tex is used to save the information. When this variable is t, - accessing the parsing information for the first time in an editing session will read that file (if available) instead of parsing the document. -- exiting Emacs or killing a buffer in reftex-mode will cause a new version +- exiting Emacs or killing a buffer in `reftex-mode' will cause a new version of the file to be written." :group 'reftex-optimizations-for-large-documents :type 'boolean) @@ -1855,22 +1932,13 @@ symbol indicating in what context the hook is called." (defcustom reftex-extra-bindings nil "Non-nil means, make additional key bindings on startup. -These extra bindings are located in the -`reftex-extra-bindings-map' map, bound to -`reftex-extra-bindings-prefix'." - :group 'reftex-miscellaneous-configurations - :type 'boolean) - -;; below, default is C-c C-y because it is free in LaTeX mode. -(defcustom reftex-extra-bindings-prefix "\C-c\C-y" - "When `reftex-extra-bindings' is set to non-nil, use extra -bindings with this prefix bound to `reftex-extra-bindings-map'." +These extra bindings are located in the users `C-c letter' map." :group 'reftex-miscellaneous-configurations :type 'boolean) (defcustom reftex-plug-into-AUCTeX nil "Plug-in flags for AUCTeX interface. -This variable is a list of 4 boolean flags. When a flag is non-nil, +This variable is a list of 5 boolean flags. When a flag is non-nil, RefTeX will - supply labels in new sections and environments (flag 1) @@ -1900,8 +1968,7 @@ may require a restart of Emacs in order to become effective." (boolean :tag "supply argument for macros like `\\label' ") (boolean :tag "supply argument for macros like `\\ref' ") (boolean :tag "supply argument for macros like `\\cite' ") - (boolean :tag "supply argument for macros like `\\index' ") - ))) + (boolean :tag "supply argument for macros like `\\index' ")))) (defcustom reftex-allow-detached-macro-args nil "Non-nil means, allow arguments of macros to be detached by whitespace. diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 8318dc0d5f3..bdee0fcf1d4 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -3,7 +3,6 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org -;; Version: 4.31 ;; Keywords: tex ;; This file is part of GNU Emacs. @@ -21,10 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -;;--------------------------------------------------------------------------- -;; ;;; Commentary: -;; + ;; RefTeX is a minor mode with distinct support for \ref, \label, \cite, ;; and \index commands in (multi-file) LaTeX documents. ;; - A table of contents provides easy access to any part of a document. @@ -34,243 +31,23 @@ ;; - Text phrases can be collected in a file, for later global indexing. ;; - The index preview buffer helps to check and edit index entries. ;; -;; -;; INSTALLATION -;; ------------ -;; -;; - If this file is part of an X/Emacs distribution, it is installed. -;; - For XEmacs 21.x, you need to install the RefTeX plug-in package -;; available from the XEmacs distribution sites. -;; - If you have downloaded this file from the maintainers webpage, follow -;; the instructions in the INSTALL file of the distribution. -;; -;; To turn RefTeX Mode on and off in a buffer, use `M-x reftex-mode'. -;; -;; To turn on RefTeX Mode for all LaTeX files, add the following lines -;; to your init file: -;; -;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; AUCTeX LaTeX mode -;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; Emacs latex mode -;; -;; -;; DOCUMENTATION -;; ------------- -;; -;; See below for a short summary of how to use RefTeX. -;; -;; There is an extensive texinfo document describing RefTeX in detail. +;; There is an extensive Texinfo document describing RefTeX in detail. ;; One way to view this documentation is `M-x reftex-info RET'. ;; ;; The documentation in various formats is also available at ;; -;; http://zon.astro.uva.nl/~dominik/Tools/ -;; -;;--------------------------------------------------------------------------- -;; -;; Introduction -;; ************ -;; -;; RefTeX is a specialized package for support of labels, references, -;; citations, and the index in LaTeX. RefTeX wraps itself round 4 LaTeX -;; macros: `\label', `\ref', `\cite', and `\index'. Using these macros -;; usually requires looking up different parts of the document and -;; searching through BibTeX database files. RefTeX automates these -;; time-consuming tasks almost entirely. It also provides functions to -;; display the structure of a document and to move around in this -;; structure quickly. -;; -;; *Note Imprint::, for information about who to contact for help, bug -;; reports or suggestions. -;; -;; Environment -;; =========== -;; -;; RefTeX needs to access all files which are part of a multifile -;; document, and the BibTeX database files requested by the -;; `\bibliography' command. To find these files, RefTeX will require a -;; search path, i.e. a list of directories to check. Normally this list -;; is stored in the environment variables `TEXINPUTS' and `BIBINPUTS' -;; which are also used by RefTeX. However, on some systems these -;; variables do not contain the full search path. If RefTeX does not work -;; for you because it cannot find some files, read *Note Finding Files::. -;; -;; Entering RefTeX Mode -;; ==================== -;; -;; To turn RefTeX Mode on and off in a particular buffer, use `M-x -;; reftex-mode'. To turn on RefTeX Mode for all LaTeX files, add the -;; following lines to your init file: -;; -;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode -;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode -;; -;; RefTeX in a Nutshell -;; ==================== -;; -;; 1. Table of Contents -;; Typing `C-c =' (`reftex-toc') will show a table of contents of the -;; document. This buffer can display sections, labels and index -;; entries defined in the document. From the buffer, you can jump -;; quickly to every part of your document. Press `?' to get help. -;; -;; 2. Labels and References -;; RefTeX helps to create unique labels and to find the correct key -;; for references quickly. It distinguishes labels for different -;; environments, knows about all standard environments (and many -;; others), and can be configured to recognize any additional labeled -;; environments you have defined yourself (variable -;; `reftex-label-alist'). -;; -;; * Creating Labels -;; Type `C-c (' (`reftex-label') to insert a label at point. -;; RefTeX will either -;; - derive a label from context (default for section labels) -;; - prompt for a label string (default for figures and -;; tables) or -;; - insert a simple label made of a prefix and a number (all -;; other environments) -;; -;; Which labels are created how is configurable with the variable -;; `reftex-insert-label-flags'. -;; -;; * Referencing Labels -;; To make a reference, type `C-c )' (`reftex-reference'). This -;; shows an outline of the document with all labels of a certain -;; type (figure, equation,...) and some label context. -;; Selecting a label inserts a `\ref{LABEL}' macro into the -;; original buffer. -;; -;; 3. Citations -;; Typing `C-c [' (`reftex-citation') will let you specify a regular -;; expression to search in current BibTeX database files (as -;; specified in the `\bibliography' command) and pull out a list of -;; matches for you to choose from. The list is _formatted_ and -;; sorted. The selected article is referenced as `\cite{KEY}' (see -;; the variable `reftex-cite-format' if you want to insert different -;; macros). -;; -;; 4. Index Support -;; RefTeX helps to enter index entries. It also compiles all entries -;; into an alphabetically sorted `*Index*' buffer which you can use -;; to check and edit the entries. RefTeX knows about the standard -;; index macros and can be configured to recognize any additional -;; macros you have defined (`reftex-index-macros'). Multiple indices -;; are supported. -;; -;; * Creating Index Entries -;; To index the current selection or the word at point, type -;; `C-c /' (`reftex-index-selection-or-word'). The default macro -;; `reftex-index-default-macro' will be used. For a more -;; complex entry type `C-c <' (`reftex-index'), select any of -;; the index macros and enter the arguments with completion. -;; -;; * The Index Phrases File (Delayed Indexing) -;; Type `C-c \' (`reftex-index-phrase-selection-or-word') to add -;; the current word or selection to a special _index phrase -;; file_. RefTeX can later search the document for occurrences -;; of these phrases and let you interactively index the matches. -;; -;; * Displaying and Editing the Index -;; To display the compiled index in a special buffer, type `C-c -;; >' (`reftex-display-index'). From that buffer you can check -;; and edit all entries. -;; -;; 5. Viewing Cross-References -;; When point is on the KEY argument of a cross-referencing macro -;; (`\label', `\ref', `\cite', `\bibitem', `\index', and variations) -;; or inside a BibTeX database entry, you can press `C-c &' -;; (`reftex-view-crossref') to display corresponding locations in the -;; document and associated BibTeX database files. -;; When the enclosing macro is `\cite' or `\ref' and no other message -;; occupies the echo area, information about the citation or label -;; will automatically be displayed in the echo area. -;; -;; 6. Multifile Documents -;; Multifile Documents are fully supported. The included files must -;; have a file variable `TeX-master' or `tex-main-file' pointing to -;; the master file. RefTeX provides cross-referencing information -;; from all parts of the document, and across document borders -;; (`xr.sty'). -;; -;; 7. Document Parsing -;; RefTeX needs to parse the document in order to find labels and -;; other information. It does it automatically once and updates its -;; list internally when `reftex-label' and `reftex-index' are used. -;; To enforce reparsing, call any of the commands described above -;; with a raw `C-u' prefix, or press the `r' key in the label -;; selection buffer, the table of contents buffer, or the index -;; buffer. -;; -;; 8. AUCTeX -;; If your major LaTeX mode is AUCTeX, RefTeX can cooperate with it -;; (see variable `reftex-plug-into-AUCTeX'). AUCTeX contains style -;; files which trigger appropriate settings in RefTeX, so that for -;; many of the popular LaTeX packages no additional customizations -;; will be necessary. -;; -;; 9. Useful Settings -;; To make RefTeX faster for large documents, try these: -;; (setq reftex-enable-partial-scans t) -;; (setq reftex-save-parse-info t) -;; (setq reftex-use-multiple-selection-buffers t) -;; -;; To integrate with AUCTeX, use -;; (setq reftex-plug-into-AUCTeX t) -;; -;; To make your own LaTeX macro definitions known to RefTeX, -;; customize the variables -;; `reftex-label-alist' (for label macros/environments) -;; `reftex-section-levels' (for sectioning commands) -;; `reftex-cite-format' (for `\cite'-like macros) -;; `reftex-index-macros' (for `\index'-like macros) -;; `reftex-index-default-macro' (to set the default macro) -;; If you have a large number of macros defined, you may want to write -;; an AUCTeX style file to support them with both AUCTeX and RefTeX. -;; -;; 10. Where Next? -;; Go ahead and use RefTeX. Use its menus until you have picked up -;; the key bindings. For an overview of what you can do in each of -;; the different special buffers, press `?'. Read the manual if you -;; get stuck, of if you are curious what else might be available. -;; The first part of the manual explains in a tutorial way how to use -;; and customize RefTeX. The second part is a command and variable -;; reference. -;; -;;--------------------------------------------------------------------------- -;; -;; AUTHOR -;; ====== -;; -;; Carsten Dominik <dominik@science.uva.nl> -;; -;; with contributions from Stephen Eglen +;; http://www.gnu.org/software/auctex/manual/reftex.index.html ;; ;; RefTeX is bundled with Emacs and available as a plug-in package for ;; XEmacs 21.x. If you need to install it yourself, you can find a ;; distribution at ;; -;; http://zon.astro.uva.nl/~dominik/Tools/ +;; http://www.gnu.org/software/auctex/reftex.html ;; -;; THANKS TO: -;; --------- -;; Thanks to the people on the Net who have used RefTeX and helped -;; developing it with their reports. In particular thanks to -;; -;; Fran Burstall, Alastair Burt, Soren Dayton, Stephen Eglen, -;; Karl Eichwalder, Peter Galbraith, Dieter Kraft, Kai Grossjohann, -;; Frank Harrell, Adrian Lanz, Rory Molinari, Stefan Monnier, -;; Laurent Mugnier, Sudeep Kumar Palat, Daniel Polani, Robin Socha, -;; Richard Stanton, Allan Strand, Jan Vroonhof, Christoph Wedler, -;; Alan Williams. -;; -;; Finally thanks to Uwe Bolick who first got me (some years ago) into -;; supporting LaTeX labels and references with an editor (which was -;; MicroEmacs at the time). -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;;;;; - +;; RefTeX was written by Carsten Dominik <dominik@science.uva.nl> with +;; contributions from Stephen Eglen. It is currently maintained by +;; the AUCTeX project. + ;;; Code: (eval-when-compile (require 'cl)) @@ -289,52 +66,13 @@ (set symbol value))) -;;; ========================================================================= -;;; -;;; Configuration variables - +;; Configuration variables (require 'reftex-vars) -;;; ========================================================================= -;;; -;;; Define the formal stuff for a minor mode named RefTeX. -;;; - -(defconst reftex-version "RefTeX version 4.31" - "Version string for RefTeX.") - -(defvar reftex-mode-map (make-sparse-keymap) - "Keymap for RefTeX mode.") - -(defvar reftex-mode-menu nil) -(defvar reftex-syntax-table nil) -(defvar reftex-syntax-table-for-bib nil) - -(unless reftex-syntax-table - (setq reftex-syntax-table (copy-syntax-table)) - (modify-syntax-entry ?\( "." reftex-syntax-table) - (modify-syntax-entry ?\) "." reftex-syntax-table)) - -(unless reftex-syntax-table-for-bib - (setq reftex-syntax-table-for-bib - (copy-syntax-table reftex-syntax-table)) - (modify-syntax-entry ?\' "." reftex-syntax-table-for-bib) - (modify-syntax-entry ?\" "." reftex-syntax-table-for-bib) - (modify-syntax-entry ?\[ "." reftex-syntax-table-for-bib) - (modify-syntax-entry ?\] "." reftex-syntax-table-for-bib)) - -;; The following definitions are out of place, but I need them here -;; to make the compilation of reftex-mode not complain. -(defvar reftex-auto-view-crossref-timer nil - "The timer used for auto-view-crossref.") -(defvar reftex-toc-auto-recenter-timer nil - "The idle timer used to recenter the toc window.") - -;;; ========================================================================= -;;; -;;; Parser functions +;;; Autoloads +;; Parser functions (autoload 'reftex-parse-one "reftex-parse" "Re-parse this file." t) (autoload 'reftex-parse-all "reftex-parse" @@ -358,11 +96,7 @@ (autoload 'reftex-ensure-index-support "reftex-parse") (autoload 'reftex-everything-regexp "reftex-parse") - -;;; ========================================================================= -;;; -;;; Labels and References - +;; Labels and References (autoload 'reftex-label-location "reftex-ref") (autoload 'reftex-label-info-update "reftex-ref") (autoload 'reftex-label-info "reftex-ref") @@ -381,10 +115,7 @@ (autoload 'reftex-goto-label "reftex-ref" "Prompt for label name and go to that location." t) -;;; ========================================================================= -;;; -;;; Table of contents - +;; Table of contents (autoload 'reftex-toc "reftex-toc" "Show the table of contents for the current document." t) (autoload 'reftex-toc-recenter "reftex-toc" @@ -392,10 +123,7 @@ (autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" "Toggle automatic recentering of TOC window." t) -;;; ========================================================================= -;;; -;;; BibTeX citations. - +;; BibTeX citations. (autoload 'reftex-citep "reftex-cite") (autoload 'reftex-citet "reftex-cite") (autoload 'reftex-make-cite-echo-string "reftex-cite") @@ -409,10 +137,7 @@ (autoload 'reftex-bib-or-thebib "reftex-cite") (autoload 'reftex-create-bibtex-file "reftex-cite") -;;; ========================================================================= -;;; -;;; Selection - +;; Selection (autoload 'reftex-select-label-mode "reftex-sel") (autoload 'reftex-select-bib-mode "reftex-sel") (autoload 'reftex-find-start-point "reftex-sel") @@ -420,11 +145,7 @@ (autoload 'reftex-get-offset "reftex-sel") (autoload 'reftex-select-item "reftex-sel") - -;;; ========================================================================= -;;; -;;; Index support - +;; Index support (autoload 'reftex-index "reftex-index" "Query for an index macro and insert it along with its arguments." t) (autoload 'reftex-index-selection-or-word "reftex-index" @@ -442,11 +163,7 @@ (autoload 'reftex-index-show-entry "reftex-index") (autoload 'reftex-index-select-tag "reftex-index") - -;;; ========================================================================= -;;; -;;; View cross references - +;; View cross references (autoload 'reftex-view-crossref "reftex-dcr" "View cross reference of \\ref or \\cite macro at point." t) (autoload 'reftex-mouse-view-crossref "reftex-dcr" @@ -455,11 +172,7 @@ (autoload 'reftex-view-crossref-from-bibtex "reftex-dcr" "View location in a LaTeX document which cites the BibTeX entry at point." t) - -;;; ========================================================================= -;;; -;;; Operations on entire Multifile documents - +;; Operations on entire Multifile documents (autoload 'reftex-create-tags-file "reftex-global" "Create TAGS file by running `etags' on the current document." t) (autoload 'reftex-grep-document "reftex-global" @@ -477,11 +190,7 @@ (autoload 'reftex-save-all-document-buffers "reftex-global" "Save all documents associated with the current document." t) - -;;; ========================================================================= -;;; -;;; AUCTeX Interface - +;; AUCTeX Interface (autoload 'reftex-arg-label "reftex-auc") (autoload 'reftex-arg-cite "reftex-auc") (autoload 'reftex-arg-index-tag "reftex-auc") @@ -494,6 +203,41 @@ (autoload 'reftex-add-section-levels "reftex-auc") (autoload 'reftex-notice-new-section "reftex-auc") + +;;; ========================================================================= +;;; +;;; Define the formal stuff for a minor mode named RefTeX. +;;; + +(defconst reftex-version emacs-version + "Version string for RefTeX.") + +(defvar reftex-mode-map (make-sparse-keymap) + "Keymap for RefTeX mode.") + +(defvar reftex-mode-menu nil) +(defvar reftex-syntax-table nil) +(defvar reftex-syntax-table-for-bib nil) + +(unless reftex-syntax-table + (setq reftex-syntax-table (copy-syntax-table)) + (modify-syntax-entry ?\( "." reftex-syntax-table) + (modify-syntax-entry ?\) "." reftex-syntax-table)) + +(unless reftex-syntax-table-for-bib + (setq reftex-syntax-table-for-bib (copy-syntax-table)) + (modify-syntax-entry ?\' "." reftex-syntax-table-for-bib) + (modify-syntax-entry ?\" "." reftex-syntax-table-for-bib) + (modify-syntax-entry ?\[ "." reftex-syntax-table-for-bib) + (modify-syntax-entry ?\] "." reftex-syntax-table-for-bib)) + +;; The following definitions are out of place, but I need them here +;; to make the compilation of reftex-mode not complain. +(defvar reftex-auto-view-crossref-timer nil + "The timer used for auto-view-crossref.") +(defvar reftex-toc-auto-recenter-timer nil + "The idle timer used to recenter the toc window.") + ;;;###autoload (defun turn-on-reftex () "Turn on RefTeX mode." @@ -503,13 +247,7 @@ (put 'reftex-mode :menu-tag "RefTeX Mode") ;;;###autoload (define-minor-mode reftex-mode - "Toggle RefTeX mode. -With a prefix argument ARG, enable RefTeX mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. - -RefTeX mode is a buffer-local minor mode with distinct support -for \\label, \\ref and \\cite in LaTeX. + "Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX. \\<reftex-mode-map>A Table of Contents of the entire (multifile) document with browsing capabilities is available with `\\[reftex-toc]'. @@ -559,8 +297,7 @@ on the menu bar. (modify-syntax-entry ?\( "." reftex-syntax-table) (modify-syntax-entry ?\) "." reftex-syntax-table) - (setq reftex-syntax-table-for-bib - (copy-syntax-table reftex-syntax-table)) + (setq reftex-syntax-table-for-bib (copy-syntax-table)) (modify-syntax-entry ?\' "." reftex-syntax-table-for-bib) (modify-syntax-entry ?\" "." reftex-syntax-table-for-bib) (modify-syntax-entry ?\[ "." reftex-syntax-table-for-bib) @@ -635,16 +372,15 @@ on the menu bar. (incf reftex-multifile-index)) (defun reftex-tie-multifile-symbols () - ;; Tie the buffer-local symbols to globals connected with the master file. - ;; If the symbols for the current master file do not exist, they are created. - + "Tie the buffer-local symbols to globals connected with the master file. +If the symbols for the current master file do not exist, they are created." (let* ((master (file-truename (reftex-TeX-master-file))) (index (assoc master reftex-master-index-list)) (symlist reftex-multifile-symbols) symbol symname newflag) ;; Find the correct index. (if index - ;; symbols do exist + ;; Symbols do exist (setq index (cdr index)) ;; Get a new index and add info to the alist. (setq index (reftex-next-multifile-index) @@ -661,13 +397,15 @@ on the menu bar. ;; Initialize if new symbols. (when newflag (set (symbol-value symbol) nil) - (put (symbol-value symbol) 'reftex-index-macros-style '(default)))) + (put (symbol-value symbol) 'reftex-index-macros-style '(default)) + (put (symbol-value symbol) 'reftex-ref-style-list + reftex-ref-style-default-list))) ;; Return t if the symbols did already exist, nil when we've made them. (not newflag))) (defun reftex-untie-multifile-symbols () - ;; Remove ties from multifile symbols, so that next use makes new ones. + "Remove ties from multifile symbols, so that next use makes new ones." (let ((symlist reftex-multifile-symbols) (symbol nil)) (while symlist @@ -761,7 +499,7 @@ for details. This function makes it possible to support RefTeX from AUCTeX style files. The entries in ENTRY-LIST will be processed after the user settings in `reftex-index-entries', and before the defaults. Any changes made to -`reftex-label-alist-style' will raise a flag to the effect that +`reftex-index-macros-style' will raise a flag to the effect that the label information is recompiled on next use." (unless reftex-docstruct-symbol (reftex-tie-multifile-symbols)) @@ -783,6 +521,52 @@ the label information is recompiled on next use." (when changed (put reftex-docstruct-symbol 'reftex-index-macros-style list))))) +(defun reftex-ref-style-activate (style) + "Activate the referencing style STYLE." + (reftex-ref-style-toggle style 'activate)) + +(defun reftex-ref-style-toggle (style &optional action) + "Activate or deactivate the referencing style STYLE. +With the optional argument ACTION a certain action can be forced. +The symbol `activate' will activate the style and `deactivate' +will deactivate it." + (unless reftex-docstruct-symbol + (reftex-tie-multifile-symbols)) + (when (and reftex-docstruct-symbol + (symbolp reftex-docstruct-symbol)) + (let ((list (get reftex-docstruct-symbol 'reftex-ref-style-list)) + changed) + (cond ((eq action 'activate) + (unless (member style list) + (setq reftex-tables-dirty t + changed t) + (add-to-list 'list style t))) + ((eq action 'deactivate) + (when (member style list) + (setq reftex-tables-dirty t + changed t) + (delete style list))) + (t + (if (member style list) + (delete style list) + (add-to-list 'list style t)) + (setq reftex-tables-dirty t + changed t))) + (when changed + (put reftex-docstruct-symbol 'reftex-ref-style-list list))))) + +(defun reftex-ref-style-list () + "Return the list of referencing styles to be active at the moment." + ;; Initialize the value of `reftex-ref-style-list' and tie it to the + ;; docstruct symbol if necessary. + (unless reftex-docstruct-symbol + (reftex-tie-multifile-symbols)) + (if (and reftex-docstruct-symbol + (symbolp reftex-docstruct-symbol) + (get reftex-docstruct-symbol 'reftex-ref-style-list)) + (get reftex-docstruct-symbol 'reftex-ref-style-list) + reftex-ref-style-default-list)) + ;;; ========================================================================= ;;; ;;; Functions to compile the tables, reset the mode etc. @@ -1282,8 +1066,8 @@ This enforces rescanning the buffer on next use." ;; Calculate the regular expressions (let* ( ; (wbol "\\(\\`\\|[\n\r]\\)[ \t]*") - (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because - ;;; because match number are hard coded + (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because + ; match numbers are hard coded (label-re (concat "\\(?:" ;; Normal \label{...} "\\\\label{\\([^}]*\\)}" @@ -1299,10 +1083,16 @@ This enforces rescanning the buffer on next use." reftex-include-file-commands "\\|") "\\)[{ \t]+\\([^} \t\n\r]+\\)")) (section-re + ;; Including `\' as a character to be matched at the end + ;; of the regexp will allow stuff like + ;; \begin{foo}\label{bar} to be matched. This will make + ;; the parser to advance one char too much. Therefore + ;; `reftex-parse-from-file' will step one char back if a + ;; section is found. (concat wbol "\\\\\\(" (mapconcat (lambda (x) (regexp-quote (car x))) reftex-section-levels-all "\\|") - "\\)\\*?\\(\\[[^]]*\\]\\)?[[{ \t\r\n]")) + "\\)\\*?\\(\\[[^]]*\\]\\)?[[{ \t\r\n\\]")) (appendix-re (concat wbol "\\(\\\\appendix\\)")) (macro-re (if macros-with-labels @@ -1780,9 +1570,18 @@ When DIE is non-nil, throw an error if file not found." "In unfinished selection process. Finish, or abort with \\[abort-recursive-edit]")))) (defun reftex-in-comment () + "Return non-nil if point is in a comment." (save-excursion - (skip-chars-backward "^%\n\r") - (eq (preceding-char) ?%))) + (save-match-data + (let ((pos (point))) + (beginning-of-line) + (re-search-forward + (or comment-start-skip + ;; The parser may open files in fundamental mode if + ;; `reftex-initialize-temporary-buffers' is nil, so here + ;; is a default suitable for plain TeX and LaTeX. + "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(%+[ \t]*\\)") + pos t))))) (defun reftex-no-props (string) ;; Return STRING with all text properties removed @@ -1996,6 +1795,7 @@ When DIE is non-nil, throw an error if file not found." (condition-case nil (scroll-down) (error nil)) (message "%s" prompt)) (t (message "") + (reftex-kill-buffer "*RefTeX Select*") (throw 'exit char))) (setq char (read-char-exclusive))))))) @@ -2123,25 +1923,95 @@ When DIE is non-nil, throw an error if file not found." (setq list (cdr list))) (nreverse rtn))) -(defun reftex-uniquify (list) - ;; Return a list of all elements in LIST, but each only once, keeping order - (let (new elm) - (while list - (setq elm (pop list)) - (unless (member elm new) - (push elm new))) - (nreverse new))) - -(defun reftex-uniquify-by-car (alist &optional keep-list) +(defun reftex-uniquify (list &optional sort) + ;; Return a list of all strings in LIST, but each only once, keeping order + ;; unless SORT is set (faster!). + (setq list (copy-sequence list)) + (if sort + (progn + (setq list (sort list 'string<)) + (let ((p list)) + (while (cdr p) + (if (string= (car p) (car (cdr p))) + (setcdr p (cdr (cdr p))) + (setq p (cdr p))))) + list) + (let ((p list) lst elt) + ;; push all sublists into lst in reverse(!) order + (while p + (push p lst) + (setq p (cdr p))) + ;; sort all sublists + (setq lst (sort lst (lambda (x1 x2) (string< (car x1) (car x2))))) + (while (cdr lst) + (setq elt (car (car lst))) + ;; for equal elements in the sorted sublist, replace the + ;; last(!) original list member with nil + (when (string= elt (car (cadr lst))) + (setcar (pop lst) nil) + (while (and (cdr lst) (string= elt (car (cadr lst)))) + (setcar (pop lst) nil))) + (pop lst))) + ;; weed out all nils and return. + (delq nil list))) + +(defun reftex-uniquify-by-car (alist &optional keep-list sort) ;; Return a list of all elements in ALIST, but each car only once. ;; Elements of KEEP-LIST are not removed even if duplicate. - (let (new elm) - (while alist - (setq elm (pop alist)) - (if (or (member (car elm) keep-list) - (not (assoc (car elm) new))) - (push elm new))) - (nreverse new))) + ;; The order is kept unless SORT is set (faster!). + (setq keep-list (sort (copy-sequence keep-list) #'string<) + alist (copy-sequence alist)) + (if sort + (let (lst elt) + (setq alist (sort alist (lambda(a b) (string< (car a) (car b))))) + (setq lst alist) + (while (cdr lst) + (setq elt (car (car lst))) + (when (string= elt (car (cadr lst))) + (while (and keep-list (string< (car keep-list) elt)) + (pop keep-list)) + (if (and keep-list (string= elt (car keep-list))) + (progn + (pop lst) + (while (and (cdr lst) + (string= elt (car (cadr lst)))) + (pop lst))) + (setcdr lst (cdr (cdr lst))) + (while (and (cdr lst) + (string= elt (car (cadr lst)))) + (setcdr lst (cdr (cdr lst)))))) + (pop lst)) + alist) + (let ((p alist) lst elt) + (while p + (push p lst) + (setq p (cdr p))) + (setq lst (sort lst (lambda(a b) (string< (car (car a)) + (car (car b)))))) + (while (cdr lst) + (setq elt (car (car (car lst)))) + (when (string= elt (car (car (cadr lst)))) + (while (and keep-list (string< (car keep-list) elt)) + (pop keep-list)) + (if (and keep-list (string= elt (car keep-list))) + (progn + (pop lst) + (while (and (cdr lst) + (string= elt (car (car (cadr lst))))) + (pop lst))) + (setcar (pop lst) nil) + (while (and (cdr lst) + (string= elt (car (car (cadr lst))))) + (setcar (pop lst) nil)))) + (pop lst))) + (delq nil alist))) + +(defun reftex-remove-if (predicate list) + "Nondestructively remove all items from LIST which satisfy PREDICATE." + (let (result) + (dolist (elt list (nreverse result)) + (unless (funcall predicate elt) + (push elt result))))) (defun reftex-abbreviate-title (string) (reftex-convert-string string "[-~ \t\n\r,;]" nil t t @@ -2243,6 +2113,7 @@ IGNORE-WORDS List of words which should be removed from the string." ((= (length text) 0) (make-string 1 ?\ )) (t text))) + ;;; ========================================================================= ;;; ;;; Fontification and Highlighting @@ -2390,28 +2261,20 @@ IGNORE-WORDS List of words which should be removed from the string." "bibtex" '(define-key bibtex-mode-map "\C-c&" 'reftex-view-crossref-from-bibtex)) -;; If the user requests so, she can have a few more bindings: ;; For most of these commands there are already bindings in place. ;; Setting `reftex-extra-bindings' really is only there to spare users ;; the hassle of defining bindings in the user space themselves. This ;; is why they violate the key binding recommendations. -(defvar reftex-extra-bindings-map - (let ((map (make-sparse-keymap))) - (define-key map "t" 'reftex-toc) - (define-key map "l" 'reftex-label) - (define-key map "r" 'reftex-reference) - (define-key map "c" 'reftex-citation) - (define-key map "v" 'reftex-view-crossref) - (define-key map "g" 'reftex-grep-document) - (define-key map "s" 'reftex-search-document) - map) - "Reftex extra bindings map") - (when reftex-extra-bindings - (define-key reftex-mode-map - reftex-extra-bindings-prefix - reftex-extra-bindings-map)) - + (loop for x in + '(("\C-ct" . reftex-toc) + ("\C-cl" . reftex-label) + ("\C-cr" . reftex-reference) + ("\C-cc" . reftex-citation) + ("\C-cv" . reftex-view-crossref) + ("\C-cg" . reftex-grep-document) + ("\C-cs" . reftex-search-document)) + do (define-key reftex-mode-map (car x) (cdr x)))) ;;; ========================================================================= ;;; @@ -2488,21 +2351,22 @@ IGNORE-WORDS List of words which should be removed from the string." :style radio :selected (eq reftex-auto-view-crossref 'window)] "--" "MISC" - ["AUC TeX Interface" reftex-toggle-plug-into-AUCTeX + ["AUCTeX Interface" reftex-toggle-plug-into-AUCTeX :style toggle :selected reftex-plug-into-AUCTeX] ["isearch whole document" reftex-isearch-minor-mode :style toggle :selected reftex-isearch-minor-mode]) ("Reference Style" - ["Default" (setq reftex-vref-is-default nil - reftex-fref-is-default nil) - :style radio :selected (not (or reftex-vref-is-default - reftex-fref-is-default))] - ["Varioref" (setq reftex-vref-is-default t - reftex-fref-is-default nil) - :style radio :selected reftex-vref-is-default] - ["Fancyref" (setq reftex-fref-is-default t - reftex-vref-is-default nil) - :style radio :selected reftex-fref-is-default]) + ,@(let (list item) + (dolist (elt reftex-ref-style-alist) + (setq elt (car elt) + item (vector + elt + `(reftex-ref-style-toggle ,elt) + :style 'toggle + :selected `(member ,elt (reftex-ref-style-list)))) + (unless (member item list) + (add-to-list 'list item t))) + list)) ("Citation Style" ,@(mapcar (lambda (x) @@ -2568,6 +2432,9 @@ IGNORE-WORDS List of words which should be removed from the string." (message "\"Ref\"-menu now contains full customization menu")) (error "Cannot expand menu (outdated version of cus-edit.el)"))) + +;;; Misc + (defun reftex-show-commentary () "Use the finder to view the file documentation from `reftex.el'." (interactive) @@ -2579,6 +2446,36 @@ With optional NODE, go directly to that node." (interactive) (info (format "(reftex)%s" (or node "")))) +(defun reftex-report-bug () + "Report a bug in RefTeX. + +Don't hesitate to report any problems or inaccurate documentation. + +If you don't have setup sending mail from (X)Emacs, please copy the +output buffer into your mail program, as it gives us important +information about your RefTeX version and configuration." + (interactive) + (require 'reporter) + (let ((reporter-prompt-for-summary-p "Bug report subject: ")) + (reporter-submit-bug-report + "bug-auctex@gnu.org" + reftex-version + (list 'window-system + 'reftex-plug-into-AUCTeX) + nil nil + "Remember to cover the basics, that is, what you expected to happen and +what in fact did happen. + +Check if the bug is reproducible with an up-to-date version of +RefTeX available from http://www.gnu.org/software/auctex/. + +If the bug is triggered by a specific \(La\)TeX file, you should try +to produce a minimal sample file showing the problem and include it +in your report. + +Your bug report will be posted to the AUCTeX bug reporting list. +------------------------------------------------------------------------"))) + ;;; Install the kill-buffer and kill-emacs hooks ------------------------------ (add-hook 'kill-buffer-hook 'reftex-kill-buffer-hook) @@ -2594,6 +2491,4 @@ With optional NODE, go directly to that node." (setq reftex-tables-dirty t) ; in case this file is evaluated by hand (provide 'reftex) -;;;============================================================================ - ;;; reftex.el ends here diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 459e884d45d..3d9f88a43c9 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -1,4 +1,4 @@ -;;; table.el --- create and edit WYSIWYG text based embedded tables +;;; table.el --- create and edit WYSIWYG text based embedded tables -*- lexical-binding: t -*- ;; Copyright (C) 2000-2012 Free Software Foundation, Inc. @@ -715,28 +715,6 @@ select a character that is unlikely to appear in your document." :type 'character :group 'table) -(defun table-set-table-fixed-width-mode (variable value) - (if (fboundp variable) - (funcall variable (if value 1 -1)))) - -(defun table-initialize-table-fixed-width-mode (variable value) - (set variable value)) - -(defcustom table-fixed-width-mode nil - "Cell width is fixed when this is non-nil. -Normally it should be nil for allowing automatic cell width expansion -that widens a cell when it is necessary. When non-nil, typing in a -cell does not automatically expand the cell width. A word that is too -long to fit in a cell is chopped into multiple lines. The chopped -location is indicated by `table-word-continuation-char'. This -variable's value can be toggled by \\[table-fixed-width-mode] at -run-time." - :tag "Fix Cell Width" - :type 'boolean - :initialize 'table-initialize-table-fixed-width-mode - :set 'table-set-table-fixed-width-mode - :group 'table) - (defcustom table-detect-cell-alignment t "Detect cell contents alignment automatically. When non-nil cell alignment is automatically determined by the @@ -1001,14 +979,10 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu (dabbrev-completion . *table--cell-dabbrev-completion)) "List of cons cells consisting of (ORIGINAL-COMMAND . TABLE-VERSION-OF-THE-COMMAND).") -(defvar table-command-list nil +(defvar table-command-list + ;; Construct the real contents of the `table-command-list'. + (mapcar #'cdr table-command-remap-alist) "List of commands that override original commands.") -;; construct the real contents of the `table-command-list' -(let ((remap-alist table-command-remap-alist)) - (setq table-command-list nil) - (while remap-alist - (setq table-command-list (cons (cdar remap-alist) table-command-list)) - (setq remap-alist (cdr remap-alist)))) (defconst table-global-menu '("Table" @@ -1241,18 +1215,17 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu ;; Unknown keywords should be quietly ignore so that future extension ;; does not cause a problem in the old implementation. Sigh... (when (featurep 'xemacs) - (mapcar - (defun table--tweak-menu-for-xemacs (menu) + (defun table--tweak-menu-for-xemacs (menu) (cond ((listp menu) - (mapcar 'table--tweak-menu-for-xemacs menu)) + (mapcar #'table--tweak-menu-for-xemacs menu)) ((vectorp menu) - (let ((i 0) (len (length menu))) - (while (< i len) + (let ((len (length menu))) + (dotimes (i len) ;; replace :help with something harmless. - (if (eq (aref menu i) :help) (aset menu i :included)) - (setq i (1+ i))))))) - (list table-global-menu table-cell-menu)) + (if (eq (aref menu i) :help) (aset menu i :included))))))) + (mapcar #'table--tweak-menu-for-xemacs + (list table-global-menu table-cell-menu)) (defvar mark-active t)) ;; register table menu under global tools menu @@ -1286,6 +1259,7 @@ current buffer is restored to the original one. The last cache point coordinate is stored in `table-cell-cache-point-coordinate'. The original buffer's point is moved to the location that corresponds to the last cache point coordinate." + (declare (debug (body)) (indent 0)) (let ((height-expansion (make-symbol "height-expansion-var-symbol")) (width-expansion (make-symbol "width-expansion-var-symbol"))) `(let (,height-expansion ,width-expansion) @@ -1341,14 +1315,9 @@ the last cache point coordinate." ;; set up the update timer unless it is explicitly inhibited. (unless table-inhibit-update (table--update-cell))))) - -;; for debugging the body form of the macro -(put 'table-with-cache-buffer 'edebug-form-spec '(body)) -;; for neat presentation use the same indentation as `progn' -(put 'table-with-cache-buffer 'lisp-indent-function 0) (if (or (featurep 'xemacs) (null (fboundp 'font-lock-add-keywords))) nil - ;; color it as a keyword + ;; Color it as a keyword. (font-lock-add-keywords 'emacs-lisp-mode '("\\<table-with-cache-buffer\\>"))) @@ -1367,122 +1336,114 @@ the last cache point coordinate." ;; ;; Point Motion Only Group -(mapc - (lambda (command) - (let ((func-symbol (intern (format "*table--cell-%s" command))) - (doc-string (format "Table remapped function for `%s'." command))) - (fset func-symbol - `(lambda - (&rest args) - ,doc-string - (interactive) - (let ((table-inhibit-update t) - (deactivate-mark nil)) - (table--finish-delayed-tasks) - (table-recognize-cell 'force) - (table-with-cache-buffer - (call-interactively ',command) - (setq table-inhibit-auto-fill-paragraph t))))) - (setq table-command-remap-alist - (cons (cons command func-symbol) - table-command-remap-alist)))) - '(move-beginning-of-line - beginning-of-line - move-end-of-line - end-of-line - beginning-of-buffer - end-of-buffer - forward-word - backward-word - forward-sentence - backward-sentence - forward-paragraph - backward-paragraph)) +(dolist (command + '(move-beginning-of-line + beginning-of-line + move-end-of-line + end-of-line + beginning-of-buffer + end-of-buffer + forward-word + backward-word + forward-sentence + backward-sentence + forward-paragraph + backward-paragraph)) + (let ((func-symbol (intern (format "*table--cell-%s" command))) + (doc-string (format "Table remapped function for `%s'." command))) + (defalias func-symbol + `(lambda + (&rest args) + ,doc-string + (interactive) + (let ((table-inhibit-update t) + (deactivate-mark nil)) + (table--finish-delayed-tasks) + (table-recognize-cell 'force) + (table-with-cache-buffer + (call-interactively ',command) + (setq table-inhibit-auto-fill-paragraph t))))) + (push (cons command func-symbol) + table-command-remap-alist))) ;; Extraction Group -(mapc - (lambda (command) - (let ((func-symbol (intern (format "*table--cell-%s" command))) - (doc-string (format "Table remapped function for `%s'." command))) - (fset func-symbol - `(lambda - (&rest args) - ,doc-string - (interactive) - (table--finish-delayed-tasks) - (table-recognize-cell 'force) - (table-with-cache-buffer - (table--remove-cell-properties (point-min) (point-max)) - (table--remove-eol-spaces (point-min) (point-max)) - (call-interactively ',command)) - (table--finish-delayed-tasks))) - (setq table-command-remap-alist - (cons (cons command func-symbol) - table-command-remap-alist)))) - '(kill-region - kill-ring-save - delete-region - copy-region-as-kill - kill-line - kill-word - backward-kill-word - kill-sentence - backward-kill-sentence - kill-paragraph - backward-kill-paragraph - kill-sexp - backward-kill-sexp)) +(dolist (command + '(kill-region + kill-ring-save + delete-region + copy-region-as-kill + kill-line + kill-word + backward-kill-word + kill-sentence + backward-kill-sentence + kill-paragraph + backward-kill-paragraph + kill-sexp + backward-kill-sexp)) + (let ((func-symbol (intern (format "*table--cell-%s" command))) + (doc-string (format "Table remapped function for `%s'." command))) + (defalias func-symbol + `(lambda + (&rest args) + ,doc-string + (interactive) + (table--finish-delayed-tasks) + (table-recognize-cell 'force) + (table-with-cache-buffer + (table--remove-cell-properties (point-min) (point-max)) + (table--remove-eol-spaces (point-min) (point-max)) + (call-interactively ',command)) + (table--finish-delayed-tasks))) + (push (cons command func-symbol) + table-command-remap-alist))) ;; Pasting Group -(mapc - (lambda (command) - (let ((func-symbol (intern (format "*table--cell-%s" command))) - (doc-string (format "Table remapped function for `%s'." command))) - (fset func-symbol - `(lambda - (&rest args) - ,doc-string - (interactive) - (table--finish-delayed-tasks) - (table-recognize-cell 'force) - (table-with-cache-buffer - (call-interactively ',command) - (table--untabify (point-min) (point-max)) - (table--fill-region (point-min) (point-max)) - (setq table-inhibit-auto-fill-paragraph t)) - (table--finish-delayed-tasks))) - (setq table-command-remap-alist - (cons (cons command func-symbol) - table-command-remap-alist)))) - '(yank - clipboard-yank - yank-clipboard-selection - insert)) +(dolist (command + '(yank + clipboard-yank + yank-clipboard-selection + insert)) + (let ((func-symbol (intern (format "*table--cell-%s" command))) + (doc-string (format "Table remapped function for `%s'." command))) + (fset func-symbol + `(lambda + (&rest args) + ,doc-string + (interactive) + (table--finish-delayed-tasks) + (table-recognize-cell 'force) + (table-with-cache-buffer + (call-interactively ',command) + (table--untabify (point-min) (point-max)) + (table--fill-region (point-min) (point-max)) + (setq table-inhibit-auto-fill-paragraph t)) + (table--finish-delayed-tasks))) + (push (cons command func-symbol) + table-command-remap-alist))) ;; Formatting Group -(mapc - (lambda (command) - (let ((func-symbol (intern (format "*table--cell-%s" command))) - (doc-string (format "Table remapped function for `%s'." command))) - (fset func-symbol - `(lambda - (&rest args) - ,doc-string - (interactive) - (table--finish-delayed-tasks) - (table-recognize-cell 'force) - (table-with-cache-buffer - (let ((fill-column table-cell-info-width)) - (call-interactively ',command)) - (setq table-inhibit-auto-fill-paragraph t)) - (table--finish-delayed-tasks))) - (setq table-command-remap-alist - (cons (cons command func-symbol) - table-command-remap-alist)))) - '(center-line - center-region - center-paragraph - fill-paragraph)) +(dolist (command + '(center-line + center-region + center-paragraph + fill-paragraph)) + (let ((func-symbol (intern (format "*table--cell-%s" command))) + (doc-string (format "Table remapped function for `%s'." command))) + (fset func-symbol + `(lambda + (&rest args) + ,doc-string + (interactive) + (table--finish-delayed-tasks) + (table-recognize-cell 'force) + (table-with-cache-buffer + (let ((fill-column table-cell-info-width)) + (call-interactively ',command)) + (setq table-inhibit-auto-fill-paragraph t)) + (table--finish-delayed-tasks))) + (push (cons command func-symbol) + table-command-remap-alist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -2581,7 +2542,7 @@ a negative argument ARG = -N means move forward N cells." DIRECTION is one of symbols; right, left, above or below." (interactive (list - (let* ((dummy (barf-if-buffer-read-only)) + (let* ((_ (barf-if-buffer-read-only)) (direction-list (let* ((tmp (delete nil (mapcar (lambda (d) @@ -2605,40 +2566,35 @@ DIRECTION is one of symbols; right, left, above or below." (table-recognize-cell 'force) (unless (table--cell-can-span-p direction) (error "Can't span %s" (symbol-name direction))) - ;; prepare beginning and ending positions of the border bar to strike through - (let ((beg (cond - ((eq direction 'right) - (save-excursion - (table--goto-coordinate + ;; Prepare beginning and end positions of the border bar to strike through. + (let ((beg (save-excursion + (table--goto-coordinate + (cond + ((eq direction 'right) (cons (car table-cell-info-rb-coordinate) - (1- (cdr table-cell-info-lu-coordinate))) 'no-extension))) - ((eq direction 'below) - (save-excursion - (table--goto-coordinate + (1- (cdr table-cell-info-lu-coordinate)))) + ((eq direction 'below) (cons (1- (car table-cell-info-lu-coordinate)) - (1+ (cdr table-cell-info-rb-coordinate))) 'no-extension))) - (t - (save-excursion - (table--goto-coordinate + (1+ (cdr table-cell-info-rb-coordinate)))) + (t (cons (1- (car table-cell-info-lu-coordinate)) - (1- (cdr table-cell-info-lu-coordinate))) 'no-extension))))) - (end (cond - ((eq direction 'left) - (save-excursion - (table--goto-coordinate + (1- (cdr table-cell-info-lu-coordinate))))) + 'no-extension))) + (end (save-excursion + (table--goto-coordinate + (cond + ((eq direction 'left) (cons (car table-cell-info-lu-coordinate) - (1+ (cdr table-cell-info-rb-coordinate))) 'no-extension))) - ((eq direction 'above) - (save-excursion - (table--goto-coordinate + (1+ (cdr table-cell-info-rb-coordinate)))) + ((eq direction 'above) (cons (1+ (car table-cell-info-rb-coordinate)) - (1- (cdr table-cell-info-lu-coordinate))) 'no-extension))) - (t - (save-excursion - (table--goto-coordinate + (1- (cdr table-cell-info-lu-coordinate)))) + (t (cons (1+ (car table-cell-info-rb-coordinate)) - (1+ (cdr table-cell-info-rb-coordinate))) 'no-extension)))))) - ;; replace the bar with blank space while taking care of edges to be border or intersection + (1+ (cdr table-cell-info-rb-coordinate))))) + 'no-extension)))) + ;; Replace the bar with blank space while taking care of edges to be border + ;; or intersection. (save-excursion (goto-char beg) (if (memq direction '(left right)) @@ -2832,7 +2788,7 @@ Creates a cell on the left and a cell on the right of the current point location ORIENTATION is a symbol either horizontally or vertically." (interactive (list - (let* ((dummy (barf-if-buffer-read-only)) + (let* ((_ (barf-if-buffer-read-only)) (completion-ignore-case t) (default (car table-cell-split-orientation-history))) (intern (downcase (completing-read @@ -2852,7 +2808,7 @@ ORIENTATION is a symbol either horizontally or vertically." WHAT is a symbol 'cell, 'row or 'column. JUSTIFY is a symbol 'left, 'center, 'right, 'top, 'middle, 'bottom or 'none." (interactive - (list (let* ((dummy (barf-if-buffer-read-only)) + (list (let* ((_ (barf-if-buffer-read-only)) (completion-ignore-case t) (default (car table-target-history))) (intern (downcase (completing-read @@ -2910,17 +2866,18 @@ JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top, (table--justify-cell-contents justify)))))) ;;;###autoload -(defun table-fixed-width-mode (&optional arg) - "Toggle fixing width mode. -In the fixed width mode, typing inside a cell never changes the cell -width where in the normal mode the cell width expands automatically in -order to prevent a word being folded into multiple lines." - (interactive "P") +(define-minor-mode table-fixed-width-mode + "Cell width is fixed when this is non-nil. +Normally it should be nil for allowing automatic cell width expansion +that widens a cell when it is necessary. When non-nil, typing in a +cell does not automatically expand the cell width. A word that is too +long to fit in a cell is chopped into multiple lines. The chopped +location is indicated by `table-word-continuation-char'. This +variable's value can be toggled by \\[table-fixed-width-mode] at +run-time." + :tag "Fix Cell Width" + :group 'table (table--finish-delayed-tasks) - (setq table-fixed-width-mode - (if (null arg) - (not table-fixed-width-mode) - (> (prefix-numeric-value arg) 0))) (table--update-cell-face)) ;;;###autoload @@ -3004,7 +2961,7 @@ CALS (DocBook DTD): URL `http://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751' " (interactive - (let* ((dummy (unless (table--probe-cell) (error "Table not found here"))) + (let* ((_ (unless (table--probe-cell) (error "Table not found here"))) (completion-ignore-case t) (default (car table-source-language-history)) (language (downcase (completing-read @@ -3093,7 +3050,7 @@ CALS (DocBook DTD): ))) dest-buffer)) -(defun table--generate-source-prologue (dest-buffer language caption col-list row-list) +(defun table--generate-source-prologue (dest-buffer language caption col-list _row-list) "Generate and insert source prologue into DEST-BUFFER." (with-current-buffer dest-buffer (cond @@ -3121,7 +3078,7 @@ CALS (DocBook DTD): (insert (format " <%s valign=\"top\">\n" (table-get-source-info 'row-type)))) ))) -(defun table--generate-source-epilogue (dest-buffer language col-list row-list) +(defun table--generate-source-epilogue (dest-buffer language _col-list _row-list) "Generate and insert source epilogue into DEST-BUFFER." (with-current-buffer dest-buffer (cond @@ -3133,14 +3090,12 @@ CALS (DocBook DTD): (set-marker-insertion-type (table-get-source-info 'colspec-marker) t) ;; insert before (save-excursion (goto-char (table-get-source-info 'colspec-marker)) - (mapc - (lambda (col) - (insert (format " <colspec colnum=\"%d\" colname=\"c%d\"/>\n" col col))) - (sort (table-get-source-info 'colnum-list) '<))) + (dolist (col (sort (table-get-source-info 'colnum-list) '<)) + (insert (format " <colspec colnum=\"%d\" colname=\"c%d\"/>\n" col col)))) (insert (format " </%s>\n </tgroup>\n</table>\n" (table-get-source-info 'row-type)))) ))) -(defun table--generate-source-scan-rows (dest-buffer language origin-cell col-list row-list) +(defun table--generate-source-scan-rows (dest-buffer language _origin-cell col-list row-list) "Generate and insert source rows into DEST-BUFFER." (table-put-source-info 'current-row 1) (while row-list @@ -3286,7 +3241,7 @@ CALS (DocBook DTD): "Test if character C is one of the horizontal characters" (memq c (string-to-list table-cell-horizontal-chars))) -(defun table--generate-source-scan-lines (dest-buffer language origin-cell tail-cell col-list row-list) +(defun table--generate-source-scan-lines (dest-buffer _language origin-cell tail-cell col-list row-list) "Scan the table line by line. Currently this method is for LaTeX only." (let* ((lu-coord (table--get-coordinate (car origin-cell))) @@ -3403,8 +3358,7 @@ Example: (table-insert 16 8 5 1) (table-insert-sequence \"@\" 0 1 2 'right) (table-forward-cell 1) - (table-insert-sequence \"64\" 0 1 2 'left)) -" + (table-insert-sequence \"64\" 0 1 2 'left))" (interactive (progn (barf-if-buffer-read-only) @@ -3896,36 +3850,34 @@ converts a table into plain text without frames. It is a companion to (defun table--make-cell-map () "Make the table cell keymap if it does not exist yet." - ;; this is irrelevant to keymap but good place to make sure to be executed + ;; This is irrelevant to keymap but good place to make sure to be executed. (table--update-cell-face) (unless table-cell-map - (let ((map (make-sparse-keymap)) - (remap-alist table-command-remap-alist)) - ;; table-command-prefix mode specific bindings + (let ((map (make-sparse-keymap))) + ;; `table-command-prefix' mode specific bindings. (if (vectorp table-command-prefix) - (mapc (lambda (binding) - (let ((seq (copy-sequence (car binding)))) - (and (vectorp seq) - (listp (aref seq 0)) - (eq (car (aref seq 0)) 'control) - (progn - (aset seq 0 (cadr (aref seq 0))) - (define-key map (vconcat table-command-prefix seq) (cdr binding)))))) - table-cell-bindings)) - ;; shorthand control bindings - (mapc (lambda (binding) - (define-key map (car binding) (cdr binding))) - table-cell-bindings) - ;; remap normal commands to table specific version - (while remap-alist - (define-key map (vector 'remap (caar remap-alist)) (cdar remap-alist)) - (setq remap-alist (cdr remap-alist))) + (dolist (binding table-cell-bindings) + (let ((seq (copy-sequence (car binding)))) + (and (vectorp seq) + (listp (aref seq 0)) + (eq (car (aref seq 0)) 'control) + (progn + (aset seq 0 (cadr (aref seq 0))) + (define-key map (vconcat table-command-prefix seq) + (cdr binding))))))) + ;; Shorthand control bindings. + (dolist (binding table-cell-bindings) + (define-key map (car binding) (cdr binding))) + ;; Remap normal commands to table specific version. + (dolist (remap table-command-remap-alist) + (define-key map (vector 'remap (car remap)) (cdr remap))) ;; (setq table-cell-map map) (fset 'table-cell-map map))) - ;; add menu for table cells + ;; Add menu for table cells. (unless table-disable-menu - (easy-menu-define table-cell-menu-map table-cell-map "Table cell menu" table-cell-menu) + (easy-menu-define table-cell-menu-map table-cell-map + "Table cell menu" table-cell-menu) (if (featurep 'xemacs) (easy-menu-add table-cell-menu))) (run-hooks 'table-cell-map-hook)) @@ -4092,6 +4044,8 @@ key binding table-cell-bindings) (help-print-return-message)))) +(defvar dabbrev-abbrev-char-regexp) + (defun *table--cell-dabbrev-expand (arg) "Table cell version of `dabbrev-expand'." (interactive "*P") @@ -4291,38 +4245,16 @@ cache buffer into the designated cell in the table buffer." (car (table--get-coordinate (cdr (table--horizontal-cell-list nil t)))) (1+ (cdr (table--get-coordinate (cdr (table--vertical-cell-list nil t)))))))) -(defun table-call-interactively (function &optional record-flag keys) - "Call FUNCTION, or a table version of it if applicable. -See `call-interactively' for full description of the arguments." - (let ((table-func (intern-soft (format "*table--cell-%s" function)))) - (call-interactively - (if (and table-func - (table--point-in-cell-p)) - table-func - function) record-flag keys))) - -(defun table-funcall (function &rest arguments) - "Call FUNCTION, or a table version of it if applicable. -See `funcall' for full description of the arguments." +(defun table-function (function) + ;; FIXME: Apparently unused. There used to be table-funcall, table-apply, + ;; and table-call-interactively instead, neither of which seemed to be + ;; used either. + "Return FUNCTION, or a table version of it if applicable." (let ((table-func (intern-soft (format "*table--cell-%s" function)))) - (apply - (if (and table-func + (if (and table-func (table--point-in-cell-p)) table-func - function) - arguments))) - -(defmacro table-apply (function &rest arguments) - "Call FUNCTION, or a table version of it if applicable. -See `apply' for full description of the arguments." - (let ((table-func (make-symbol "table-func"))) - `(let ((,table-func (intern-soft (format "*table--cell-%s" ,function)))) - (apply - (if (and ,table-func - (table--point-in-cell-p)) - ,table-func - ,function) - ,@arguments)))) + function))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -5124,7 +5056,7 @@ Focus only on the corner pattern. Further cell validity check is required." (throw 'retry-vertical nil)) (t (throw 'retry-horizontal nil))))))))))))) -(defun table--editable-cell-p (&optional abort-on-error) +(defun table--editable-cell-p (&optional _abort-on-error) (and (not buffer-read-only) (get-text-property (point) 'table-cell))) @@ -5310,7 +5242,7 @@ instead of the current buffer and returns the OBJECT." "Put cell's vertical alignment property." (table--put-property cell 'table-valign valign)) -(defun table--point-entered-cell-function (&optional old-point new-point) +(defun table--point-entered-cell-function (&optional _old-point _new-point) "Point has entered a cell. Refresh the menu bar." ;; Avoid calling point-motion-hooks recursively. @@ -5322,7 +5254,7 @@ Refresh the menu bar." (table--warn-incompatibility) (run-hooks 'table-point-entered-cell-hook)))) -(defun table--point-left-cell-function (&optional old-point new-point) +(defun table--point-left-cell-function (&optional _old-point _new-point) "Point has left a cell. Refresh the menu bar." ;; Avoid calling point-motion-hooks recursively. diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index a00d748a4a4..01248a91cf2 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,10 @@ +2012-10-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-http.el (url-http-user-agent-string): Leak less info. + (url-http, url-http-file-exists-p, url-http-file-readable-p) + (url-http-file-attributes, url-http-options, url-https-default-port) + (url-https-asynchronous-p): Don't autoload. + 2012-09-30 Stefan Monnier <monnier@iro.umontreal.ca> * url-handlers.el (url-file-handler): Don't assume any url-FOO function diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 18d28e89f78..85b6efcde0d 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -215,17 +215,11 @@ request.") (and (listp url-privacy-level) (memq 'agent url-privacy-level))) "" - (format "User-Agent: %sURL/%s%s\r\n" + (format "User-Agent: %sURL/%s\r\n" (if url-package-name (concat url-package-name "/" url-package-version " ") "") - url-version - (cond - ((and url-os-type url-system-type) - (concat " (" url-os-type "; " url-system-type ")")) - ((or url-os-type url-system-type) - (concat " (" (or url-system-type url-os-type) ")")) - (t ""))))) + url-version))) (defun url-http-create-request (&optional ref-url) "Create an HTTP request for `url-http-target-url', referred to by REF-URL." @@ -1153,7 +1147,6 @@ the end of the document." (when (eq process-buffer (current-buffer)) (goto-char (point-max))))) -;;;###autoload (defun url-http (url callback cbargs &optional retry-buffer) "Retrieve URL via HTTP asynchronously. URL must be a parsed URL. See `url-generic-parse-url' for details. @@ -1299,7 +1292,6 @@ previous `url-http' call, which is being re-attempted." (url-request-data nil)) (url-retrieve-synchronously url))) -;;;###autoload (defun url-http-file-exists-p (url) (let ((status nil) (exists nil) @@ -1313,7 +1305,6 @@ previous `url-http' call, which is being re-attempted." (kill-buffer buffer)) exists)) -;;;###autoload (defalias 'url-http-file-readable-p 'url-http-file-exists-p) (defun url-http-head-file-attributes (url &optional id-format) @@ -1333,13 +1324,11 @@ previous `url-http' call, which is being re-attempted." (declare-function url-dav-file-attributes "url-dav" (url &optional id-format)) -;;;###autoload (defun url-http-file-attributes (url &optional id-format) (if (url-dav-supported-p url) (url-dav-file-attributes url id-format) (url-http-head-file-attributes url id-format))) -;;;###autoload (defun url-http-options (url) "Return a property list describing options available for URL. This list is retrieved using the `OPTIONS' HTTP method. @@ -1417,9 +1406,7 @@ p3p ;; with url-http.el on systems with 8-character file names. (require 'tls) -;;;###autoload (defconst url-https-default-port 443 "Default HTTPS port.") -;;;###autoload (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.") ;; FIXME what is the point of this alias being an autoload? diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index fb6f8d4d58b..5a378df6513 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -136,12 +136,10 @@ this variable." :type 'boolean :group 'change-log) -(defcustom add-log-buffer-file-name-function nil +(defvar add-log-buffer-file-name-function 'buffer-file-name "If non-nil, function to call to identify the full filename of a buffer. -This function is called with no argument. If this is nil, the default is to -use `buffer-file-name'." - :type '(choice (const nil) function) - :group 'change-log) +This function is called with no argument. The default is to +use `buffer-file-name'.") (defcustom add-log-file-name-function nil "If non-nil, function to call to identify the filename for a ChangeLog entry. @@ -806,9 +804,7 @@ non-nil, otherwise in local time." (let* ((defun (add-log-current-defun)) (version (and change-log-version-info-enabled (change-log-version-number-search))) - (buf-file-name (if add-log-buffer-file-name-function - (funcall add-log-buffer-file-name-function) - buffer-file-name)) + (buf-file-name (funcall add-log-buffer-file-name-function)) (buffer-file (if buf-file-name (expand-file-name buf-file-name))) (file-name (expand-file-name (find-change-log file-name buffer-file))) ;; Set ITEM to the file name to use in the new item. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 11ec785b647..0e79c962b47 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -565,11 +565,24 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error." (goto-char (match-beginning 1)) (beginning-of-line))) +(defvar diff--auto-refine-data nil) + ;; Define diff-{hunk,file}-{prev,next} (easy-mmode-define-navigation diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view - (if diff-auto-refine-mode - (condition-case-unless-debug nil (diff-refine-hunk) (error nil)))) + (when diff-auto-refine-mode + (setq diff--auto-refine-data (cons (current-buffer) (point-marker))) + (run-at-time 0.0 nil + (lambda () + (when diff--auto-refine-data + (let ((buffer (car diff--auto-refine-data)) + (point (cdr diff--auto-refine-data))) + (setq diff--auto-refine-data nil) + (with-local-quit + (when (buffer-live-p buffer) + (with-current-buffer buffer + (goto-char point) + (diff-refine-hunk)))))))))) (easy-mmode-define-navigation diff-file diff-file-header-re "file" diff-end-of-file) @@ -1317,6 +1330,9 @@ a diff with \\[diff-reverse-direction]. \\{diff-mode-map}" (set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults) + (add-hook 'font-lock-mode-hook + (lambda () (remove-overlays nil nil 'diff-mode 'fine)) + nil 'local) (set (make-local-variable 'outline-regexp) diff-outline-regexp) (set (make-local-variable 'imenu-generic-expression) diff-imenu-generic-expression) @@ -1390,6 +1406,8 @@ modified lines of the diff." (set (make-local-variable 'whitespace-style) '(face trailing)) (let ((style (save-excursion (goto-char (point-min)) + ;; FIXME: For buffers filled from async processes, this search + ;; will simply fail because the buffer is still empty :-( (when (re-search-forward diff-hunk-header-re nil t) (goto-char (match-beginning 0)) (diff-hunk-style))))) @@ -1899,7 +1917,7 @@ For use in `add-log-current-defun-function'." '((default :inherit diff-refine-change) (((class color) (min-colors 88) (background light)) - :background "#ffaaaa") + :background "#ffbbbb") (((class color) (min-colors 88) (background dark)) :background "#aa2222")) "Face used for removed characters shown by `diff-refine-hunk'." diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 2c41ce8c457..65776dfccad 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -979,7 +979,7 @@ this variable represents.") (defface ediff-fine-diff-A (if (featurep 'emacs) '((((class color) (min-colors 88) (background light)) - :background "#ffaaaa") + :background "#ffbbbb") (((class color) (min-colors 88) (background dark)) :background "#aa2222") (((class color) (min-colors 16)) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 932abb9818c..3c34a762a1b 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -341,7 +341,7 @@ automatically." (defvar log-edit-font-lock-keywords ;; Copied/inspired by message-font-lock-keywords. `((log-edit-match-to-eoh - (,(concat "^\\(\\([[:alpha:]]+\\):\\)" log-edit-header-contents-regexp) + (,(concat "^\\(\\([[:alpha:]-]+\\):\\)" log-edit-header-contents-regexp) (progn (goto-char (match-beginning 0)) (match-end 0)) nil (1 (if (assoc-string (match-string 2) log-edit-headers-alist t) 'log-edit-header @@ -900,14 +900,44 @@ Rename relative filenames in the ChangeLog entry as FILES." (insert "\n")) log-edit-author)) +(defun log-edit-toggle-header (header value) + "Toggle a boolean-type header in the current buffer. +If the value of HEADER is VALUE, clear it. Otherwise, add the +header if it's not present and set it to VALUE. Then make sure +there is an empty line after the headers. Return t if toggled +on, otherwise nil." + (let ((val t) + (line (concat header ": " value "\n"))) + (save-excursion + (save-restriction + (rfc822-goto-eoh) + (narrow-to-region (point-min) (point)) + (goto-char (point-min)) + (if (re-search-forward (concat "^" header ":" + log-edit-header-contents-regexp) + nil t) + (if (setq val (not (string= (match-string 1) value))) + (replace-match line t t) + (replace-match "" t t nil 1)) + (insert line))) + (rfc822-goto-eoh) + (delete-horizontal-space) + (unless (looking-at "\n") + (insert "\n"))) + val)) + (defun log-edit-extract-headers (headers comment) "Extract headers from COMMENT to form command line arguments. -HEADERS should be an alist with elements of the form (HEADER . CMDARG) -associating header names to the corresponding cmdline option name and the -result is then a list of the form (MSG CMDARG1 HDRTEXT1 CMDARG2 HDRTEXT2...). -where MSG is the remaining text from STRING. -If \"Summary\" is not in HEADERS, then the \"Summary\" header is extracted -anyway and put back as the first line of MSG." +HEADERS should be an alist with elements (HEADER . CMDARG) +or (HEADER . FUNCTION) associating headers to command line +options and the result is then a list of the form (MSG ARGUMENTS...) +where MSG is the remaining text from COMMENT. +FUNCTION should be a function of one argument that takes the +header value and returns the list of strings to be appended to +ARGUMENTS. CMDARG will be added to ARGUMENTS followed by the +header value. If \"Summary\" is not in HEADERS, then the +\"Summary\" header is extracted anyway and put back as the first +line of MSG." (with-temp-buffer (insert comment) (rfc822-goto-eoh) @@ -923,8 +953,10 @@ anyway and put back as the first line of MSG." nil t) (if (eq t (cdr header)) (setq summary (match-string 1)) - (push (match-string 1) res) - (push (or (cdr header) (car header)) res)) + (if (functionp (cdr header)) + (setq res (nconc res (funcall (cdr header) (match-string 1)))) + (push (match-string 1) res) + (push (or (cdr header) (car header)) res))) (replace-match "" t t))) ;; Remove header separator if the header is empty. (widen) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index babcf6f1beb..7037b606fe7 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -132,7 +132,7 @@ Used in `smerge-diff-base-mine' and related functions." '((default :inherit smerge-refined-change) (((class color) (min-colors 88) (background light)) - :background "#ffaaaa") + :background "#ffbbbb") (((class color) (min-colors 88) (background dark)) :background "#aa2222") (t :inverse-video t)) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index ea9ce949ccb..5d7cb366e82 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -608,16 +608,52 @@ The car of the list is the current branch." (defun vc-git-unregister (file) (vc-git-command nil 0 file "rm" "-f" "--cached" "--")) +(declare-function log-edit-mode "log-edit" ()) +(declare-function log-edit-toggle-header "log-edit" (header value)) (declare-function log-edit-extract-headers "log-edit" (headers string)) +(defun vc-git-log-edit-toggle-signoff () + "Toggle whether to add the \"Signed-off-by\" line at the end of +the commit message." + (interactive) + (log-edit-toggle-header "Sign-Off" "yes")) + +(defun vc-git-log-edit-toggle-amend () + "Toggle whether this will amend the previous commit. +If toggling on, also insert its message into the buffer." + (interactive) + (when (log-edit-toggle-header "Amend" "yes") + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert (with-output-to-string + (vc-git-command + standard-output 1 nil + "log" "--max-count=1" "--pretty=format:%B" "HEAD"))))) + +(defvar vc-git-log-edit-mode-map + (let ((map (make-sparse-keymap "Git-Log-Edit"))) + (define-key map "\C-c\C-s" 'vc-git-log-edit-toggle-signoff) + (define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend) + map)) + +(define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git" + "Major mode for editing Git log messages. +It is based on `log-edit-mode', and has Git-specific extensions.") + (defun vc-git-checkin (files _rev comment) (let ((coding-system-for-write vc-git-commits-coding-system)) - (apply 'vc-git-command nil 0 files - (nconc (list "commit" "-m") - (log-edit-extract-headers '(("Author" . "--author") - ("Date" . "--date")) - comment) - (list "--only" "--"))))) + (cl-flet ((boolean-arg-fn + (argument) + (lambda (value) (when (equal value "yes") (list argument))))) + (apply 'vc-git-command nil 0 files + (nconc (list "commit" "-m") + (log-edit-extract-headers + `(("Author" . "--author") + ("Date" . "--date") + ("Amend" . ,(boolean-arg-fn "--amend")) + ("Sign-Off" . ,(boolean-arg-fn "--signoff"))) + comment) + (list "--only" "--")))))) (defun vc-git-find-revision (file rev buffer) (let* (process-file-side-effects diff --git a/lisp/window.el b/lisp/window.el index 811b1781b4c..41af7f9f44b 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -701,7 +701,7 @@ SIDE. Return the new window, nil if its creation window failed." (set-window-parameter new 'delete-window 'delete-side-window) ;; Auto-adjust height/width of new window unless a size has been ;; explicitly requested. - (unless (if left-or-right + (unless (if left-or-right (cdr (assq 'window-width alist)) (cdr (assq 'window-height alist))) (setq alist @@ -5615,7 +5615,7 @@ the selected one." buffer window 'reuse alist display-buffer-mark-dedicated))))) (defun display-buffer-at-bottom (buffer alist) - "Try displaying BUFFER in a window at the botom of the selected frame. + "Try displaying BUFFER in a window at the bottom of the selected frame. This either splits the window at the bottom of the frame or the frame's root window, or reuses an existing window at the bottom of the selected frame." diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog index 7d49d9b531b..80d29bc5d8a 100644 --- a/lwlib/ChangeLog +++ b/lwlib/ChangeLog @@ -1,3 +1,7 @@ +2012-10-06 Ulrich Müller <ulm@gentoo.org> + + * Makefile.in (AR, ARFLAGS): Get values from configure. + 2012-08-16 Paul Eggert <eggert@cs.ucla.edu> Use ASCII tests for character types. diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in index 2e70e0a4b6d..85a76f7a1c2 100644 --- a/lwlib/Makefile.in +++ b/lwlib/Makefile.in @@ -37,7 +37,8 @@ CFLAGS=@CFLAGS@ CPPFLAGS=@CPPFLAGS@ RANLIB=@RANLIB@ -AR = ar cq +AR = @AR@ +ARFLAGS = @ARFLAGS@ LUCID_OBJS = lwlib-Xlw.o xlwmenu.o lwlib-Xaw.o MOTIF_OBJS = lwlib-Xm.o @@ -65,7 +66,7 @@ all:: liblw.a liblw.a: $(OBJS) rm -f $@ - $(AR) $@ $(OBJS) + $(AR) $(ARFLAGS) $@ $(OBJS) $(RANLIB) $@ ## Generated files in ../src, non-generated in $(srcdir)/../src. diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 2760efb3f27..f3cb23be1cd 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 4 +# manywarnings.m4 serial 5 dnl Copyright (C) 2008-2012 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -35,14 +35,12 @@ AC_DEFUN([gl_MANYWARN_COMPLEMENT], # make sure your gcc understands it. AC_DEFUN([gl_MANYWARN_ALL_GCC], [ - dnl First, check if -Wno-missing-field-initializers is needed. - dnl -Wmissing-field-initializers is implied by -W, but that issues - dnl warnings with GCC version before 4.7, for the common idiom - dnl of initializing types on the stack to zero, using { 0, } + dnl First, check for some issues that only occur when combining multiple + dnl gcc warning categories. AC_REQUIRE([AC_PROG_CC]) if test -n "$GCC"; then - dnl First, check -W -Werror -Wno-missing-field-initializers is supported + dnl Check if -W -Werror -Wno-missing-field-initializers is supported dnl with the current $CC $CFLAGS $CPPFLAGS. AC_MSG_CHECKING([whether -Wno-missing-field-initializers is supported]) AC_CACHE_VAL([gl_cv_cc_nomfi_supported], [ @@ -77,8 +75,24 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], ]) AC_MSG_RESULT([$gl_cv_cc_nomfi_needed]) fi + + dnl Next, check if -Werror -Wuninitialized is useful with the + dnl user's choice of $CFLAGS; some versions of gcc warn that it + dnl has no effect if -O is not also used + AC_MSG_CHECKING([whether -Wuninitialized is supported]) + AC_CACHE_VAL([gl_cv_cc_uninitialized_supported], [ + gl_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Werror -Wuninitialized" + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[]], [[]])], + [gl_cv_cc_uninitialized_supported=yes], + [gl_cv_cc_uninitialized_supported=no]) + CFLAGS="$gl_save_CFLAGS"]) + AC_MSG_RESULT([$gl_cv_cc_uninitialized_supported]) + fi + # List all gcc warning categories. gl_manywarn_set= for gl_manywarn_item in \ -W \ @@ -197,10 +211,14 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item" done - # Disable the missing-field-initializers warning if needed + # Disable specific options as needed. if test "$gl_cv_cc_nomfi_needed" = yes; then gl_manywarn_set="$gl_manywarn_set -Wno-missing-field-initializers" fi + if test "$gl_cv_cc_uninitialized_supported" = no; then + gl_manywarn_set="$gl_manywarn_set -Wno-uninitialized" + fi + $1=$gl_manywarn_set ]) diff --git a/m4/pselect.m4 b/m4/pselect.m4 index 97bf12cd2d6..5edacd28f85 100644 --- a/m4/pselect.m4 +++ b/m4/pselect.m4 @@ -1,4 +1,4 @@ -# pselect.m4 +# pselect.m4 serial 2 dnl Copyright (C) 2011-2012 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -23,6 +23,44 @@ AC_DEFUN([gl_FUNC_PSELECT], return !p;]])], [gl_cv_sig_pselect=yes], [gl_cv_sig_pselect=no])]) + + dnl On FreeBSD 8.2, pselect() doesn't always reject bad fds. + AC_CACHE_CHECK([whether pselect detects invalid fds], + [gl_cv_func_pselect_detects_ebadf], + [ + AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +#include <sys/types.h> +#include <sys/time.h> +#if HAVE_SYS_SELECT_H +# include <sys/select.h> +#endif +#include <unistd.h> +#include <errno.h> +]],[[ + fd_set set; + dup2(0, 16); + FD_ZERO(&set); + FD_SET(16, &set); + close(16); + struct timespec timeout; + timeout.tv_sec = 0; + timeout.tv_nsec = 5000; + return pselect (17, &set, NULL, NULL, &timeout, NULL) != -1 || errno != EBADF; +]])], [gl_cv_func_pselect_detects_ebadf=yes], + [gl_cv_func_pselect_detects_ebadf=no], + [ + case "$host_os" in + # Guess yes on glibc systems. + *-gnu*) gl_cv_func_pselect_detects_ebadf="guessing yes" ;; + # If we don't know, assume the worst. + *) gl_cv_func_pselect_detects_ebadf="guessing no" ;; + esac + ]) + ]) + case $gl_cv_func_pselect_detects_ebadf in + *yes) ;; + *) REPLACE_PSELECT=1 ;; + esac fi if test $ac_cv_func_pselect = no || test $gl_cv_sig_pselect = no; then diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index ab43728ace4..9c69f2e4d15 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -102,6 +102,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], REPLACE_MALLOC=0; AC_SUBST([REPLACE_MALLOC]) REPLACE_MBTOWC=0; AC_SUBST([REPLACE_MBTOWC]) REPLACE_MKSTEMP=0; AC_SUBST([REPLACE_MKSTEMP]) + REPLACE_PTSNAME=0; AC_SUBST([REPLACE_PTSNAME]) REPLACE_PTSNAME_R=0; AC_SUBST([REPLACE_PTSNAME_R]) REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV]) REPLACE_RANDOM_R=0; AC_SUBST([REPLACE_RANDOM_R]) diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4 index 8af3353ea51..f45dee1dc4d 100644 --- a/m4/sys_stat_h.m4 +++ b/m4/sys_stat_h.m4 @@ -1,4 +1,4 @@ -# sys_stat_h.m4 serial 28 -*- Autoconf -*- +# sys_stat_h.m4 serial 27 -*- Autoconf -*- dnl Copyright (C) 2006-2012 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -11,6 +11,9 @@ AC_DEFUN([gl_HEADER_SYS_STAT_H], [ AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS]) + dnl For the mkdir substitute. + AC_REQUIRE([AC_C_INLINE]) + dnl Check for broken stat macros. AC_REQUIRE([AC_HEADER_STAT]) diff --git a/msdos/ChangeLog b/msdos/ChangeLog index 525868b2c70..d3d9bc657cc 100644 --- a/msdos/ChangeLog +++ b/msdos/ChangeLog @@ -1,3 +1,8 @@ +2012-10-04 Paul Eggert <eggert@cs.ucla.edu> + + Merge from gnulib. + * msdos/sedlibmk.inp (REPLACE_PTSNAME): Edit to appropriate value. + 2012-09-27 Paul Eggert <eggert@cs.ucla.edu> Check more robustly for timer_settime. diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 67719cffbd4..9879947ca45 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -541,6 +541,7 @@ am__cd = cd /^REPLACE_PRINTF *=/s/@REPLACE_PRINTF@/0/ /^REPLACE_PTHREAD_SIGMASK *=/s/@REPLACE_PTHREAD_SIGMASK@/0/ /^REPLACE_PSELECT *=/s/@REPLACE_PSELECT@/0/ +/^REPLACE_PTSNAME *=/s/@REPLACE_PTSNAME@/0/ /^REPLACE_PTSNAME_R *=/s/@REPLACE_PTSNAME_R@/0/ /^REPLACE_PUTENV *=/s/@REPLACE_PUTENV@/0/ /^REPLACE_PWRITE *=/s/@REPLACE_PWRITE@/0/ diff --git a/nt/ChangeLog b/nt/ChangeLog index 7e064cc3e42..b0dcb9982f1 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,64 @@ +2012-10-02 Eli Zaretskii <eliz@gnu.org> + + * preprep.c (RVA_TO_PTR): Cast the result to 'void *', to avoid + compiler warnings when using the value. + +2012-10-01 Eli Zaretskii <eliz@gnu.org> + + * preprep.c (RVA_TO_PTR): Use 'unsigned char *' instead of + 'void *', for pointer arithmetics. + (OFFSET_TO_RVA, RVA_TO_OFFSET, RVA_TO_SECTION_OFFSET): Enclose all + macro arguments in parentheses. + +2012-09-30 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in ($(TRES)): Use $(EMACS_MANIFEST). + +2012-09-30 Fabrice Popineau <fabrice.popineau@supelec.fr> + + * inc/sys/socket.h: Don't map Winsock error codes to standard ones + that are already defined. + + * inc/ms-w32.h (EMACS_INT, EMACS_UINT, EMACS_INT_MAX, PRIuMAX) + (pI, _INTPTR) [_MSC_VER]: Fix definitions for MSVC. + [_MSC_VER]: Add pragmas to suppress some MSVC warnings. + + * preprep.c (pfnCheckSumMappedFile, rva_to_section) + (offset_to_section, relocate_offset, OFFSET_TO_RVA) + (RVA_TO_OFFSET, RVA_TO_SECTION_OFFSET, PTR_TO_RVA) + (OFFSET_TO_PTR, ROUND_UP, ROUND_DOWN) + (copy_executable_and_move_sections, ADJUST_IMPORT_RVA, main): Use + DWORD_PTR instead of DWORD for compatibility with x64. + + * nmake.defs: Support AMD64. + (EMACS_HEAPSIZE, EMACS_PURESIZE, EMACS_MANIFEST): New macros. + + * gmake.defs: (EMACS_HEAPSIZE, EMACS_PURESIZE, EMACS_MANIFEST): + New macros. + + * addsection.c (pfnCheckSumMappedFile, rva_to_section) + (offset_to_section, relocate_offset, OFFSET_TO_RVA) + (RVA_TO_OFFSET, RVA_TO_SECTION_OFFSET, PTR_TO_RVA) + (OFFSET_TO_PTR, ROUND_UP, ROUND_DOWN) + (copy_executable_and_add_section, main): Use DWORD_PTR instead of + DWORD, for compatibility with x64. + + * emacs-x64.manifest: New file. + + * emacs-x86.manifest: Renamed from emacs.manifest. + +2012-09-30 Eli Zaretskii <eliz@gnu.org> + + * inc/sys/time.h (ITIMER_REAL, ITIMER_PROF): Define. + (struct itimerval): Define. + (getitimer, setitimer): Add prototypes. + + * inc/ms-w32.h <sigset_t> [_MSVC_VER]: Make the typedef consistent + with MinGW. + (SA_RESTART, SIGPROF): Define. + + * config.nt (HAVE_SETITIMER): Define to 1. + 2012-09-30 Juanma Barranquero <lekktu@gmail.com> * config.nt: Sync with autogen/config.in. diff --git a/nt/addsection.c b/nt/addsection.c index ac3dd913f17..d720dec428f 100644 --- a/nt/addsection.c +++ b/nt/addsection.c @@ -35,10 +35,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. in \\win32sdk\mstools\samples\image\include\imagehlp.h. */ PIMAGE_NT_HEADERS -(__stdcall * pfnCheckSumMappedFile) (LPVOID BaseAddress, - DWORD FileLength, - LPDWORD HeaderSum, - LPDWORD CheckSum); +(__stdcall * pfnCheckSumMappedFile) (PVOID BaseAddress, + DWORD_PTR FileLength, + PDWORD_PTR HeaderSum, + PDWORD_PTR CheckSum); #undef min #undef max @@ -164,7 +164,7 @@ find_section (const char *name, IMAGE_NT_HEADERS *nt_header) /* Return pointer to section header for section containing the given relative virtual address. */ IMAGE_SECTION_HEADER * -rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) +rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header) { PIMAGE_SECTION_HEADER section; int i; @@ -179,7 +179,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) some very old exes (eg. gzip dated Dec 1993). Since w32_executable_type relies on this function to work reliably, we need to cope with this. */ - DWORD real_size = max (section->SizeOfRawData, + DWORD_PTR real_size = max (section->SizeOfRawData, section->Misc.VirtualSize); if (rva >= section->VirtualAddress && rva < section->VirtualAddress + real_size) @@ -192,7 +192,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) /* Return pointer to section header for section containing the given offset in its raw data area. */ IMAGE_SECTION_HEADER * -offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header) +offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header) { PIMAGE_SECTION_HEADER section; int i; @@ -212,8 +212,8 @@ offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header) /* Return offset to an object in dst, given offset in src. We assume there is at least one section in both src and dst images, and that the some sections may have been added to dst (after sections in src). */ -static DWORD -relocate_offset (DWORD offset, +static DWORD_PTR +relocate_offset (DWORD_PTR offset, IMAGE_NT_HEADERS * src_nt_header, IMAGE_NT_HEADERS * dst_nt_header) { @@ -247,32 +247,33 @@ relocate_offset (DWORD offset, } #define OFFSET_TO_RVA(offset, section) \ - (section->VirtualAddress + ((DWORD)(offset) - section->PointerToRawData)) + (section->VirtualAddress + ((DWORD_PTR)(offset) - section->PointerToRawData)) #define RVA_TO_OFFSET(rva, section) \ - (section->PointerToRawData + ((DWORD)(rva) - section->VirtualAddress)) + (section->PointerToRawData + ((DWORD_PTR)(rva) - section->VirtualAddress)) #define RVA_TO_SECTION_OFFSET(rva, section) \ - ((DWORD)(rva) - section->VirtualAddress) + ((DWORD_PTR)(rva) - section->VirtualAddress) /* Convert address in executing image to RVA. */ -#define PTR_TO_RVA(ptr) ((DWORD)(ptr) - (DWORD) GetModuleHandle (NULL)) +#define PTR_TO_RVA(ptr) ((DWORD_PTR)(ptr) - (DWORD_PTR) GetModuleHandle (NULL)) #define PTR_TO_OFFSET(ptr, pfile_data) \ ((unsigned const char *)(ptr) - (pfile_data)->file_base) #define OFFSET_TO_PTR(offset, pfile_data) \ - ((pfile_data)->file_base + (DWORD)(offset)) + ((pfile_data)->file_base + (DWORD_PTR)(offset)) -#define ROUND_UP(p, align) (((DWORD)(p) + (align)-1) & ~((align)-1)) -#define ROUND_DOWN(p, align) ((DWORD)(p) & ~((align)-1)) +#define ROUND_UP(p, align) \ + (((DWORD_PTR)(p) + (align)-1) & ~((DWORD_PTR)(align)-1)) +#define ROUND_DOWN(p, align) ((DWORD_PTR)(p) & ~((DWORD_PTR)(align)-1)) static void copy_executable_and_add_section (file_data *p_infile, file_data *p_outfile, const char *new_section_name, - DWORD new_section_size) + DWORD_PTR new_section_size) { unsigned char *dst; PIMAGE_DOS_HEADER dos_header; @@ -280,7 +281,7 @@ copy_executable_and_add_section (file_data *p_infile, PIMAGE_NT_HEADERS dst_nt_header; PIMAGE_SECTION_HEADER section; PIMAGE_SECTION_HEADER dst_section; - DWORD offset; + DWORD_PTR offset; int i; int be_verbose = GetEnvironmentVariable ("DEBUG_DUMP", NULL, 0) > 0; @@ -317,17 +318,17 @@ copy_executable_and_add_section (file_data *p_infile, Note that dst is updated implicitly by each COPY_CHUNK. */ dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base; - nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + + nt_header = (PIMAGE_NT_HEADERS) (((unsigned char *) dos_header) + dos_header->e_lfanew); section = IMAGE_FIRST_SECTION (nt_header); dst = (unsigned char *) p_outfile->file_base; COPY_CHUNK ("Copying DOS header...", dos_header, - (DWORD) nt_header - (DWORD) dos_header, be_verbose); + (DWORD_PTR) nt_header - (DWORD_PTR) dos_header, be_verbose); dst_nt_header = (PIMAGE_NT_HEADERS) dst; COPY_CHUNK ("Copying NT header...", nt_header, - (DWORD) section - (DWORD) nt_header, be_verbose); + (DWORD_PTR) section - (DWORD_PTR) nt_header, be_verbose); dst_section = (PIMAGE_SECTION_HEADER) dst; COPY_CHUNK ("Copying section table...", section, nt_header->FileHeader.NumberOfSections * sizeof (*section), @@ -509,8 +510,8 @@ main (int argc, char **argv) /* Patch up header fields; profiler is picky about this. */ { HANDLE hImagehelp = LoadLibrary ("imagehlp.dll"); - DWORD headersum; - DWORD checksum; + DWORD_PTR headersum; + DWORD_PTR checksum; dos_header = (PIMAGE_DOS_HEADER) out_file.file_base; nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew); diff --git a/nt/config.nt b/nt/config.nt index 3b398eae04c..e342c78e20f 100644 --- a/nt/config.nt +++ b/nt/config.nt @@ -774,7 +774,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define HAVE_SENDTO 1 /* Define to 1 if you have the `setitimer' function. */ -#undef HAVE_SETITIMER +#define HAVE_SETITIMER 1 /* Define to 1 if you have the `setlocale' function. */ #define HAVE_SETLOCALE 1 diff --git a/nt/emacs-x64.manifest b/nt/emacs-x64.manifest new file mode 100644 index 00000000000..517e44f150b --- /dev/null +++ b/nt/emacs-x64.manifest @@ -0,0 +1,21 @@ +<?xml version="1.0" encoding="UTF-8" standalone="yes"?> +<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> + <dependency> + <dependentAssembly> + <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" + version="6.0.0.0" processorArchitecture="AMD64" + publicKeyToken="6595b64144ccf1df" + language="*"/> + </dependentAssembly> + </dependency> + <assemblyIdentity version="1.0.0.0" processorArchitecture="AMD64" + name="emacs" type="win32"/> + <description>GNU Emacs</description> + <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3"> + <security> + <requestedPrivileges> + <requestedExecutionLevel level="asInvoker"/> + </requestedPrivileges> + </security> + </trustInfo> +</assembly> diff --git a/nt/emacs.manifest b/nt/emacs-x86.manifest index 64c6f1edfb7..64c6f1edfb7 100644 --- a/nt/emacs.manifest +++ b/nt/emacs-x86.manifest diff --git a/nt/emacs.rc b/nt/emacs.rc index b45c57bf60b..63ed75490f9 100644 --- a/nt/emacs.rc +++ b/nt/emacs.rc @@ -1,6 +1,10 @@ Emacs ICON icons\emacs.ico 32649 CURSOR icons\hand.cur -1 24 "emacs.manifest" +#ifdef WIN64 +1 24 "emacs-x64.manifest" +#else +1 24 "emacs-x86.manifest" +#endif #ifndef VS_VERSION_INFO #define VS_VERSION_INFO 1 diff --git a/nt/gmake.defs b/nt/gmake.defs index 0b29c73e741..7206237c47a 100644 --- a/nt/gmake.defs +++ b/nt/gmake.defs @@ -139,15 +139,27 @@ OS_TYPE = windowsnt ifeq "$(PROCESSOR_ARCHITECTURE)" "x86" ARCH = i386 CPU = i386 +EMACS_HEAPSIZE = 27 +EMACS_PURESIZE = 5000000 +EMACS_MANIFEST = emacs-x86.manifest else ifeq "$(PROCESSOR_ARCHITECTURE)" "MIPS" ARCH = mips +EMACS_HEAPSIZE = 27 +EMACS_PURESIZE = 5000000 +EMACS_MANIFEST = emacs-mips.manifest else ifeq "$(PROCESSOR_ARCHITECTURE)" "ALPHA" ARCH = alpha +EMACS_HEAPSIZE = 27 +EMACS_PURESIZE = 5000000 +EMACS_MANIFEST = emacs-alpha.manifest else ifeq "$(PROCESSOR_ARCHITECTURE)" "PPC" ARCH = ppc +EMACS_HEAPSIZE = 27 +EMACS_PURESIZE = 5000000 +EMACS_MANIFEST = emacs-ppc.manifest else $(error Unknown architecture type "$(PROCESSOR_ARCHITECTURE)") endif diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 107ab6e788b..06a3af937df 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -121,7 +121,7 @@ extern char *getenv (); #include <sys/types.h> #ifdef _MSC_VER -typedef unsigned long sigset_t; +typedef int sigset_t; typedef int ssize_t; #endif @@ -130,6 +130,7 @@ struct sigaction { void (_CALLBACK_ *sa_handler)(int); sigset_t sa_mask; }; +#define SA_RESTART 0 #define SIG_BLOCK 1 #define SIG_SETMASK 2 #define SIG_UNBLOCK 3 @@ -293,6 +294,7 @@ struct timespec #define SIGPIPE 13 /* Write on pipe with no readers */ #define SIGALRM 14 /* Alarm */ #define SIGCHLD 18 /* Death of child */ +#define SIGPROF 19 /* Profiling */ #ifndef NSIG #define NSIG 23 @@ -356,7 +358,7 @@ extern char *get_emacs_configuration_options (void); extern int getloadavg (double *, int); -#if defined (__MINGW32__) || _MSC_VER >= 1400 +#if defined (__MINGW32__) /* Define to 1 if the system has the type `long long int'. */ # define HAVE_LONG_LONG_INT 1 @@ -364,21 +366,37 @@ extern int getloadavg (double *, int); /* Define to 1 if the system has the type `unsigned long long int'. */ # define HAVE_UNSIGNED_LONG_LONG_INT 1 -#elif _MSC_VER >= 1200 +#endif +#ifdef _MSC_VER +# if defined(_WIN64) +typedef __int64 EMACS_INT; +typedef unsigned __int64 EMACS_UINT; +# define EMACS_INT_MAX LLONG_MAX +# define PRIuMAX "llu" +# define pI "ll" +/* Fix a bug in MSVC headers : stdint.h */ +# define _INTPTR 2 +# elif defined(_WIN32) /* Temporarily disable wider-than-pointer integers until they're tested more. Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */ -# ifdef WIDE_EMACS_INT +# ifdef WIDE_EMACS_INT /* Use pre-C99-style 64-bit integers. */ typedef __int64 EMACS_INT; typedef unsigned __int64 EMACS_UINT; -# define EMACS_INT_MAX _I64_MAX -# define pI "I64" - +# define EMACS_INT_MAX LLONG_MAX +# define PRIuMAX "llu" +# define pI "I64" +# else +typedef int EMACS_INT; +typedef unsigned int EMACS_UINT; +# define EMACS_INT_MAX LONG_MAX +# define PRIuMAX "lu" +# define pI "l" +# endif # endif - #endif /* We need a little extra space, see ../../lisp/loadup.el. */ @@ -418,6 +436,22 @@ extern void _DebPrint (const char *fmt, ...); #define DebPrint(stuff) #endif +#ifdef _MSC_VER +#if _MSC_VER >= 800 && !defined(__cplusplus) +/* Unnamed type definition in parentheses. + A structure, union, or enumerated type with no name is defined in a + parenthetical expression. The type definition is meaningless. */ +#pragma warning(disable:4116) +/* 'argument' : conversion from 'type1' to 'type2', possible loss of + data A floating point type was converted to an integer type. A + possible loss of data may have occurred. */ +#pragma warning(disable:4244) +/* Negative integral constant converted to unsigned type. + An expression converts a negative integer constant to an unsigned type. + The result of the expression is probably meaningless. */ +#pragma warning(disable:4308) +#endif +#endif #define TERM_HEADER "w32term.h" diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h index 77610404ffb..70225a9c82f 100644 --- a/nt/inc/sys/socket.h +++ b/nt/inc/sys/socket.h @@ -126,42 +126,147 @@ int fcntl (int s, int cmd, int options); extern int h_errno; /* map winsock error codes to standard names */ +#if defined(EWOULDBLOCK) +#undef EWOULDBLOCK +#endif #define EWOULDBLOCK WSAEWOULDBLOCK +#if defined(EINPROGRESS) +#undef EINPROGRESS +#endif #define EINPROGRESS WSAEINPROGRESS +#if defined(EALREADY) +#undef EALREADY +#endif #define EALREADY WSAEALREADY +#if defined(ENOTSOCK) +#undef ENOTSOCK +#endif #define ENOTSOCK WSAENOTSOCK +#if defined(EDESTADDRREQ) +#undef EDESTADDRREQ +#endif #define EDESTADDRREQ WSAEDESTADDRREQ +#if defined(EMSGSIZE) +#undef EMSGSIZE +#endif #define EMSGSIZE WSAEMSGSIZE +#if defined(EPROTOTYPE) +#undef EPROTOTYPE +#endif #define EPROTOTYPE WSAEPROTOTYPE +#if defined(ENOPROTOOPT) +#undef ENOPROTOOPT +#endif #define ENOPROTOOPT WSAENOPROTOOPT +#if defined(EPROTONOSUPPORT) +#undef EPROTONOSUPPORT +#endif #define EPROTONOSUPPORT WSAEPROTONOSUPPORT +#if defined(ESOCKTNOSUPPORT) +#undef ESOCKTNOSUPPORT +#endif #define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT +#if defined(EOPNOTSUPP) +#undef EOPNOTSUPP +#endif #define EOPNOTSUPP WSAEOPNOTSUPP +#if defined(EPFNOSUPPORT) +#undef EPFNOSUPPORT +#endif #define EPFNOSUPPORT WSAEPFNOSUPPORT +#if defined(EAFNOSUPPORT) +#undef EAFNOSUPPORT +#endif #define EAFNOSUPPORT WSAEAFNOSUPPORT +#if defined(EADDRINUSE) +#undef EADDRINUSE +#endif #define EADDRINUSE WSAEADDRINUSE +#if defined(EADDRNOTAVAIL) +#undef EADDRNOTAVAIL +#endif #define EADDRNOTAVAIL WSAEADDRNOTAVAIL +#if defined(ENETDOWN) +#undef ENETDOWN +#endif #define ENETDOWN WSAENETDOWN +#if defined(ENETUNREACH) +#undef ENETUNREACH +#endif #define ENETUNREACH WSAENETUNREACH +#if defined(ENETRESET) +#undef ENETRESET +#endif #define ENETRESET WSAENETRESET +#if defined(ECONNABORTED) +#undef ECONNABORTED +#endif #define ECONNABORTED WSAECONNABORTED +#if defined(ECONNRESET) +#undef ECONNRESET +#endif #define ECONNRESET WSAECONNRESET +#if defined(ENOBUFS) +#undef ENOBUFS +#endif #define ENOBUFS WSAENOBUFS +#if defined(EISCONN) +#undef EISCONN +#endif #define EISCONN WSAEISCONN +#if defined(ENOTCONN) +#undef ENOTCONN +#endif #define ENOTCONN WSAENOTCONN +#if defined(ESHUTDOWN) +#undef ESHUTDOWN +#endif #define ESHUTDOWN WSAESHUTDOWN +#if defined(ETOOMANYREFS) +#undef ETOOMANYREFS +#endif #define ETOOMANYREFS WSAETOOMANYREFS +#if defined(ETIMEDOUT) +#undef ETIMEDOUT +#endif #define ETIMEDOUT WSAETIMEDOUT +#if defined(ECONNREFUSED) +#undef ECONNREFUSED +#endif #define ECONNREFUSED WSAECONNREFUSED +#if defined(ELOOP) +#undef ELOOP +#endif #define ELOOP WSAELOOP /* #define ENAMETOOLONG WSAENAMETOOLONG */ +#if defined(EHOSTDOWN) +#undef EHOSTDOWN +#endif #define EHOSTDOWN WSAEHOSTDOWN +#if defined(EHOSTUNREACH) +#undef EHOSTUNREACH +#endif #define EHOSTUNREACH WSAEHOSTUNREACH /* #define ENOTEMPTY WSAENOTEMPTY */ +#if defined(EPROCLIM) +#undef EPROCLIM +#endif #define EPROCLIM WSAEPROCLIM +#if defined(EUSERS) +#undef EUSERS +#endif #define EUSERS WSAEUSERS +#if defined(EDQUOT) +#undef EDQUOT +#endif #define EDQUOT WSAEDQUOT +#if defined(ESTALE) +#undef ESTALE +#endif #define ESTALE WSAESTALE +#if defined(EREMOTE) +#undef EREMOTE +#endif #define EREMOTE WSAEREMOTE #endif /* _SOCKET_H_ */ diff --git a/nt/inc/sys/time.h b/nt/inc/sys/time.h index db54c90cf1f..c12c194fd2a 100644 --- a/nt/inc/sys/time.h +++ b/nt/inc/sys/time.h @@ -2,7 +2,8 @@ #define SYS_TIME_H_INCLUDED /* - * sys/time.h doesn't exist on NT + * sys/time.h either doesn't exist on Windows, or doesn't necessarily + * have the below stuff. */ struct timeval @@ -19,6 +20,18 @@ struct timezone void gettimeofday (struct timeval *, struct timezone *); +#define ITIMER_REAL 0 +#define ITIMER_PROF 1 + +struct itimerval +{ + struct timeval it_interval; /* timer interval */ + struct timeval it_value; /* current value */ +}; + +int getitimer (int, struct itimerval *); +int setitimer (int, struct itimerval *, struct itimerval *); + #endif /* SYS_TIME_H_INCLUDED */ /* end of sys/time.h */ diff --git a/nt/makefile.w32-in b/nt/makefile.w32-in index cf4af2b14cd..82bd829492d 100644 --- a/nt/makefile.w32-in +++ b/nt/makefile.w32-in @@ -66,7 +66,7 @@ $(BLD)/preprep.exe: $(BLD)/preprep.$(O) # The resource file. NT 3.10 requires the use of cvtres; even though # it is not necessary on later versions, it is still ok to use it. # -$(TRES): emacs.rc icons/emacs.ico emacs.manifest stamp_BLD +$(TRES): emacs.rc icons/emacs.ico $(EMACS_MANIFEST) stamp_BLD $(RC) $(RC_OUT)$(TRES) emacs.rc $(CLIENTRES): emacsclient.rc stamp_BLD diff --git a/nt/nmake.defs b/nt/nmake.defs index ec6f5102f4c..48809afc771 100644 --- a/nt/nmake.defs +++ b/nt/nmake.defs @@ -87,7 +87,11 @@ ARCH = alpha ! if "$(PROCESSOR_ARCHITECTURE)" == "PPC"
ARCH = ppc
! else
-! error Unknown architecture type "$(PROCESSOR_ARCHITECTURE)"
+! if "$(PROCESSOR_ARCHITECTURE)" == "AMD64"
+ARCH = AMD64
+! else
+! error Unknown architecture type "$(PROCESSOR_ARCHITECTURE)"
+! endif
! endif
! endif
! endif
@@ -106,7 +110,7 @@ CC = cl CC_OUT = -Fo
LINK = link
LINK_OUT = -out:
-RC = rc
+RC = rc $(ARCH_RCFLAGS)
RC_OUT = -Fo
RC_INCLUDE = -i
@@ -147,21 +151,21 @@ DEBUG_CFLAGS = MWINDOWS = -subsystem:windows -entry:mainCRTStartup
-CFLAGS = -I. $(ARCH_CFLAGS) \
+CFLAGS = -I. $(ARCH_CFLAGS) -D_CRT_SECURE_NO_WARNINGS \
$(DEBUG_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)
-ESC_CFLAGS = -I. $(ARCH_CFLAGS) \
+ESC_CFLAGS = -I. $(ARCH_CFLAGS) -D_CRT_SECURE_NO_WARNINGS \
$(DEBUG_CFLAGS) $(ESC_USER_CFLAGS) $(LOCAL_FLAGS)
#SYS_LDFLAGS = -nologo -release -incremental:no -version:3.10 -swaprun:cd -swaprun:net setargv.obj
-!ifdef NOOPT
-SYS_LDFLAGS = -nologo -manifest -dynamicbase:no -debug -incremental:no -version:3.10 -swaprun:cd -swaprun:net setargv.obj
-!else
-SYS_LDFLAGS = -nologo -manifest -dynamicbase:no -release -incremental:no -version:3.10 -swaprun:cd -swaprun:net setargv.obj
-!endif
+SYS_LDFLAGS = -nologo -manifest -dynamicbase:no -incremental:no -version:3.10 -swaprun:cd -swaprun:net setargv.obj
# see comments in allocate_heap in w32heap.c before changing any of the
# -stack, -heap, or -base settings.
-TEMACS_EXTRA_LINK = -stack:0x00800000 -heap:0x00100000 -base:0x01000000 -pdb:$(BLD)\temacs.pdb -machine:$(ARCH) $(SUBSYSTEM_CONSOLE) -entry:_start -map:$(BLD)\temacs.map $(EXTRA_LINK)
+!if "$(ARCH)" == "i386"
+TEMACS_EXTRA_LINK = -stack:0x00800000 -heap:0x00100000 -base:0x01000000 -pdb:$(BLD)\temacs.pdb -machine:x86 $(SUBSYSTEM_CONSOLE) -entry:_start -map:$(BLD)\temacs.map $(EXTRA_LINK)
+!elseif "$(ARCH)" == "AMD64"
+TEMACS_EXTRA_LINK = -stack:0x00800000 -heap:0x00100000 -base:0x400000000 -pdb:$(BLD)\temacs.pdb -machine:x64 $(SUBSYSTEM_CONSOLE) -entry:_start -map:$(BLD)\temacs.map $(EXTRA_LINK)
+!endif
!ifdef NOOPT
OBJDIR = obj
@@ -212,11 +216,17 @@ ARCH_CFLAGS = -nologo -D_X86_=1 -c -Zl -Zp8 -W2 -Od -Gd $(DEBUG_FLAG) ARCH_CFLAGS = -nologo -D_X86_=1 -c -Zl -Zp8 -W2 -Oi -Ot -Oy- -Ob2 -GF -Gy -Gd $(DEBUG_FLAG)
!endif
ARCH_LDFLAGS = $(SYS_LDFLAGS)
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-x86.manifest
!else
!if "$(ARCH)" == "mips"
ARCH_CFLAGS = -D_MIPS_=1 -c -W2 -Zi -Od -Gt0
ARCH_LDFLAGS = $(SYS_LDFLAGS)
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-mips.manifest
!else
!if "$(ARCH)" == "alpha"
@@ -226,12 +236,30 @@ ARCH_CFLAGS = -D_ALPHA_=1 -c -Ze -Zi -W2 -Od -D__stdcall= -D__cdecl= ARCH_CFLAGS = -D_ALPHA_=1 -c -Ze -Zi -W2 -O1 -D__stdcall= -D__cdecl=
!endif
ARCH_LDFLAGS = $(SYS_LDFLAGS)
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-alpha.manifest
!else
!if "$(ARCH)" == "ppc"
# These flags are a guess...if they don't work, please send me mail.
-ARCH_CFLAGS = -D_PPC_=1 -c -Ze -Zi -W2 -Od
ARCH_LDFLAGS = $(SYS_LDFLAGS)
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-ppc.manifest
+
+!else
+!if "$(ARCH)" == "AMD64"
+!ifdef NOOPT
+ARCH_CFLAGS = -nologo -D_AMD64_=1 -DWIN64 -D_WIN64 -DWIN32 -D_WIN32 -c -Zl -Zp8 -W2 -Od -Gd -Wp64 $(DEBUG_FLAG)
+!else
+ARCH_CFLAGS = -nologo -D_AMD64_=1 -DWIN64 -D_WIN64 -DWIN32 -D_WIN32 -c -Zl -Zp8 -W2 -O2x -GF -Gy -Gd $(DEBUG_FLAG)
+!endif
+ARCH_LDFLAGS = $(SYS_LDFLAGS) -machine:x64
+ARCH_RCFLAGS = -DWIN64
+EMACS_HEAPSIZE = 42
+EMACS_PURESIZE = 10000000
+EMACS_MANIFEST = emacs-x64.manifest
!else
!ERROR Unknown architecture type "$(ARCH)".
@@ -239,6 +267,7 @@ ARCH_LDFLAGS = $(SYS_LDFLAGS) !endif
!endif
!endif
+!endif
LINK_FLAGS = $(ARCH_LDFLAGS) $(DEBUG_LINK) $(USER_LDFLAGS)
@@ -262,4 +291,3 @@ EXTRA_LINK = -profile .c{$(BLD)}.obj::
$(CC) $(CFLAGS) -Fo$(BLD)\ $<
!ENDIF
-
diff --git a/nt/preprep.c b/nt/preprep.c index 6fe7d325296..6976567e038 100644 --- a/nt/preprep.c +++ b/nt/preprep.c @@ -36,9 +36,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. PIMAGE_NT_HEADERS (__stdcall * pfnCheckSumMappedFile) (LPVOID BaseAddress, - DWORD FileLength, - LPDWORD HeaderSum, - LPDWORD CheckSum); + DWORD_PTR FileLength, + PDWORD_PTR HeaderSum, + PDWORD_PTR CheckSum); #undef min #undef max @@ -196,7 +196,7 @@ find_section (const char *name, IMAGE_NT_HEADERS *nt_header) /* Return pointer to section header for section containing the given relative virtual address. */ IMAGE_SECTION_HEADER * -rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) +rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header) { PIMAGE_SECTION_HEADER section; int i; @@ -211,7 +211,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) some very old exes (eg. gzip dated Dec 1993). Since w32_executable_type relies on this function to work reliably, we need to cope with this. */ - DWORD real_size = max (section->SizeOfRawData, + DWORD_PTR real_size = max (section->SizeOfRawData, section->Misc.VirtualSize); if (rva >= section->VirtualAddress && rva < section->VirtualAddress + real_size) @@ -224,7 +224,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) /* Return pointer to section header for section containing the given offset in its raw data area. */ IMAGE_SECTION_HEADER * -offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header) +offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header) { PIMAGE_SECTION_HEADER section; int i; @@ -244,8 +244,8 @@ offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header) /* Return offset to an object in dst, given offset in src. We assume there is at least one section in both src and dst images, and that the some sections may have been added to dst (after sections in src). */ -static DWORD -relocate_offset (DWORD offset, +static DWORD_PTR +relocate_offset (DWORD_PTR offset, IMAGE_NT_HEADERS * src_nt_header, IMAGE_NT_HEADERS * dst_nt_header) { @@ -279,28 +279,29 @@ relocate_offset (DWORD offset, } #define OFFSET_TO_RVA(offset, section) \ - (section->VirtualAddress + ((DWORD)(offset) - section->PointerToRawData)) + ((section)->VirtualAddress + ((DWORD_PTR)(offset) - (section)->PointerToRawData)) #define RVA_TO_OFFSET(rva, section) \ - (section->PointerToRawData + ((DWORD)(rva) - section->VirtualAddress)) + ((section)->PointerToRawData + ((DWORD_PTR)(rva) - (section)->VirtualAddress)) #define RVA_TO_SECTION_OFFSET(rva, section) \ - ((DWORD)(rva) - section->VirtualAddress) + ((DWORD_PTR)(rva) - (section)->VirtualAddress) #define RVA_TO_PTR(var,section,filedata) \ - ((void *)(RVA_TO_OFFSET(var,section) + (filedata)->file_base)) + ((void *)((unsigned char *)(RVA_TO_OFFSET(var,section) + (filedata)->file_base))) /* Convert address in executing image to RVA. */ -#define PTR_TO_RVA(ptr) ((DWORD)(ptr) - (DWORD) GetModuleHandle (NULL)) +#define PTR_TO_RVA(ptr) ((DWORD_PTR)(ptr) - (DWORD_PTR) GetModuleHandle (NULL)) #define PTR_TO_OFFSET(ptr, pfile_data) \ ((unsigned const char *)(ptr) - (pfile_data)->file_base) #define OFFSET_TO_PTR(offset, pfile_data) \ - ((pfile_data)->file_base + (DWORD)(offset)) + ((pfile_data)->file_base + (DWORD_PTR)(offset)) -#define ROUND_UP(p, align) (((DWORD)(p) + (align)-1) & ~((align)-1)) -#define ROUND_DOWN(p, align) ((DWORD)(p) & ~((align)-1)) +#define ROUND_UP(p, align) \ + (((DWORD_PTR)(p) + (align)-1) & ~((DWORD_PTR)(align)-1)) +#define ROUND_DOWN(p, align) ((DWORD_PTR)(p) & ~((DWORD_PTR)(align)-1)) /* The MSVC prep program generates a ._xe file from .exe, where relevant @@ -353,9 +354,9 @@ copy_executable_and_move_sections (file_data *p_infile, PIMAGE_SECTION_HEADER reloc_section; PIMAGE_DATA_DIRECTORY import_dir; PIMAGE_DATA_DIRECTORY reloc_dir; - DWORD import_delta_rva; - DWORD reloc_delta_rva; - DWORD offset; + DWORD_PTR import_delta_rva; + DWORD_PTR reloc_delta_rva; + DWORD_PTR offset; int i; #define COPY_CHUNK(message, src, size) \ @@ -388,7 +389,7 @@ copy_executable_and_move_sections (file_data *p_infile, Note that dst is updated implicitly by each COPY_CHUNK. */ dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base; - nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + + nt_header = (PIMAGE_NT_HEADERS) (((unsigned char *) dos_header) + dos_header->e_lfanew); section = IMAGE_FIRST_SECTION (nt_header); @@ -406,10 +407,10 @@ copy_executable_and_move_sections (file_data *p_infile, dst = (unsigned char *) p_outfile->file_base; COPY_CHUNK ("Copying DOS header...", dos_header, - (DWORD) nt_header - (DWORD) dos_header); + (DWORD_PTR) nt_header - (DWORD_PTR) dos_header); dst_nt_header = (PIMAGE_NT_HEADERS) dst; COPY_CHUNK ("Copying NT header...", nt_header, - (DWORD) section - (DWORD) nt_header); + (DWORD_PTR) section - (DWORD_PTR) nt_header); dst_section = (PIMAGE_SECTION_HEADER) dst; COPY_CHUNK ("Copying section table...", section, nt_header->FileHeader.NumberOfSections * sizeof (*section)); @@ -537,7 +538,7 @@ copy_executable_and_move_sections (file_data *p_infile, #define ADJUST_IMPORT_RVA(var) \ do { \ if ((var) != 0) \ - *((DWORD *)&(var)) += import_delta_rva; \ + *((DWORD_PTR *)&(var)) += import_delta_rva; \ } while (0) dst_nt_header->OptionalHeader.SizeOfInitializedData = 0; @@ -627,10 +628,10 @@ copy_executable_and_move_sections (file_data *p_infile, { IMAGE_BASE_RELOCATION *relocs, *block, *start_block, *end_block; - DWORD import_start = import_section->VirtualAddress + dst_nt_header->OptionalHeader.ImageBase; - DWORD import_end = import_start + import_section->Misc.VirtualSize; - DWORD len_import_relocs; - DWORD len_remaining_relocs; + DWORD_PTR import_start = import_section->VirtualAddress + dst_nt_header->OptionalHeader.ImageBase; + DWORD_PTR import_end = import_start + import_section->Misc.VirtualSize; + DWORD_PTR len_import_relocs; + DWORD_PTR len_remaining_relocs; int seen_high = 0; WORD * high_word; void * holder; @@ -643,8 +644,8 @@ copy_executable_and_move_sections (file_data *p_infile, any; the profiler needs to be able to patch RVAs in the import section itself. */ for (block = relocs, start_block = 0; - (DWORD) block - (DWORD) relocs < reloc_dir->Size; - block = (void *)((DWORD) block + block->SizeOfBlock)) + (DWORD_PTR) block - (DWORD_PTR) relocs < reloc_dir->Size; + block = (void *)((DWORD_PTR) block + block->SizeOfBlock)) { if (block->VirtualAddress >= import_section->VirtualAddress + import_section->Misc.VirtualSize) { @@ -660,8 +661,8 @@ copy_executable_and_move_sections (file_data *p_infile, } if (start_block) { - len_import_relocs = (DWORD) end_block - (DWORD) start_block; - len_remaining_relocs = (DWORD) relocs + reloc_dir->Size - (DWORD) end_block; + len_import_relocs = (DWORD_PTR) end_block - (DWORD_PTR) start_block; + len_remaining_relocs = (DWORD_PTR) relocs + reloc_dir->Size - (DWORD_PTR) end_block; holder = malloc (len_import_relocs); if (holder == 0) abort (); @@ -675,14 +676,14 @@ copy_executable_and_move_sections (file_data *p_infile, to the old import section location, and patching them to reference the new location. */ for (block = relocs; - (DWORD) block - (DWORD) relocs < reloc_dir->Size; - block = (void *)((DWORD) block + block->SizeOfBlock)) + (DWORD_PTR) block - (DWORD_PTR) relocs < reloc_dir->Size; + block = (void *)((DWORD_PTR) block + block->SizeOfBlock)) { - DWORD page_rva = block->VirtualAddress; - DWORD page_offset; + DWORD_PTR page_rva = block->VirtualAddress; + DWORD_PTR page_offset; union { WORD word; - DWORD dword; + DWORD_PTR dword; } * ploc; WORD *fixup; @@ -692,7 +693,7 @@ copy_executable_and_move_sections (file_data *p_infile, continue; for (fixup = (WORD *) &block[1]; - (DWORD) fixup - (DWORD) block < block->SizeOfBlock; + (DWORD_PTR) fixup - (DWORD_PTR) block < block->SizeOfBlock; fixup++) { page_offset = (*fixup) & 0xfff; @@ -794,8 +795,8 @@ main (int argc, char **argv) /* Patch up header fields; profiler is picky about this. */ { HANDLE hImagehelp = LoadLibrary ("imagehlp.dll"); - DWORD headersum; - DWORD checksum; + DWORD_PTR headersum; + DWORD_PTR checksum; dos_header = (PIMAGE_DOS_HEADER) out_file.file_base; nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew); diff --git a/oldXMenu/ChangeLog b/oldXMenu/ChangeLog index 09859d0d630..133b18b4e3f 100644 --- a/oldXMenu/ChangeLog +++ b/oldXMenu/ChangeLog @@ -1,3 +1,7 @@ +2012-10-06 Ulrich Müller <ulm@gentoo.org> + + * Makefile.in (AR, ARFLAGS): Get values from configure. + 2012-06-26 Paul Eggert <eggert@cs.ucla.edu> * Makefile.in (ALL_CFLAGS): Add -I../lib -I${srcdir}/../lib. diff --git a/oldXMenu/Makefile.in b/oldXMenu/Makefile.in index 00b3d8e3c69..ee78325f0d7 100644 --- a/oldXMenu/Makefile.in +++ b/oldXMenu/Makefile.in @@ -57,8 +57,8 @@ CFLAGS=@CFLAGS@ TAGS = etags RM = rm -f RANLIB = @RANLIB@ -# Solaris 2.1 ar doesn't accept the 'l' option. -AR = ar cq +AR = @AR@ +ARFLAGS = @ARFLAGS@ OBJS = Activate.o \ AddPane.o \ @@ -98,7 +98,7 @@ ALL_CFLAGS=$(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \ libXMenu11.a: $(OBJS) $(EXTRA) $(RM) $@ - $(AR) $@ $(OBJS) $(EXTRA) + $(AR) $(ARFLAGS) $@ $(OBJS) $(EXTRA) $(RANLIB) $@ Activate.o: Activate.c XMenuInt.h XMenu.h X10.h diff --git a/src/.gdbinit b/src/.gdbinit index 7a6bfb07fed..952d7392a4c 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -1121,15 +1121,15 @@ end define xbacktrace set $bt = backtrace_list while $bt - xgettype (*$bt->function) + xgettype ($bt->function) if $type == Lisp_Symbol - xprintsym (*$bt->function) + xprintsym ($bt->function) printf " (0x%x)\n", $bt->args else - xgetptr *$bt->function + xgetptr $bt->function printf "0x%x ", $ptr if $type == Lisp_Vectorlike - xgetptr (*$bt->function) + xgetptr ($bt->function) set $size = ((struct Lisp_Vector *) $ptr)->header.size if ($size & PSEUDOVECTOR_FLAG) output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS) diff --git a/src/ChangeLog b/src/ChangeLog index 1f5ad1e6d05..956e78e6c7e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,387 @@ +2012-10-06 Paul Eggert <eggert@cs.ucla.edu> + + * keyboard.c (read_char): Remove unnecessary 'volatile's and label. + +2012-10-05 Eli Zaretskii <eliz@gnu.org> + + * w32proc.c (stop_timer_thread): Fix declaration of 'err'. + + * w32.c (utime): Open the file with FILE_FLAG_BACKUP_SEMANTICS, so + that time stamps of directories could also be changed. Don't + request the too broad GENERIC_WRITE, only the more restrictive + FILE_WRITE_ATTRIBUTES access rights. + + * fileio.c (Fset_file_times): Special-case ignoring errors for + directories only on MSDOS, not on MS-Windows. + +2012-10-05 Ikumi Keita <ikumi@ikumi.que.jp> (tiny change) + + * minibuf.c (Fcompleting_read): Doc fix. (Bug#12555) + +2012-10-04 Eli Zaretskii <eliz@gnu.org> + + * w32.c (utime): Test for INVALID_HANDLE_VALUE, not for NULL, to + see whether CreateFile failed. + +2012-10-04 Paul Eggert <eggert@cs.ucla.edu> + + * profiler.c (handle_profiler_signal): Inhibit pending signals too, + to avoid similar races. + * keyboard.c (pending_signals): Now bool, not int. + + Port timers to OpenBSD, plus check for timer failures. + OpenBSD problem reported by Han Boetes. + * profiler.c (setup_cpu_timer): Check for failure of timer_settime + and/or setitimer. + (Fprofiler_cpu_stop): Don't assume HAVE_SETITIMER. + * syssignal.h (HAVE_ITIMERSPEC): New macro. This is for platforms + like OpenBSD, which has timer_settime but does not declare it. + OpenBSD does not define SIGEV_SIGNAL, so use that when deciding + whether to use itimerspec-related primitives. All uses of + HAVE_TIMER_SETTIME replaced with HAVE_ITIMERSPEC. + +2012-10-02 Paul Eggert <eggert@cs.ucla.edu> + + * profiler.c (handle_profiler_signal): Fix a malloc race + that caused Emacs to hang on Fedora 17 when profiling Lisp. + +2012-10-02 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (windowDidEnterFullScreen): Remove fprintf. + +2012-10-02 Eli Zaretskii <eliz@gnu.org> + + * w32proc.c (sys_wait): Declare 'signame' 'const char *', to be + consistent with the change in return value of 'safe_strsignal'. + +2012-10-02 Paul Eggert <eggert@cs.ucla.edu> + + Prefer plain 'static' to 'static inline' (Bug#12541). + * bidi.c (bidi_get_type, bidi_check_type, bidi_get_category) + (bidi_set_sor_type, bidi_push_embedding_level) + (bidi_pop_embedding_level, bidi_remember_char, bidi_copy_it) + (bidi_cache_reset, bidi_cache_shrink, bidi_cache_fetch_state) + (bidi_cache_search, bidi_cache_ensure_space) + (bidi_cache_iterator_state, bidi_cache_find) + (bidi_peek_at_next_level, bidi_set_paragraph_end) + (bidi_count_bytes, bidi_char_at_pos, bidi_fetch_char) + (bidi_explicit_dir_char, bidi_resolve_neutral_1): + Now 'static', not 'static inline'. + + Count overruns when profiling; change units to ns. + * profiler.c (handle_profiler_signal): Count sampling intervals, not ms. + Give extra weight to samples after overruns, to attempt to count + the time more accurately. + (setup_cpu_timer): Change sampling interval units from ms to ns, since + the underlying primitives nominally do ns. + (Fprofiler_cpu_start): Document the change. Mention that + the sampling intervals are only approximate. + +2012-10-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * frame.c (Fmake_terminal_frame): Prefer safer CONSP over !NILP. + + * coding.h (ENCODE_FILE, DECODE_FILE, DECODE_SYSTEM): Remove special + case for the special 0 coding-system. + + * buffer.c (Fset_buffer_multibyte): Signal an error instead of widening. + (Fmake_overlay): Remove redundant tests. + (fix_start_end_in_overlays): Remove redundant recentering. + +2012-10-02 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in ($(BLD)/alloc.$(O), $(BLD)/gmalloc.$(O)): + Update dependencies. + +2012-10-01 Paul Eggert <eggert@cs.ucla.edu> + + Fix a malloc race condition involving strsignal. + A signal can arrive in the middle of a malloc, and Emacs's signal + handler can invoke strsignal, which can invoke malloc, which is + not portable. This race condition bug makes Emacs hang on GNU/Linux. + Fix it by altering the signal handler so that it does not invoke + strsignal. + * emacs.c (shut_down_emacs): Use safe_strsignal, not strsignal. + * process.c (status_message): Use const pointer, in case strsignal + is #defined to safe_strsignal. + * sysdep.c (sys_siglist, init_signals): Always define and + initialize a substitute sys_siglist if the system does not define + one, even if HAVE_STRSIGNAL. + (safe_strsignal): Rename from strsignal. Always define, + using sys_siglist. Return a const pointer. + * syssignal.h (safe_strsignal): New decl. + (strsignal) [!HAVE_STRSIGNAL]: Define in terms of safe_strsignal. + +2012-10-01 Eli Zaretskii <eliz@gnu.org> + + * w32proc.c (timer_loop): Fix code that waits for timer + expiration, to avoid high CPU usage. + +2012-10-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * fns.c (check_hash_table, get_key_arg, maybe_resize_hash_table) + (sweep_weak_table): Remove redundant prototypes. + +2012-10-01 Fabrice Popineau <fabrice.popineau@gmail.com> + + * emacs.c: Move the inclusion of TERM_HEADER after including + windows.h on WINDOWSNT. This avoids compilation problems with + MSVC. + +2012-10-01 Eli Zaretskii <eliz@gnu.org> + + * unexw32.c (OFFSET_TO_RVA, RVA_TO_OFFSET) + (RVA_TO_SECTION_OFFSET): Encode all macro arguments in parentheses. + (RVA_TO_PTR): Cast the result of RVA_TO_OFFSET to 'unsigned char *', + as the previous version used 'void *'. + + * ralloc.c (ROUNDUP): Fix last change. + (MEM_ROUNDUP): Don't cast MEM_ALIGN, it is already of type + 'size_t'. + + * w32proc.c <disable_itimers>: New static flag. + (init_timers): Initialize it to zero, after creating the critical + sections used by the timer threads. + (term_timers): Set to 1 before deleting the critical sections. + (getitimer, setitimer): If disable_itimers is non-zero, return an + error indication without doing anything. Reported by Fabrice + Popineau <fabrice.popineau@supelec.fr> as part of bug#12544. + (alarm) [HAVE_SETITIMER]: Be more conformant to the expected + return results. + [!HAVE_SETITIMER]: Behave as the previous version that didn't + support timers. + + * emacs.c (shut_down_emacs) [WINDOWSNT]: Move the call to + term_ntproc after all the other bookkeeping, to get timers working + as long as possible. + +2012-10-01 Paul Eggert <eggert@cs.ucla.edu> + + * xdisp.c (syms_of_xdisp): Default message-log-max to 1000, not 100. + Suggested by Juri Linkov in + <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00821.html>. + + Prefer plain 'static' to 'static inline' (Bug#12541). + With static functions, modern compilers inline pretty well by + themselves; advice from programmers often hurts as much as it helps. + On my host (x86-64, Fedora 17, GCC 4.7.2, default 'configure'), + this change shrinks the text size of the Emacs executable by 1.1% + without affecting CPU significantly in my benchmark. + * alloc.c (mem_find, live_string_p, live_cons_p, live_symbol_p) + (live_float_p, live_misc_p, live_vector_p, live_buffer_p) + (mark_maybe_object, mark_maybe_pointer, bounded_number): + * buffer.c (bset_abbrev_mode, bset_abbrev_table) + (bset_auto_fill_function, bset_auto_save_file_format) + (bset_auto_save_file_name, bset_backed_up, bset_begv_marker) + (bset_bidi_display_reordering, bset_buffer_file_coding_system) + (bset_cache_long_line_scans, bset_case_fold_search) + (bset_ctl_arrow, bset_cursor_in_non_selected_windows) + (bset_cursor_type, bset_display_table, bset_extra_line_spacing) + (bset_file_format, bset_file_truename, bset_fringe_cursor_alist) + (bset_fringe_indicator_alist, bset_fringes_outside_margins) + (bset_header_line_format, bset_indicate_buffer_boundaries) + (bset_indicate_empty_lines, bset_invisibility_spec) + (bset_left_fringe_width, bset_major_mode, bset_mark) + (bset_minor_modes, bset_mode_line_format, bset_mode_name) + (bset_name, bset_overwrite_mode, bset_pt_marker) + (bset_right_fringe_width, bset_save_length) + (bset_scroll_bar_width, bset_scroll_down_aggressively) + (bset_scroll_up_aggressively, bset_selective_display) + (bset_selective_display_ellipses, bset_vertical_scroll_bar_type) + (bset_word_wrap, bset_zv_marker, set_buffer_overlays_before) + (set_buffer_overlays_after): + * category.c (bset_category_table): + * charset.c (read_hex): + * coding.c (produce_composition, produce_charset) + (handle_composition_annotation, handle_charset_annotation) + (char_encodable_p): + * dispnew.c (swap_glyph_pointers, copy_row_except_pointers) + (assign_row, set_frame_matrix_frame, make_current) + (add_row_entry): + * eval.c (set_specpdl_symbol, set_specpdl_old_value): + * fns.c (maybe_resize_hash_table): + * frame.c (fset_buffer_predicate, fset_minibuffer_window): + * gmalloc.c (register_heapinfo): + * image.c (lookup_image_type): + * intervals.c (set_interval_object, set_interval_left) + (set_interval_right, copy_interval_parent, rotate_right) + (rotate_left, balance_possible_root_interval): + * keyboard.c (kset_echo_string, kset_kbd_queue) + (kset_keyboard_translate_table, kset_last_prefix_arg) + (kset_last_repeatable_command, kset_local_function_key_map) + (kset_overriding_terminal_local_map, kset_real_last_command) + (kset_system_key_syms, clear_event, set_prop): + * lread.c (digit_to_number): + * marker.c (attach_marker, live_buffer, set_marker_internal): + * nsterm.m (ns_compute_glyph_string_overhangs): + * process.c (pset_buffer, pset_command) + (pset_decode_coding_system, pset_decoding_buf) + (pset_encode_coding_system, pset_encoding_buf, pset_filter) + (pset_log, pset_mark, pset_name, pset_plist, pset_sentinel) + (pset_status, pset_tty_name, pset_type, pset_write_queue): + * syntax.c (bset_syntax_table, dec_bytepos): + * terminal.c (tset_param_alist): + * textprop.c (interval_has_some_properties) + (interval_has_some_properties_list): + * window.c (wset_combination_limit, wset_dedicated) + (wset_display_table, wset_hchild, wset_left_fringe_width) + (wset_left_margin_cols, wset_new_normal, wset_new_total) + (wset_normal_cols, wset_normal_lines, wset_parent, wset_pointm) + (wset_right_fringe_width, wset_right_margin_cols) + (wset_scroll_bar_width, wset_start, wset_temslot, wset_vchild) + (wset_vertical_scroll_bar_type, wset_window_parameters): + * xdisp.c (wset_base_line_number, wset_base_line_pos) + (wset_column_number_displayed, wset_region_showing) + (window_box_edges, run_window_scroll_functions) + (append_glyph_string_lists, prepend_glyph_string_lists) + (append_glyph_string, set_glyph_string_background_width) + (append_glyph, append_composite_glyph) + (take_vertical_position_into_account): + * xfaces.c (x_create_gc, x_free_gc, merge_face_vectors) + (face_attr_equal_p, lface_equal_p, hash_string_case_insensitive) + (lface_hash, lface_same_font_attributes_p, lookup_face): + * xml.c (libxml2_loaded_p): + * xterm.c (x_set_mode_line_face_gc, x_set_glyph_string_gc) + (x_set_glyph_string_clipping, x_clear_glyph_string_rect): + Now 'static', not 'static inline'. + + * bidi.c: Tune. + (bidi_copy_it): Do the whole copy with a single memcpy. + (bidi_char_at_pos): Merge the two STRING_CHAR calls into one. + + Revert the FOLLOW-SYMLINKS change for file-attributes. + Doing it right would require several changes to Tramp, and there's + not enough time to get that tested before the freeze today. + * dired.c (directory_files_internal, Ffile_attributes): + Undo last change. + + * frame.c (x_report_frame_params): Port better to wider ints. + Do not assume that EMACS_UINT is the same width as uprintmax_t, + or that pointers can be printed in 15 decimal digits. + Avoid GCC warnings if EMACS_UINT is wider than a pointer. + +2012-09-30 Fabrice Popineau <fabrice.popineau@supelec.fr> + + Support x64 build on MS-Windows. + * w32term.h (SCROLL_BAR_PACK, SCROLL_BAR_UNPACK): Define for x64. + (SET_SCROLL_BAR_W32_WINDOW): Cast ID to intptr_t, for + compatibility with x64. + (x_get_focus_frame): Add prototype. + + * w32term.c (w32_draw_underwave): Don't use GCC extensions for + defining an XRectangle structure. + + * w32proc.c (RVA_TO_PTR, w32_executable_type): Fix pointer + arithmetics for compatibility with x64. + + * w32menu.c (add_menu_item): Use UINT_PTR instead of UINT, for + compatibility with x64. + + * w32heap.h: Adjust prototypes and declarations. + + * w32heap.c (RVA_TO_PTR, allocate_heap, sbrk, init_heap) + (round_heap): Use DWORD_PTR, ptrdiff_t and size_t instead of + DWORD, long, and unsigned long, for compatibility with x64. + (allocate_heap) [_WIN64]: Reserve 32GB of memory. + (sbrk): Argument is now of type ptrdiff_t. + + * w32fns.c (HMONITOR): Condition declaration on _WIN32_WINNT being + less than 0x0500. + (w32_msg_pump): Use WPARAM type for 'result'. + + * w32.c (init_environment, get_emacs_configuration): Support AMD64 + architecture. + (init_ntproc): Cast arguments of _open_osfhandle to intptr_t, for + compatibility with x64. + + * vm-limit.c (lim_data): Now size_t. + (check_memory_limits): Adjust prototypes of real_morecore and + __morecore to receive argument of type ptrdiff_t. Use size_t for + five_percent and data_size. + + * unexw32.c: Use DWORD_PTR instead of DWORD for file-scope + variables, for compatibility with x64. + (rva_to_section, offset_to_section, relocate_offset) + (OFFSET_TO_RVA, RVA_TO_OFFSET, RVA_TO_SECTION_OFFSET) + (PTR_TO_RVA, RVA_TO_PTR, OFFSET_TO_PTR, get_section_info) + (copy_executable_and_dump_data): Use DWORD_PTR instead of DWORD + for compatibility with x64. + + * sysdep.c (STDERR_FILENO): Define if not already defined. + + * ralloc.c (real_morecore): Argument type is now ptrdiff_t. + (__morecore): Argument type is now ptrdiff_t. + (ROUNDUP, MEM_ROUNDUP): Use size_t instead of 'unsigned long'. + (relinquish): Use ptrdiff_t type for 'excess'. + (r_alloc_sbrk): Argument type is now ptrdiff_t. + + * makefile.w32-in (HEAPSIZE): Get value from EMACS_HEAPSIZE. + (bootstrap-temacs-CMD, bootstrap-temacs-SH): Use $(EMACS_PURESIZE) + instead of a literal number. + + * gmalloc.c [WINDOWSNT]: Include w32heap.h. + (min): Define only if not already defined. + + * frame.c (x_report_frame_params): Use EMACS_UINT for the return + value of FRAME_X_WINDOW, to fit a 64-bit pointer on 64-bit Windows + hosts. + + * image.c (x_bitmap_pixmap): Return ptrdiff_t, not int, since + 'bitmaps' is a pointer. + + * dispextern.h (x_bitmap_pixmap): Adjust prototype. + + * alloc.c (gdb_make_enums_visible): Now conditional on __GNUC__. + +2012-09-30 Paul Eggert <eggert@cs.ucla.edu> + + file-attributes has a new optional arg FOLLOW-SYMLINKS. + * dired.c (directory_files_internal, Ffile_attributes): + New arg follow_symlinks. All uses changed. + +2012-09-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * .gdbinit (xbacktrace): Adjust to recent "struct backtrace" change. + +2012-09-30 Eli Zaretskii <eliz@gnu.org> + + Support atimers and CPU profiler via profile.c on MS-Windows. + * w32proc.c (sig_mask, crit_sig): New static variables. + (sys_signal): Support SIGALRM and SIGPROF. + (sigemptyset, sigaddset, sigfillset, sigprocmask) + (pthread_sigmask, setpgrp): Move here from w32.c. sigaddset, + sigfillset, and sigprocmask are no longer no-ops. + (sigismember): New function. + (struct itimer_data): New definition. + (ticks_now, real_itimer, prof_itimer, clocks_min, crit_real) + (crit_prof): New static variables. + (MAX_SINGLE_SLEEP): New definition. + (timer_loop, stop_timer_thread, term_timers, init_timers) + (start_timer_thread, getitimer, setitimer): New functions. + (alarm): No longer a no-op, calls setitimer. + + * w32.c (term_ntproc): Call term_timers. + (init_ntproc): Make sure all signals are unblocked at startup, to + erase any traces of dumping. Call init_timers. + + * w32fns.c (hourglass_timer, HOURGLASS_ID): Remove. + Windows-specific code to display the hourglass mouse pointer is no + longer used. + (w32_wnd_proc): Remove code that handled the WM_TIMER message due + to hourglass timer expiration. + (start_hourglass, cancel_hourglass, DEFAULT_HOURGLASS_DELAY): + Remove, no longer used. + (w32_note_current_window, show_hourglass, hide_hourglass): + New functions, in support of hourglass cursor display similar to other + window systems. + (syms_of_w32fns): Don't initialize hourglass_timer. + + * xdisp.c (start_hourglass, cancel_hourglass): Now used on + WINDOWSNT as well. + (start_hourglass) [WINDOWSNT]: Call w32_note_current_window. + + * w32.h (init_timers, term_timers): Add prototypes. + 2012-09-30 Kenichi Handa <handa@gnu.org> * coding.c (decode_coding_ccl, encode_coding_ccl): Pay attention diff --git a/src/alloc.c b/src/alloc.c index df166b4924a..3ed8cc2d990 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -74,6 +74,7 @@ extern void *sbrk (); #endif #ifdef WINDOWSNT #include "w32.h" +#include "w32heap.h" /* for sbrk */ #endif #ifdef DOUG_LEA_MALLOC @@ -354,7 +355,7 @@ static void mem_rotate_left (struct mem_node *); static void mem_rotate_right (struct mem_node *); static void mem_delete (struct mem_node *); static void mem_delete_fixup (struct mem_node *); -static inline struct mem_node *mem_find (void *); +static struct mem_node *mem_find (void *); #endif @@ -3549,7 +3550,7 @@ mem_init (void) /* Value is a pointer to the mem_node containing START. Value is MEM_NIL if there is no node in the tree containing START. */ -static inline struct mem_node * +static struct mem_node * mem_find (void *start) { struct mem_node *p; @@ -3925,7 +3926,7 @@ mem_delete_fixup (struct mem_node *x) /* Value is non-zero if P is a pointer to a live Lisp string on the heap. M is a pointer to the mem_block for P. */ -static inline bool +static bool live_string_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_STRING) @@ -3948,7 +3949,7 @@ live_string_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live Lisp cons on the heap. M is a pointer to the mem_block for P. */ -static inline bool +static bool live_cons_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_CONS) @@ -3974,7 +3975,7 @@ live_cons_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live Lisp symbol on the heap. M is a pointer to the mem_block for P. */ -static inline bool +static bool live_symbol_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_SYMBOL) @@ -4000,7 +4001,7 @@ live_symbol_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live Lisp float on the heap. M is a pointer to the mem_block for P. */ -static inline bool +static bool live_float_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_FLOAT) @@ -4024,7 +4025,7 @@ live_float_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live Lisp Misc on the heap. M is a pointer to the mem_block for P. */ -static inline bool +static bool live_misc_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_MISC) @@ -4050,7 +4051,7 @@ live_misc_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live vector-like object. M is a pointer to the mem_block for P. */ -static inline bool +static bool live_vector_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_VECTOR_BLOCK) @@ -4086,7 +4087,7 @@ live_vector_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live buffer. M is a pointer to the mem_block for P. */ -static inline bool +static bool live_buffer_p (struct mem_node *m, void *p) { /* P must point to the start of the block, and the buffer @@ -4152,7 +4153,7 @@ DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "", /* Mark OBJ if we can prove it's a Lisp_Object. */ -static inline void +static void mark_maybe_object (Lisp_Object obj) { void *po; @@ -4221,7 +4222,7 @@ mark_maybe_object (Lisp_Object obj) /* If P points to Lisp data, mark that as live if it isn't already marked. */ -static inline void +static void mark_maybe_pointer (void *p) { struct mem_node *m; @@ -5051,7 +5052,7 @@ inhibit_garbage_collection (void) /* Used to avoid possible overflows when converting from C to Lisp integers. */ -static inline Lisp_Object +static Lisp_Object bounded_number (EMACS_INT number) { return make_number (min (MOST_POSITIVE_FIXNUM, number)); @@ -6607,7 +6608,8 @@ The time is in seconds as a floating point value. */); /* When compiled with GCC, GDB might say "No enum type named pvec_type" if we don't have at least one symbol with that type, and then xbacktrace could fail. Similarly for the other enums and - their values. */ + their values. Some non-GCC compilers don't like these constructs. */ +#ifdef __GNUC__ union { enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS; @@ -6627,3 +6629,4 @@ union enum lsb_bits lsb_bits; #endif } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; +#endif /* __GNUC__ */ diff --git a/src/atimer.c b/src/atimer.c index 048c62798ef..5752192be76 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -42,7 +42,7 @@ static struct atimer *atimers; /* The alarm timer and whether it was properly initialized, if POSIX timers are available. */ -#ifdef HAVE_TIMER_SETTIME +#ifdef HAVE_ITIMERSPEC static timer_t alarm_timer; static bool alarm_timer_ok; #endif @@ -296,7 +296,7 @@ set_alarm (void) #endif EMACS_TIME now, interval; -#ifdef HAVE_TIMER_SETTIME +#ifdef HAVE_ITIMERSPEC if (alarm_timer_ok) { struct itimerspec ispec; @@ -416,7 +416,7 @@ void init_atimer (void) { struct sigaction action; -#ifdef HAVE_TIMER_SETTIME +#ifdef HAVE_ITIMERSPEC struct sigevent sigev; sigev.sigev_notify = SIGEV_SIGNAL; sigev.sigev_signo = SIGALRM; diff --git a/src/bidi.c b/src/bidi.c index af0209565e2..6f3d749ef22 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -96,7 +96,7 @@ static Lisp_Object Qparagraph_start, Qparagraph_separate; /* Return the bidi type of a character CH, subject to the current directional OVERRIDE. */ -static inline bidi_type_t +static bidi_type_t bidi_get_type (int ch, bidi_dir_t override) { bidi_type_t default_type; @@ -145,14 +145,14 @@ bidi_get_type (int ch, bidi_dir_t override) } } -static inline void +static void bidi_check_type (bidi_type_t type) { eassert (UNKNOWN_BT <= type && type <= NEUTRAL_ON); } /* Given a bidi TYPE of a character, return its category. */ -static inline bidi_category_t +static bidi_category_t bidi_get_category (bidi_type_t type) { switch (type) @@ -226,7 +226,7 @@ bidi_mirror_char (int c) embedding levels on either side of the run boundary. Also, update the saved info about previously seen characters, since that info is generally valid for a single level run. */ -static inline void +static void bidi_set_sor_type (struct bidi_it *bidi_it, int level_before, int level_after) { int higher_level = (level_before > level_after ? level_before : level_after); @@ -257,7 +257,7 @@ bidi_set_sor_type (struct bidi_it *bidi_it, int level_before, int level_after) /* Push the current embedding level and override status; reset the current level to LEVEL and the current override status to OVERRIDE. */ -static inline void +static void bidi_push_embedding_level (struct bidi_it *bidi_it, int level, bidi_dir_t override) { @@ -269,7 +269,7 @@ bidi_push_embedding_level (struct bidi_it *bidi_it, /* Pop the embedding level and directional override status from the stack, and return the new level. */ -static inline int +static int bidi_pop_embedding_level (struct bidi_it *bidi_it) { /* UAX#9 says to ignore invalid PDFs. */ @@ -279,7 +279,7 @@ bidi_pop_embedding_level (struct bidi_it *bidi_it) } /* Record in SAVED_INFO the information about the current character. */ -static inline void +static void bidi_remember_char (struct bidi_saved_info *saved_info, struct bidi_it *bidi_it) { @@ -295,18 +295,14 @@ bidi_remember_char (struct bidi_saved_info *saved_info, /* Copy the bidi iterator from FROM to TO. To save cycles, this only copies the part of the level stack that is actually in use. */ -static inline void +static void bidi_copy_it (struct bidi_it *to, struct bidi_it *from) { - int i; - - /* Copy everything except the level stack and beyond. */ - memcpy (to, from, offsetof (struct bidi_it, level_stack[0])); - - /* Copy the active part of the level stack. */ - to->level_stack[0] = from->level_stack[0]; /* level zero is always in use */ - for (i = 1; i <= from->stack_idx; i++) - to->level_stack[i] = from->level_stack[i]; + /* Copy everything from the start through the active part of + the level stack. */ + memcpy (to, from, + (offsetof (struct bidi_it, level_stack[1]) + + from->stack_idx * sizeof from->level_stack[0])); } @@ -344,7 +340,7 @@ enum intact. This is called when the cached information is no more useful for the current iteration, e.g. when we were reseated to a new position on the same object. */ -static inline void +static void bidi_cache_reset (void) { bidi_cache_idx = bidi_cache_start; @@ -355,7 +351,7 @@ bidi_cache_reset (void) iterator for reordering a buffer or a string that does not come from display properties, because that means all the previously cached info is of no further use. */ -static inline void +static void bidi_cache_shrink (void) { if (bidi_cache_size > BIDI_CACHE_CHUNK) @@ -366,7 +362,7 @@ bidi_cache_shrink (void) bidi_cache_reset (); } -static inline void +static void bidi_cache_fetch_state (ptrdiff_t idx, struct bidi_it *bidi_it) { int current_scan_dir = bidi_it->scan_dir; @@ -383,7 +379,7 @@ bidi_cache_fetch_state (ptrdiff_t idx, struct bidi_it *bidi_it) level less or equal to LEVEL. if LEVEL is -1, disregard the resolved levels in cached states. DIR, if non-zero, means search in that direction from the last cache hit. */ -static inline ptrdiff_t +static ptrdiff_t bidi_cache_search (ptrdiff_t charpos, int level, int dir) { ptrdiff_t i, i_start; @@ -488,7 +484,7 @@ bidi_cache_find_level_change (int level, int dir, bool before) return -1; } -static inline void +static void bidi_cache_ensure_space (ptrdiff_t idx) { /* Enlarge the cache as needed. */ @@ -510,7 +506,7 @@ bidi_cache_ensure_space (ptrdiff_t idx) } } -static inline void +static void bidi_cache_iterator_state (struct bidi_it *bidi_it, bool resolved) { ptrdiff_t idx; @@ -567,7 +563,7 @@ bidi_cache_iterator_state (struct bidi_it *bidi_it, bool resolved) bidi_cache_idx = idx + 1; } -static inline bidi_type_t +static bidi_type_t bidi_cache_find (ptrdiff_t charpos, int level, struct bidi_it *bidi_it) { ptrdiff_t i = bidi_cache_search (charpos, level, bidi_it->scan_dir); @@ -587,7 +583,7 @@ bidi_cache_find (ptrdiff_t charpos, int level, struct bidi_it *bidi_it) return UNKNOWN_BT; } -static inline int +static int bidi_peek_at_next_level (struct bidi_it *bidi_it) { if (bidi_cache_idx == bidi_cache_start || bidi_cache_last_idx == -1) @@ -790,7 +786,7 @@ bidi_initialize (void) /* Do whatever UAX#9 clause X8 says should be done at paragraph's end. */ -static inline void +static void bidi_set_paragraph_end (struct bidi_it *bidi_it) { bidi_it->invalid_levels = 0; @@ -872,7 +868,7 @@ bidi_line_init (struct bidi_it *bidi_it) /* Count bytes in string S between BEG/BEGBYTE and END. BEG and END are zero-based character positions in S, BEGBYTE is byte position corresponding to BEG. UNIBYTE means S is a unibyte string. */ -static inline ptrdiff_t +static ptrdiff_t bidi_count_bytes (const unsigned char *s, const ptrdiff_t beg, const ptrdiff_t begbyte, const ptrdiff_t end, bool unibyte) { @@ -896,22 +892,22 @@ bidi_count_bytes (const unsigned char *s, const ptrdiff_t beg, return p - start; } -/* Fetch and returns the character at byte position BYTEPOS. If S is +/* Fetch and return the character at byte position BYTEPOS. If S is non-NULL, fetch the character from string S; otherwise fetch the character from the current buffer. UNIBYTE means S is a unibyte string. */ -static inline int +static int bidi_char_at_pos (ptrdiff_t bytepos, const unsigned char *s, bool unibyte) { if (s) { + s += bytepos; if (unibyte) - return s[bytepos]; - else - return STRING_CHAR (s + bytepos); + return *s; } else - return FETCH_MULTIBYTE_CHAR (bytepos); + s = BYTE_POS_ADDR (bytepos); + return STRING_CHAR (s); } /* Fetch and return the character at BYTEPOS/CHARPOS. If that @@ -928,7 +924,7 @@ bidi_char_at_pos (ptrdiff_t bytepos, const unsigned char *s, bool unibyte) u+2029 to handle it as a paragraph separator. STRING->s is the C string to iterate, or NULL if iterating over a buffer or a Lisp string; in the latter case, STRING->lstring is the Lisp string. */ -static inline int +static int bidi_fetch_char (ptrdiff_t bytepos, ptrdiff_t charpos, ptrdiff_t *disp_pos, int *disp_prop, struct bidi_string_data *string, bool frame_window_p, ptrdiff_t *ch_len, ptrdiff_t *nchars) @@ -1318,7 +1314,7 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, bool no_default_p) The rest of this file constitutes the core of the UBA implementation. ***********************************************************************/ -static inline bool +static bool bidi_explicit_dir_char (int ch) { bidi_type_t ch_type; @@ -1841,7 +1837,7 @@ bidi_resolve_weak (struct bidi_it *bidi_it) /* Resolve the type of a neutral character according to the type of surrounding strong text and the current embedding level. */ -static inline bidi_type_t +static bidi_type_t bidi_resolve_neutral_1 (bidi_type_t prev_type, bidi_type_t next_type, int lev) { /* N1: European and Arabic numbers are treated as though they were R. */ diff --git a/src/buffer.c b/src/buffer.c index 356a308fce6..425d05ca790 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -150,222 +150,222 @@ static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t); static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool); /* These setters are used only in this file, so they can be private. */ -static inline void +static void bset_abbrev_mode (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (abbrev_mode) = val; } -static inline void +static void bset_abbrev_table (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (abbrev_table) = val; } -static inline void +static void bset_auto_fill_function (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (auto_fill_function) = val; } -static inline void +static void bset_auto_save_file_format (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (auto_save_file_format) = val; } -static inline void +static void bset_auto_save_file_name (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (auto_save_file_name) = val; } -static inline void +static void bset_backed_up (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (backed_up) = val; } -static inline void +static void bset_begv_marker (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (begv_marker) = val; } -static inline void +static void bset_bidi_display_reordering (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (bidi_display_reordering) = val; } -static inline void +static void bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (buffer_file_coding_system) = val; } -static inline void +static void bset_cache_long_line_scans (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (cache_long_line_scans) = val; } -static inline void +static void bset_case_fold_search (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (case_fold_search) = val; } -static inline void +static void bset_ctl_arrow (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (ctl_arrow) = val; } -static inline void +static void bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (cursor_in_non_selected_windows) = val; } -static inline void +static void bset_cursor_type (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (cursor_type) = val; } -static inline void +static void bset_display_table (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (display_table) = val; } -static inline void +static void bset_extra_line_spacing (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (extra_line_spacing) = val; } -static inline void +static void bset_file_format (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (file_format) = val; } -static inline void +static void bset_file_truename (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (file_truename) = val; } -static inline void +static void bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (fringe_cursor_alist) = val; } -static inline void +static void bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (fringe_indicator_alist) = val; } -static inline void +static void bset_fringes_outside_margins (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (fringes_outside_margins) = val; } -static inline void +static void bset_header_line_format (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (header_line_format) = val; } -static inline void +static void bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (indicate_buffer_boundaries) = val; } -static inline void +static void bset_indicate_empty_lines (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (indicate_empty_lines) = val; } -static inline void +static void bset_invisibility_spec (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (invisibility_spec) = val; } -static inline void +static void bset_left_fringe_width (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (left_fringe_width) = val; } -static inline void +static void bset_major_mode (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (major_mode) = val; } -static inline void +static void bset_mark (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (mark) = val; } -static inline void +static void bset_minor_modes (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (minor_modes) = val; } -static inline void +static void bset_mode_line_format (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (mode_line_format) = val; } -static inline void +static void bset_mode_name (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (mode_name) = val; } -static inline void +static void bset_name (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (name) = val; } -static inline void +static void bset_overwrite_mode (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (overwrite_mode) = val; } -static inline void +static void bset_pt_marker (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (pt_marker) = val; } -static inline void +static void bset_right_fringe_width (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (right_fringe_width) = val; } -static inline void +static void bset_save_length (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (save_length) = val; } -static inline void +static void bset_scroll_bar_width (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (scroll_bar_width) = val; } -static inline void +static void bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (scroll_down_aggressively) = val; } -static inline void +static void bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (scroll_up_aggressively) = val; } -static inline void +static void bset_selective_display (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (selective_display) = val; } -static inline void +static void bset_selective_display_ellipses (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (selective_display_ellipses) = val; } -static inline void +static void bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (vertical_scroll_bar_type) = val; } -static inline void +static void bset_word_wrap (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (word_wrap) = val; } -static inline void +static void bset_zv_marker (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (zv_marker) = val; @@ -651,13 +651,13 @@ copy_overlays (struct buffer *b, struct Lisp_Overlay *list) /* Set an appropriate overlay of B. */ -static inline void +static void set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o) { b->overlays_before = o; } -static inline void +static void set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o) { b->overlays_after = o; @@ -2464,7 +2464,7 @@ current buffer is cleared. */) begv = BEGV, zv = ZV; if (narrowed) - Fwiden (); + error ("Changing multibyteness in a narrowed buffer"); if (NILP (flag)) { @@ -3689,7 +3689,6 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) beforep->next = current_buffer->overlays_before; set_buffer_overlays_before (current_buffer, before_list); } - recenter_overlay_lists (current_buffer, current_buffer->overlay_center); if (afterp) { @@ -3847,17 +3846,16 @@ for the rear of the overlay advance when text is inserted there end = OVERLAY_END (overlay); if (OVERLAY_POSITION (end) < b->overlay_center) { - if (b->overlays_after) - XOVERLAY (overlay)->next = b->overlays_after; + eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL)); + XOVERLAY (overlay)->next = b->overlays_after; set_buffer_overlays_after (b, XOVERLAY (overlay)); } else { - if (b->overlays_before) - XOVERLAY (overlay)->next = b->overlays_before; + eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL)); + XOVERLAY (overlay)->next = b->overlays_before; set_buffer_overlays_before (b, XOVERLAY (overlay)); } - /* This puts it in the right list, and in the right order. */ recenter_overlay_lists (b, b->overlay_center); @@ -4141,7 +4139,7 @@ DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0, /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. */ noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, - 0, 0, 0); + NULL, NULL, 0); /* Make a list of them all. */ result = Flist (noverlays, overlay_vec); diff --git a/src/category.c b/src/category.c index 01a6f54ad17..fe02303f679 100644 --- a/src/category.c +++ b/src/category.c @@ -40,7 +40,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "keymap.h" /* This setter is used only in this file, so it can be private. */ -static inline void +static void bset_category_table (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (category_table) = val; diff --git a/src/charset.c b/src/charset.c index b0915ffde9c..6b999824dab 100644 --- a/src/charset.c +++ b/src/charset.c @@ -421,7 +421,7 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries, /* Read a hexadecimal number (preceded by "0x") from the file FP while paying attention to comment character '#'. */ -static inline unsigned +static unsigned read_hex (FILE *fp, bool *eof, bool *overflow) { int c; diff --git a/src/coding.c b/src/coding.c index 32d300b9923..d9606cf5710 100644 --- a/src/coding.c +++ b/src/coding.c @@ -6822,7 +6822,7 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, [ -LENGTH ANNOTATION_MASK NCHARS NBYTES METHOD [ COMPONENTS... ] ] */ -static inline void +static void produce_composition (struct coding_system *coding, int *charbuf, ptrdiff_t pos) { int len; @@ -6866,7 +6866,7 @@ produce_composition (struct coding_system *coding, int *charbuf, ptrdiff_t pos) [ -LENGTH ANNOTATION_MASK NCHARS CHARSET-ID ] */ -static inline void +static void produce_charset (struct coding_system *coding, int *charbuf, ptrdiff_t pos) { ptrdiff_t from = pos - charbuf[2]; @@ -7101,7 +7101,7 @@ decode_coding (struct coding_system *coding) position of a composition after POS (if any) or to LIMIT, and return BUF. */ -static inline int * +static int * handle_composition_annotation (ptrdiff_t pos, ptrdiff_t limit, struct coding_system *coding, int *buf, ptrdiff_t *stop) @@ -7184,7 +7184,7 @@ handle_composition_annotation (ptrdiff_t pos, ptrdiff_t limit, If the property value is nil, set *STOP to the position where the property value is non-nil (limiting by LIMIT), and return BUF. */ -static inline int * +static int * handle_charset_annotation (ptrdiff_t pos, ptrdiff_t limit, struct coding_system *coding, int *buf, ptrdiff_t *stop) @@ -8429,7 +8429,7 @@ highest priority. */) } -static inline bool +static bool char_encodable_p (int c, Lisp_Object attrs) { Lisp_Object tail; diff --git a/src/coding.h b/src/coding.h index c45d2ef86e2..989552bf667 100644 --- a/src/coding.h +++ b/src/coding.h @@ -646,10 +646,8 @@ struct coding_system for file names, if any. */ #define ENCODE_FILE(name) \ (! NILP (Vfile_name_coding_system) \ - && !EQ (Vfile_name_coding_system, make_number (0)) \ ? code_convert_string_norecord (name, Vfile_name_coding_system, 1) \ : (! NILP (Vdefault_file_name_coding_system) \ - && !EQ (Vdefault_file_name_coding_system, make_number (0)) \ ? code_convert_string_norecord (name, Vdefault_file_name_coding_system, 1) \ : name)) @@ -658,10 +656,8 @@ struct coding_system for file names, if any. */ #define DECODE_FILE(name) \ (! NILP (Vfile_name_coding_system) \ - && !EQ (Vfile_name_coding_system, make_number (0)) \ ? code_convert_string_norecord (name, Vfile_name_coding_system, 0) \ : (! NILP (Vdefault_file_name_coding_system) \ - && !EQ (Vdefault_file_name_coding_system, make_number (0)) \ ? code_convert_string_norecord (name, Vdefault_file_name_coding_system, 0) \ : name)) @@ -670,7 +666,6 @@ struct coding_system for system functions, if any. */ #define ENCODE_SYSTEM(str) \ (! NILP (Vlocale_coding_system) \ - && !EQ (Vlocale_coding_system, make_number (0)) \ ? code_convert_string_norecord (str, Vlocale_coding_system, 1) \ : str) @@ -678,7 +673,6 @@ struct coding_system for system functions, if any. */ #define DECODE_SYSTEM(str) \ (! NILP (Vlocale_coding_system) \ - && !EQ (Vlocale_coding_system, make_number (0)) \ ? code_convert_string_norecord (str, Vlocale_coding_system, 0) \ : str) diff --git a/src/dispextern.h b/src/dispextern.h index 3c42d7abb9d..f1ea8e97ee8 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3157,7 +3157,7 @@ extern unsigned row_hash (struct glyph_row *); extern int x_bitmap_height (struct frame *, ptrdiff_t); extern int x_bitmap_width (struct frame *, ptrdiff_t); -extern int x_bitmap_pixmap (struct frame *, ptrdiff_t); +extern ptrdiff_t x_bitmap_pixmap (struct frame *, ptrdiff_t); extern void x_reference_bitmap (struct frame *, ptrdiff_t); extern ptrdiff_t x_create_bitmap_from_data (struct frame *, char *, unsigned int, unsigned int); diff --git a/src/dispnew.c b/src/dispnew.c index 555136d785c..6f8fb10b41d 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -1028,7 +1028,7 @@ swap_glyphs_in_rows (struct glyph_row *a, struct glyph_row *b) these should all go together for the row's hash value to be correct. */ -static inline void +static void swap_glyph_pointers (struct glyph_row *a, struct glyph_row *b) { int i; @@ -1057,7 +1057,7 @@ swap_glyph_pointers (struct glyph_row *a, struct glyph_row *b) that glyph pointers, the `used' counts, and the hash values in the structures are left unchanged. */ -static inline void +static void copy_row_except_pointers (struct glyph_row *to, struct glyph_row *from) { struct glyph *pointers[1 + LAST_AREA]; @@ -1084,7 +1084,7 @@ copy_row_except_pointers (struct glyph_row *to, struct glyph_row *from) exchanged between TO and FROM. Pointers must be exchanged to avoid a memory leak. */ -static inline void +static void assign_row (struct glyph_row *to, struct glyph_row *from) { swap_glyph_pointers (to, from); @@ -1249,7 +1249,7 @@ line_draw_cost (struct glyph_matrix *matrix, int vpos) /* Return true if the glyph rows A and B have equal contents. MOUSE_FACE_P means compare the mouse_face_p flags of A and B, too. */ -static inline bool +static bool row_equal_p (struct glyph_row *a, struct glyph_row *b, bool mouse_face_p) { eassert (verify_row_hash (a)); @@ -2657,7 +2657,7 @@ fill_up_frame_row_with_spaces (struct glyph_row *row, int upto) function must be called before updates to make explicit that we are working on frame matrices or not. */ -static inline void +static void set_frame_matrix_frame (struct frame *f) { frame_matrix_frame = f; @@ -2672,7 +2672,7 @@ set_frame_matrix_frame (struct frame *f) done in frame matrices, and that we have to perform analogous operations in window matrices of frame_matrix_frame. */ -static inline void +static void make_current (struct glyph_matrix *desired_matrix, struct glyph_matrix *current_matrix, int row) { struct glyph_row *current_row = MATRIX_ROW (current_matrix, row); @@ -4158,7 +4158,7 @@ static struct run **runs; /* Add glyph row ROW to the scrolling hash table. */ -static inline struct row_entry * +static struct row_entry * add_row_entry (struct glyph_row *row) { struct row_entry *entry; diff --git a/src/emacs.c b/src/emacs.c index 05affeefde7..bc54f56b98a 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -31,10 +31,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "lisp.h" -#ifdef HAVE_WINDOW_SYSTEM -#include TERM_HEADER -#endif /* HAVE_WINDOW_SYSTEM */ - #ifdef WINDOWSNT #include <fcntl.h> #include <windows.h> /* just for w32.h */ @@ -42,6 +38,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "w32heap.h" /* for prototype of sbrk */ #endif +#ifdef HAVE_WINDOW_SYSTEM +#include TERM_HEADER +#endif /* HAVE_WINDOW_SYSTEM */ + #ifdef NS_IMPL_GNUSTEP /* At least under Debian, GSConfig is in a subdirectory. --Stef */ #include <GNUstepBase/GSConfig.h> @@ -1886,7 +1886,7 @@ shut_down_emacs (int sig, Lisp_Object stuff) static char const format[] = "Fatal error %d: "; char buf[sizeof format - 2 + INT_STRLEN_BOUND (int)]; int buflen = sprintf (buf, format, sig); - char const *sig_desc = strsignal (sig); + char const *sig_desc = safe_strsignal (sig); ignore_value (write (STDERR_FILENO, buf, buflen)); ignore_value (write (STDERR_FILENO, sig_desc, strlen (sig_desc))); } @@ -1912,10 +1912,6 @@ shut_down_emacs (int sig, Lisp_Object stuff) unrequest_sigio (); ignore_sigio (); -#ifdef WINDOWSNT - term_ntproc (0); -#endif - /* Do this only if terminating normally, we want glyph matrices etc. in a core dump. */ if (sig == 0 || sig == SIGTERM) @@ -1935,6 +1931,10 @@ shut_down_emacs (int sig, Lisp_Object stuff) #ifdef HAVE_LIBXML2 xml_cleanup_parser (); #endif + +#ifdef WINDOWSNT + term_ntproc (0); +#endif } diff --git a/src/eval.c b/src/eval.c index 561ba922482..4d200fbc2bd 100644 --- a/src/eval.c +++ b/src/eval.c @@ -119,13 +119,13 @@ static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); /* Functions to set Lisp_Object slots of struct specbinding. */ -static inline void +static void set_specpdl_symbol (Lisp_Object symbol) { specpdl_ptr->symbol = symbol; } -static inline void +static void set_specpdl_old_value (Lisp_Object oldval) { specpdl_ptr->old_value = oldval; diff --git a/src/fileio.c b/src/fileio.c index 9ce9e7b8395..b4eda01afcc 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3034,7 +3034,7 @@ Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of { if (set_file_times (-1, SSDATA (encoded_absname), t, t)) { -#ifdef DOS_NT +#ifdef MSDOS struct stat st; /* Setting times on a directory always fails. */ diff --git a/src/fns.c b/src/fns.c index 6d6f019b311..c999b5b08b9 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3337,14 +3337,6 @@ Lisp_Object Qeq, Qeql, Qequal; Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; -/* Function prototypes. */ - -static struct Lisp_Hash_Table *check_hash_table (Lisp_Object); -static ptrdiff_t get_key_arg (Lisp_Object, ptrdiff_t, Lisp_Object *, char *); -static void maybe_resize_hash_table (struct Lisp_Hash_Table *); -static bool sweep_weak_table (struct Lisp_Hash_Table *, bool); - - /*********************************************************************** Utilities @@ -3695,7 +3687,7 @@ copy_hash_table (struct Lisp_Hash_Table *h1) /* Resize hash table H if it's too full. If H cannot be resized because it's already too large, throw an error. */ -static inline void +static void maybe_resize_hash_table (struct Lisp_Hash_Table *h) { if (NILP (h->next_free)) diff --git a/src/frame.c b/src/frame.c index 4bcacef39c5..2fcf7275f9c 100644 --- a/src/frame.c +++ b/src/frame.c @@ -120,12 +120,12 @@ static void x_report_frame_params (struct frame *, Lisp_Object *); #endif /* These setters are used only in this file, so they can be private. */ -static inline void +static void fset_buffer_predicate (struct frame *f, Lisp_Object val) { f->buffer_predicate = val; } -static inline void +static void fset_minibuffer_window (struct frame *f, Lisp_Object val) { f->minibuffer_window = val; @@ -632,7 +632,7 @@ affects all frames on the same terminal device. */) Lisp_Object terminal; terminal = Fassq (Qterminal, parms); - if (!NILP (terminal)) + if (CONSP (terminal)) { terminal = XCDR (terminal); t = get_terminal (terminal, 1); @@ -3028,9 +3028,9 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist) void x_report_frame_params (struct frame *f, Lisp_Object *alistptr) { - char buf[16]; Lisp_Object tem; - unsigned long w; + uprintmax_t w; + char buf[INT_BUFSIZE_BOUND (w)]; /* Represent negative positions (off the top or left screen edge) in a way that Fmodify_frame_parameters will understand correctly. */ @@ -3067,17 +3067,17 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr) MS-Windows it returns a value whose type is HANDLE, which is actually a pointer. Explicit casting avoids compiler warnings. */ - w = (unsigned long) FRAME_X_WINDOW (f); + w = (uintptr_t) FRAME_X_WINDOW (f); store_in_alist (alistptr, Qwindow_id, - make_formatted_string (buf, "%lu", w)); + make_formatted_string (buf, "%"pMu, w)); #ifdef HAVE_X_WINDOWS #ifdef USE_X_TOOLKIT /* Tooltip frame may not have this widget. */ if (FRAME_X_OUTPUT (f)->widget) #endif - w = (unsigned long) FRAME_OUTER_WINDOW (f); + w = (uintptr_t) FRAME_OUTER_WINDOW (f); store_in_alist (alistptr, Qouter_window_id, - make_formatted_string (buf, "%lu", w)); + make_formatted_string (buf, "%"pMu, w)); #endif store_in_alist (alistptr, Qicon_name, f->icon_name); FRAME_SAMPLE_VISIBILITY (f); diff --git a/src/gmalloc.c b/src/gmalloc.c index 78d6934755b..dc584955661 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -36,6 +36,10 @@ Fifth Floor, Boston, MA 02110-1301, USA. #include <pthread.h> #endif +#ifdef WINDOWSNT +#include <w32heap.h> /* for sbrk */ +#endif + #ifdef __cplusplus extern "C" { @@ -460,7 +464,7 @@ get_contiguous_space (ptrdiff_t size, void *position) /* This is called when `_heapinfo' and `heapsize' have just been set to describe a new info table. Set up the table to describe itself and account for it in the statistics. */ -static inline void +static void register_heapinfo (void) { size_t block, blocks; @@ -1289,7 +1293,9 @@ Fifth Floor, Boston, MA 02110-1301, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ +#ifndef min #define min(A, B) ((A) < (B) ? (A) : (B)) +#endif /* On Cygwin the dumped emacs may try to realloc storage allocated in the static heap. We just malloc space in the new heap and copy the diff --git a/src/image.c b/src/image.c index 7901b95f236..91eeb91920c 100644 --- a/src/image.c +++ b/src/image.c @@ -186,11 +186,11 @@ x_bitmap_width (FRAME_PTR f, ptrdiff_t id) } #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) -int +ptrdiff_t x_bitmap_pixmap (FRAME_PTR f, ptrdiff_t id) { /* HAVE_NTGUI needs the explicit cast here. */ - return (int) FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap; + return (ptrdiff_t) FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap; } #endif diff --git a/src/intervals.c b/src/intervals.c index 584ee1e923d..1ed93e1302d 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -64,7 +64,7 @@ static INTERVAL reproduce_tree (INTERVAL, INTERVAL); /* Use these functions to set Lisp_Object or pointer slots of struct interval. */ -static inline void +static void set_interval_object (INTERVAL i, Lisp_Object obj) { eassert (BUFFERP (obj) || STRINGP (obj)); @@ -72,13 +72,13 @@ set_interval_object (INTERVAL i, Lisp_Object obj) i->up.obj = obj; } -static inline void +static void set_interval_left (INTERVAL i, INTERVAL left) { i->left = left; } -static inline void +static void set_interval_right (INTERVAL i, INTERVAL right) { i->right = right; @@ -87,7 +87,7 @@ set_interval_right (INTERVAL i, INTERVAL right) /* Make the parent of D be whatever the parent of S is, regardless of the type. This is used when balancing an interval tree. */ -static inline void +static void copy_interval_parent (INTERVAL d, INTERVAL s) { d->up = s->up; @@ -341,7 +341,7 @@ root_interval (INTERVAL interval) c c */ -static inline INTERVAL +static INTERVAL rotate_right (INTERVAL interval) { INTERVAL i; @@ -388,7 +388,7 @@ rotate_right (INTERVAL interval) c c */ -static inline INTERVAL +static INTERVAL rotate_left (INTERVAL interval) { INTERVAL i; @@ -466,7 +466,7 @@ balance_an_interval (INTERVAL i) /* Balance INTERVAL, potentially stuffing it back into its parent Lisp Object. */ -static inline INTERVAL +static INTERVAL balance_possible_root_interval (INTERVAL interval) { Lisp_Object parent; diff --git a/src/keyboard.c b/src/keyboard.c index f3d7df5e98f..d06b02024c5 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -76,9 +76,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Positive if interrupt input is blocked right now. */ volatile int interrupt_input_blocked; -/* Nonzero means an input interrupt or alarm signal has arrived. +/* True means an input interrupt or alarm signal has arrived. The QUIT macro checks this. */ -volatile int pending_signals; +volatile bool pending_signals; #define KBD_BUFFER_SIZE 4096 @@ -448,47 +448,47 @@ static char *find_user_signal_name (int); static void store_user_signal_events (void); /* These setters are used only in this file, so they can be private. */ -static inline void +static void kset_echo_string (struct kboard *kb, Lisp_Object val) { kb->INTERNAL_FIELD (echo_string) = val; } -static inline void +static void kset_kbd_queue (struct kboard *kb, Lisp_Object val) { kb->INTERNAL_FIELD (kbd_queue) = val; } -static inline void +static void kset_keyboard_translate_table (struct kboard *kb, Lisp_Object val) { kb->INTERNAL_FIELD (Vkeyboard_translate_table) = val; } -static inline void +static void kset_last_prefix_arg (struct kboard *kb, Lisp_Object val) { kb->INTERNAL_FIELD (Vlast_prefix_arg) = val; } -static inline void +static void kset_last_repeatable_command (struct kboard *kb, Lisp_Object val) { kb->INTERNAL_FIELD (Vlast_repeatable_command) = val; } -static inline void +static void kset_local_function_key_map (struct kboard *kb, Lisp_Object val) { kb->INTERNAL_FIELD (Vlocal_function_key_map) = val; } -static inline void +static void kset_overriding_terminal_local_map (struct kboard *kb, Lisp_Object val) { kb->INTERNAL_FIELD (Voverriding_terminal_local_map) = val; } -static inline void +static void kset_real_last_command (struct kboard *kb, Lisp_Object val) { kb->INTERNAL_FIELD (Vreal_last_command) = val; } -static inline void +static void kset_system_key_syms (struct kboard *kb, Lisp_Object val) { kb->INTERNAL_FIELD (system_key_syms) = val; @@ -2283,11 +2283,10 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps, Lisp_Object prev_event, int *used_mouse_menu, EMACS_TIME *end_time) { - volatile Lisp_Object c; + Lisp_Object c; ptrdiff_t jmpcount; sys_jmp_buf local_getcjmp; sys_jmp_buf save_jump; - volatile int key_already_recorded = 0; Lisp_Object tem, save; volatile Lisp_Object previous_echo_area_message; volatile Lisp_Object also_record; @@ -2519,10 +2518,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps, return c; /* wrong_kboard_jmpbuf */ if (! NILP (c)) - { - key_already_recorded = 1; - goto non_reread_1; - } + goto exit; } /* Make a longjmp point for quits to use, but don't alter getcjmp just yet. @@ -2850,12 +2846,10 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps, goto wrong_kboard; } - non_reread_1: - /* Buffer switch events are only for internal wakeups so don't show them to the user. Also, don't record a key if we already did. */ - if (BUFFERP (c) || key_already_recorded) + if (BUFFERP (c)) goto exit; /* Process special events within read_char @@ -3749,7 +3743,7 @@ kbd_buffer_events_waiting (int discard) /* Clear input event EVENT. */ -static inline void +static void clear_event (struct input_event *event) { event->kind = NO_EVENT; @@ -8054,7 +8048,7 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void /* Access slot with index IDX of vector tool_bar_item_properties. */ #define PROP(IDX) AREF (tool_bar_item_properties, (IDX)) -static inline void +static void set_prop (ptrdiff_t idx, Lisp_Object val) { ASET (tool_bar_item_properties, idx, val); diff --git a/src/lisp.h b/src/lisp.h index c3cabe0af29..2a647e593a8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2131,7 +2131,7 @@ extern char *stack_bottom; a request to exit Emacs when it is safe to do. */ extern void process_pending_signals (void); -extern int volatile pending_signals; +extern bool volatile pending_signals; extern void process_quit_flag (void); #define QUIT \ diff --git a/src/lread.c b/src/lread.c index d22011be7c8..a2b6d1f26d9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1700,7 +1700,7 @@ readevalloop (Lisp_Object readcharfun, if (NILP (Ffboundp (macroexpand)) /* Don't macroexpand in .elc files, since it should have been done already. We actually don't know whether we're in a .elc file or not, - so we use circumstancial evidence: .el files normally go through + so we use circumstantial evidence: .el files normally go through Vload_source_file_function -> load-with-code-conversion -> eval-buffer. */ || EQ (readcharfun, Qget_file_char) @@ -2283,7 +2283,7 @@ read_escape (Lisp_Object readcharfun, int stringp) /* Return the digit that CHARACTER stands for in the given BASE. Return -1 if CHARACTER is out of range for BASE, and -2 if CHARACTER is not valid for any supported BASE. */ -static inline int +static int digit_to_number (int character, int base) { int digit; diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 3d1464cc742..c6fbf59fb5a 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -25,7 +25,7 @@ ALL = emacs EMACSLOADPATH=$(CURDIR)/../lisp # Size in MBs of the static heap in temacs.exe. -HEAPSIZE = 27 +HEAPSIZE = $(EMACS_HEAPSIZE) LOCAL_FLAGS = -Demacs=1 -I../lib -I../nt/inc -DHAVE_NTGUI=1 $(EMACS_EXTRA_C_FLAGS) @@ -247,10 +247,10 @@ bootstrap: bootstrap-emacs # WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as # this can break with GNU Make 3.81 and later if sh.exe is used. bootstrap-temacs-CMD: - $(MAKE) $(MFLAGS) $(XMFLAGS) temacs CFLAGS=$(ARGQUOTE)$(ESC_CFLAGS) -DPURESIZE=5000000$(ARGQUOTE) + $(MAKE) $(MFLAGS) $(XMFLAGS) temacs CFLAGS=$(ARGQUOTE)$(ESC_CFLAGS) -DPURESIZE=$(EMACS_PURESIZE)$(ARGQUOTE) bootstrap-temacs-SH: - $(MAKE) $(MFLAGS) $(XMFLAGS) temacs CFLAGS=$(ARGQUOTE)$(CFLAGS) -DPURESIZE=5000000$(ARGQUOTE) + $(MAKE) $(MFLAGS) $(XMFLAGS) temacs CFLAGS=$(ARGQUOTE)$(CFLAGS) -DPURESIZE=$(EMACS_PURESIZE)$(ARGQUOTE) bootstrap-temacs: $(MAKE) $(MFLAGS) bootstrap-temacs-$(SHELLTYPE) @@ -485,6 +485,7 @@ $(BLD)/alloc.$(O) : \ $(SRC)/blockinput.h \ $(SRC)/puresize.h \ $(SRC)/w32.h \ + $(SRC)/w32heap.h \ $(NT_INC)/unistd.h \ $(GNU_LIB)/verify.h \ $(BUFFER_H) \ @@ -955,6 +956,7 @@ $(BLD)/fringe.$(O) : \ $(BLD)/gmalloc.$(O) : \ $(SRC)/gmalloc.c \ + $(SRC)/w32heap.h \ $(NT_INC)/stdint.h \ $(NT_INC)/unistd.h \ $(CONFIG_H) diff --git a/src/marker.c b/src/marker.c index 0c4e8cb3b55..e01647bdb2a 100644 --- a/src/marker.c +++ b/src/marker.c @@ -427,7 +427,7 @@ Returns nil if MARKER points nowhere. */) /* Change M so it points to B at CHARPOS and BYTEPOS. */ -static inline void +static void attach_marker (struct Lisp_Marker *m, struct buffer *b, ptrdiff_t charpos, ptrdiff_t bytepos) { @@ -454,7 +454,7 @@ attach_marker (struct Lisp_Marker *m, struct buffer *b, whether BUFFER is a buffer object and return buffer pointer corresponding to BUFFER if BUFFER is live, or NULL otherwise. */ -static inline struct buffer * +static struct buffer * live_buffer (Lisp_Object buffer) { struct buffer *b; @@ -477,7 +477,7 @@ live_buffer (Lisp_Object buffer) /* Internal function to set MARKER in BUFFER at POSITION. Non-zero RESTRICTED means limit the POSITION by the visible part of BUFFER. */ -static inline Lisp_Object +static Lisp_Object set_marker_internal (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer, int restricted) { diff --git a/src/minibuf.c b/src/minibuf.c index 6f9c61dcfb1..dd4ca34c3fb 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1703,7 +1703,7 @@ If INITIAL-INPUT is non-nil, insert it in the minibuffer initially, functions, which use one-indexing for POSITION.) This feature is deprecated--it is best to pass nil for INITIAL-INPUT and supply the default value DEF instead. The user can yank the default value into - the minibuffer easily using \\[next-history-element]. + the minibuffer easily using \\<minibuffer-local-map>\\[next-history-element]. HIST, if non-nil, specifies a history list and optionally the initial position in the list. It can be a symbol, which is the history list diff --git a/src/nsterm.m b/src/nsterm.m index d41c38f4e40..2df0e1a1ad5 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2171,7 +2171,7 @@ ns_shift_glyphs_for_insert (struct frame *f, ========================================================================== */ -static inline void +static void ns_compute_glyph_string_overhangs (struct glyph_string *s) /* -------------------------------------------------------------------------- External (RIF); compute left/right overhang of whole string and set in s @@ -5871,7 +5871,6 @@ not_in_argv (NSString *arg) { [self setFSValue: FULLSCREEN_BOTH]; #ifndef NEW_STYLE_FS - fprintf(stderr, "%s %d\n", __func__, FRAME_PIXEL_WIDTH (emacsframe)); [self windowDidBecomeKey:notification]; #endif } diff --git a/src/process.c b/src/process.c index ab215766c07..92bea0d3a27 100644 --- a/src/process.c +++ b/src/process.c @@ -335,82 +335,82 @@ static struct sockaddr_and_len { static int pty_max_bytes; /* These setters are used only in this file, so they can be private. */ -static inline void +static void pset_buffer (struct Lisp_Process *p, Lisp_Object val) { p->buffer = val; } -static inline void +static void pset_command (struct Lisp_Process *p, Lisp_Object val) { p->command = val; } -static inline void +static void pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val) { p->decode_coding_system = val; } -static inline void +static void pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val) { p->decoding_buf = val; } -static inline void +static void pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val) { p->encode_coding_system = val; } -static inline void +static void pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val) { p->encoding_buf = val; } -static inline void +static void pset_filter (struct Lisp_Process *p, Lisp_Object val) { p->filter = val; } -static inline void +static void pset_log (struct Lisp_Process *p, Lisp_Object val) { p->log = val; } -static inline void +static void pset_mark (struct Lisp_Process *p, Lisp_Object val) { p->mark = val; } -static inline void +static void pset_name (struct Lisp_Process *p, Lisp_Object val) { p->name = val; } -static inline void +static void pset_plist (struct Lisp_Process *p, Lisp_Object val) { p->plist = val; } -static inline void +static void pset_sentinel (struct Lisp_Process *p, Lisp_Object val) { p->sentinel = val; } -static inline void +static void pset_status (struct Lisp_Process *p, Lisp_Object val) { p->status = val; } -static inline void +static void pset_tty_name (struct Lisp_Process *p, Lisp_Object val) { p->tty_name = val; } -static inline void +static void pset_type (struct Lisp_Process *p, Lisp_Object val) { p->type = val; } -static inline void +static void pset_write_queue (struct Lisp_Process *p, Lisp_Object val) { p->write_queue = val; @@ -570,7 +570,7 @@ status_message (struct Lisp_Process *p) if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) { - char *signame; + char const *signame; synchronize_system_messages_locale (); signame = strsignal (code); if (signame == 0) diff --git a/src/profiler.c b/src/profiler.c index 90a85c5230e..51580710f28 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -128,8 +128,8 @@ static void evict_lower_half (log_t *log) } /* Record the current backtrace in LOG. COUNT is the weight of this - current backtrace: milliseconds for CPU counts, and the allocation - size for memory logs. */ + current backtrace: interrupt counts for CPU, and the allocation + size for memory. */ static void record_backtrace (log_t *log, EMACS_INT count) @@ -198,15 +198,13 @@ record_backtrace (log_t *log, EMACS_INT count) } } -/* Sample profiler. */ - -/* FIXME: Add support for the CPU profiler in W32. */ +/* Sampling profiler. */ #ifdef PROFILER_CPU_SUPPORT /* The profiler timer and whether it was properly initialized, if POSIX timers are available. */ -#ifdef HAVE_TIMER_SETTIME +#ifdef HAVE_ITIMERSPEC static timer_t profiler_timer; static bool profiler_timer_ok; #endif @@ -222,10 +220,10 @@ static Lisp_Object cpu_log; /* Separate counter for the time spent in the GC. */ static EMACS_INT cpu_gc_count; -/* The current sample interval in milliseconds. */ -static EMACS_INT current_sample_interval; +/* The current sampling interval in nanoseconds. */ +static EMACS_INT current_sampling_interval; -/* Signal handler for sample profiler. */ +/* Signal handler for sampling profiler. */ static void handle_profiler_signal (int signal) @@ -237,11 +235,33 @@ handle_profiler_signal (int signal) not expect the ARRAY_MARK_FLAG to be set. We could try and harden the hash-table code, but it doesn't seem worth the effort. */ - cpu_gc_count = saturated_add (cpu_gc_count, current_sample_interval); + cpu_gc_count = saturated_add (cpu_gc_count, 1); else { + Lisp_Object oquit; + bool saved_pending_signals; + EMACS_INT count = 1; +#ifdef HAVE_ITIMERSPEC + if (profiler_timer_ok) + { + int overruns = timer_getoverrun (profiler_timer); + eassert (0 <= overruns); + count += overruns; + } +#endif + /* record_backtrace uses hash functions that call Fequal, which + uses QUIT, which can call malloc, which can cause disaster in + a signal handler. So inhibit QUIT. */ + oquit = Vinhibit_quit; + saved_pending_signals = pending_signals; + Vinhibit_quit = Qt; + pending_signals = 0; + eassert (HASH_TABLE_P (cpu_log)); - record_backtrace (XHASH_TABLE (cpu_log), current_sample_interval); + record_backtrace (XHASH_TABLE (cpu_log), count); + + Vinhibit_quit = oquit; + pending_signals = saved_pending_signals; } } @@ -252,25 +272,27 @@ deliver_profiler_signal (int signal) } static enum profiler_cpu_running -setup_cpu_timer (Lisp_Object sample_interval) +setup_cpu_timer (Lisp_Object sampling_interval) { struct sigaction action; struct itimerval timer; struct timespec interval; + int billion = 1000000000; - if (! RANGED_INTEGERP (1, sample_interval, - (TYPE_MAXIMUM (time_t) < EMACS_INT_MAX / 1000 - ? (EMACS_INT) TYPE_MAXIMUM (time_t) * 1000 + 999 + if (! RANGED_INTEGERP (1, sampling_interval, + (TYPE_MAXIMUM (time_t) < EMACS_INT_MAX / billion + ? ((EMACS_INT) TYPE_MAXIMUM (time_t) * billion + + (billion - 1)) : EMACS_INT_MAX))) return NOT_RUNNING; - current_sample_interval = XINT (sample_interval); - interval = make_emacs_time (current_sample_interval / 1000, - current_sample_interval % 1000 * 1000000); + current_sampling_interval = XINT (sampling_interval); + interval = make_emacs_time (current_sampling_interval / billion, + current_sampling_interval % billion); emacs_sigaction_init (&action, deliver_profiler_signal); sigaction (SIGPROF, &action, 0); -#ifdef HAVE_TIMER_SETTIME +#ifdef HAVE_ITIMERSPEC if (! profiler_timer_ok) { /* System clocks to try, in decreasing order of desirability. */ @@ -304,25 +326,29 @@ setup_cpu_timer (Lisp_Object sample_interval) { struct itimerspec ispec; ispec.it_value = ispec.it_interval = interval; - timer_settime (profiler_timer, 0, &ispec, 0); - return TIMER_SETTIME_RUNNING; + if (timer_settime (profiler_timer, 0, &ispec, 0) == 0) + return TIMER_SETTIME_RUNNING; } #endif +#ifdef HAVE_SETITIMER timer.it_value = timer.it_interval = make_timeval (interval); - setitimer (ITIMER_PROF, &timer, 0); - return SETITIMER_RUNNING; + if (setitimer (ITIMER_PROF, &timer, 0) == 0) + return SETITIMER_RUNNING; +#endif + + return NOT_RUNNING; } DEFUN ("profiler-cpu-start", Fprofiler_cpu_start, Sprofiler_cpu_start, 1, 1, 0, doc: /* Start or restart the cpu profiler. -It takes call-stack samples each SAMPLE-INTERVAL milliseconds. +It takes call-stack samples each SAMPLING-INTERVAL nanoseconds, approximately. See also `profiler-log-size' and `profiler-max-stack-depth'. */) - (Lisp_Object sample_interval) + (Lisp_Object sampling_interval) { if (profiler_cpu_running) - error ("Sample profiler is already running"); + error ("CPU profiler is already running"); if (NILP (cpu_log)) { @@ -331,9 +357,9 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) profiler_max_stack_depth); } - profiler_cpu_running = setup_cpu_timer (sample_interval); + profiler_cpu_running = setup_cpu_timer (sampling_interval); if (! profiler_cpu_running) - error ("Invalid sample interval"); + error ("Invalid sampling interval"); return Qt; } @@ -349,7 +375,7 @@ Return non-nil if the profiler was running. */) case NOT_RUNNING: return Qnil; -#ifdef HAVE_TIMER_SETTIME +#ifdef HAVE_ITIMERSPEC case TIMER_SETTIME_RUNNING: { struct itimerspec disable; @@ -359,6 +385,7 @@ Return non-nil if the profiler was running. */) break; #endif +#ifdef HAVE_SETITIMER case SETITIMER_RUNNING: { struct itimerval disable; @@ -366,6 +393,7 @@ Return non-nil if the profiler was running. */) setitimer (ITIMER_PROF, &disable, 0); } break; +#endif } signal (SIGPROF, SIG_IGN); diff --git a/src/ralloc.c b/src/ralloc.c index ab91baae5b5..e4a8fe9c6da 100644 --- a/src/ralloc.c +++ b/src/ralloc.c @@ -72,7 +72,7 @@ static void r_alloc_init (void); /* Declarations for working with the malloc, ralloc, and system breaks. */ /* Function to set the real break value. */ -POINTER (*real_morecore) (long int); +POINTER (*real_morecore) (ptrdiff_t); /* The break value, as seen by malloc. */ static POINTER virtual_break_value; @@ -91,18 +91,18 @@ static int extra_bytes; /* Macros for rounding. Note that rounding to any value is possible by changing the definition of PAGE. */ #define PAGE (getpagesize ()) -#define ROUNDUP(size) (((unsigned long int) (size) + page_size - 1) \ - & ~(page_size - 1)) +#define ROUNDUP(size) (((size_t) (size) + page_size - 1) \ + & ~((size_t)(page_size - 1))) #define MEM_ALIGN sizeof (double) -#define MEM_ROUNDUP(addr) (((unsigned long int)(addr) + MEM_ALIGN - 1) \ - & ~(MEM_ALIGN - 1)) +#define MEM_ROUNDUP(addr) (((size_t)(addr) + MEM_ALIGN - 1) \ + & ~(MEM_ALIGN - 1)) /* The hook `malloc' uses for the function which gets more space from the system. */ #ifndef SYSTEM_MALLOC -extern POINTER (*__morecore) (long int); +extern POINTER (*__morecore) (ptrdiff_t); #endif @@ -308,7 +308,7 @@ static void relinquish (void) { register heap_ptr h; - long excess = 0; + ptrdiff_t excess = 0; /* Add the amount of space beyond break_value in all heaps which have extend beyond break_value at all. */ @@ -752,7 +752,7 @@ free_bloc (bloc_ptr bloc) GNU malloc package. */ static POINTER -r_alloc_sbrk (long int size) +r_alloc_sbrk (ptrdiff_t size) { register bloc_ptr b; POINTER address; diff --git a/src/syntax.c b/src/syntax.c index 91ef4e66663..d3cafcc472e 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -151,7 +151,7 @@ static void scan_sexps_forward (struct lisp_parse_state *, static int in_classes (int, Lisp_Object); /* This setter is used only in this file, so it can be private. */ -static inline void +static void bset_syntax_table (struct buffer *b, Lisp_Object val) { b->INTERNAL_FIELD (syntax_table) = val; @@ -372,7 +372,7 @@ char_quoted (ptrdiff_t charpos, ptrdiff_t bytepos) /* Return the bytepos one character before BYTEPOS. We assume that BYTEPOS is not at the start of the buffer. */ -static inline ptrdiff_t +static ptrdiff_t dec_bytepos (ptrdiff_t bytepos) { if (NILP (BVAR (current_buffer, enable_multibyte_characters))) diff --git a/src/sysdep.c b/src/sysdep.c index b7141011d05..74617fcaf0f 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -54,6 +54,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #ifdef WINDOWSNT #define read sys_read #define write sys_write +#ifndef STDERR_FILENO +#define STDERR_FILENO fileno(GetStdHandle(STD_ERROR_HANDLE)) +#endif #include <windows.h> #endif /* not WINDOWSNT */ @@ -1540,12 +1543,10 @@ deliver_thread_signal (int sig, signal_handler_t handler) errno = old_errno; } -#if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST -static char *my_sys_siglist[NSIG]; -# ifdef sys_siglist -# undef sys_siglist -# endif +#if !HAVE_DECL_SYS_SIGLIST +# undef sys_siglist # define sys_siglist my_sys_siglist +static char const *sys_siglist[NSIG]; #endif /* Handle bus errors, invalid instruction, etc. */ @@ -1608,7 +1609,7 @@ init_signals (bool dumping) main_thread = pthread_self (); #endif -#if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST +#if !HAVE_DECL_SYS_SIGLIST if (! initialized) { sys_siglist[SIGABRT] = "Aborted"; @@ -1756,7 +1757,7 @@ init_signals (bool dumping) sys_siglist[SIGXFSZ] = "File size limit exceeded"; # endif } -#endif /* !defined HAVE_STRSIGNAL && !defined HAVE_DECL_SYS_SIGLIST */ +#endif /* !HAVE_DECL_SYS_SIGLIST */ /* Don't alter signal handlers if dumping. On some machines, changing signal handlers sets static data that would make signals @@ -2277,21 +2278,20 @@ set_file_times (int fd, const char *filename, return fdutimens (fd, filename, timespec); } -#ifndef HAVE_STRSIGNAL -char * -strsignal (int code) +/* Like strsignal, except async-signal-safe, and this function typically + returns a string in the C locale rather than the current locale. */ +char const * +safe_strsignal (int code) { - char *signame = 0; + char const *signame = 0; if (0 <= code && code < NSIG) - { - /* Cast to suppress warning if the table has const char *. */ - signame = (char *) sys_siglist[code]; - } + signame = sys_siglist[code]; + if (! signame) + signame = "Unknown signal"; return signame; } -#endif /* HAVE_STRSIGNAL */ #ifndef DOS_NT /* For make-serial-process */ diff --git a/src/syssignal.h b/src/syssignal.h index ece2515dec9..83ab19698dd 100644 --- a/src/syssignal.h +++ b/src/syssignal.h @@ -29,8 +29,12 @@ extern void init_signals (bool); #define FORWARD_SIGNAL_TO_MAIN_THREAD #endif -#if (defined SIGPROF && (defined HAVE_TIMER_SETTIME || defined HAVE_SETITIMER) \ - && !defined PROFILING) +#if defined HAVE_TIMER_SETTIME && defined SIGEV_SIGNAL +# define HAVE_ITIMERSPEC +#endif + +#if (defined SIGPROF && !defined PROFILING \ + && (defined HAVE_SETITIMER || defined HAVE_ITIMERSPEC)) # define PROFILER_CPU_SUPPORT #endif @@ -39,6 +43,7 @@ extern sigset_t empty_mask; typedef void (*signal_handler_t) (int); extern void emacs_sigaction_init (struct sigaction *, signal_handler_t); +char const *safe_strsignal (int); #if NSIG < NSIG_MINIMUM # undef NSIG @@ -70,8 +75,7 @@ extern void emacs_sigaction_init (struct sigaction *, signal_handler_t); #endif /* ! defined (SIGCLD) */ #ifndef HAVE_STRSIGNAL -/* strsignal is in sysdep.c */ -char *strsignal (int); +# define strsignal(sig) safe_strsignal (sig) #endif void deliver_process_signal (int, signal_handler_t); diff --git a/src/terminal.c b/src/terminal.c index 719c2a36111..2c0c60e7345 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -42,7 +42,7 @@ struct terminal *initial_terminal; static void delete_initial_terminal (struct terminal *); /* This setter is used only in this file, so it can be private. */ -static inline void +static void tset_param_alist (struct terminal *t, Lisp_Object val) { t->param_alist = val; diff --git a/src/textprop.c b/src/textprop.c index 872912ea706..379eafb73f7 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -241,7 +241,7 @@ interval_has_all_properties (Lisp_Object plist, INTERVAL i) /* Return nonzero if the plist of interval I has any of the properties of PLIST, regardless of their values. */ -static inline int +static int interval_has_some_properties (Lisp_Object plist, INTERVAL i) { register Lisp_Object tail1, tail2, sym; @@ -263,7 +263,7 @@ interval_has_some_properties (Lisp_Object plist, INTERVAL i) /* Return nonzero if the plist of interval I has any of the property names in LIST, regardless of their values. */ -static inline int +static int interval_has_some_properties_list (Lisp_Object list, INTERVAL i) { register Lisp_Object tail1, tail2, sym; diff --git a/src/unexmacosx.c b/src/unexmacosx.c index d38b91e955a..d304e85d490 100644 --- a/src/unexmacosx.c +++ b/src/unexmacosx.c @@ -119,7 +119,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* LC_DATA_IN_CODE is not defined in mach-o/loader.h on OS X 10.7. But it is used if we build with "Command Line Tools for Xcode 4.5 - (OS X Lion) - Septemper 2012". */ + (OS X Lion) - September 2012". */ #ifndef LC_DATA_IN_CODE #define LC_DATA_IN_CODE 0x29 /* table of non-instructions in __text */ #endif diff --git a/src/unexw32.c b/src/unexw32.c index 52b2ec4bf2b..3eefc9ce058 100644 --- a/src/unexw32.c +++ b/src/unexw32.c @@ -67,18 +67,18 @@ void dump_bss_and_heap (file_data *p_infile, file_data *p_outfile); /* Cached info about the .data section in the executable. */ PIMAGE_SECTION_HEADER data_section; PCHAR data_start = 0; -DWORD data_size = 0; +DWORD_PTR data_size = 0; /* Cached info about the .bss section in the executable. */ PIMAGE_SECTION_HEADER bss_section; PCHAR bss_start = 0; -DWORD bss_size = 0; -DWORD extra_bss_size = 0; +DWORD_PTR bss_size = 0; +DWORD_PTR extra_bss_size = 0; /* bss data that is static might be discontiguous from non-static. */ PIMAGE_SECTION_HEADER bss_section_static; PCHAR bss_start_static = 0; -DWORD bss_size_static = 0; -DWORD extra_bss_size_static = 0; +DWORD_PTR bss_size_static = 0; +DWORD_PTR extra_bss_size_static = 0; PIMAGE_SECTION_HEADER heap_section; @@ -231,7 +231,7 @@ find_section (char * name, IMAGE_NT_HEADERS * nt_header) /* Return pointer to section header for section containing the given relative virtual address. */ IMAGE_SECTION_HEADER * -rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) +rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header) { PIMAGE_SECTION_HEADER section; int i; @@ -246,7 +246,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) some very old exes (eg. gzip dated Dec 1993). Since w32_executable_type relies on this function to work reliably, we need to cope with this. */ - DWORD real_size = max (section->SizeOfRawData, + DWORD_PTR real_size = max (section->SizeOfRawData, section->Misc.VirtualSize); if (rva >= section->VirtualAddress && rva < section->VirtualAddress + real_size) @@ -259,7 +259,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) /* Return pointer to section header for section containing the given offset in its raw data area. */ IMAGE_SECTION_HEADER * -offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header) +offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header) { PIMAGE_SECTION_HEADER section; int i; @@ -279,8 +279,8 @@ offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header) /* Return offset to an object in dst, given offset in src. We assume there is at least one section in both src and dst images, and that the some sections may have been added to dst (after sections in src). */ -DWORD -relocate_offset (DWORD offset, +DWORD_PTR +relocate_offset (DWORD_PTR offset, IMAGE_NT_HEADERS * src_nt_header, IMAGE_NT_HEADERS * dst_nt_header) { @@ -314,25 +314,25 @@ relocate_offset (DWORD offset, } #define OFFSET_TO_RVA(offset, section) \ - (section->VirtualAddress + ((DWORD)(offset) - section->PointerToRawData)) + ((section)->VirtualAddress + ((DWORD_PTR)(offset) - (section)->PointerToRawData)) #define RVA_TO_OFFSET(rva, section) \ - (section->PointerToRawData + ((DWORD)(rva) - section->VirtualAddress)) + ((section)->PointerToRawData + ((DWORD_PTR)(rva) - (section)->VirtualAddress)) #define RVA_TO_SECTION_OFFSET(rva, section) \ - ((DWORD)(rva) - section->VirtualAddress) + ((DWORD_PTR)(rva) - (section)->VirtualAddress) /* Convert address in executing image to RVA. */ -#define PTR_TO_RVA(ptr) ((DWORD)(ptr) - (DWORD) GetModuleHandle (NULL)) +#define PTR_TO_RVA(ptr) ((DWORD_PTR)(ptr) - (DWORD_PTR) GetModuleHandle (NULL)) #define RVA_TO_PTR(var,section,filedata) \ - ((void *)(RVA_TO_OFFSET (var,section) + (filedata).file_base)) + ((unsigned char *)(RVA_TO_OFFSET (var,section) + (filedata).file_base)) #define PTR_TO_OFFSET(ptr, pfile_data) \ ((unsigned char *)(ptr) - (pfile_data)->file_base) #define OFFSET_TO_PTR(offset, pfile_data) \ - ((pfile_data)->file_base + (DWORD)(offset)) + ((pfile_data)->file_base + (DWORD_PTR)(offset)) /* Flip through the executable and cache the info necessary for dumping. */ @@ -349,7 +349,7 @@ get_section_info (file_data *p_infile) printf ("Unknown EXE header in %s...bailing.\n", p_infile->name); exit (1); } - nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + + nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) + dos_header->e_lfanew); if (nt_header == NULL) { @@ -488,7 +488,7 @@ copy_executable_and_dump_data (file_data *p_infile, PIMAGE_NT_HEADERS dst_nt_header; PIMAGE_SECTION_HEADER section; PIMAGE_SECTION_HEADER dst_section; - DWORD offset; + DWORD_PTR offset; int i; int be_verbose = GetEnvironmentVariable ("DEBUG_DUMP", NULL, 0) > 0; @@ -541,17 +541,17 @@ copy_executable_and_dump_data (file_data *p_infile, Note that dst is updated implicitly by each COPY_CHUNK. */ dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base; - nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + + nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) + dos_header->e_lfanew); section = IMAGE_FIRST_SECTION (nt_header); dst = (unsigned char *) p_outfile->file_base; COPY_CHUNK ("Copying DOS header...", dos_header, - (DWORD) nt_header - (DWORD) dos_header, be_verbose); + (DWORD_PTR) nt_header - (DWORD_PTR) dos_header, be_verbose); dst_nt_header = (PIMAGE_NT_HEADERS) dst; COPY_CHUNK ("Copying NT header...", nt_header, - (DWORD) section - (DWORD) nt_header, be_verbose); + (DWORD_PTR) section - (DWORD_PTR) nt_header, be_verbose); dst_section = (PIMAGE_SECTION_HEADER) dst; COPY_CHUNK ("Copying section table...", section, nt_header->FileHeader.NumberOfSections * sizeof (*section), @@ -627,8 +627,8 @@ copy_executable_and_dump_data (file_data *p_infile, } if (section == heap_section) { - DWORD heap_start = (DWORD) get_heap_start (); - DWORD heap_size = get_committed_heap_size (); + DWORD_PTR heap_start = (DWORD_PTR) get_heap_start (); + DWORD_PTR heap_size = get_committed_heap_size (); /* Dump the used portion of the predump heap, adjusting the section's size to the appropriate size. */ diff --git a/src/vm-limit.c b/src/vm-limit.c index 8de0acd1bb2..3020b84858a 100644 --- a/src/vm-limit.c +++ b/src/vm-limit.c @@ -41,7 +41,7 @@ static void (*warn_function) (const char *); static POINTER data_space_start; /* Number of bytes of writable memory we can expect to be able to get. */ -static unsigned long lim_data; +static size_t lim_data; #if defined (HAVE_GETRLIMIT) && defined (RLIMIT_AS) @@ -88,7 +88,7 @@ get_lim_data (void) static void get_lim_data (void) { - extern unsigned long reserved_heap_size; + extern size_t reserved_heap_size; lim_data = reserved_heap_size; } @@ -166,13 +166,13 @@ static void check_memory_limits (void) { #ifdef REL_ALLOC - extern POINTER (*real_morecore) (long); + extern POINTER (*real_morecore) (ptrdiff_t); #endif - extern POINTER (*__morecore) (long); + extern POINTER (*__morecore) (ptrdiff_t); register POINTER cp; - unsigned long five_percent; - unsigned long data_size; + size_t five_percent; + size_t data_size; enum warnlevel new_warnlevel; if (lim_data == 0) diff --git a/src/w32.c b/src/w32.c index 3154c725abf..f17c06ea807 100644 --- a/src/w32.c +++ b/src/w32.c @@ -1528,52 +1528,6 @@ is_unc_volume (const char *filename) return 1; } -/* Routines that are no-ops on NT but are defined to get Emacs to compile. */ -int -sigemptyset (sigset_t *set) -{ - *set = 0; - return 0; -} - -int -sigaddset (sigset_t *set, int signo) -{ - return 0; -} - -int -sigfillset (sigset_t *set) -{ - return 0; -} - -int -sigprocmask (int how, const sigset_t *set, sigset_t *oset) -{ - return 0; -} - -int -pthread_sigmask (int how, const sigset_t *set, sigset_t *oset) -{ - if (sigprocmask (how, set, oset) == -1) - return EINVAL; - return 0; -} - -int -setpgrp (int pid, int gid) -{ - return 0; -} - -int -alarm (int seconds) -{ - return 0; -} - #define REG_ROOT "SOFTWARE\\GNU\\Emacs" LPBYTE @@ -1784,7 +1738,8 @@ init_environment (char ** argv) /* FIXME: should use substring of get_emacs_configuration (). But I don't think the Windows build supports alpha, mips etc anymore, so have taken the easy option for now. */ - else if (p && xstrcasecmp (p, "\\i386") == 0) + else if (p && (xstrcasecmp (p, "\\i386") == 0 + || xstrcasecmp (p, "\\AMD64") == 0)) { *p = 0; p = strrchr (modname, '\\'); @@ -1932,7 +1887,16 @@ get_emacs_configuration (void) case PROCESSOR_INTEL_386: case PROCESSOR_INTEL_486: case PROCESSOR_INTEL_PENTIUM: +#ifdef _WIN64 + arch = "amd64"; +#else arch = "i386"; +#endif + break; +#endif +#ifdef PROCESSOR_AMD_X8664 + case PROCESSOR_AMD_X8664: + arch = "amd64"; break; #endif @@ -3988,9 +3952,13 @@ utime (const char *name, struct utimbuf *times) } /* Need write access to set times. */ - fh = CreateFile (name, GENERIC_WRITE, FILE_SHARE_READ | FILE_SHARE_WRITE, - 0, OPEN_EXISTING, 0, NULL); - if (fh) + fh = CreateFile (name, FILE_WRITE_ATTRIBUTES, + /* If NAME specifies a directory, FILE_SHARE_DELETE + allows other processes to delete files inside it, + while we have the directory open. */ + FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, + 0, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); + if (fh != INVALID_HANDLE_VALUE) { convert_from_time_t (times->actime, &atime); convert_from_time_t (times->modtime, &mtime); @@ -6623,6 +6591,9 @@ void term_ntproc (int ignored) { (void)ignored; + + term_timers (); + /* shutdown the socket interface if necessary */ term_winsock (); @@ -6632,6 +6603,8 @@ term_ntproc (int ignored) void init_ntproc (int dumping) { + sigset_t initial_mask = 0; + /* Initialize the socket interface now if available and requested by the user by defining PRELOAD_WINSOCK; otherwise loading will be delayed until open-network-stream is called (w32-has-winsock can @@ -6687,19 +6660,19 @@ init_ntproc (int dumping) fclose (stderr); if (stdin_save != INVALID_HANDLE_VALUE) - _open_osfhandle ((long) stdin_save, O_TEXT); + _open_osfhandle ((intptr_t) stdin_save, O_TEXT); else _open ("nul", O_TEXT | O_NOINHERIT | O_RDONLY); _fdopen (0, "r"); if (stdout_save != INVALID_HANDLE_VALUE) - _open_osfhandle ((long) stdout_save, O_TEXT); + _open_osfhandle ((intptr_t) stdout_save, O_TEXT); else _open ("nul", O_TEXT | O_NOINHERIT | O_WRONLY); _fdopen (1, "w"); if (stderr_save != INVALID_HANDLE_VALUE) - _open_osfhandle ((long) stderr_save, O_TEXT); + _open_osfhandle ((intptr_t) stderr_save, O_TEXT); else _open ("nul", O_TEXT | O_NOINHERIT | O_WRONLY); _fdopen (2, "w"); @@ -6708,7 +6681,12 @@ init_ntproc (int dumping) /* unfortunately, atexit depends on implementation of malloc */ /* atexit (term_ntproc); */ if (!dumping) - signal (SIGABRT, term_ntproc); + { + /* Make sure we start with all signals unblocked. */ + sigprocmask (SIG_SETMASK, &initial_mask, NULL); + signal (SIGABRT, term_ntproc); + } + init_timers (); /* determine which drives are fixed, for GetCachedVolumeInformation */ { @@ -6815,7 +6793,7 @@ serial_open (char *port) OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); if (hnd == INVALID_HANDLE_VALUE) error ("Could not open %s", port); - fd = (int) _open_osfhandle ((int) hnd, 0); + fd = (int) _open_osfhandle ((intptr_t) hnd, 0); if (fd == -1) error ("Could not open %s", port); diff --git a/src/w32.h b/src/w32.h index a833c8f4315..2e2315e245d 100644 --- a/src/w32.h +++ b/src/w32.h @@ -142,6 +142,9 @@ extern void syms_of_fontset (void); extern void syms_of_w32font (void); extern void check_windows_init_file (void); +extern void term_timers (void); +extern void init_timers (void); + extern int _sys_read_ahead (int fd); extern int _sys_wait_accept (int fd); diff --git a/src/w32fns.c b/src/w32fns.c index d7b45e263b3..6d5d6822354 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -79,9 +79,7 @@ extern void w32_menu_display_help (HWND, HMENU, UINT, UINT); extern void w32_free_menu_strings (HWND); extern const char *map_w32_filename (const char *, const char **); -/* If non-zero, a w32 timer that, when it expires, displays an - hourglass cursor on all frames. */ -static unsigned hourglass_timer = 0; +/* If non-NULL, a handle to a frame where to display the hourglass cursor. */ static HWND hourglass_hwnd = NULL; #ifndef IDC_HAND @@ -139,7 +137,7 @@ struct MONITOR_INFO }; /* Reportedly, MSVC does not have this in its headers. */ -#ifdef _MSC_VER +#if defined (_MSC_VER) && _WIN32_WINNT < 0x0500 DECLARE_HANDLE(HMONITOR); #endif @@ -175,7 +173,6 @@ unsigned int msh_mousewheel = 0; #define MOUSE_BUTTON_ID 1 #define MOUSE_MOVE_ID 2 #define MENU_FREE_ID 3 -#define HOURGLASS_ID 4 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP is received. */ #define MENU_FREE_DELAY 1000 @@ -2255,7 +2252,7 @@ static void w32_msg_pump (deferred_msg * msg_buf) { MSG msg; - int result; + WPARAM result; HWND focus_window; msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL); @@ -2286,7 +2283,7 @@ w32_msg_pump (deferred_msg * msg_buf) /* Reply is not expected. */ break; case WM_EMACS_SETKEYBOARDLAYOUT: - result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0); + result = (WPARAM) ActivateKeyboardLayout ((HKL) msg.wParam, 0); if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, result, 0)) emacs_abort (); @@ -3313,12 +3310,6 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) menubar_in_use = 0; } } - else if (wParam == hourglass_timer) - { - KillTimer (hwnd, hourglass_timer); - hourglass_timer = 0; - w32_show_hourglass (x_window_to_frame (dpyinfo, hwnd)); - } return 0; case WM_NCACTIVATE: @@ -5040,66 +5031,50 @@ no value of TYPE (always string in the MS Windows case). */) Busy cursor ***********************************************************************/ -/* Default number of seconds to wait before displaying an hourglass - cursor. Duplicated from xdisp.c, but cannot use the version there - due to lack of atimers on w32. */ -#define DEFAULT_HOURGLASS_DELAY 1 - -/* Cancel a currently active hourglass timer, and start a new one. */ - void -start_hourglass (void) +w32_note_current_window (void) { - DWORD delay; - int secs, msecs = 0; struct frame * f = SELECTED_FRAME (); - /* No cursors on non GUI frames. */ if (!FRAME_W32_P (f)) return; - cancel_hourglass (); - - if (INTEGERP (Vhourglass_delay) - && XINT (Vhourglass_delay) > 0) - secs = XFASTINT (Vhourglass_delay); - else if (FLOATP (Vhourglass_delay) - && XFLOAT_DATA (Vhourglass_delay) > 0) - { - Lisp_Object tem; - tem = Ftruncate (Vhourglass_delay, Qnil); - secs = XFASTINT (tem); - msecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000; - } - else - secs = DEFAULT_HOURGLASS_DELAY; - - delay = secs * 1000 + msecs; hourglass_hwnd = FRAME_W32_WINDOW (f); - hourglass_timer = SetTimer (hourglass_hwnd, HOURGLASS_ID, delay, NULL); } - -/* Cancel the hourglass cursor timer if active, hide an hourglass - cursor if shown. */ - void -cancel_hourglass (void) +show_hourglass (struct atimer *timer) { - if (hourglass_timer) - { - KillTimer (hourglass_hwnd, hourglass_timer); - hourglass_timer = 0; - } + struct frame *f; - if (hourglass_shown_p) - w32_hide_hourglass (); + hourglass_atimer = NULL; + + block_input (); + f = x_window_to_frame (&one_w32_display_info, + hourglass_hwnd); + + if (f) + f->output_data.w32->hourglass_p = 0; + else + f = SELECTED_FRAME (); + + if (!FRAME_W32_P (f)) + return; + + w32_show_hourglass (f); + unblock_input (); } +void +hide_hourglass (void) +{ + block_input (); + w32_hide_hourglass (); + unblock_input (); +} -/* Timer function of hourglass_timer. - Display an hourglass cursor. Set the hourglass_p flag in display info +/* Display an hourglass cursor. Set the hourglass_p flag in display info to indicate that an hourglass cursor is shown. */ static void @@ -7123,8 +7098,6 @@ only be necessary if the default setting causes problems. */); check_window_system_func = check_w32; - - hourglass_timer = 0; hourglass_hwnd = NULL; defsubr (&Sx_show_tip); diff --git a/src/w32heap.c b/src/w32heap.c index dc65198f90b..8b9b19ea35d 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -26,7 +26,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "w32heap.h" #include "lisp.h" /* for VALMASK */ -#define RVA_TO_PTR(rva) ((unsigned char *)((DWORD)(rva) + (DWORD)GetModuleHandle (NULL))) +#define RVA_TO_PTR(rva) ((unsigned char *)((DWORD_PTR)(rva) + (DWORD_PTR)GetModuleHandle (NULL))) /* This gives us the page size and the size of the allocation unit on NT. */ SYSTEM_INFO sysinfo_cache; @@ -34,7 +34,7 @@ SYSTEM_INFO sysinfo_cache; /* This gives us version, build, and platform identification. */ OSVERSIONINFO osinfo_cache; -unsigned long syspage_mask = 0; +size_t syspage_mask = 0; /* The major and minor versions of NT. */ int w32_major_version; @@ -97,7 +97,7 @@ PIMAGE_SECTION_HEADER preload_heap_section; unsigned char *data_region_base = NULL; unsigned char *data_region_end = NULL; unsigned char *real_data_region_end = NULL; -unsigned long reserved_heap_size = 0; +size_t reserved_heap_size = 0; /* The start of the data segment. */ unsigned char * @@ -121,16 +121,20 @@ allocate_heap (void) the preload heap section up to the usable address limit. Since GNU malloc can handle gaps in the memory it gets from sbrk, we can simply set the sbrk pointer to the base of the new heap region. */ - unsigned long base = + DWORD_PTR base = ROUND_UP ((RVA_TO_PTR (preload_heap_section->VirtualAddress) + preload_heap_section->Misc.VirtualSize), get_allocation_unit ()); - unsigned long end = 1 << VALBITS; /* 256MB */ + DWORD_PTR end = ((unsigned __int64)1) << VALBITS; /* 256MB */ void *ptr = NULL; while (!ptr && (base < end)) { +#ifdef _WIN64 + reserved_heap_size = min(end - base, 0x4000000000i64); /* Limit to 256Gb */ +#else reserved_heap_size = end - base; +#endif ptr = VirtualAlloc ((void *) base, get_reserved_heap_size (), MEM_RESERVE, @@ -144,7 +148,11 @@ allocate_heap (void) static char * allocate_heap (void) { - unsigned long size = 0x80000000; /* start by asking for 2GB */ +#ifdef _WIN64 + size_t size = 0x4000000000i64; /* start by asking for 32GB */ +#else + size_t size = 0x80000000; /* start by asking for 2GB */ +#endif void *ptr = NULL; while (!ptr && size > 0x00100000) @@ -166,17 +174,17 @@ allocate_heap (void) be the address of the _start_ (not end) of the new block in case of success, and zero (not -1) in case of failure. */ void * -sbrk (unsigned long increment) +sbrk (ptrdiff_t increment) { void *result; - long size = (long) increment; + ptrdiff_t size = increment; result = data_region_end; /* If size is negative, shrink the heap by decommitting pages. */ if (size < 0) { - int new_size; + ptrdiff_t new_size; unsigned char *new_data_region_end; size = -size; @@ -189,7 +197,7 @@ sbrk (unsigned long increment) partial deallocation [cga]. */ new_data_region_end = (data_region_end - size); new_data_region_end = (unsigned char *) - ((long) (new_data_region_end + syspage_mask) & ~syspage_mask); + ((DWORD_PTR) (new_data_region_end + syspage_mask) & ~syspage_mask); new_size = real_data_region_end - new_data_region_end; real_data_region_end = new_data_region_end; if (new_size > 0) @@ -220,7 +228,7 @@ sbrk (unsigned long increment) /* We really only commit full pages, so record where the real end of committed memory is [cga]. */ real_data_region_end = (unsigned char *) - ((long) (data_region_end + syspage_mask) & ~syspage_mask); + ((DWORD_PTR) (data_region_end + syspage_mask) & ~syspage_mask); } return result; @@ -245,7 +253,7 @@ init_heap (void) PIMAGE_NT_HEADERS nt_header; dos_header = (PIMAGE_DOS_HEADER) RVA_TO_PTR (0); - nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + + nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) + dos_header->e_lfanew); preload_heap_section = find_section ("EMHEAP", nt_header); @@ -261,7 +269,7 @@ init_heap (void) #if !USE_LSB_TAG /* Ensure that the addresses don't use the upper tag bits since the Lisp type goes there. */ - if (((unsigned long) data_region_base & ~VALMASK) != 0) + if (((DWORD_PTR) data_region_base & ~VALMASK) != 0) { printf ("Error: The heap was allocated in upper memory.\n"); exit (1); @@ -284,13 +292,13 @@ init_heap (void) /* Round the heap up to the given alignment. */ void -round_heap (unsigned long align) +round_heap (size_t align) { - unsigned long needs_to_be; - unsigned long need_to_alloc; + DWORD_PTR needs_to_be; + DWORD_PTR need_to_alloc; - needs_to_be = (unsigned long) ROUND_UP (get_heap_end (), align); - need_to_alloc = needs_to_be - (unsigned long) get_heap_end (); + needs_to_be = (DWORD_PTR) ROUND_UP (get_heap_end (), align); + need_to_alloc = needs_to_be - (DWORD_PTR) get_heap_end (); if (need_to_alloc) sbrk (need_to_alloc); diff --git a/src/w32heap.h b/src/w32heap.h index fda3c58bf01..aae4845b4cc 100644 --- a/src/w32heap.h +++ b/src/w32heap.h @@ -24,8 +24,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. #include <windows.h> -#define ROUND_UP(p, align) (((DWORD)(p) + (align)-1) & ~((align)-1)) -#define ROUND_DOWN(p, align) ((DWORD)(p) & ~((align)-1)) +#define ROUND_UP(p, align) (((DWORD_PTR)(p) + (align)-1) & ~((DWORD_PTR)(align)-1)) +#define ROUND_DOWN(p, align) ((DWORD_PTR)(p) & ~((DWORD_PTR)(align)-1)) /* * Heap related stuff. @@ -42,7 +42,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. extern unsigned char *get_data_start (void); extern unsigned char *get_data_end (void); -extern unsigned long reserved_heap_size; +extern size_t reserved_heap_size; extern SYSTEM_INFO sysinfo_cache; extern OSVERSIONINFO osinfo_cache; extern BOOL using_dynamic_heap; @@ -58,13 +58,13 @@ enum { extern int os_subtype; /* Emulation of Unix sbrk(). */ -extern void *sbrk (unsigned long size); +extern void *sbrk (ptrdiff_t size); /* Initialize heap structures for sbrk on startup. */ extern void init_heap (void); /* Round the heap to this size. */ -extern void round_heap (unsigned long size); +extern void round_heap (size_t size); /* Cache system info, e.g., the NT page size. */ extern void cache_system_info (void); @@ -89,6 +89,6 @@ IMAGE_SECTION_HEADER * find_section (char * name, IMAGE_NT_HEADERS * nt_header); /* Return pointer to section header for section containing the given relative virtual address. */ -IMAGE_SECTION_HEADER * rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header); +IMAGE_SECTION_HEADER * rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header); #endif /* NTHEAP_H_ */ diff --git a/src/w32menu.c b/src/w32menu.c index fb1cb606940..0a10f1f0893 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -1483,8 +1483,8 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) utf8to16 (out_string, utf8_len, utf16_string); return_value = unicode_append_menu (menu, fuFlags, - item != NULL ? (UINT) item - : (UINT) wv->call_data, + item != NULL ? (UINT_PTR) item + : (UINT_PTR) wv->call_data, utf16_string); if (!return_value) { @@ -1496,7 +1496,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) of minor importance compared with menus not working at all. */ return_value = AppendMenu (menu, fuFlags, - item != NULL ? (UINT) item: (UINT) wv->call_data, + item != NULL ? (UINT_PTR) item: (UINT_PTR) wv->call_data, out_string); /* Don't use Unicode menus in future, unless this is Windows NT or later, where a failure of AppendMenuW does NOT mean @@ -1513,7 +1513,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) return_value = AppendMenu (menu, fuFlags, - item != NULL ? (UINT) item : (UINT) wv->call_data, + item != NULL ? (UINT_PTR) item : (UINT_PTR) wv->call_data, out_string ); } @@ -1550,7 +1550,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) } set_menu_item_info (menu, - item != NULL ? (UINT) item : (UINT) wv->call_data, + item != NULL ? (UINT_PTR) item : (UINT_PTR) wv->call_data, FALSE, &info); } } diff --git a/src/w32proc.c b/src/w32proc.c index b367b42d8c6..d032b21c59e 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -62,7 +62,7 @@ extern BOOL WINAPI IsValidLocale (LCID, DWORD); #define RVA_TO_PTR(var,section,filedata) \ ((void *)((section)->PointerToRawData \ - + ((DWORD)(var) - (section)->VirtualAddress) \ + + ((DWORD_PTR)(var) - (section)->VirtualAddress) \ + (filedata).file_base)) Lisp_Object Qhigh, Qlow; @@ -86,18 +86,23 @@ typedef void (_CALLBACK_ *signal_handler) (int); /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */ static signal_handler sig_handlers[NSIG]; +static sigset_t sig_mask; + +static CRITICAL_SECTION crit_sig; + /* Improve on the CRT 'signal' implementation so that we could record - the SIGCHLD handler. */ + the SIGCHLD handler and fake interval timers. */ signal_handler sys_signal (int sig, signal_handler handler) { signal_handler old; /* SIGCHLD is needed for supporting subprocesses, see sys_kill - below. All the others are the only ones supported by the MS - runtime. */ + below. SIGALRM and SIGPROF are used by setitimer. All the + others are the only ones supported by the MS runtime. */ if (!(sig == SIGCHLD || sig == SIGSEGV || sig == SIGILL - || sig == SIGFPE || sig == SIGABRT || sig == SIGTERM)) + || sig == SIGFPE || sig == SIGABRT || sig == SIGTERM + || sig == SIGALRM || sig == SIGPROF)) { errno = EINVAL; return SIG_ERR; @@ -111,7 +116,7 @@ sys_signal (int sig, signal_handler handler) if (!(sig == SIGABRT && old == term_ntproc)) { sig_handlers[sig] = handler; - if (sig != SIGCHLD) + if (!(sig == SIGCHLD || sig == SIGALRM || sig == SIGPROF)) signal (sig, handler); } return old; @@ -143,6 +148,540 @@ sigaction (int sig, const struct sigaction *act, struct sigaction *oact) return retval; } +/* Emulate signal sets and blocking of signals used by timers. */ + +int +sigemptyset (sigset_t *set) +{ + *set = 0; + return 0; +} + +int +sigaddset (sigset_t *set, int signo) +{ + if (!set) + { + errno = EINVAL; + return -1; + } + if (signo < 0 || signo >= NSIG) + { + errno = EINVAL; + return -1; + } + + *set |= (1U << signo); + + return 0; +} + +int +sigfillset (sigset_t *set) +{ + if (!set) + { + errno = EINVAL; + return -1; + } + + *set = 0xFFFFFFFF; + return 0; +} + +int +sigprocmask (int how, const sigset_t *set, sigset_t *oset) +{ + if (!(how == SIG_BLOCK || how == SIG_UNBLOCK || how == SIG_SETMASK)) + { + errno = EINVAL; + return -1; + } + + if (oset) + *oset = sig_mask; + + if (!set) + return 0; + + switch (how) + { + case SIG_BLOCK: + sig_mask |= *set; + break; + case SIG_SETMASK: + sig_mask = *set; + break; + case SIG_UNBLOCK: + /* FIXME: Catch signals that are blocked and reissue them when + they are unblocked. Important for SIGALRM and SIGPROF only. */ + sig_mask &= ~(*set); + break; + } + + return 0; +} + +int +pthread_sigmask (int how, const sigset_t *set, sigset_t *oset) +{ + if (sigprocmask (how, set, oset) == -1) + return EINVAL; + return 0; +} + +int +sigismember (const sigset_t *set, int signo) +{ + if (signo < 0 || signo >= NSIG) + { + errno = EINVAL; + return -1; + } + if (signo > sizeof (*set) * BITS_PER_CHAR) + emacs_abort (); + + return (*set & (1U << signo)) != 0; +} + +int +setpgrp (int pid, int gid) +{ + return 0; +} + +/* Emulations of interval timers. + + Limitations: only ITIMER_REAL and ITIMER_PROF are supported. + + Implementation: a separate thread is started for each timer type, + the thread calls the appropriate signal handler when the timer + expires, after stopping the thread which installed the timer. */ + +/* FIXME: clock_t counts overflow after 49 days, need to handle the + wrap-around. */ +struct itimer_data { + clock_t expire; + clock_t reload; + int terminate; + int type; + HANDLE caller_thread; + HANDLE timer_thread; +}; + +static clock_t ticks_now; +static struct itimer_data real_itimer, prof_itimer; +static clock_t clocks_min; +/* If non-zero, itimers are disabled. Used during shutdown, when we + delete the critical sections used by the timer threads. */ +static int disable_itimers; + +static CRITICAL_SECTION crit_real, crit_prof; + +#define MAX_SINGLE_SLEEP 30 + +static DWORD WINAPI +timer_loop (LPVOID arg) +{ + struct itimer_data *itimer = (struct itimer_data *)arg; + int which = itimer->type; + int sig = (which == ITIMER_REAL) ? SIGALRM : SIGPROF; + CRITICAL_SECTION *crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof; + const DWORD max_sleep = MAX_SINGLE_SLEEP * 1000 / CLOCKS_PER_SEC; + int new_count = 0; + + while (1) + { + DWORD sleep_time; + signal_handler handler; + clock_t now, expire, reload; + + /* Load new values if requested by setitimer. */ + EnterCriticalSection (crit); + expire = itimer->expire; + reload = itimer->reload; + LeaveCriticalSection (crit); + if (itimer->terminate) + return 0; + + if (itimer->expire == 0) + { + /* We are idle. */ + Sleep (max_sleep); + continue; + } + + expire = itimer->expire; + if (expire > (now = clock ())) + sleep_time = expire - now; + else + sleep_time = 0; + /* Don't sleep too long at a time, to be able to see the + termination flag without too long a delay. */ + while (sleep_time > max_sleep) + { + if (itimer->terminate) + return 0; + Sleep (max_sleep); + expire = itimer->expire; + sleep_time = (expire > (now = clock ())) ? expire - now : 0; + } + if (itimer->terminate) + return 0; + if (sleep_time > 0) + { + Sleep (sleep_time * 1000 / CLOCKS_PER_SEC); + /* Always sleep past the expiration time, to make sure we + never call the handler _before_ the expiration time, + always slightly after it. Sleep(5) makes sure we don't + hog the CPU by calling 'clock' with high frequency, and + also let other threads work. */ + while (clock () < expire) + Sleep (5); + } + + if (itimer->expire == 0) + continue; + + /* Time's up. */ + handler = sig_handlers[sig]; + if (!(handler == SIG_DFL || handler == SIG_IGN || handler == SIG_ERR) + /* FIXME: Don't ignore masked signals. Instead, record that + they happened and reissue them when the signal is + unblocked. */ + && !sigismember (&sig_mask, sig) + /* Simulate masking of SIGALRM and SIGPROF when processing + fatal signals. */ + && !fatal_error_in_progress + && itimer->caller_thread) + { + /* Simulate a signal delivered to the thread which installed + the timer, by suspending that thread while the handler + runs. */ + DWORD result = SuspendThread (itimer->caller_thread); + + if (result == (DWORD)-1) + return 2; + + handler (sig); + ResumeThread (itimer->caller_thread); + } + + if (itimer->expire == 0) + continue; + + /* Update expiration time and loop. */ + EnterCriticalSection (crit); + expire = itimer->expire; + reload = itimer->reload; + if (reload > 0) + { + now = clock (); + if (expire <= now) + { + clock_t lag = now - expire; + + /* If we missed some opportunities (presumably while + sleeping or while the signal handler ran), skip + them. */ + if (lag > reload) + expire = now - (lag % reload); + + expire += reload; + } + } + else + expire = 0; /* become idle */ + itimer->expire = expire; + LeaveCriticalSection (crit); + } + return 0; +} + +static void +stop_timer_thread (int which) +{ + struct itimer_data *itimer = + (which == ITIMER_REAL) ? &real_itimer : &prof_itimer; + int i; + DWORD err, exit_code = 255; + BOOL status; + + /* Signal the thread that it should terminate. */ + itimer->terminate = 1; + + if (itimer->timer_thread == NULL) + return; + + /* Wait for the timer thread to terminate voluntarily, then kill it + if it doesn't. This loop waits twice more than the maximum + amount of time a timer thread sleeps, see above. */ + for (i = 0; i < MAX_SINGLE_SLEEP / 5; i++) + { + if (!((status = GetExitCodeThread (itimer->timer_thread, &exit_code)) + && exit_code == STILL_ACTIVE)) + break; + Sleep (10); + } + if ((status == FALSE && (err = GetLastError ()) == ERROR_INVALID_HANDLE) + || exit_code == STILL_ACTIVE) + { + if (!(status == FALSE && err == ERROR_INVALID_HANDLE)) + TerminateThread (itimer->timer_thread, 0); + } + + /* Clean up. */ + CloseHandle (itimer->timer_thread); + itimer->timer_thread = NULL; + if (itimer->caller_thread) + { + CloseHandle (itimer->caller_thread); + itimer->caller_thread = NULL; + } +} + +/* This is called at shutdown time from term_ntproc. */ +void +term_timers (void) +{ + if (real_itimer.timer_thread) + stop_timer_thread (ITIMER_REAL); + if (prof_itimer.timer_thread) + stop_timer_thread (ITIMER_PROF); + + /* We are going to delete the critical sections, so timers cannot + work after this. */ + disable_itimers = 1; + + DeleteCriticalSection (&crit_real); + DeleteCriticalSection (&crit_prof); + DeleteCriticalSection (&crit_sig); +} + +/* This is called at initialization time from init_ntproc. */ +void +init_timers (void) +{ + /* Make sure we start with zeroed out itimer structures, since + dumping may have left there traces of threads long dead. */ + memset (&real_itimer, 0, sizeof real_itimer); + memset (&prof_itimer, 0, sizeof prof_itimer); + + InitializeCriticalSection (&crit_real); + InitializeCriticalSection (&crit_prof); + InitializeCriticalSection (&crit_sig); + + disable_itimers = 0; +} + +static int +start_timer_thread (int which) +{ + DWORD exit_code; + struct itimer_data *itimer = + (which == ITIMER_REAL) ? &real_itimer : &prof_itimer; + + if (itimer->timer_thread + && GetExitCodeThread (itimer->timer_thread, &exit_code) + && exit_code == STILL_ACTIVE) + return 0; + + /* Start a new thread. */ + if (!DuplicateHandle (GetCurrentProcess (), GetCurrentThread (), + GetCurrentProcess (), &itimer->caller_thread, 0, + FALSE, DUPLICATE_SAME_ACCESS)) + { + errno = ESRCH; + return -1; + } + + itimer->terminate = 0; + itimer->type = which; + /* Request that no more than 64KB of stack be reserved for this + thread, to avoid reserving too much memory, which would get in + the way of threads we start to wait for subprocesses. See also + new_child below. */ + itimer->timer_thread = CreateThread (NULL, 64 * 1024, timer_loop, + (void *)itimer, 0x00010000, NULL); + + if (!itimer->timer_thread) + { + CloseHandle (itimer->caller_thread); + itimer->caller_thread = NULL; + errno = EAGAIN; + return -1; + } + + /* This is needed to make sure that the timer thread running for + profiling gets CPU as soon as the Sleep call terminates. */ + if (which == ITIMER_PROF) + SetThreadPriority (itimer->caller_thread, THREAD_PRIORITY_TIME_CRITICAL); + + return 0; +} + +/* Most of the code of getitimer and setitimer (but not of their + subroutines) was shamelessly stolen from itimer.c in the DJGPP + library, see www.delorie.com/djgpp. */ +int +getitimer (int which, struct itimerval *value) +{ + volatile clock_t *t_expire; + volatile clock_t *t_reload; + clock_t expire, reload; + __int64 usecs; + CRITICAL_SECTION *crit; + + if (disable_itimers) + return -1; + + ticks_now = clock (); + + if (!value) + { + errno = EFAULT; + return -1; + } + + if (which != ITIMER_REAL && which != ITIMER_PROF) + { + errno = EINVAL; + return -1; + } + + t_expire = (which == ITIMER_REAL) ? &real_itimer.expire: &prof_itimer.expire; + t_reload = (which == ITIMER_REAL) ? &real_itimer.reload: &prof_itimer.reload; + crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof; + + EnterCriticalSection (crit); + reload = *t_reload; + expire = *t_expire; + LeaveCriticalSection (crit); + + if (expire) + expire -= ticks_now; + + value->it_value.tv_sec = expire / CLOCKS_PER_SEC; + usecs = (expire % CLOCKS_PER_SEC) * (__int64)1000000 / CLOCKS_PER_SEC; + value->it_value.tv_usec = usecs; + value->it_interval.tv_sec = reload / CLOCKS_PER_SEC; + usecs = (reload % CLOCKS_PER_SEC) * (__int64)1000000 / CLOCKS_PER_SEC; + value->it_interval.tv_usec= usecs; + + return 0; +} + +int +setitimer(int which, struct itimerval *value, struct itimerval *ovalue) +{ + volatile clock_t *t_expire, *t_reload; + clock_t expire, reload, expire_old, reload_old; + __int64 usecs; + CRITICAL_SECTION *crit; + + if (disable_itimers) + return -1; + + /* Posix systems expect timer values smaller than the resolution of + the system clock be rounded up to the clock resolution. First + time we are called, measure the clock tick resolution. */ + if (!clocks_min) + { + clock_t t1, t2; + + for (t1 = clock (); (t2 = clock ()) == t1; ) + ; + clocks_min = t2 - t1; + } + + if (ovalue) + { + if (getitimer (which, ovalue)) /* also sets ticks_now */ + return -1; /* errno already set */ + } + else + ticks_now = clock (); + + if (which != ITIMER_REAL && which != ITIMER_PROF) + { + errno = EINVAL; + return -1; + } + + t_expire = + (which == ITIMER_REAL) ? &real_itimer.expire : &prof_itimer.expire; + t_reload = + (which == ITIMER_REAL) ? &real_itimer.reload : &prof_itimer.reload; + + crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof; + + if (!value + || (value->it_value.tv_sec == 0 && value->it_value.tv_usec == 0)) + { + EnterCriticalSection (crit); + /* Disable the timer. */ + *t_expire = 0; + *t_reload = 0; + LeaveCriticalSection (crit); + return 0; + } + + reload = value->it_interval.tv_sec * CLOCKS_PER_SEC; + + usecs = value->it_interval.tv_usec; + if (value->it_interval.tv_sec == 0 + && usecs && usecs * CLOCKS_PER_SEC < clocks_min * 1000000) + reload = clocks_min; + else + { + usecs *= CLOCKS_PER_SEC; + reload += usecs / 1000000; + } + + expire = value->it_value.tv_sec * CLOCKS_PER_SEC; + usecs = value->it_value.tv_usec; + if (value->it_value.tv_sec == 0 + && usecs * CLOCKS_PER_SEC < clocks_min * 1000000) + expire = clocks_min; + else + { + usecs *= CLOCKS_PER_SEC; + expire += usecs / 1000000; + } + + expire += ticks_now; + + EnterCriticalSection (crit); + expire_old = *t_expire; + reload_old = *t_reload; + if (!(expire == expire_old && reload == reload_old)) + { + *t_reload = reload; + *t_expire = expire; + } + LeaveCriticalSection (crit); + + return start_timer_thread (which); +} + +int +alarm (int seconds) +{ +#ifdef HAVE_SETITIMER + struct itimerval new_values, old_values; + + new_values.it_value.tv_sec = seconds; + new_values.it_value.tv_usec = 0; + new_values.it_interval.tv_sec = new_values.it_interval.tv_usec = 0; + + if (setitimer (ITIMER_REAL, &new_values, &old_values) < 0) + return 0; + return old_values.it_value.tv_sec; +#else + return seconds; +#endif +} + /* Defined in <process.h> which conflicts with the local copy */ #define _P_NOWAIT 1 @@ -593,7 +1132,7 @@ get_result: else if (WIFSIGNALED (retval)) { int code = WTERMSIG (retval); - char *signame; + const char *signame; synchronize_system_messages_locale (); signame = strsignal (code); @@ -668,7 +1207,7 @@ w32_executable_type (char * filename, if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) goto unwind; - nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew); + nt_header = (PIMAGE_NT_HEADERS) ((unsigned char *) dos_header + dos_header->e_lfanew); if ((char *) nt_header > (char *) dos_header + executable.size) { diff --git a/src/w32term.c b/src/w32term.c index 5d5e572c475..1cc8bd2adef 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -102,7 +102,7 @@ struct w32_display_info *x_display_list; Lisp_Object w32_display_name_list; -#ifndef GLYPHSET +#if _WIN32_WINNT < 0x0500 /* Pre Windows 2000, this was not available, but define it here so that Emacs compiled on such a platform will run on newer versions. */ @@ -360,7 +360,11 @@ w32_draw_underwave (struct glyph_string *s, COLORREF color) /* Find and set clipping rectangle */ - wave_clip = (XRectangle){ x0, y0, width, wave_height }; + wave_clip.x = x0; + wave_clip.y = y0; + wave_clip.width = width; + wave_clip.height = wave_height; + get_glyph_string_clip_rect (s, &w32_string_clip); CONVERT_TO_XRECT (string_clip, w32_string_clip); diff --git a/src/w32term.h b/src/w32term.h index 5d756f435e4..fcaccc4d624 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -201,6 +201,8 @@ extern struct w32_display_info *w32_term_init (Lisp_Object, extern int x_display_pixel_height (struct w32_display_info *); extern int x_display_pixel_width (struct w32_display_info *); +extern Lisp_Object x_get_focus_frame (struct frame *); + #define PIX_TYPE COLORREF @@ -431,7 +433,15 @@ struct scroll_bar { /* Turning a lisp vector value into a pointer to a struct scroll_bar. */ #define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) +#ifdef _WIN64 +/* Building a 64-bit C integer from two 32-bit lisp integers. */ +#define SCROLL_BAR_PACK(low, high) (XINT (high) << 32 | XINT (low)) +/* Setting two lisp integers to the low and high words of a 64-bit C int. */ +#define SCROLL_BAR_UNPACK(low, high, int64) \ + (XSETINT ((low), ((DWORDLONG)(int64)) & 0xffffffff), \ + XSETINT ((high), ((DWORDLONG)(int64) >> 32) & 0xffffffff)) +#else /* not _WIN64 */ /* Building a 32-bit C integer from two 16-bit lisp integers. */ #define SCROLL_BAR_PACK(low, high) (XINT (high) << 16 | XINT (low)) @@ -439,7 +449,7 @@ struct scroll_bar { #define SCROLL_BAR_UNPACK(low, high, int32) \ (XSETINT ((low), (int32) & 0xffff), \ XSETINT ((high), ((int32) >> 16) & 0xffff)) - +#endif /* not _WIN64 */ /* Extract the window id of the scroll bar from a struct scroll_bar. */ #define SCROLL_BAR_W32_WINDOW(ptr) \ @@ -447,7 +457,7 @@ struct scroll_bar { /* Store a window id in a struct scroll_bar. */ #define SET_SCROLL_BAR_W32_WINDOW(ptr, id) \ - (SCROLL_BAR_UNPACK ((ptr)->w32_window_low, (ptr)->w32_window_high, (int) id)) + (SCROLL_BAR_UNPACK ((ptr)->w32_window_low, (ptr)->w32_window_high, (intptr_t) id)) /* Extract the X widget of the scroll bar from a struct scroll_bar. */ #define SCROLL_BAR_X_WIDGET(ptr) \ diff --git a/src/window.c b/src/window.c index bb3b73f9acd..3b974616e38 100644 --- a/src/window.c +++ b/src/window.c @@ -133,102 +133,102 @@ static EMACS_INT window_scroll_preserve_hpos; static EMACS_INT window_scroll_preserve_vpos; /* These setters are used only in this file, so they can be private. */ -static inline void +static void wset_combination_limit (struct window *w, Lisp_Object val) { w->combination_limit = val; } -static inline void +static void wset_dedicated (struct window *w, Lisp_Object val) { w->dedicated = val; } -static inline void +static void wset_display_table (struct window *w, Lisp_Object val) { w->display_table = val; } -static inline void +static void wset_hchild (struct window *w, Lisp_Object val) { w->hchild = val; } -static inline void +static void wset_left_fringe_width (struct window *w, Lisp_Object val) { w->left_fringe_width = val; } -static inline void +static void wset_left_margin_cols (struct window *w, Lisp_Object val) { w->left_margin_cols = val; } -static inline void +static void wset_new_normal (struct window *w, Lisp_Object val) { w->new_normal = val; } -static inline void +static void wset_new_total (struct window *w, Lisp_Object val) { w->new_total = val; } -static inline void +static void wset_normal_cols (struct window *w, Lisp_Object val) { w->normal_cols = val; } -static inline void +static void wset_normal_lines (struct window *w, Lisp_Object val) { w->normal_lines = val; } -static inline void +static void wset_parent (struct window *w, Lisp_Object val) { w->parent = val; } -static inline void +static void wset_pointm (struct window *w, Lisp_Object val) { w->pointm = val; } -static inline void +static void wset_right_fringe_width (struct window *w, Lisp_Object val) { w->right_fringe_width = val; } -static inline void +static void wset_right_margin_cols (struct window *w, Lisp_Object val) { w->right_margin_cols = val; } -static inline void +static void wset_scroll_bar_width (struct window *w, Lisp_Object val) { w->scroll_bar_width = val; } -static inline void +static void wset_start (struct window *w, Lisp_Object val) { w->start = val; } -static inline void +static void wset_temslot (struct window *w, Lisp_Object val) { w->temslot = val; } -static inline void +static void wset_vchild (struct window *w, Lisp_Object val) { w->vchild = val; } -static inline void +static void wset_vertical_scroll_bar_type (struct window *w, Lisp_Object val) { w->vertical_scroll_bar_type = val; } -static inline void +static void wset_window_parameters (struct window *w, Lisp_Object val) { w->window_parameters = val; diff --git a/src/xdisp.c b/src/xdisp.c index b23a06ff3d1..635e7ecd0b2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -367,22 +367,22 @@ static Lisp_Object Qmargin, Qpointer; static Lisp_Object Qline_height; /* These setters are used only in this file, so they can be private. */ -static inline void +static void wset_base_line_number (struct window *w, Lisp_Object val) { w->base_line_number = val; } -static inline void +static void wset_base_line_pos (struct window *w, Lisp_Object val) { w->base_line_pos = val; } -static inline void +static void wset_column_number_displayed (struct window *w, Lisp_Object val) { w->column_number_displayed = val; } -static inline void +static void wset_region_showing (struct window *w, Lisp_Object val) { w->region_showing = val; @@ -1191,7 +1191,7 @@ window_box (struct window *w, int area, int *box_x, int *box_y, *BOTTOM_RIGHT_Y the coordinates of the bottom-right corner of the box. */ -static inline void +static void window_box_edges (struct window *w, int area, int *top_left_x, int *top_left_y, int *bottom_right_x, int *bottom_right_y) { @@ -1278,7 +1278,7 @@ string_from_display_spec (Lisp_Object spec) /* Limit insanely large values of W->hscroll on frame F to the largest value that will still prevent first_visible_x and last_visible_x of 'struct it' from overflowing an int. */ -static inline int +static int window_hscroll_limited (struct window *w, struct frame *f) { ptrdiff_t window_hscroll = w->hscroll; @@ -1625,7 +1625,7 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, returns an invalid character. If we find one, we return a `?', but with the length of the invalid character. */ -static inline int +static int string_char_and_length (const unsigned char *str, int *len) { int c; @@ -1673,7 +1673,7 @@ string_pos_nchars_ahead (struct text_pos pos, Lisp_Object string, ptrdiff_t ncha /* Value is the text position, i.e. character and byte position, for character position CHARPOS in STRING. */ -static inline struct text_pos +static struct text_pos string_pos (ptrdiff_t charpos, Lisp_Object string) { struct text_pos pos; @@ -12577,7 +12577,7 @@ debug_method_add (struct window *w, char const *fmt, ...) buffer position, END is given as a distance from Z. Used in redisplay_internal for display optimization. */ -static inline int +static int text_outside_line_unchanged_p (struct window *w, ptrdiff_t start, ptrdiff_t end) { @@ -12838,7 +12838,7 @@ check_point_in_composition (struct buffer *prev_buf, ptrdiff_t prev_pt, /* Reconsider the setting of B->clip_changed which is displayed in window W. */ -static inline void +static void reconsider_clip_changes (struct window *w, struct buffer *b) { if (b->clip_changed @@ -14538,7 +14538,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, We assume that the window's buffer is really current. */ -static inline struct text_pos +static struct text_pos run_window_scroll_functions (Lisp_Object window, struct text_pos startp) { struct window *w = XWINDOW (window); @@ -22491,7 +22491,7 @@ init_glyph_string (struct glyph_string *s, /* Append the list of glyph strings with head H and tail T to the list with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the result. */ -static inline void +static void append_glyph_string_lists (struct glyph_string **head, struct glyph_string **tail, struct glyph_string *h, struct glyph_string *t) { @@ -22511,7 +22511,7 @@ append_glyph_string_lists (struct glyph_string **head, struct glyph_string **tai list with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the result. */ -static inline void +static void prepend_glyph_string_lists (struct glyph_string **head, struct glyph_string **tail, struct glyph_string *h, struct glyph_string *t) { @@ -22530,7 +22530,7 @@ prepend_glyph_string_lists (struct glyph_string **head, struct glyph_string **ta /* Append glyph string S to the list with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the resulting list. */ -static inline void +static void append_glyph_string (struct glyph_string **head, struct glyph_string **tail, struct glyph_string *s) { @@ -22545,7 +22545,7 @@ append_glyph_string (struct glyph_string **head, struct glyph_string **tail, Value is a pointer to a realized face that is ready for display if DISPLAY_P is non-zero. */ -static inline struct face * +static struct face * get_char_face_and_encoding (struct frame *f, int c, int face_id, XChar2b *char2b, int display_p) { @@ -22578,7 +22578,7 @@ get_char_face_and_encoding (struct frame *f, int c, int face_id, The encoding of GLYPH->u.ch is returned in *CHAR2B. Value is a pointer to a realized face that is ready for display. */ -static inline struct face * +static struct face * get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph, XChar2b *char2b, int *two_byte_p) { @@ -22615,7 +22615,7 @@ get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph, /* Get glyph code of character C in FONT in the two-byte form CHAR2B. Return 1 if FONT has a glyph for C, otherwise return 0. */ -static inline int +static int get_char_glyph_code (int c, struct font *font, XChar2b *char2b) { unsigned code; @@ -23089,7 +23089,7 @@ right_overwriting (struct glyph_string *s) first glyph following S. LAST_X is the right-most x-position + 1 in the drawing area. */ -static inline void +static void set_glyph_string_background_width (struct glyph_string *s, int start, int last_x) { /* If the face of this glyph string has to be drawn to the end of @@ -23650,7 +23650,7 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, /* Store one glyph for IT->char_to_display in IT->glyph_row. Called from x_produce_glyphs when IT->glyph_row is non-null. */ -static inline void +static void append_glyph (struct it *it) { struct glyph *glyph; @@ -23724,7 +23724,7 @@ append_glyph (struct it *it) IT->glyph_row. Called from x_produce_glyphs when IT->glyph_row is non-null. */ -static inline void +static void append_composite_glyph (struct it *it) { struct glyph *glyph; @@ -23793,7 +23793,7 @@ append_composite_glyph (struct it *it) /* Change IT->ascent and IT->height according to the setting of IT->voffset. */ -static inline void +static void take_vertical_position_into_account (struct it *it) { if (it->voffset) @@ -28986,7 +28986,7 @@ and is used only on frames for which no explicit name has been set doc: /* Maximum number of lines to keep in the message log buffer. If nil, disable message logging. If t, log messages but don't truncate the buffer when it becomes large. */); - Vmessage_log_max = make_number (100); + Vmessage_log_max = make_number (1000); DEFVAR_LISP ("window-size-change-functions", Vwindow_size_change_functions, doc: /* Functions called before redisplay, if window sizes have changed. @@ -29357,10 +29357,6 @@ init_xdisp (void) help_echo_showing_p = 0; } -/* Since w32 does not support atimers, it defines its own implementation of - the following three functions in w32fns.c. */ -#ifndef WINDOWSNT - /* Platform-independent portion of hourglass implementation. */ /* Cancel a currently active hourglass timer, and start a new one. */ @@ -29383,6 +29379,10 @@ start_hourglass (void) else delay = make_emacs_time (DEFAULT_HOURGLASS_DELAY, 0); +#ifdef WINDOWSNT + w32_note_current_window (); +#endif + hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay, show_hourglass, NULL); #endif @@ -29405,4 +29405,3 @@ cancel_hourglass (void) hide_hourglass (); #endif } -#endif /* ! WINDOWSNT */ diff --git a/src/xfaces.c b/src/xfaces.c index 28be6aaf082..f861dde2d15 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -601,7 +601,7 @@ x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap, /* Create and return a GC for use on frame F. GC values and mask are given by XGCV and MASK. */ -static inline GC +static GC x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv) { GC gc; @@ -615,7 +615,7 @@ x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv) /* Free GC which was used on frame F. */ -static inline void +static void x_free_gc (struct frame *f, GC gc) { eassert (input_blocked_p ()); @@ -628,7 +628,7 @@ x_free_gc (struct frame *f, GC gc) #ifdef WINDOWSNT /* W32 emulation of GCs */ -static inline GC +static GC x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv) { GC gc; @@ -642,7 +642,7 @@ x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv) /* Free GC which was used on frame F. */ -static inline void +static void x_free_gc (struct frame *f, GC gc) { IF_DEBUG (eassert (--ngcs >= 0)); @@ -654,7 +654,7 @@ x_free_gc (struct frame *f, GC gc) #ifdef HAVE_NS /* NS emulation of GCs */ -static inline GC +static GC x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv) @@ -664,7 +664,7 @@ x_create_gc (struct frame *f, return gc; } -static inline void +static void x_free_gc (struct frame *f, GC gc) { xfree (gc); @@ -677,7 +677,7 @@ x_free_gc (struct frame *f, GC gc) CHECK_LIVE_FRAME. This is here because it's a frequent pattern in Lisp function definitions. */ -static inline struct frame * +static struct frame * frame_or_selected_frame (Lisp_Object frame, int nparam) { if (NILP (frame)) @@ -1920,7 +1920,7 @@ struct named_merge_point FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list pointed to by NAMED_MERGE_POINTS, and return 1. */ -static inline int +static int push_named_merge_point (struct named_merge_point *new_named_merge_point, Lisp_Object face_name, enum named_merge_point_kind named_merge_point_kind, @@ -2004,7 +2004,7 @@ resolve_face_name (Lisp_Object face_name, int signal_p) face text properties; Ediff uses that). If SIGNAL_P is non-zero, signal an error if FACE_NAME is not a valid face name. If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face name. */ -static inline Lisp_Object +static Lisp_Object lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name, int signal_p) { @@ -2033,7 +2033,7 @@ lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name, non-zero, signal an error if FACE_NAME is not a valid face name. If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face name. */ -static inline Lisp_Object +static Lisp_Object lface_from_face_name (struct frame *f, Lisp_Object face_name, int signal_p) { face_name = resolve_face_name (face_name, signal_p); @@ -2047,7 +2047,7 @@ lface_from_face_name (struct frame *f, Lisp_Object face_name, int signal_p) is non-zero, signal an error if FACE_NAME does not name a face. Otherwise, value is zero if FACE_NAME is not a face. */ -static inline int +static int get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name, Lisp_Object *attrs, int signal_p) { @@ -2069,7 +2069,7 @@ get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name, non-zero, signal an error if FACE_NAME does not name a face. Otherwise, value is zero if FACE_NAME is not a face. */ -static inline int +static int get_lface_attributes (struct frame *f, Lisp_Object face_name, Lisp_Object *attrs, int signal_p, struct named_merge_point *named_merge_points) @@ -2234,7 +2234,7 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid) loops in face inheritance/remapping; it should be 0 when called from other places. */ -static inline void +static void merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to, struct named_merge_point *named_merge_points) { @@ -3906,7 +3906,7 @@ return the font name used for CHARACTER. */) all attributes are `equal'. Tries to be fast because this function is called quite often. */ -static inline int +static int face_attr_equal_p (Lisp_Object v1, Lisp_Object v2) { /* Type can differ, e.g. when one attribute is unspecified, i.e. nil, @@ -3939,7 +3939,7 @@ face_attr_equal_p (Lisp_Object v1, Lisp_Object v2) all attributes are `equal'. Tries to be fast because this function is called quite often. */ -static inline int +static int lface_equal_p (Lisp_Object *v1, Lisp_Object *v2) { int i, equal_p = 1; @@ -4024,7 +4024,7 @@ For internal use only. */) /* Return a hash code for Lisp string STRING with case ignored. Used below in computing a hash value for a Lisp face. */ -static inline unsigned +static unsigned hash_string_case_insensitive (Lisp_Object string) { const unsigned char *s; @@ -4038,7 +4038,7 @@ hash_string_case_insensitive (Lisp_Object string) /* Return a hash code for face attribute vector V. */ -static inline unsigned +static unsigned lface_hash (Lisp_Object *v) { return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX]) @@ -4057,7 +4057,7 @@ lface_hash (Lisp_Object *v) family, point size, weight, width, slant, and font. Both LFACE1 and LFACE2 must be fully-specified. */ -static inline int +static int lface_same_font_attributes_p (Lisp_Object *lface1, Lisp_Object *lface2) { eassert (lface_fully_specified_p (lface1) @@ -4453,7 +4453,7 @@ uncache_face (struct face_cache *c, struct face *face) Value is the ID of the face found. If no suitable face is found, realize a new one. */ -static inline int +static int lookup_face (struct frame *f, Lisp_Object *attr) { struct face_cache *cache = FRAME_FACE_CACHE (f); diff --git a/src/xml.c b/src/xml.c index a22ca208743..a0c4fe17fc4 100644 --- a/src/xml.c +++ b/src/xml.c @@ -73,7 +73,7 @@ libxml2_loaded_p (void) #define fn_xmlCleanupParser xmlCleanupParser #define fn_xmlCheckVersion xmlCheckVersion -static inline int +static int libxml2_loaded_p (void) { return 1; diff --git a/src/xterm.c b/src/xterm.c index 6cd1d583870..a4c3e125d8d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1027,7 +1027,7 @@ x_set_mouse_face_gc (struct glyph_string *s) Faces to use in the mode line have already been computed when the matrix was built, so there isn't much to do, here. */ -static inline void +static void x_set_mode_line_face_gc (struct glyph_string *s) { s->gc = s->face->gc; @@ -1038,7 +1038,7 @@ x_set_mode_line_face_gc (struct glyph_string *s) S->stippled_p to a non-zero value if the face of S has a stipple pattern. */ -static inline void +static void x_set_glyph_string_gc (struct glyph_string *s) { PREPARE_FACE_FOR_DISPLAY (s->f, s->face); @@ -1083,7 +1083,7 @@ x_set_glyph_string_gc (struct glyph_string *s) /* Set clipping for output of glyph string S. S may be part of a mode line or menu if we don't have X toolkit support. */ -static inline void +static void x_set_glyph_string_clipping (struct glyph_string *s) { XRectangle *r = s->clip; @@ -1156,7 +1156,7 @@ x_compute_glyph_string_overhangs (struct glyph_string *s) /* Fill rectangle X, Y, W, H with background color of glyph string S. */ -static inline void +static void x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h) { XGCValues xgcv; |
