diff options
| author | Joakim Verona <joakim@verona.se> | 2010-08-17 23:19:11 +0200 |
|---|---|---|
| committer | Joakim Verona <joakim@verona.se> | 2010-08-17 23:19:11 +0200 |
| commit | a8101f663e6cbff953b67b8bef33bc0171818477 (patch) | |
| tree | 8f71a16188f75e91670e05379fb4de2d0136cbf4 /lisp | |
| parent | fe72c5b4651334677326104ec138e7cdd50f2ffe (diff) | |
| parent | 489cd5bd5a0128d6c3bee49fa2c451f2927ddea9 (diff) | |
| download | emacs-a8101f663e6cbff953b67b8bef33bc0171818477.tar.gz | |
merge from trunk
Diffstat (limited to 'lisp')
273 files changed, 23472 insertions, 5587 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 49e1ee9fc6a..0087163f097 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,1468 @@ +2010-08-17 Jan Djärv <jan.h.d@swipnet.se> + + * mail/emacsbug.el (report-emacs-bug-insert-to-mailer) + (report-emacs-bug-can-use-xdg-email): New functions. + (report-emacs-bug): Set can-xdg-email to result of + report-emacs-bug-can-use-xdg-email. If can-xdg-email bind + \C-cm to report-emacs-bug-insert-to-mailer and add help text + about it. + +2010-08-17 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-make-symbolic-link): Flush file + properties. + (tramp-handle-process-file): Call the program in a subshell, in + order to preserve working directory. + (tramp-action-password): Hide password prompt before next run. + (tramp-process-actions): Widen connection buffer for the trace. + +2010-08-16 Deniz Dogan <deniz.a.m.dogan@gmail.com> + + * net/rcirc.el (rcirc-log-process-buffers): New option. + (rcirc-print): Use it. + (rcirc-generate-log-filename): New function. + (rcirc-log-filename-function): Change default to + rcirc-generate-log-filename (Bug#6828). + +2010-08-16 Chong Yidong <cyd@stupidchicken.com> + + * simple.el (deactivate-mark): If select-active-regions is `only', + only set selection for temporarily active regions. + + * cus-start.el: Change defcustom for select-active-regions. + +2010-08-15 Chong Yidong <cyd@stupidchicken.com> + + * mouse.el (mouse--drag-set-mark-and-point): New function. + (mouse-drag-track): Use LOCATION arg to push-mark. Use + mouse--drag-set-mark-and-point to take click-count into + consideration when updating point and mark (Bug#6840). + +2010-08-15 Chong Yidong <cyd@stupidchicken.com> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Give the Ruby rule a lower priority than Gnu (Bug#6778). + +2010-08-14 Štěpán Němec <stepnem@gmail.com> (tiny change) + + * font-lock.el (lisp-font-lock-keywords-2): Add + combine-after-change-calls, condition-case-no-debug, + with-demoted-errors, and with-silent-modifications (Bug#6025). + +2010-08-14 Kevin Ryde <user42@zip.com.au> + + * emacs-lisp/copyright.el (copyright-update-year) + (copyright-update): Temporary switch-to-buffer to ensure the + buffer change being queried is visible (Bug#5394). + +2010-08-14 Tom Tromey <tromey@redhat.com> + + * progmodes/etags.el (tags-file-name): Mark safe if stringp + (Bug#6733). + +2010-08-14 Eli Zaretskii <eliz@gnu.org> + + * mouse.el (mouse-yank-primary): Fix mouse-2 on MS-Windows and + MS-DOS. (Bug#6689) + +2010-08-13 Jan Djärv <jan.h.d@swipnet.se> + + * menu-bar.el (menu-bar-set-tool-bar-position): New function. + (menu-bar-showhide-tool-bar-menu-customize-enable-left) + (menu-bar-showhide-tool-bar-menu-customize-enable-right) + (menu-bar-showhide-tool-bar-menu-customize-enable-top) + (menu-bar-showhide-tool-bar-menu-customize-enable-bottom): Call + menu-bar-set-tool-bar-position. + +2010-08-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/octave-mod.el (octave-mode-syntax-table): Use the new "c" + comment style (bug#6834). + * progmodes/scheme.el (scheme-mode-syntax-table): + * emacs-lisp/lisp-mode.el (lisp-mode-syntax-table): Remove spurious + "b" flag in "' 14b" syntax. + + * progmodes/octave-mod.el (octave-mode-map): Remove special bindings + for (un)commenting the region and performing completion. + (octave-mode-menu): Use standard commands for help and completion. + (octave-mode-syntax-table): Support %{..%} comments (sort of). + (octave-mode): Use define-derived-mode. + Set completion-at-point-functions and don't set columns. + Don't disable adaptive-fill-regexp. + (octave-describe-major-mode, octave-comment-region) + (octave-uncomment-region, octave-comment-indent) + (octave-indent-for-comment): Remove. + (octave-indent-calculate): Rename from calculate-octave-indent. + (octave-indent-line, octave-fill-paragraph): Update caller. + (octave-initialize-completions): No need to make an alist. + (octave-completion-at-point-function): New function. + (octave-complete-symbol): Use it. + (octave-insert-defun): Use define-skeleton. + + * progmodes/octave-mod.el (octave-mode): Set comment-add. + (octave-mode-map): Use comment-dwim (bug#6829). + +2010-08-12 Antoine Levitt <antoine.levitt@gmail.com> (tiny change) + + * cus-edit.el (custom-save-variables, custom-save-faces): Fix up + indentation of inserted comment. + +2010-08-11 Jan Djärv <jan.h.d@swipnet.se> + + * faces.el (region): Add type gtk that uses gtk colors. + + * dynamic-setting.el (dynamic-setting-handle-config-changed-event): + Handle theme-name change. + +2010-08-10 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 2.5 + (sql-product-alist): Add :prompt-cont-regexp property for several + database products. + (sql-prompt-cont-regexp): New variable. + (sql-output-newline-count, sql-output-by-send): + New variables. Record number of newlines in input text. + (sql-send-string): Handle multiple filters and count newlines. + (sql-send-magic-terminator): Count terminator newline. + (sql-interactive-remove-continuation-prompt): Filters output to + remove continuation prompts; one for each newline. + (sql-interactive-mode): Set up new variables, prompt regexp and + output filter. + (sql-mode-sqlite-font-lock-keywords): Correct some keywords. + (sql-make-alternate-buffer-name): Correct buffer name in edge cases. + +2010-08-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pcase.el: New file. + +2010-08-10 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-vc-registered-read-file-names): Read input + as here-document, otherwise the command could exceed maximum + length of command line. + (tramp-handle-vc-registered): Call script accordingly. + Reported by Toru TSUNEYOSHI <t_tuneyosi@hotmail.com>. + +2010-08-10 Kenichi Handa <handa@m17n.org> + + * language/hebrew.el: Exclude U+05C3 (Hebrew SOF PASUQ) from the + composable pattern. + +2010-08-09 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-version-split) + (package--version-first-nonzero, package-version-compare): + Functions removed. + (package-directory-list, package-load-all-descriptors) + (package--built-in, package-activate, define-package) + (package-installed-p, package-compute-transaction) + (package-read-all-archive-contents) + (package--add-to-archive-contents, package-buffer-info) + (package-tar-file-info, package-list-packages-internal): + Use version-to-list and version-list-*. + + * emacs-lisp/package-x.el (package-upload-buffer-internal): + Use version-to-list. + (package-upload-buffer-internal): Use version-list-<=. + +2010-08-09 Kenichi Handa <handa@m17n.org> + + * language/hebrew.el: Exclude U+05BD (Hebrew MAQAF) from the + composable pattern. + +2010-08-08 Chong Yidong <cyd@stupidchicken.com> + + * tutorial.el (tutorial--default-keys): C-d is now bound to + delete-forward-char (Bug#6826). + + * mouse.el (mouse-drag-track): Remove accidentally-removed check + for `double' value of mouse-1-click-follows-link (Bug#6807). + +2010-08-08 Johan Bockgård <bojohan@gnu.org> + + * replace.el (replace-highlight): Bind isearch-forward and + isearch-error, ensuring that highlighting is updated if the user + switches the search direction (Bug#6808). + + * isearch.el (isearch-lazy-highlight-forward): New var. + (isearch-lazy-highlight-new-loop, isearch-lazy-highlight-search): + (isearch-lazy-highlight-update): Use it. + +2010-08-08 Kenichi Handa <handa@m17n.org> + + * international/mule.el (define-charset): Store NAME as :base property. + (ctext-non-standard-encodings-table): Pay attention to charset aliases. + (ctext-pre-write-conversion): Sort ctext-standard-encodings by the + current priority. Force using the designation of the specific + charset by adding `charset' text property. Improve the whole algorithm. + +2010-08-08 Juanma Barranquero <lekktu@gmail.com> + + * emulation/pc-select.el (pc-selection-mode-hook) + (copy-region-as-kill-nomark, beginning-of-buffer-mark) + (pc-selection-mode): Fix typos in docstrings. + +2010-08-08 Kenichi Handa <handa@m17n.org> + + * language/cyrillic.el: Don't add "microsoft-cp1251" to + ctext-non-standard-encodings-alist here. + + * international/mule.el (ctext-non-standard-encodings-alist): + Add "koi8-r" and "microsoft-cp1251". + (ctext-standard-encodings): New variable. + (ctext-non-standard-encodings-table): List only elements for + non-standard encodings. + (ctext-pre-write-conversion): Adjusted for the above change. + Check ctext-standard-encodings. + + * international/mule-conf.el (compound-text): Doc fix. + (ctext-no-compositions): Doc fix. + (compound-text-with-extensions): Doc fix. + +2010-08-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (exchange-dot-and-mark): Mark obsolete, finally. + +2010-08-08 Juanma Barranquero <lekktu@gmail.com> + + * progmodes/which-func.el (which-func-format): Split help-echo text + into lines, like other mode-line tooltips. + + * server.el (server-start): When using TCP sockets, force IPv4 + and use a literal 127.0.0.1 for localhost. (Related to bug#6781.) + +2010-08-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * bindings.el (complete-symbol): Run completion-at-point as a fallback. + +2010-08-08 Juanma Barranquero <lekktu@gmail.com> + + * term.el (term-delimiter-argument-list): Reflow docstring. + (term-read-input-ring, term-write-input-ring, term-send-input) + (term-bol, term-erase-in-display, serial-supported-or-barf): + Fix typos in docstrings. + +2010-08-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * bindings.el (function-key-map): Add a S-tab => backtab fallback. + +2010-08-08 Juanma Barranquero <lekktu@gmail.com> + + * dabbrev.el (dabbrev-completion): Fix typo in docstring. + +2010-08-08 MON KEY <monkey@sandpframing.com> (tiny change) + + * emacs-lisp/syntax.el (syntax-ppss-toplevel-pos): + Fix typo in docstring (bug#6747). + +2010-08-08 Leo <sdl.web@gmail.com> + + * eshell/esh-io.el (eshell-get-target): Better detection of + read-only file (Bug#6762). + +2010-08-08 Juanma Barranquero <lekktu@gmail.com> + + * align.el (align-default-spacing): Doc fix. + (align-region-heuristic, align-regexp): Fix typos in docstrings. + +2010-08-08 Stephen Peters <speters@itasoftware.com> + + * calendar/icalendar.el + (icalendar--split-value): Fixed splitting regexp. (Bug#6766) + (icalendar--get-weekday-numbers): New + (icalendar--convert-recurring-to-diary): Handle multiple byday + values in weekly rules. (Bug#6766) + +2010-08-08 Ulf Jasper <ulf.jasper@web.de> + + * calendar/icalendar.el (icalendar-uid-format): Doc fix. + (icalendar--create-uid, icalendar-export-region) + (icalendar--parse-summary-and-rest): Code formatting. + +2010-08-08 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (calc-trail-mode,calc-refresh): Use `face' property + to italicize headers. + (calc-highlight-selections-with-faces): New variable. + (calc-selected-face, calc-nonselected-face): New faces. + + * calc/calccomp.el (math-comp-highlight-string): Use + `calc-highlight-selections-with-faces' to determine how to highlight + sub-formulas. + + * calc/calc-sel.el (calc-show-selections): Change message to when + using faces to highlight selections. + +2010-08-07 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el (sql-mode-sqlite-font-lock-keywords): + Add SQLite 3 keywords, functions and datatypes. + (sql-interactive-mode): Remove `comint-process-echoes' set to t + (Bug#6686). + +2010-08-07 Chong Yidong <cyd@stupidchicken.com> + + * simple.el (select-active-regions): Move to keyboard.c. + (deactivate-mark): Used saved-region-selection. + (select-active-region): Function removed. + (activate-mark, set-mark, push-mark-command) + (handle-shift-selection): Don't call it. + (keyboard-quit): Avoid adding the region to the window selection. + + * mouse.el (mouse-drag-track): Remove hacks to deal with old + select-active-regions implementation. + (mouse-yank-at-click): Doc fix. + + * cus-start.el: Add custom declaration for select-active-regions. + +2010-08-07 Eli Zaretskii <eliz@gnu.org> + + * simple.el (delete-forward-char): Doc fix. + + * tutorial.el (help-with-tutorial): Hack safe file-local variables + after reading the tutorial. + +2010-08-06 Alan Mackenzie <bug-cc-mode@gnu.org> + + * progmodes/cc-cmds.el (c-mask-paragraph, c-fill-paragraph): Fix + for the case that a C style comment has its delimiters alone on + their respective lines. + +2010-08-06 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-start-file-process): Set connection + property "vec". + (tramp-process-sentinel): Use it for flushing the cache. We + cannot do it via the process buffer, the buffer could be deleted + already when running the sentinel. + +2010-08-06 Jürgen Hötzel <juergen@archlinux.org> (tiny change) + + * comint.el (comint-mode): Make directory tracking functions + functional on remote files. (Bug#6764) + +2010-08-06 Dan Nicolaescu <dann@ics.uci.edu> + + * vc/diff-mode.el (diff-mode-shared-map): Bind g to revert-buffer. + +2010-08-05 Eli Zaretskii <eliz@gnu.org> + + * emacs-lisp/find-gc.el (find-gc-source-files): Rename + unexec.c => unexcoff.c. + + * emacs-lisp/authors.el (authors-fixed-entries): Rename + unexec.c => unexcoff.c. + +2010-08-05 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-dired-uncache): Flush directory + cache, not only file cache. + (tramp-process-sentinel): New defun. + (tramp-handle-start-file-process): Use it, in order to invalidate + file caches. + +2010-08-03 Leo <sdl.web@gmail.com> + + * server.el (server-start): Simplify loop. + +2010-08-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * frame.el (screen-height, screen-width, set-screen-width) + (set-screen-height): Remove ancient compatibility aliases. + + * textmodes/fill.el (justify-current-line): Don't add 1 to nspaces + when justifying. It seems useless and harmful for ncols=1 (bug#6738). + + * emacs-lisp/timer.el (timer-event-handler): Protect against timers + that change current buffer. + +2010-08-01 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * mouse.el (mouse-fixup-help-message): Match "mouse-2" only at the + beginning of the string. Use `string-match-p'. (Bug#6765) + +2010-08-01 Jan Djärv <jan.h.d@swipnet.se> + + * cus-start.el (x-gtk-use-system-tooltips): New variable. + +2010-08-01 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package--list-packages): Fix column alignment. + (package--builtins): Tweak descriptions. + (package-print-package): Upcase descriptions if necessary. + Show all built-in packages in font-lock-builtin-face. + (package-list-packages-internal): Omit "emacs" package. + Show status of built-in packages as "built-in". + +2010-07-31 Chong Yidong <cyd@stupidchicken.com> + + * mouse.el (mouse-save-then-kill): Doc fix. Deactivate mark + before killing to preserve the primary selection (Bug#6701). + + * term/x-win.el (x-select-text): Doc fix. + +2010-07-31 Nathaniel Flath <flat0103@gmail.com> + + Enhance Java Mode to handle Java 5.0 (Tiger) and Java 6 (Mustang). + The following functions were modified or created: + + * progmodes/cc-vars.el (c-offsets-alist, c-inside-block-syms) + (objc-font-lock-extra-types): + * progmodes/cc-mode.el (c-basic-common-init): + * progmodes/cc-langs.el (c-make-mode-syntax-table) + (c++-make-template-syntax-table) + (c-identifier-syntax-modifications, c-symbol-start, c-operators) + (c-<-op-cont-regexp, c->-op-cont-regexp, c-class-decl-kwds) + (c-brace-list-decl-kwds, c-modifier-kwds, c-prefix-spec-kwds-re) + (c-type-list-kwds, c-decl-prefix-re, c-opt-type-suffix-key): + * progmodes/cc-fonts.el (c-make-inverse-face) + (c-basic-matchers-after): + * progmodes/cc-engine.el (c-forward-keyword-clause) + (c-forward-<>-arglist, c-forward-<>-arglist-recur) + (c-forward-name, c-forward-type, c-forward-decl-or-cast-1) + (c-guess-continued-construct, c-guess-basic-syntax): + +2010-07-31 Jan Djärv <jan.h.d@swipnet.se> + + * faces.el (face-all-attributes): Improve documentation (Bug#6767). + +2010-07-31 Eli Zaretskii <eliz@gnu.org> + + * files.el (bidi-paragraph-direction): Define safe local values. + + * language/hebrew.el ("Hebrew"): Add TUTORIAL.he to + language-info-alist. Remove outdated FIXME in a comment. + +2010-07-31 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-cmds.el (c-mask-paragraph): Fix bug #6688: + Auto-fill broken in C/C++ modes. + +2010-07-29 Jan Djärv <jan.h.d@swipnet.se> + + * menu-bar.el (menu-bar-showhide-tool-bar-menu-customize-enable-left) + (menu-bar-showhide-tool-bar-menu-customize-disable) + (menu-bar-showhide-tool-bar-menu-customize-enable-right) + (menu-bar-showhide-tool-bar-menu-customize-enable-bottom) + (menu-bar-showhide-tool-bar-menu-customize-enable-top): New functions + (menu-bar-showhide-tool-bar-menu): If tool bar is moveable, + make a menu for Options => toolbar that can move it. + +2010-07-29 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package-x.el (package--make-rss-entry): + (package-maint-add-news-item, package--update-news) + (package-upload-buffer-internal): New arg ARCHIVE-URL. + + * emacs-lisp/package.el (package-archive-url): Rename from + package-archive-id. + (package-install): Doc fix. + (package-download-single, package-download-tar, package-install) + (package-menu-view-commentary): Callers changed. + +2010-07-29 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-start-file-process): Check only for + `remote-tty' process property. + (tramp-open-shell): Don't check for tty. + (tramp-open-connection-setup-interactive-shell): Set `remote-tty' + process property. + + * progmodes/gdb-mi.el (gdb-init-1): Check also for tty on a remote + host. + +2010-07-28 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-load-list, package-archives) + (package-archive-contents, package-user-dir) + (package-directory-list, package--builtins, package-alist) + (package-activated-list, package-obsolete-alist): Mark as risky. + +2010-07-28 Phil Hagelberg <phil@evri.com> + + Add support for non-default package repositories. + * emacs-lisp/package.el (package-archive-base): Var deleted. + (package-archives): New variable. + (package-archive-contents): Doc fix. + (package-load-descriptor): Do nothing if descriptor file is missing. + (package--write-file-no-coding): New function. + (package-unpack-single): Use it. + (package-archive-id): New function. + (package-download-single, package-download-tar) + (package-menu-view-commentary): Use it. + (package-installed-p): Make second argument optional. + (package-read-all-archive-contents): New function. + (package-initialize): Use it. + (package-read-archive-contents): Add ARCHIVE argument. + (package--add-to-archive-contents): New function. + (package-install): Don't call package-read-archive-contents. + (package--download-one-archive): Store archive file in a + subdirectory of package-user-dir. + (package-menu-execute): Remove spurious line movement. + +2010-07-28 Jan Djärv <jan.h.d@swipnet.se> + + * cus-start.el (tool-bar-style): Add text-image-horiz. + +2010-07-28 Michael Albinus <michael.albinus@gmx.de> + + * progmodes/gud.el (gud-common-init): Check for remoteness of + `file', and not of `default-directory'. + +2010-07-28 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-methods): Move hostname to the end in all + ssh `tramp-login-args'. + (tramp-verbose): Describe verbose level 9. + (tramp-open-shell): Check for tty if `tramp-verbose' >= 9. + (tramp-open-connection-setup-interactive-shell): Trace stty + settings if `tramp-verbose' >= 9. + (tramp-handle-start-file-process): Implement tty setting. + (Bug#4604, Bug#6360) + + * net/tramp-cmds.el (tramp-bug): Recommend setting of + `tramp-verbose' to 9. + +2010-07-27 Aaron S. Hawley <ashawley@burlingtontelecom.net> + + * emacs-lisp/re-builder.el (reb-re-syntax, reb-lisp-mode) + (reb-lisp-syntax-p, reb-change-syntax, reb-cook-regexp): + Remove references to package `lisp-re' (bug#4369). + +2010-07-27 Tom Tromey <tromey@redhat.com> + + * progmodes/js.el (js-mode): + * progmodes/make-mode.el (makefile-mode): + * progmodes/simula.el (simula-mode): + * progmodes/tcl.el (tcl-mode): Derive from prog-mode. + +2010-07-27 Juanma Barranquero <lekktu@gmail.com> + + * help-fns.el (find-lisp-object-file-name): Doc fix (bug#6494). + + * cedet/semantic/db-file.el (object-write): Fix typo in docstring. + + * time.el (display-time-day-and-date): Remove spurious * in docstring. + (display-time-world-buffer-name, display-time-world-mode-map): + Fix typos in docstrings. + +2010-07-27 Shyam Karanatt <shyam@swathanthran.in> (tiny change) + + * image-mode.el (image-display-size): New function. + (image-forward-hscroll, image-next-line, image-eol, image-eob) + (image-mode-fit-frame): Use it (Bug#6639). + +2010-07-27 Chong Yidong <cyd@stupidchicken.com> + + * dired.el (dired-buffers-for-dir): Handle list values of + dired-directory (Bug#6636). + +2010-07-26 Sam Steingold <sds@gnu.org> + + * mouse.el (mouse-yank-primary, mouse-yank-secondary): + Do not call `x-get-selection' the second time, reuse the value. + +2010-07-26 Daiki Ueno <ueno@unixuser.org> + + * epa-mail.el (epa-mail-mode-map): Add alternative key bindings + which consist of control chars only. Suggested by Richard Stallman. + +2010-07-25 Daiki Ueno <ueno@unixuser.org> + + * epa-file.el (epa-file-insert-file-contents): Check if LOCAL-FILE + exists before passing an error to find-file-not-found-functions + (bug#6723). + +2010-07-23 Lukas Huonker <l.huonker@gmail.com> + + * play/tetris.el (tetris-tty-colors, tetris-x-colors, tetris-blank): + Remove leading nil element, adjust values. + (tetris-shapes, tetris-shape-scores): + Change representation of shapes and remove some redundancy. + (tetris-get-shape-cell, tetris-shape-width, tetris-draw-next-shape) + (tetris-draw-shape, tetris-erase-shape, tetris-test-shape): + Adjust for working with new representation of shapes. + (tetris-shape-rotations): New function. + (tetris-move-bottom, tetris-move-left, tetris-move-right) + (tetris-rotate-prev, tetris-rotate-next): + Adjust for working with the new version of tetris-test-shape. + +2010-07-23 Markus Triska <markus.triska@gmx.at> + + * progmodes/ps-mode.el: Use comint (bug#5954). + (ps-run-mode-map): Adapt for comint-mode; omit "\r", [return].. + (ps-mode-other-newline): Simplify. + (ps-run-mode): Derive from comint-mode instead of + fundamental-mode, yielding input history etc. + (ps-run-start, ps-run-quit, ps-run-clear, ps-run-region) + (ps-run-send-string): Adapt for comint-mode. + (ps-run-newline): Remove now unneeded function. + +2010-07-23 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-methods): Move hostname to the end in all + plink `tramp-login-args'. + +2010-07-23 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-open-shell): New defun. + (tramp-find-shell, tramp-open-connection-setup-interactive-shell): + Use it. + +2010-07-23 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-file-name-regexp-unified) + (tramp-completion-file-name-regexp-unified): On W32 systems, do + not regard the volume letter as remote filename. (Bug#5447) + +2010-07-23 Juanma Barranquero <lekktu@gmail.com> + + * custom.el (custom-declare-variable): Give a clearer error message + when the docstring is missing (bug#6476). + +2010-07-22 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 2.4. Improved Login prompting. + (sql-login-params): New widget definition. + (sql-oracle-login-params, sql-mysql-login-params) + (sql-solid-login-params, sql-sybase-login-params) + (sql-informix-login-params, sql-ingres-login-params) + (sql-ms-login-params, sql-postgres-login-params) + (sql-interbase-login-params, sql-db2-login-params) + (sql-linter-login-params): Use it. + (sql-sqlite-login-params): Use it; Define "database" parameter as + a file name. + (sql-sqlite-program): Change to "sqlite3". + (sql-comint-sqlite): Make sure database name is complete. + (sql-for-each-login): New function. + (sql-connect, sql-save-connection): Use it. + (sql-get-login-ext): New function. + (sql-get-login): Use it. + (sql-make-alternate-buffer-name): Handle :file parameters. + +2010-07-22 Juanma Barranquero <lekktu@gmail.com> + + * dired.el (dired-no-confirm): Document value t and fix defcustom to + accept it (bug#6597). Suggested by Drew Adams <drew.adams@oracle.com>. + +2010-07-22 Teemu Likonen <tlikonen@iki.fi> (tiny change) + + * dired.el (dired-mode-map): Use command remapping (bug#6632). + +2010-07-22 Lawrence Mitchell <wence@gmx.li> + + * term/vt100.el (vt100-wide-mode): Fix :init-value keyword (bug#6620). + +2010-07-21 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-get-ls-command) + (tramp-get-ls-command-with-dired): Run tests on "/dev/null" + instead of "/". + +2010-07-20 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 2.3. + (sql-connection-alist): Changed keys from symbols to strings; + enhanced the widget definition. + (sql-mode-menu): Added submenu to select connections. + (sql-interactive-mode-menu): Added "Save Connection" item. + (sql-add-product): Fixed menu item. + (sql-get-product-feature): Improved error handling. + (sql--alt-buffer-part, sql--alt-if-not-empty): Removed. + (sql-make-alternate-buffer-name): Simplified. + (sql-product-interactive): Handle missing product. + (sql-connect): Support string keys, minor improvements. + (sql-save-connection): New function. + (sql-connection-menu-filter): New function. + +2010-07-20 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-file-name-handler): Trace 'quit. + (tramp-open-connection-setup-interactive-shell): Apply + workaround for IRIX64 bug. Move argument of last + `tramp-send-command' where it belongs to. + +2010-07-20 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-perl-file-attributes) + (tramp-perl-directory-files-and-attributes): Don't pass "$3". + (tramp-maybe-open-connection): Use `async-args' and `gw-args' in + front of `login-args'. + +2010-07-19 Juanma Barranquero <lekktu@gmail.com> + + * time.el (display-time-world-mode): Define with `define-derived-mode'. + Set `show-trailing-whitespace' to nil. + (display-time-world-display): Simplify. + +2010-07-18 Alan Mackenzie <acm@muc.de> + + Enhance `c-file-style' in file/directory local variables. + * progmodes/cc-mode.el (c-count-cfss): New function. + (c-before-hack-hook): Call `c-set-style' differently according to + whether c-file-style was set in file or directory local + variables. + +2010-07-18 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 2.2. + (sql-product, sql-user, sql-database, sql-server, sql-port): Use + defcustom :safe keyword rather than putting safe-local-variable + property. + (sql-password): Use defcustom :risky keyword rather than putting + risky-local-variable property. + (sql-oracle-login-params, sql-sqlite-login-params) + (sql-solid-login-params, sql-sybase-login-params) + (sql-informix-login-params, sql-ingres-login-params) + (sql-ms-login-params, sql-postgres-login-params) + (sql-interbase-login-params, sql-db2-login-params) + (sql-linter-login-params): Add `port' option. + (sql-get-product-feature): Added NO-INDIRECT parameter. + (sql-comint-oracle, sql-comint-sybase) + (sql-comint-informix, sql-comint-sqlite, sql-comint-mysql) + (sql-comint-solid, sql-comint-ingres, sql-comint-ms) + (sql-comint-postgres, sql-comint-interbase, sql-comint-db2) + (sql-comint-linter): Renamed sql-connect-* functions to + sql-comint-*. + (sql-product-alist, sql-mode-menu): Renamed as above and + :sqli-connect-func to :sqli-comint-func. + (sql-connection): New variable. + (sql-interactive-mode): Set it. + (sql-connection-alist): New variable. + (sql-connect): New function. + (sql--alt-buffer-part, sql--alt-if-not-empty) + (sql-make-alternate-buffer-name): Improved alternative buffer name. + +2010-07-17 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * image-mode.el (image-bookmark-make-record): Do not set context + in an image (Bug#6650). + +2010-07-17 Chong Yidong <cyd@stupidchicken.com> + + * simple.el (select-active-region): New function. + (push-mark-command, set-mark, activate-mark) + (handle-shift-selection): Use it. + (deactivate-mark): Don't check for size of region. + + * mouse.el (mouse-drag-track): Use select-active-region. + +2010-07-17 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-get-ls-command-with-dired): Make test for + "--dired" stronger. + +2010-07-17 Chong Yidong <cyd@stupidchicken.com> + + * term/x-win.el (x-select-enable-primary): Change default to nil. + (x-select-enable-clipboard): Add :version keyword. + + * mouse.el (mouse-drag-copy-region): + * simple.el (select-active-regions): Likewise. + +2010-07-16 Reiner Steib <Reiner.Steib@gmx.de> + + * vc/vc.el (vc-coding-system-inherit-eol): New defvar. + (vc-coding-system-for-diff): Use it to decide whether to inherit + from the file the EOL format for reading the diffs of that file. + (Bug#4451) + +2010-07-16 Eli Zaretskii <eliz@gnu.org> + + * mail/rmailmm.el (rmail-mime-save): Make the temp buffer + unibyte, so compressed attachments are not compressed again. + +2010-07-16 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-shell-command): Don't use hard-wired + "/bin/sh" but `tramp-remote-sh' from `tramp-methods'. + (tramp-find-shell): Simplify setting connection property. + (tramp-get-ls-command): Make test for "--color=never" stronger. + +2010-07-15 Simon South <ssouth@member.fsf.org> + + * progmodes/delphi.el (delphi-previous-indent-of): Indent case + blocks within record declarations (i.e. variant parts) correctly. + +2010-07-15 Simon South <ssouth@member.fsf.org> + + * progmodes/delphi.el (delphi-token-at): Give newlines precedence + over literal tokens when parsing so newlines aren't "absorbed" by + single-line comments. Corrects the indentation of case blocks + that have a comment on the first line. + +2010-07-14 Karl Fogel <kfogel@red-bean.com> + + * bookmark.el (bookmark-load-hook): Fix doc string as suggested + by Drew Adams (Bug#5504). + +2010-07-14 Jan Djärv <jan.h.d@swipnet.se> + + * xt-mouse.el (xterm-mouse-event-read): Fix for characters > 127 + now that Unicode is used (Bug#6594). + +2010-07-14 Chong Yidong <cyd@stupidchicken.com> + + * term/x-win.el (x-select-enable-clipboard): Default to t. + (x-initialize-window-system): Don't overwrite Paste menu item. + + * simple.el (select-active-regions): Default to t. + (push-mark-command): Don't overwrite primary with empty string. + + * mouse.el: Bind mouse-2 to mouse-yank-primary. + (mouse-drag-copy-region): Default to nil. + + * menu-bar.el (menu-bar-enable-clipboard): Don't overwrite + Cut/Copy/Paste menu bar items. + +2010-07-13 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + Allow C-w when setting a bookmark in a Gnus Article buffer (Bug#5975). + Patch applied by Karl Fogel. + + * bookmark.el (bookmark-set): Don't set `bookmark-yank-point' + and `bookmark-current-buffer' if they have been already set in + another buffer (e.g gnus-art). + +2010-07-13 Karl Fogel <kfogel@red-bean.com> + Thierry Volpiatto <thierry.volpiatto@gmail.com> + + Preparation for setting bookmarks in Gnus article buffers (Bug#5975). + + * bookmark.el (bookmark-make-record-default): Allow unneeded + information to be omitted from the record. + + Adjust declarations and calls: + + * info.el (bookmark-make-record-default): Adjust declaration. + (Info-bookmark-make-record): Adjust call. + + * woman.el (bookmark-make-record-default): Adjust declaration. + (woman-bookmark-make-record): Adjust call. + + * man.el (bookmark-make-record-default): Adjust declaration. + (Man-bookmark-make-record): Adjust call. + + * image-mode.el (bookmark-make-record-default): Adjust declaration. + + * doc-view.el (bookmark-make-record-default): Adjust declaration. + +2010-07-13 Karl Fogel <kfogel@red-bean.com> + + * bookmark.el (bookmark-show-annotation): Use `when' instead of `if'. + This is also from Thierry Volpiatto's patch in bug #6444. However, + because it was extraneous to the functional change in that patch, + and causes a re-indendation, I am committing it separately. + +2010-07-13 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * bookmark.el (bookmark-show-annotation): Ensure annotations show, + e.g. in Info bookmarks, by using `switch-to-buffer-other-window'. + Patch applied by Karl Fogel (Bug#6444). + +2010-07-13 Chong Yidong <cyd@stupidchicken.com> + + * frame.el (make-frame): Fix typo in 2010-06-30 change (Bug#6625). + +2010-07-13 Adrian Robert <Adrian.B.Robert@gmail.com> + + * term/ns-win.el: Bind M-~ to 'ns-prev-frame (due to Matthew + Dempsky; bug#5084). Remove incorrect binding for S-tab. + (ns-alternatives-map): Change S-tab binding to backtab + (bug#6616). + + * simple.el (normal-erase-is-backspace-setup-frame): Set mode on + under ns. + +2010-07-12 Andreas Schwab <schwab@linux-m68k.org> + + * language/tai-viet.el ("TaiViet"): Try to fix re-encoding bugs. + (Bug#5806) + + * language/tv-util.el (tai-viet-re): Remove format. + +2010-07-12 Kenichi Handa <handa@m17n.org> + + * language/hebrew.el: Remove no-byte-compile declaration. + Change coding: tag to utf-8. Register hebrew-shape-gstring in + composition-function-table for 3-character looking back. + (hebrew-font-get-precomposed): New function. + (hebrew-shape-gstring): Utilize precomposed glyphs if available. + +2010-07-11 Chong Yidong <cyd@stupidchicken.com> + + * mouse.el (mouse-drag-track): Handle select-active-regions + (Bug#6612). + +2010-07-11 Magnus Henoch <magnus.henoch@gmail.com> + + * net/tramp-gvfs.el (tramp-gvfs-handle-copy-file): Do not pass + empty argument to gvfs-copy. + +2010-07-10 Glenn Morris <rgm@gnu.org> + + * calendar/calendar.el (calendar-week-end-day): New function. + * calendar/cal-tex.el (cal-tex-cursor-month): Remove unused vars. + Respect calendar-week-start-day. (Bug#6606) + (cal-tex-insert-day-names, cal-tex-insert-blank-days) + (cal-tex-insert-blank-days-at-end): Respect calendar-week-start-day. + (cal-tex-first-blank-p, cal-tex-last-blank-p): Simplify, and + respect calendar-week-start-day. + +2010-07-10 Chong Yidong <cyd@stupidchicken.com> + + * simple.el (use-region-p): Doc fix (Bug#6607). + +2010-07-10 Aleksei Gusev <aleksei.gusev@gmail.com> (tiny change) + + * progmodes/compile.el (compilation-error-regexp-alist-alist): Add + regexps for cucumber and ruby. + +2010-07-08 Daiki Ueno <ueno@unixuser.org> + + * epa-file.el (epa-file-error, epa-file--find-file-not-found-function) + (epa-file-insert-file-contents): Hack to prevent + find-file from opening empty buffer when decryption failed + (bug#6568). + +2010-07-07 Agustín Martín <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-alternate-dictionary): + Use file-readable-p. + Return nil if no word-list is found at default locations. + (ispell-complete-word-dict): Default to nil. + (ispell-command-loop): Use 'word-list' when using lookup-words. + (lookup-words): Use ispell-complete-word-dict or + ispell-alternate-dictionary. Check for word-list availability + and handle errors if needed with better messages (Bug#6539). + (ispell-complete-word): Use ispell-complete-word-dict or + ispell-alternate-dictionary. + +2010-07-07 Christoph Scholtes <cschol2112@gmail.com> + + * progmodes/python.el (python-font-lock-keywords): Add Python 2.7 + builtins (BufferError, BytesWarning, WindowsError; callables + bin, bytearray, bytes, format, memoryview, next, print; __package__). + +2010-07-07 Glenn Morris <rgm@gnu.org> + + * play/zone.el (top-level): Do not require timer, tabify, or cl. + (zone-shift-left): Ignore intangibility, and any errors from + forward-char. + (zone-shift-right): Remove no-op end-of-line. Ignore intangibility. + (zone-pgm-putz-with-case): Use upcase-region rather than inserting, + deleting, and copying text properties. + (zone-line-specs, zone-pgm-stress): Check forward-line exit status. + (zone-pgm-rotate): Handle odd buffers like that of gomoku, where getting + to point-max is hard. + (zone-fret, zone-fill-out-screen): Replace cl's do with dotimes. + (zone-fill-out-screen): Ignore intangibility. + +2010-07-05 Chong Yidong <cyd@stupidchicken.com> + + * menu-bar.el (menu-bar-mode): + * tool-bar.el (tool-bar-mode): Replace default-frame-alist element + if it has been set. + + * mouse.el (mouse-drag-track): Call mouse-start-end to handle + word/line selection (Bug#6565). + +2010-07-04 Juanma Barranquero <lekktu@gmail.com> + + * net/dbus.el (dbus-send-signal): Declare function. + +2010-07-04 Michael Albinus <michael.albinus@gmx.de> + + * net/dbus.el: Implement signal "PropertiesChanged" (from D-Bus 1.3.1). + (dbus-register-property): New optional argument EMITS-SIGNAL. + (dbus-property-handler): Send signal "PropertiesChanged" if requested. + +2010-07-03 Chong Yidong <cyd@stupidchicken.com> + + * mouse.el (mouse-drag-overlay): Variable deleted. + (mouse-move-drag-overlay, mouse-show-mark): Functions deleted. + (mouse--remap-link-click-p): New function. + (mouse-drag-track): Handle dragging by using temporary Transient + Mark mode, instead of a special overlay. + (mouse-kill-ring-save, mouse-save-then-kill): Don't call + mouse-show-mark. + + * mouse-sel.el (mouse-sel-selection-alist): mouse-drag-overlay + deleted. + +2010-07-02 Juri Linkov <juri@jurta.org> + + * autoinsert.el (auto-insert-alist): Fix readability + by using dotted pair notation for lambda. + +2010-07-02 Juri Linkov <juri@jurta.org> + + * faces.el (read-face-name): Rename arg `string-describing-default' + to `default'. Doc fix. Display the default value in quotes + in the prompt. With empty input, return the `default' arg, + unless the default value is a string (in which case return nil). + (describe-face): Replace the string `default' arg of `read-face-name' + with the symbol `default'. + +2010-07-02 Chong Yidong <cyd@stupidchicken.com> + + * emulation/viper-cmd.el (viper-delete-backward-char) + (viper-del-backward-char-in-insert) + (viper-del-backward-char-in-replace, viper-change) + (viper-backward-indent): Replace delete-backward-char with + delete-char (Bug#6552). + +2010-07-01 Chong Yidong <cyd@stupidchicken.com> + + * ruler-mode.el (ruler--save-header-line-format): Fix typos. + +2010-06-30 Chong Yidong <cyd@stupidchicken.com> + + * frame.el (make-frame): Add default-frame-alist to the PARAMETERS + argument passed to frame-creation-function (Bug#5378). + + * faces.el (x-handle-named-frame-geometry) + (x-handle-reverse-video, x-create-frame-with-faces) + (face-set-after-frame-default, tty-create-frame-with-faces): Don't + separately consult default-frame-alist. It is now passed as the + PARAMETER argument. + +2010-06-30 Andreas Schwab <schwab@linux-m68k.org> + + * startup.el (command-line): Don't call tool-bar-setup in a + tty-only build. + +2010-06-30 Chong Yidong <cyd@stupidchicken.com> + + * ruler-mode.el (ruler--save-header-line-format): New fun. + (ruler-mode): Use it as a setter function, so as not to overwrite + ruler-mode-header-line-format-old if Ruler mode is on (Bug#5370). + +2010-06-29 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc.el (vc-deduce-backend): New fun. Handle diff buffers. + (vc-root-diff, vc-print-root-log, vc-log-incoming) + (vc-log-outgoing): Use it. + (vc-diff-internal): Set diff-vc-backend. + + * vc/diff-mode.el (diff-vc-backend): New var. + +2010-06-28 Jan Djärv <jan.h.d@swipnet.se> + + * dynamic-setting.el (font-setting-change-default-font): Remove + call to message. + +2010-06-28 Kenichi Handa <handa@m17n.org> + + * international/quail.el (quail-insert-kbd-layout): Fix the + showing of untranslated characters. + +2010-06-28 Chong Yidong <cyd@stupidchicken.com> + + * simple.el (delete-active-region): New option. + (delete-backward-char): Implement in Lisp. + (delete-forward-char): New command. + + * mouse.el (mouse-region-delete-keys): Deleted. + (mouse-show-mark): Simplify. + + * bindings.el (global-map): Bind delete and DEL, the former to + delete-forward-char. + +2010-06-27 Lennart Borgman <lennart.borgman@gmail.com> + + * progmodes/ruby-mode.el (ruby-mode-map): Don't bind TAB. + (ruby-mode): Bind indent-line-function (Bug#5119). + +2010-06-27 Chong Yidong <cyd@stupidchicken.com> + + * startup.el (command-line): Recognize "0" X resource value. + +2010-06-27 Chong Yidong <cyd@stupidchicken.com> + + * startup.el (command-line): Use X resources to set the value of + menu-bar-mode and tool-bar-mode, before calling frame-initialize. + + * menu-bar.el (menu-bar-mode): + * tool-bar.el (tool-bar-mode): Don't change default-frame-alist. + Set init-value to t. + + * frame.el (frame-notice-user-settings): Don't change + default-frame-alist based on menu-bar-mode and tool-bar-mode, or + vice versa (Bug#2249). + +2010-06-26 Eli Zaretskii <eliz@gnu.org> + + * w32-fns.el (w32-convert-standard-filename): Doc fix. + +2010-06-25 Agustín Martín <agustin.martin@hispalinux.es> + + * textmodes/flyspell.el (flyspell-check-previous-highlighted-word): + Make sure `flyspell-word' re-checks word after function run (Bug#6504). + + * textmodes/ispell.el (ispell-init-process): Make sure ispell and + default directories are expanded (Bug#6143). + +2010-06-24 Juri Linkov <juri@jurta.org> + + * minibuffer.el (completions-format): Change default from nil to + `horizontal'. Remove `nil' value from :type. Doc fix. (Bug#6459) + +2010-06-24 Juri Linkov <juri@jurta.org> + + * vc/vc.el (vc-diff-internal): Set `revert-buffer-function' + buffer-locally to lambda that re-runs the vc diff command. + (Bug#6447) + +2010-06-24 Chong Yidong <cyd@stupidchicken.com> + + * kmacro.el (kmacro-call-macro): Don't issue hint message if the + echo area is in use (Bug#3412). + +2010-06-22 Glenn Morris <rgm@gnu.org> + + * textmodes/texinfmt.el (texinfo-format-region) + (texinfo-raise-lower-sections, texinfo-format-separate-node) + (texinfo-itemize-item, texinfo-multitable-item, texinfo-alias) + (texinfo-format-option, texinfo-noindent): + Use line-beginning-position and line-end-position. + + * calc/calc-aent.el, calc/calc-ext.el, calc/calc-lang.el: + * calc/calc-store.el, calc/calc-units.el, calc/calc.el: + * calc/calccomp.el: Add explicit utf-8 coding cookies to files with + utf-8 characters. + +2010-06-21 Karl Fogel <kfogel@red-bean.com> + + * play/zone.el (zone-fall-through-ws): Fix next-line -> + forward-line fallout. + +2010-07-06 Chong Yidong <cyd@stupidchicken.com> + + * mouse.el (mouse-appearance-menu): Add docstring. + + * help.el (describe-key): Print up-event using key-description. + +2010-07-03 Michael Albinus <michael.albinus@gmx.de> + + * net/zeroconf.el (zeroconf-resolve-service) + (zeroconf-service-resolver-handler): Use + `dbus-byte-array-to-string'. + (zeroconf-publish-service): Use `dbus-string-to-byte-array'. + +2010-07-03 Jan Moringen <jan.moringen@uni-bielefeld.de> + + * net/zeroconf.el (zeroconf-service-remove-hook): New defun. + +2010-06-30 Dan Nicolaescu <dann@ics.uci.edu> + + Avoid displaying files with a nil state in vc-dir. + * vc/vc-dir.el (vc-dir-update): Obey the noinsert argument in all + cases that cause insertion. + (vc-dir-resynch-file): Tell vc-dir-update to avoid inserting files + with a nil state. + +2010-06-30 Chong Yidong <cyd@stupidchicken.com> + + * xml.el (xml-parse-region): Avoid infloop (Bug#5281). + +2010-06-29 Leo <sdl.web@gmail.com> + + * emacs-lisp/rx.el (rx): Doc fix. (Bug#6537) + +2010-06-27 Oleksandr Gavenko <gavenkoa@gmail.com> (tiny change) + + * generic-x.el (bat-generic-mode): Fix regexp for command line + switches (Bug#5719). + +2010-06-27 Masatake YAMATO <yamato@redhat.com> + + * htmlfontify.el (hfy-face-attr-for-class): Use append instead + of nconc to avoid pure storage error (Bug#6239). + +2010-06-27 Christoph <cschol2112@googlemail.com> (tiny change) + + * bookmark.el (bookmark-bmenu-2-window, bookmark-bmenu-other-window) + (bookmark-bmenu-other-window-with-mouse): Remove unnecessary + bindings of bookmark-automatically-show-annotations (Bug#6515). + +2010-06-25 Eli Zaretskii <eliz@gnu.org> + + * arc-mode.el (archive-zip-extract): Don't quote the file name on + MS-Windows and MS-DOS. (Bug#6467, Bug#6144) + +2010-06-24 Štěpán Němec <stepnem@gmail.com> (tiny change) + + * comint.el (make-comint, make-comint-in-buffer): Mention return + value in the docstrings. (Bug#6498) + +2010-06-24 Yoni Rabkin <yoni@rabkins.net> + + * bs.el (bs-mode-font-lock-keywords): Remove "by" from Dired pattern, + since it is not present when using some non-default switches. + +2010-06-23 Karl Fogel <kfogel@red-bean.com> + + * simple.el (compose-mail): Fix doc string to refer to + `compose-mail-user-agent-warnings', instead of to the + nonexistent `compose-mail-check-user-agent'. + +2010-06-21 Alan Mackenzie <bug-cc-mode@gnu.org> + + Fix an indentation bug: + + * progmodes/cc-mode.el (c-common-init): Initialise c-new-BEG/END. + (c-neutralize-syntax-in-and-mark-CPP): c-new-BEG/END: Take account + of existing values. + + * progmodes/cc-engine.el (c-clear-<-pair-props-if-match-after) + (c-clear->-pair-props-if-match-before): now return t when they've + cleared properties, nil otherwise. + (c-before-change-check-<>-operators): Set c-new-beg/end correctly + by taking account of the existing value. + + * progmodes/cc-defs.el + (c-clear-char-property-with-value-function): Fix this to clear the + property rather than overwriting it with nil. + +2010-06-20 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-print-package): Add link to + package description via describe-package. + (describe-package-1): List package requirements. Add button to + perform installation. + (package-menu-describe-package): New command. + + * help-mode.el (help-package): New button type. + +2010-06-19 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el: Move package-list-packages binding to + menu-bar.el. + (describe-package, describe-package-1, package--dir): New funs. + (package-activate-1): Use package--dir. + + * emacs-lisp/package-x.el (gnus-article-buffer): Require package. + + * help-mode.el (help-package-def): New button type. + + * menu-bar.el: Move package-list-packages binding here from + package.el. + +2010-06-19 Gustav Hållberg <gustav@gmail.com> (tiny change) + + * descr-text.el (describe-char): Avoid trailing whitespace. (Bug#6423) + +2010-06-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/edebug.el (edebug-read-list): + Phase out old-style backquotes. + +2010-06-17 Juri Linkov <juri@jurta.org> + + * help-mode.el (help-mode): Set buffer-local variable + revert-buffer-function to help-mode-revert-buffer. + (help-mode-revert-buffer): New function. + + * info.el (Info-revert-find-node): Check for major-mode Info-mode + before popping to "*info*" (like in other Info functions). + Keep buffer-name in old-buffer-name. Keep Info-history-forward in + old-history-forward. Pop to old-buffer-name or "*info*" to + recreate the killed buffer. Set Info-history-forward from + old-history-forward. + (Info-breadcrumbs-depth): Add :group and :version. + +2010-06-17 Dan Nicolaescu <dann@ics.uci.edu> + + * emacs-lisp/package.el (package-menu-mode-map): Add a menu. + +2010-06-17 Agustín Martín <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-aspell-find-dictionary): Fix regexp + for languages like Portuguese with pt_{BR,PT} and no plain pt. + +2010-06-17 Juanma Barranquero <lekktu@gmail.com> + + * emacs-lisp/package.el (package-menu-mode-map): + Move initialization into declaration. + + * menu-bar.el (menu-bar-options-menu): Fix typo in menu entry. + +2010-06-17 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-archive-base): Point to + elpa.gnu.org. + (package-enable, package-load-list): New defcustoms. + (package-user-dir, package-directory-list): Turn into defcustoms. + Don't include package-user-dir in package-directory-list. + (package--builtins-base): Don't include Emacs as a "package". + (package-subdirectory-regexp): New var. + (package-load-all-descriptors, package-compute-transaction) + (package-download-transaction): Obey package-load-list. + (package-activate-1): Rename from package-do-activate. + (package-list-packages-internal): Check package-load-list. + (package-load-descriptor, package-generate-autoloads) + (package-unpack, package-unpack-single) + (package--read-archive-file, package-delete): Use + expand-file-name. + + * emacs-lisp/package-x.el: New file. Package uploading + functionality split out from package.el. + + * startup.el (command-line): Load packages after reading init + file. + +2010-06-17 Tom Tromey <tromey@redhat.com> + + * emacs-lisp/package.el: New file. + +2010-06-22 Dan Nicolaescu <dann@ics.uci.edu> + + Fix vc-annotate for renamed files when using Git. + * vc-git.el (vc-git-find-revision): Deal with empty results from + ls-files. Doe not pass the object as a file name to cat-file, it + is not a file name. + (vc-git-annotate-command): Pass the file name using -- to avoid + ambiguity with the revision. + (vc-git-previous-revision): Pass a relative file name. + +2010-06-22 Glenn Morris <rgm@gnu.org> + + * progmodes/js.el (js-mode-map): Use standard capitalization and + ellipses for menu entries. + + * wid-edit.el (widget-complete): Doc fix. + +2010-06-22 Jürgen Hötzel <juergen@hoetzel.info> (tiny change) + + * wid-edit.el (widget-complete): Fix typo in 2009-12-02 change. + +2010-06-22 Dan Nicolaescu <dann@ics.uci.edu> + + Fix annotating other revisions for renamed files in vc-annotate. + * vc-annotate.el (vc-annotate): Add an optional argument for the + VC backend. Use it when non-nil. + (vc-annotate-warp-revision): Pass the VC backend to vc-annotate. + (Bug#6487) + + Fix vc-annotate-show-changeset-diff-revision-at-line for git. + * vc-annotate.el (vc-annotate-show-diff-revision-at-line-internal): + Do not pass the file name to the 'previous-revision call when we + don't want a file diff. (Bug#6489) + +2010-06-21 Dan Nicolaescu <dann@ics.uci.edu> + + Fix finding revisions for renamed files in vc-annotate. + * vc.el (vc-find-revision): Add an optional argument for + the VC backend. Use it when non-nil. + * vc-annotate.el (vc-annotate-find-revision-at-line): Pass the VC + backend to vc-find-revision. (Bug#6487) + +2010-06-21 Dan Nicolaescu <dann@ics.uci.edu> + + Fix reading file names in Git annotate buffers. + * vc-git.el (vc-git-annotate-extract-revision-at-line): Remove + trailing whitespace. Suggested by Eric Hanchrow. (Bug#6481) + +2010-06-20 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-mode.el (c-before-hack-hook): When the mode is set + in file local variables, set it first. + +2010-06-19 Glenn Morris <rgm@gnu.org> + + * descr-text.el (describe-char-unicode-data): Insert separating + space when needed. (Bug#6422) + + * progmodes/idlwave.el (idlwave-action-and-binding): + Fix typo in 2009-12-03 change. (Bug#6450) + +2010-06-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/macroexp.el (macroexpand-all-1): Put back special + handling for `lambda' (misunderstanding). + +2010-06-16 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-poly.el (math-accum-factors): Make sure that + constants aren't distributed after they are factored out. + +2010-06-16 Juri Linkov <juri@jurta.org> + + * facemenu.el (list-colors-display): Call `pop-to-buffer' before + `list-colors-print'. (Bug#6332) + + * subr.el (read-quoted-char): Fix up last change (bug#6290). + +2010-06-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/macroexp.el (macroexpand-all-1): Don't handle `lambda' + specially, since it's a macro. Fix up wrong hint passed to maybe-cons. + + * font-lock.el (font-lock-major-mode): Rename from + font-lock-mode-major-mode to distinguish it from + global-font-lock-mode's own font-lock-mode-major-mode (bug#6135). + (font-lock-set-defaults): + * font-core.el (font-lock-default-function): Adjust users. + (font-lock-mode): Don't set it at all. + +2010-06-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-annotate.el (vc-annotate): Use vc-read-revision. + +2010-06-16 Glenn Morris <rgm@gnu.org> + + * calendar/appt.el (appt-time-msg-list): Doc fix. + (appt-check): Let-bind appt-warn-time. + (appt-add): Make the 3rd argument optional. + Simplify argument names. Doc fix. Check for integer WARNTIME. + Only add WARNTIME to the output list if non-nil. + +2010-06-16 Ivan Kanis <apple@kanis.eu> + + * calendar/appt.el (appt-check): Let the 3rd element of + appt-time-msg-list specify the warning time. + (appt-add): Add new argument with the warning time. (Bug#5176) + +2010-06-16 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> (tiny change) + + * vc-svn.el (vc-svn-after-dir-status): Fix regexp for Subversions + older than version 1.6. (Bug#6361) + +2010-06-16 Helmut Eller <eller.helmut@gmail.com> + + * emacs-lisp/cl-macs.el (destructuring-bind): Bind `bind-enquote', + used by cl-do-arglist. (Bug#6408) + +2010-06-16 Agustín Martín <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-dictionary-base-alist): Fix + portuguese casechars/not-casechars for missing 'çÇ'. + Suggested by Rolando Pereira (bug#6434). + +2010-06-15 Juanma Barranquero <lekktu@gmail.com> + + * facemenu.el (list-colors-sort): Doc fix. + +2010-06-15 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> (tiny change) + + * progmodes/sql.el (sql-connect-mysql): Fix typo. + +2010-06-14 Juri Linkov <juri@jurta.org> + + Add sort option `list-colors-sort'. (Bug#6332) + * facemenu.el (color-rgb-to-hsv): New function. + (list-colors-sort): New defcustom. + (list-colors-sort-key): New function. + (list-colors-display): Doc fix. Sort list according to the option + `list-colors-sort'. + (list-colors-print): Add HSV values to `help-echo' property of + RGB strings. + +2010-06-14 Juri Linkov <juri@jurta.org> + + * compare-w.el: Move to the "vc" subdirectory. + 2010-06-14 Stefan Monnier <monnier@iro.umontreal.ca> * image-mode.el (image-mode-map): Remap left-char and right-char. @@ -299,8 +1764,7 @@ 2010-06-03 Chong Yidong <cyd@stupidchicken.com> - * net/rcirc.el (rcirc-nickname<, rcirc-sort-nicknames-join): Doc - fix. + * net/rcirc.el (rcirc-nickname<, rcirc-sort-nicknames-join): Doc fix. 2010-06-03 Stefan Monnier <monnier@iro.umontreal.ca> @@ -674,12 +2138,12 @@ (rcirc-user-name-history): Add variable. 2010-05-25 Ryan Yeske <rcyeske@gmail.com> - Jonathan Rockway <jon@jrock.us> + Jonathan Rockway <jon@jrock.us> * net/rcirc.el (rcirc-server-alist): Add :pass. (rcirc): When prompting for connection parameters, also prompt for username and password. - (rcirc-connect): Take a PASS argument. If PASS is non-nil, send + (rcirc-connect): Take a PASS argument. If PASS is non-nil, send value to server when connecting. 2010-05-25 Stefan Monnier <monnier@iro.umontreal.ca> @@ -1061,8 +2525,8 @@ 2010-05-13 Agustín Martín <agustin.martin@hispalinux.es> - * ispell.el (ispell-init-process): Do not kill ispell process - everytime when spellchecking from the minibuffer (bug#6143). + * textmodes/ispell.el (ispell-init-process): Do not kill ispell + process everytime when spellchecking from the minibuffer (bug#6143). 2010-05-13 Stefan Monnier <monnier@iro.umontreal.ca> @@ -1723,8 +3187,8 @@ 2010-04-27 Agustín Martín <agustin.martin@hispalinux.es> - * ispell.el (ispell-init-process): Fix personal dictionary condition - in default directory check. + * textmodes/ispell.el (ispell-init-process): Fix personal dictionary + condition in default directory check. (ispell-init-process,ispell-kill-ispell,kill-buffer-hook): Kill ispell process when killing its associated buffer. @@ -2403,7 +3867,7 @@ (verilog-pretty-declarations): Support lineup of declarations in port lists. (verilog-skip-backward-comments, verilog-skip-forward-comment-p): - fix bug for /* / comments + fix bug for /* / comments. (verilog-backward-syntactic-ws, verilog-forward-syntactic-ws): Speed up and simplfy as this is never called with a bound. (verilog-pretty-declarations): Enhance to line up declarations @@ -3757,7 +5221,7 @@ 2010-02-03 Michael Albinus <michael.albinus@gmx.de> * net/ange-ftp.el (ange-ftp-insert-directory): Parse directory - also in case of (and (not full) (not wildcard)). This is needed, + also in case of (and (not full) (not wildcard)). This is needed when dired is called with a list of files, which are not in `default-directory'. (Bug#5478) @@ -4512,7 +5976,7 @@ 2010-01-02 Karl Fogel <kfogel@red-bean.com> - * bookmark.el (bookmark-bmenu-any-marks): New function + * bookmark.el (bookmark-bmenu-any-marks): New function. (bookmark-bmenu-save): Clear buffer modification if no marks. 2010-01-02 Karl Fogel <kfogel@red-bean.com> @@ -10246,7 +11710,7 @@ * textmodes/fill.el: Convert to utf-8 encoding. (fill-french-nobreak-p): Remove redundant » and « inherited from our - pre-unicode days. + pre-Unicode days. * add-log.el (change-log-fill-forward-paragraph): New function. (change-log-mode): Use it so fill-region DTRT. diff --git a/lisp/ChangeLog.1 b/lisp/ChangeLog.1 index bd8b8c3ae27..b33b6c62532 100644 --- a/lisp/ChangeLog.1 +++ b/lisp/ChangeLog.1 @@ -173,7 +173,7 @@ 1986-03-15 Bill Rozas (jinx@prep) - * scheme.el: (scheme-zap-name) Uses expand-file-name to obtain an + * scheme.el (scheme-zap-name): Uses expand-file-name to obtain an absolute pathname. 1986-03-15 Richard M. Stallman (rms@prep) @@ -184,7 +184,7 @@ 1986-03-13 Bill Rozas (jinx@prep) - * scheme.el: (scheme-zap-name) change it back to fromedit.zap + * scheme.el (scheme-zap-name): Change it back to fromedit.zap since that is where scheme expects it and it is too much work to change scheme right now. This interface is obsolete anyway, but some people (athena) still use it. @@ -384,7 +384,7 @@ * info.el (Info-find-node): Fix braino. Also, allow abbreviations for node names. - Info-tagify: insert tags in forward order so that + (Info-tagify): Insert tags in forward order so that an abbrev finds the textually first possibility rather than the last. @@ -570,7 +570,7 @@ 1986-01-18 Richard M. Stallman (rms@prep) - * doctor.el: Fix typo "symtoms". + * doctor.el: Fix typo "symtoms". 1986-01-10 Richard Mlynarik (mly@prep) @@ -660,7 +660,7 @@ 1985-12-27 Richard Mlynarik (mly@prep) * view.el: - Various: Fix cases of "view" => "View" which were missed. Damn. + Various: Fix cases of "view" => "View" which were missed. Damn. 1985-12-27 Richard M. Stallman (rms@prep) @@ -917,7 +917,7 @@ * files.el (normal-mode): New command to choose major mode automatically. - * inc-vers.el: Renamed from inc-version.el + * inc-vers.el: Renamed from inc-version.el for file name length reasons. * term/*.el: terminal-specific files found here now. @@ -1021,8 +1021,6 @@ in the *compilation* buffer, thus allowing buffers to have local compilation-error-regexp variables. - (provide 'compile) - 1985-12-05 Richard M. Stallman (rms@prep) * files.el (recover-file): @@ -1139,7 +1137,7 @@ 1985-11-27 Richard Mlynarik (mly@prep) - * rnews.el: (news-mode, news-set-mode-line): + * rnews.el (news-mode, news-set-mode-line): Get rid of news-mode-group-string. * rnews.el (news-unsubscribe-internal): @@ -1495,7 +1493,7 @@ * mouseinit.el Delete this file. Put its contents in files - term-bg.el, term-bgnv.el, term-bgrv.el, term-bbn.el + term-bg.el, term-bgnv.el, term-bgrv.el, term-bbn.el. (Perhaps there should be a subdirectory emacs/lisp/term/ ??) 1985-10-23 Richard M. Stallman (rms@prep) @@ -1616,7 +1614,7 @@ 1985-10-17 Richard Mlynarik (mly@mit-prep) - * rnews.el: (news-save-item-in-file) + * rnews.el (news-save-item-in-file): Append to file, rather than overwriting. * isearch.el @@ -1915,7 +1913,7 @@ * texinfo.el: Change syntax for @xref and @pxref to use braces. - Change syntax for @node to read entire line + Change syntax for @node to read entire line. (new function texinfo-format-parse-line-args for that). Change paragraph-separate, etc., so only directives without braces separate paragraphs. When formatting, discard all of the @@ -2178,8 +2176,8 @@ "c-continued-statement-offset" as in the documentation and manual * rmail.el (rmail-find): - Hack default of last search string, hack reverse search - (-ve prefix arg) + Hack default of last search string, hack reverse search. + (-ve prefix arg): Make "-" be negative-argument 1985-07-23 Richard Mlynarik (mly@mit-prep) @@ -2523,10 +2521,10 @@ No, this directory is added automatically to the path used by call-process. It should have worked before. - RMS - * loaddefs.el: C-z -> C-c in documentation for mail. + * loaddefs.el: C-z -> C-c in documentation for mail. autoload report-emacs-bug from emacsbug.el. - * emacsbug.el: New file. Reports bugs with version info. + * emacsbug.el: New file. Reports bugs with version info. * helper.el (Helper-describe-bindings): Make it describe local bindings faster by binding global map to @@ -2534,7 +2532,7 @@ * lisp-mode.el: First form of prog1 is distinguished. - * loaddefs.el: autoload functions from chistory.el and echistory.el. + * loaddefs.el: Autoload functions from chistory.el and echistory.el. * chistory.el: New file containing two alternatives to `repeat-complex-command' @@ -2587,10 +2585,10 @@ 1985-06-11 K. Shane Hartman (shane@mit-prep) - * ebuff-menu.el: Make M-C-v scroll-other-window instead of + * ebuff-menu.el: Make M-C-v scroll-other-window instead of scroll-down. Make M-v scroll-down. - * ebuff-menu.el, echistory.el: Made them use electric. + * ebuff-menu.el, echistory.el: Made them use electric. * electric.el: New module for packages that retain control until some event @@ -2602,7 +2600,7 @@ Made it use helper.el. Remove kill-ring-save stuff pending use of new winning prin1-to-string for minibuffer hacking. - * view.el: Made it use helper.el. + * view.el: Made it use helper.el. * helper.el: New module for packages which want to do help without giving up @@ -2804,7 +2802,7 @@ 1985-06-01 K. Shane Hartman (shane@mit-prep) - * loaddefs.el: Update documentation for rmail. + * loaddefs.el: Update documentation for rmail. * lisp-mode.el (calculate-lisp-indent): Asked (fboundp 'lisp-indent-hook). Right question is boundp. @@ -2858,7 +2856,7 @@ Skip strings, comments, char constants. Find symbols even if they have no letters in them. - * mlsupport.el: Insert symbol-value call in use-local-map. + * mlsupport.el: Insert symbol-value call in use-local-map. Handle key codes > 127 in local-bind-to-key. Write ml-modify-syntax-entry. @@ -3097,7 +3095,7 @@ * sendmail.el, loaddefs.el added send-mail-function; initially sendmail-send-it - (also, mail-yank-ignored-headers had a typo) + (also, mail-yank-ignored-headers had a typo). * rmail.el (rmail-get-new-mail, convert-to-babyl-format, ...) * loaddefs.el: @@ -3167,7 +3165,7 @@ 1985-05-16 K. Shane Hartman (shane@mit-prep) * dired.el: Put dired-rename-file, dired-copy file-on keys. Make - them change buffer if appropriate. Put dired-mark-backup-files, + them change buffer if appropriate. Put dired-mark-backup-files, dired-mark-temp-files on keys. Eliminate possibility of looping at last line in dired-repeat-over-filenames. @@ -3196,53 +3194,56 @@ replace loop so that replacing continues after moving back to previous. - * add-log.el: add prefix arg to add-change-log-entry so will + * add-log.el: Add prefix arg to add-change-log-entry so will prompt for information if desired. If there is an entry for today, make sure login-name is same before using it, else make new entry. Use auto-fill-mode. 1985-05-12 Richard M. Stallman (rms@mit-prep) - * lisp-mode.el: defined lisp-mode-commands, lisp-mode-variables. + * lisp-mode.el: Defined lisp-mode-commands, lisp-mode-variables. Added external-lisp-mode. Made doc strings mention mode hook variables. - * shell.el: defined functions `lisp' and `inferior-lisp-mode'. + * shell.el: Defined functions `lisp' and `inferior-lisp-mode'. Renamed shell-send-defun... to lisp-send-defun... and made them use process "lisp", buffer *lisp*. - * text-mode.el: made indented-text-mode not call text-mode. + * text-mode.el: Made indented-text-mode not call text-mode. Made doc strings mention mode hook variables. * c-mode.el: Made doc strings mention mode hook variables. - * add-log.el + * add-log.el: Change format used for change log entries. Select indented-text-mode for the change log file. 1985-05-12 K. Shane Hartman (shane@mit-ajax) - simple.el: suppress matching close paren if preceded + + * simple.el: Suppress matching close paren if preceded by char syntax \. - mim-mode.el: flush private paren blinker in favor of default. - add-log.el: change mode-string to mode-name so reflected in + * mim-mode.el: Flush private paren blinker in favor of default. + * add-log.el: Change mode-string to mode-name so reflected in mode-line. change \\W to \\sW when looking for place to add. 1985-05-12 Richard M. Stallman (rms@mit-prep) - simple.el: modified open-line to insert newlines before + + * simple.el: Modified open-line to insert newlines before an existing one before dot. This makes better redisplay. - dired.el: Installed Shane's changes that allow user to choose + * dired.el: Installed Shane's changes that allow user to choose switches to use. 1985-05-11 Richard M. Stallman (rms@mit-prep) - rmail.el: if given file name as argument, + + * rmail.el: If given file name as argument, correctly displays one message of that file but does not try to get new mail. - simple.el: Fix what-line bug: line # too high by 1 if not at bol. + * simple.el: Fix what-line bug: line # too high by 1 if not at bol. Put in blink-matching-paren-distance, and check for wrong kinds of parens matching. - time.el: Put in display-time-day-and-date flag, + * time.el: Put in display-time-day-and-date flag, to display day and date in addition to the time. - startup.el: Call lisp-interaction-mode-hook if defined. + * startup.el: Call lisp-interaction-mode-hook if defined. Set current buffer variables from defaults in case user's init file has changed them. diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index 50b82e13a15..cf4d13ccefb 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -1357,7 +1357,7 @@ 2003-06-10 Rajesh Vaidheeswarran <rv@gnu.org> - * whitespace.el (whitespace-version): Bump to 3.3 + * whitespace.el (whitespace-version): Bump to 3.3. (whitespace-cleanup): Respect user preference for silence * whitespace.el: Remove :tag in commentary :link. Remove empty @@ -1645,7 +1645,7 @@ (bibtex-version): Remove support for bug reporting. (bibtex-field-delimiters, bibtex-entry-delimiters) (bibtex-sort-ignore-string-entries, bibtex-maintain-sorted-entries) - Replace make-variable-buffer-local by make-local-variable for + Replace make-variable-buffer-local by make-local-variable. (bibtex-entry-format): New tag `required-fields'. (bibtex-maintain-sorted-entries): New var. (bibtex-sort-entry-class, bibtex-sort-entry-class-alist): New vars. @@ -4069,9 +4069,9 @@ (ccl-encode-mule-utf-16-le-with-signature) (ccl-encode-mule-utf-16-be-with-signature): New CCL programs. (mule-utf-16-post-read-conversion): New function. - (mule-utf-16-le-with-signature, mule-utf-16-be-with-signature), + (mule-utf-16-le-with-signature, mule-utf-16-be-with-signature) (mule-utf-16): New coding systems. - (utf-16-le-with-signature, utf-16-be-with-signature), + (utf-16-le-with-signature, utf-16-be-with-signature) (utf-16): Aliases of the above coding systems. 2003-04-08 Martin Stjernholm <bug-cc-mode@gnu.org> @@ -4109,7 +4109,7 @@ Other cleanups. Command line option --no-desktop introduced. (desktop-read): Record buffers in the desktop file in - the same order as that in the buffer list, + the same order as that in the buffer list. (desktop-save): Put buffers in the order given in desktop file, regardless of what handlers do. (desktop-file-version): New variable. Version number of desktop @@ -7684,7 +7684,7 @@ * gdb-ui.el : Remove inappropriate key-bindings. (gdb-info-breakpoints-custom, gdb-goto-bp-this-line): Parse correctly when breakpoint has no line number. - (def-gdb-auto-update-handler, gdb-info-locals-handler), + (def-gdb-auto-update-handler, gdb-info-locals-handler) (gdb-display-end): Avoid using insert-buffer. (gdb-frames-select-by-mouse): Rename gdb-frames-mouse-select. @@ -20177,10 +20177,10 @@ 2002-01-05 Andre Spiegel <spiegel@gnu.org> - * vc.el (vc-branch-part): Return nil if there's no `.' + * vc.el (vc-branch-part): Return nil if there's no `.'. (vc-default-previous-version): Renamed from vc-previous-version. New args BACKEND and FILE. Return nil for revision numbers - without a `.' + without a `.'. (vc-version-diff): Call vc-BACKEND-previous-version. (vc-steal-lock): Steal lock before composing mail, so that no mail is sent when the stealing goes wrong. And we'll actually see the @@ -23253,11 +23253,11 @@ lambda expression. (ps-mode-menu-main): Submenu with options on/off was replaced with a toggle button. - (ps-mode, ps-run-mode): Define with `define-derived-mode' + (ps-mode, ps-run-mode): Define with `define-derived-mode'. (ps-mode): Autoload cookie added on same line as comment. (ps-mode-tabkey, ps-mode-backward-delete-char): (ps-mode-r-balance): Replace `delete-horizontal-space' and - `indent-to' with `indent-line-to' + `indent-to' with `indent-line-to'. (ps-mode-print-buffer, ps-mode-print-region): Use `funcall' instead of `eval'. (ps-mode-print-region): Use `with-temp-buffer'. @@ -23464,7 +23464,7 @@ (vc-default-annotate-current-time): Added. * vc-cvs.el (vc-cvs-annotate-difference): Removed to generic - version in vc.el, with + version in vc.el. (vc-cvs-annotate-current-time): Added, as override of default. (vc-cvs-annotate-time): Added. Taken mostly from the (now removed) `vc-cvs-annotate-difference'. diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11 index 86bf9434fc9..c1ee441ea6b 100644 --- a/lisp/ChangeLog.11 +++ b/lisp/ChangeLog.11 @@ -84,7 +84,7 @@ 2004-12-30 Andreas Leue <al@sphenon.de> - * textmodes/artist.el (artist-version): 1.2.6 + * textmodes/artist.el (artist-version): 1.2.6. (artist-prev-next-op-alist): New variable. (artist-select-next-op-in-list): New function. (artist-select-prev-op-in-list): New function. @@ -380,7 +380,7 @@ (calculator-radix-grouping-digits) (calculator-radix-grouping-separator): New defcustoms for the new radix grouping mode functionality. - (calculator-mode-hook): Now used in electric mode too, + (calculator-mode-hook): Now used in electric mode too. (calculator): Call it. (calculator-mode-map): Some new keys. (calculator-message): New function. Some new calls. @@ -2239,7 +2239,7 @@ (math-so-far, math-integ-expr, math-expr-parts, calc-low) (calc-high, math-solve-var, math-solve-full, math-solve-vars) (math-try-solve-sign, math-solve-b, math-solve-system-vv) - (math-solve-res): New variables + (math-solve-res): New variables. (math-derivative, calcFunc-deriv, calcFunc-tderiv) (math-integral, math-replace-integral-parts) (math-integrate-by-parts, calc-dump-integral-cache) @@ -4692,7 +4692,7 @@ mark mode (to include the current match to region boundaries). Push the search string to `query-replace-from-history-variable'. Add prompt "Query replace regexp" for isearch-regexp. - Add region beginning/end as last arguments of `perform-replace.' + Add region beginning/end as last arguments of `perform-replace'. (isearch-query-replace-regexp): Replace code by the call to `isearch-query-replace' with arg `t'. @@ -9809,7 +9809,7 @@ (compile): Additional argument for interactive compiles like TeX. - * progmodes/grep.el (kill-grep): Move here from compile.el + * progmodes/grep.el (kill-grep): Move here from compile.el. (grep-error, grep-hit-face, grep-error-face) (grep-mode-font-lock-keywords): New variables. (grep-regexp-alist): Simplify regexp and add `binary' case. @@ -10944,12 +10944,12 @@ (rsf-bbdb-auto-delete-spam-entries): Rename from rmail-bbdb-auto-delete-spam-bbdb-entries. The cc: field is scanned together with the recipients field for spam testing; Don't - delete spam message if rmail-delete-after-output is non-nil; + delete spam message if rmail-delete-after-output is non-nil. (rsf-check-field): New function, extracted from code in rmail-spam-filter to ease addition of header fields like - content-type:; + content-type:. (message-content-type): New variable. The content-type: field was - added also in defcustom of rsf-definitions-alist; + added also in defcustom of rsf-definitions-alist. (rmail-spam-filter): Replace repeated test code for header fields by calls to check-field; change the call to rmail-output-to-rmail-file such that rmail-current-message stays @@ -11474,7 +11474,7 @@ 2003-12-29 Stuart Herring <herring@lanl.gov> (tiny change) * comint.el (comint-watch-for-password-prompt): Pass `string' as - arg to send-invisible + arg to send-invisible. (send-invisible): Doc fix. The argument is now a prompt, not the string to send. (comint-read-noecho): Doc fix. @@ -12951,7 +12951,7 @@ Ensure that recentf correctly updates the menu bar. * recentf.el (recentf-menu-path,recentf-menu-before): Doc fix. (recentf-menu-bar): New function. - (recentf-clear-data): Use it + (recentf-clear-data): Use it. (recentf-update-menu): Likewise. Use easy-menu-add-item instead of easy-menu-change. @@ -13500,7 +13500,7 @@ (reftex-toc-split-windows-fraction): New option. (reftex-recenter-toc-when-idle): Search *toc* window on all visible frames. - (reftex-toc): Additional parameter REUSE + (reftex-toc): Additional parameter REUSE. (reftex-toc-recenter): Remember current frame. Call `reftex-toc' with REUSE argument. (reftex-recenter-toc-when-idle): Reset `current-prefix-arg' for @@ -14153,7 +14153,7 @@ erroneously in previous version. (bibtex-string-files): Docstring reflects new parsing scheme. (bibtex-autokey-transcriptions): Merge some rewrite entries, fix - docstring, add # as one of the chars to crush + docstring, add # as one of the chars to crush. (bibtex-autokey-prefix-string, bibtex-autokey-names) (bibtex-autokey-names-stretch, bibtex-autokey-additional-names) (bibtex-autokey-name-change-strings) @@ -14229,7 +14229,7 @@ preamble entries. (bibtex-fill-field-bounds): New function. (bibtex-fill-field): New command. Bound to fill-paragraph-function. - (bibtex-fill-entry): Use bibtex-fill-field-bounds + (bibtex-fill-entry): Use bibtex-fill-field-bounds. (bibtex-String): Use bibtex-strings. Always obey bibtex-sort-ignore-string-entries. diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12 index b058e6813d5..640c45dfc0c 100644 --- a/lisp/ChangeLog.12 +++ b/lisp/ChangeLog.12 @@ -943,7 +943,7 @@ 2007-03-20 Richard Stallman <rms@gnu.org> * textmodes/ispell.el (ispell-call-process): New function. - Defends against bad `default-directory.' + Defends against bad `default-directory'. (ispell-check-version, ispell-find-aspell-dictionaries) (ispell-get-aspell-config-value, lookup-words): Call it. (ispell-call-process-region): New function. @@ -1606,7 +1606,7 @@ (org-set-frame-title, org-show-reference) (org-unhighlight-once, org-verify-change-for-undo): New functions. (org-show-variable): Remove command. - (org-add-log-maybe): New arguments STATE, FINDPOS + (org-add-log-maybe): New arguments STATE, FINDPOS. (org-table-sort-lines): Rewrite from scratch. (org-link-search): New argument AVOID-POS. (org-print-icalendar-entries): Remove argument CATEGORY. @@ -2938,7 +2938,7 @@ 2006-12-30 Jan Djärv <jan.h.d@swipnet.se> - * scroll-bar.el (previous-scroll-bar-mode): New variable + * scroll-bar.el (previous-scroll-bar-mode): New variable. (set-scroll-bar-mode): Set previous-scroll-bar-mode. (scroll-bar-mode): Use previous-scroll-bar-mode if set. @@ -5438,7 +5438,7 @@ (cperl-to-comment-or-eol): Do not call `cperl-update-syntaxification' recursively. Bound `next-single-property-change' via `point-max'. - (cperl-unwind-to-safe): Bound likewise + (cperl-unwind-to-safe): Bound likewise. (cperl-font-lock-fontify-region-function): Likewise. (cperl-find-pods-heres): Mark as recursive for `cperl-to-comment-or-eol' Initialization of `cperl-font-lock-multiline-start' could be @@ -5480,7 +5480,7 @@ (cperl-calculate-indent): `char-after' could be nil... (cperl-find-pods-heres): REx can start after "[" too. Highlight (??{}) in RExen too. - (cperl-maybe-white-and-comment-rex): New constant + (cperl-maybe-white-and-comment-rex): New constant. (cperl-white-and-comment-rex): Likewise. XXXX Not very efficient, but hard to make better while keeping 1 group. @@ -5526,7 +5526,7 @@ Syntax-mark a {}-part of (?{}) as "comment" (it was the ()-part) Better logic to distinguish what is what in REx - (cperl-tips-faces): Document REx highlighting + (cperl-tips-faces): Document REx highlighting. (cperl-praise): Mention REx syntax highlight etc. After 5.17: @@ -5566,7 +5566,7 @@ (cperl-indent-comment-at-column-0): New customization variable. (cperl-comment-indent): Indentation after $#a would increase by 1. (cperl-mode): Make `defun-prompt-regexp' grok BEGIN/END etc. - (cperl-find-pods-heres): Mark CODE of s///e as `syntax-type' `multiline' + (cperl-find-pods-heres): Mark CODE of s///e as `syntax-type' `multiline'. (cperl-at-end-of-expr): Would fail if @BAR=12 follows after ";". (cperl-init-faces): If `cperl-highlight-variables-indiscriminately' highlight $ in $foo too (UNTESTED). @@ -5579,7 +5579,7 @@ (cperl-style-alist): Likewise. (cperl-fix-line-spacing): Support `cperl-merge-trailing-else' being nil, and `cperl-extra-newline-before-brace' etc - being t + being t. (cperl-indent-exp): Plans B and C to find continuation blocks even if `cperl-extra-newline-before-brace' is t. @@ -7296,7 +7296,7 @@ (gdb-stack-position): New variable. (gdb-starting, gdb-exited): Reset gdb-stack-position to nil. (gdb-frames-mode): Set gdb-stack-position to nil. - Add to overlay-arrow-variable-list + Add to overlay-arrow-variable-list. (gdb-reset): Delete gdb-stack-position from above list. 2006-08-14 Jan Djärv <jan.h.d@swipnet.se> @@ -7459,7 +7459,7 @@ * avoid.el (mouse-avoidance-animating-pointer): New var. (mouse-avoidance-nudge-mouse): Use it. (mouse-avoidance-banish): Rename from mouse-avoidance-banish-hook. - (mouse-avoidance-exile): Rename from mouse-avoidance-exile-hook + (mouse-avoidance-exile): Rename from mouse-avoidance-exile-hook. (mouse-avoidance-fancy): Rename from mouse-avoidance-fancy-hook. Don't activate if currently animating. All callers changed. @@ -8723,7 +8723,7 @@ * progmodes/gdb-ui.el (gdb-same-frame): New option. (gud-old-arrow, gdb-frame-begin, gdb-printing): New variables. (gdb-init-1): Initialise them. - (gdb-starting): Reset gdb-printing + (gdb-starting): Reset gdb-printing. (gdb-starting): Save value of gud-overlay-arrow-position. (gdb-frame-begin): Set gdb-frame-begin, gdb-printing. (gdb-stopped): Don't look for source if calling procedure e.g "p a ()". @@ -9460,7 +9460,7 @@ links to BibTeX database entries.. (org-get-current-options, org-set-regexps-and-options): Implement logging as a startup option. - (org-store-link): Make sure context string is never empty + (org-store-link): Make sure context string is never empty. (org-insert-link): Use relative path when possible. (org-at-item-checklet-p): New function. (org-shifttab, org-shiftmetaleft, org-shiftmetaright) @@ -10197,7 +10197,7 @@ (gdb-init-1, gdb-post-prompt): ...and references to it. (gdb-frame-handler): Strip directory name from filename if present. - * progmodes/gud.el (gdb-force-update): Delete defvar + * progmodes/gud.el (gdb-force-update): Delete defvar. (gud-speedbar-buttons): ...and references to it. Use window-start to try to keep position in watch expression. @@ -10246,7 +10246,7 @@ * diff-mode.el (diff-mode-shared-map): Don't bind M-W, M-U, M-C, M-r, M-R, M-A, M-SPC or M-DEL. - (diff-mode-map): diff-refine-hunk now on C-c C-w + (diff-mode-map): diff-refine-hunk now on C-c C-w. (diff-mode-map): Bind C-c C-e, C-c C-n, C-c C-r, C-c C-u. * help-mode.el (help-mode): view-exit-action calls delete-window @@ -10862,7 +10862,7 @@ (org-edit-agenda-file-list, org-store-new-agenda-file-list) (org-read-agenda-file-list): New functions. (org-table-edit-field) - (org-table-create-or-convert-from-region): New commands + (org-table-create-or-convert-from-region): New commands. (org-table-toggle-vline-visibility): Command removed. (org-table-convert-region): Made a command. (orgtbl-delete-backward-char, orgtbl-delete-char): Remove commands. @@ -10881,7 +10881,7 @@ Optional argument unrestricted means ignore any restrictions. (org-install-agenda-files-menu): Find a buffer in Org-mode before trying to modify the menu. Use generalized access to - `org-agenda-files.' + `org-agenda-files'. (org-agenda-list, org-todo-list, org-cycle-agenda-files) (org-agenda-file-to-front, org-remove-file, org-diary) (org-tags-view, org-export-icalendar-all-agenda-files) @@ -13666,7 +13666,7 @@ (thumbs-resize-image): Rename from thumbs-resize-image-interactive. Use increment argument to enlarge/shrink. Preserve point. (thumbs-shrink-image): Rename from thumbs-resize-image-size-down. - (thumbs-enlarge-image): Rename from thumbs-resize-image-size-up + (thumbs-enlarge-image): Rename from thumbs-resize-image-size-up. (thumbs-show-thumbs-list): Set thumbs-buffer to current-buffer. (thumbs-mark, thumbs-unmark): Preserve point. (thumbs-modify-image): Keep old temp files and use to modify. @@ -16160,7 +16160,7 @@ (c-after-statement-terminator-p): Adapt for virtual semicolons; check more rigorously for "end of macro". (c-back-over-illiterals, c-forward-over-illiterals): Adapt for - virtual semicolons; + virtual semicolons. (c-beginning-of-statement): Adapt for virtual semicolons; Separate out the code for forward movement into ... (c-end-of-statement): Now contains the code for forward movement, @@ -19706,7 +19706,7 @@ (allout-mode): Use key-binding substitution in the docstring. (allout-kill-line): Spell-out kill ring data structure mutation instead of using byte-compiler-complaint-provoking `pop'. - (allout-insert-listified): Use `insert' rather than `insert-string' + (allout-insert-listified): Use `insert' rather than `insert-string'. (allout-toggle-current-subtree-encryption): Update docstring, adjust to new gpp-based encryption, use new `allout-encrypted-topic-p'. (allout-encrypt-string): Totally revamped vis new underlying @@ -20757,13 +20757,13 @@ * progmodes/gdb-ui.el (gdb-info-breakpoints-custom): Put `font-lock-function-name-face'. (gdb-info-frames-custom): Put `font-lock-function-name-face' - and `font-lock-variable-name-face' + and `font-lock-variable-name-face'. (gdb-registers-font-lock-keywords): New font lock keywords definition. (gdb-registers-mode): Use `gdb-registers-font-lock-keywords'. (gdb-memory-font-lock-keywords): New font lock keywords definition. (gdb-memory-mode): Use `gdb-memory-font-lock-keywords'. (gdb-local-font-lock-keywords): New font lock keywords definition. - (gdb-locals-mode): Use `gdb-local-font-lock-keywords' + (gdb-locals-mode): Use `gdb-local-font-lock-keywords'. (gdb-threads-font-lock-keywords): New font lock keywords definition. (gdb-threads-mode): Use `gdb-threads-font-lock-keywords'. @@ -29352,7 +29352,7 @@ * loadhist.el (unload-feature): Update for new format of load-history. Simplify the code. - * mail/rmail.el (rmail-ignored-headers): Ignore more headers + * mail/rmail.el (rmail-ignored-headers): Ignore more headers. (rmail-font-lock-keywords): Don't fontify the text of a citation. * mail/sendmail.el (mail-font-lock-keywords): @@ -29421,7 +29421,7 @@ (org-evaluate-time-range): Insert at point instead of directly after time range. (org-first-headline-recenter, org-subtree-end-visible-p) - (org-optimize-window-after-visibility-change): New functions + (org-optimize-window-after-visibility-change): New functions. (org-agenda-post-command-hook): Don't allow point at end of line, to make sure it always hits the text properties. (org-agenda-next-date-line, org-agenda-previous-date-line): @@ -29603,13 +29603,13 @@ 2005-04-11 Jan Djärv <jan.h.d@swipnet.se> - * dired.el (dired-mode): Use dnd-* instead of x-dnd-* + * dired.el (dired-mode): Use dnd-* instead of x-dnd-*. (dired-dnd-handle-local-file): Call dnd-get-local-file-name. (dired-dnd-handle-file): Call dnd-get-local-file-uri. * cus-edit.el (dnd): New group. - * term/w32-win.el (dnd): Require dnd + * term/w32-win.el (dnd): Require dnd. (w32-drag-n-drop): Call dnd-handle-one-url. * x-dnd.el: Require dnd. @@ -31918,7 +31918,7 @@ * progmodes/gdb-ui.el (gdb-var-update-handler) (gdb-speedbar-timer-fn): Ensure speedbar updates with new values - for watch expressions, + for watch expressions. (gdb-var-create-handler): Don't set speedbar-update-flag. (gdb-post-prompt): Simplify test for speedbar. @@ -32781,14 +32781,14 @@ 2005-01-15 James R. Van Zandt <jrvz@comcast.net> (tiny change) * progmodes/sh-script.el: Code copied from make-mode.el - with small changes, + with small changes. (sh-mode-map): Bind C-c C-\. (sh-backslash-column, sh-backslash-align): New variables. (sh-backslash-region, sh-append-backslash): New functions. 2005-01-15 Sergey Poznyakoff <gray@Mirddin.farlep.net> - * mail/rmail.el: Updated to work with movemail from GNU Mailutils + * mail/rmail.el: Updated to work with movemail from GNU Mailutils. (rmail-pop-password, rmail-pop-password-required): Move to rmail-obsolete group. (rmail-set-pop-password): Rename to rmail-set-remote-password. @@ -32892,7 +32892,7 @@ * textmodes/reftex-vars.el (reftex-cite-format-builtin): Add optional arguments to most cite commands. - (reftex-cite-cleanup-optional-args): New option + (reftex-cite-cleanup-optional-args): New option. (reftex-cite-prompt-optional-args): New option. (reftex-trust-label-prefix): New option. diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13 index da88e3334c2..630a4bc0865 100644 --- a/lisp/ChangeLog.13 +++ b/lisp/ChangeLog.13 @@ -1498,7 +1498,7 @@ (ps-header-footer-string): Delete function. (ps-encode-header-string-function): New variable. (ps-generate-header-line): Call ps-encode-header-string-function. - (ps-basic-plot-string-function): New variable + (ps-basic-plot-string-function): New variable. (ps-begin-job): Set ps-basic-plot-string-function and ps-encode-header-string-function. For setting up headers and footers, don't use caches such as ps-rh-cache. Don't call @@ -1588,7 +1588,7 @@ * international/mule.el (ctext-non-standard-encodings-alist): Rename from non-standard-icccm-encodings-alist. - (ctext-non-standard-encodings-regexp): New variable + (ctext-non-standard-encodings-regexp): New variable. (ctext-post-read-conversion): Full rewrite. (ctext-non-standard-designations-alist): Rename from non-standard-designations-alist. @@ -8209,7 +8209,7 @@ (allout-end-of-line): Preserve mark activation status when jumping. (allout-open-topic): Account for opening after a child that contains a hidden trailing newline. Preserve match data. - Run allout-structure-added-hook + Run allout-structure-added-hook. (allout-encrypt-decrypted): Preserve match data. (allout-toggle-current-subtree-exposure): Add new interactive function for toggle subtree exposure - suggested by tassilo. @@ -9880,7 +9880,7 @@ (org-find-base-buffer-visiting): Catch the case that there is no buffer visiting the file. (org-property-or-variable-value): New function. - (org-todo): Use `org-property-or-variable-value' + (org-todo): Use `org-property-or-variable-value'. (org-agenda-compact-blocks): New option. (org-prepare-agenda, org-agenda-list): Use `org-agenda-compact-blocks'. (org-agenda-schedule, org-agenda-deadline): @@ -10227,7 +10227,7 @@ * progmodes/cperl-mode.el: Merge upstream 5.23. (cperl-where-am-i): Remove function. - (cperl-backward-to-noncomment): Don't go too far when skipping POD/HEREs + (cperl-backward-to-noncomment): Don't go too far when skipping POD/HEREs. (cperl-sniff-for-indent): De-invert [string] and [comment]. When looking for label, skip s:m:y:tr. (cperl-indent-line): Likewise. diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index a01020b87d0..79a8b3776f2 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -640,7 +640,7 @@ 2009-04-11 Chong Yidong <cyd@stupidchicken.com> - * files.el (dir-locals-directory-cache): Rename from + * files.el (dir-locals-directory-cache): Rename from dir-locals-directory-alist. Change format to include the mtime of the directory-local variables file (Bug#2833). (dir-locals-set-directory-class): New arg mtime. Store it in @@ -8625,7 +8625,7 @@ 2008-07-31 Alan Mackenzie <acm@muc.de> - * progmodes/cc-mode.el (c-before-hack-hook): New function + * progmodes/cc-mode.el (c-before-hack-hook): New function. (Top Level): Install c-before-hack-hook on before-hack-local-variables-hook, rather than c-postprocess-file-styles on hack-local-variables-hook. diff --git a/lisp/ChangeLog.2 b/lisp/ChangeLog.2 index e3193944011..90c00dc6360 100644 --- a/lisp/ChangeLog.2 +++ b/lisp/ChangeLog.2 @@ -3717,9 +3717,9 @@ 1986-08-07 Richard Mlynarik (mly@prep) * rfc822.el, loaddefs.el, mail-utils.el: - Hairy address parser, used only if mail-use-rfc822 is non-nil + Hairy address parser, used only if mail-use-rfc822 is non-nil. (It is nil by default, so if one doesn't like or need the hair of - this file, then one is never troubled by it) + this file, then one is never troubled by it.) * disassemble.el, loaddefs.el: Code from doug@csli.stanford.edu modified by mly. diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3 index 26b872af9bb..f99f2ec4ec0 100644 --- a/lisp/ChangeLog.3 +++ b/lisp/ChangeLog.3 @@ -2619,7 +2619,7 @@ * frame.el (frame-initialize): Fix error syntax. (toggle-horizontal-scroll-bar): Likewise. - (toggle-horizontal-scroll-bar): Renamed from set-horizontal-bar + (toggle-horizontal-scroll-bar): Renamed from set-horizontal-bar. (toggle-vertical-scroll-bar): Likewise. (toggle-auto-lower, toggle-auto-raise): Likewise. (set-foreground-color, set-background-color): @@ -10344,7 +10344,7 @@ (list-diary-entries, mark-diary-entries) (include-other-diary-files, mark-included-diary-files): Added the possibility of `shared diary files' with a recursive - include mechanism like the C preprocessor + include mechanism like the C preprocessor. (list-calendar-holidays): Eliminated the 'special class of holidays, rewriting the entire mechanism to make it more general. (calendar-holiday-function-float): Changed the 'float class of @@ -12091,7 +12091,7 @@ 1988-12-12 Richard Stallman (rms@mole.ai.mit.edu) - * telnet.el (telnet-send-input): Save input in telnet-previous-input + * telnet.el (telnet-send-input): Save input in telnet-previous-input. (telnet-mode): Make that var buffer-local. (telnet-copy-last-input): New fn to yank that var; now on C-c C-y. diff --git a/lisp/ChangeLog.5 b/lisp/ChangeLog.5 index 6da88b3c0be..8cb0e343a1a 100644 --- a/lisp/ChangeLog.5 +++ b/lisp/ChangeLog.5 @@ -193,8 +193,8 @@ ispell-menu-map, ispell-menu-lucid, and ispell-menu-map-needed so users can more easily modify and upgrade entries. (ispell-dictionary-alist): Once more a single variable. - (ispell-required-version): Documentation changes - (ispell-skip-sgml): Documentation changes + (ispell-required-version): Documentation changes. + (ispell-skip-sgml): Documentation changes. (ispell-command-loop): `mode-line-format' now shows misspelled word. (ispell-message-text-end): Can now process postscript version 1. (ispell-message-start-skip): New variable for block skips, set up for @@ -584,7 +584,7 @@ 19.28 and earlier and XEmacs 19.11 and earlier. * ediff.el (ediff-patch-buffer): Now handles buffers that don't visit any file. - (ediff-windows): Renamed to ediff-windows-wordwise, added + (ediff-windows): Renamed to ediff-windows-wordwise. (ediff-windows-linewise): New function. Changed ediff-small/large-regions to ediff-regions-wordwise/linewise. @@ -783,7 +783,7 @@ * mail-extr.el (mail-extr-all-letters-but-separators): Reinstate \377, the bug in search.c is apparently gone. - (mail-extr-first-letters): Add 8-bit characters + (mail-extr-first-letters): Add 8-bit characters. (mail-extr-last-letters): Ditto. * simple.el (indent-for-comment): Move to beginning of line only @@ -889,7 +889,7 @@ (ada-end-stmt-re): Add "separate" body parts, "else", and "package <Id> is". (ada-subprogram-start-re): Add "entry", "protected" and - "package body" + "package body". (ada-indent-function): Handle "elsif" the same way as "if", added "separate" for no indent. (ada-get-indent-type): If "type ... is .." is followed by code on @@ -1328,7 +1328,7 @@ ones the numbers of subexpressions to refer to. (vc-cvs-status): New per-file property, only used in the CVS case. (vc-cvs-status): New function. - (vc-log-info): Adapted to new version of vc-parse-buffer + (vc-log-info): Adapted to new version of vc-parse-buffer. (vc-fetch-properties): Adapted to new version of vc-parse-buffer. Better search regexp for CVS latest version. (vc-log-info): Search for branch version only in the RCS case, @@ -1800,7 +1800,7 @@ (vc-consult-rcs-headers): New function. (vc-branch-version): New per-file property, refers to the RCS version selected by `rcs -b'. - (vc-workfile-version): New function. Also new per-file property + (vc-workfile-version): New function. Also new per-file property. (vc-consult-headers): New parameter variable. (vc-mistrust-permissions): Default set to `nil'. (vc-locking-user): Property is now cached. The other functions @@ -2145,7 +2145,7 @@ 1995-04-03 David Kågedal <davidk@lysator.liu.se> * tempo.el (tempo-insert): - Added the P tag and modified the s tag accordingly + Added the P tag and modified the s tag accordingly. (tempo-insert-named): Checks for valid name, insert mark otherwise. * tempo.el (tempo-dolist): Changed (cadr ...) to (car (cdr ...)). @@ -2457,7 +2457,7 @@ (enriched-delq-1, enriched-make-list-uniq) (enriched-make-relatively-unique, enriched-common-tail) (enriched-reorder, enriched-insert-annotations) - (enriched-loc-annotations, enriched-annotate-change + (enriched-loc-annotations, enriched-annotate-change) (enriched-encode-unknown): Move to format.el. Names changed. (enriched-display-table): Copy standard table if there is one, @@ -3365,7 +3365,7 @@ (ispell-command-loop): Properly adjust screen with different settings of ispell-choices-win-default-height. (check-ispell-version): Use fundamental-mode as default-major-mode. - (ispell-change-dictionary): Remove unnecessary process kills + (ispell-change-dictionary): Remove unnecessary process kills. (ispell-region): Fold sgml support in with tib checking. (ispell-message): Skips checking of forwarded messages. @@ -3526,7 +3526,7 @@ 1995-02-02 Richard Stallman <rms@pogo.gnu.ai.mit.edu> - * c-mode.el (c-mode-map): No binding for c-fill-paragraph + * c-mode.el (c-mode-map): No binding for c-fill-paragraph. (c-fill-paragraph): Return t. (c-mode): Put c-fill-paragraph in fill-paragraph-function. @@ -3770,7 +3770,7 @@ * tempo.el (tempo-insert-template): Quoted transient-mark-mode Expansion around region now puts point at the first mark. - * tempo.el (tempo-region-start, tempo-region-stop): New variables + * tempo.el (tempo-region-start, tempo-region-stop): New variables. (tempo-insert-template, tempo-insert): Don't affect the mark. Check for Transient Mark mode. @@ -3965,7 +3965,7 @@ Keybinding for bold-italic changed from M-g o to M-g l; M-g o is now "other". (facemenu-justification-menu, facemenu-indentation-menu): - New submenus, moved from enriched.el + New submenus, moved from enriched.el. (list-colors-display, facemenu-color-equal): New functions. (facemenu-menu): Added "Display Faces" item. (facemenu-new-faces-at-end): New variable. @@ -4554,18 +4554,18 @@ reference keys before they are used. (bibtex-generate-autokey, bibtex-clean-entry): New function to generate an autokey if necessary. - (bibtex-autokey-names, bibtex-autokey-name-change-strings, - bibtex-autokey-name-length, bibtex-autokey-name-separator, - bibtex-autokey-year-length, bibtex-autokey-titlewords, - bibtex-autokey-title-terminators, - bibtex-autokey-titlewords-stretch, - bibtex-autokey-titleword-first-ignore, - bibtex-autokey-titleword-abbrevs, - bibtex-autokey-titleword-change-strings, - bibtex-autokey-titleword-length, - bibtex-autokey-titleword-separator, - bibtex-autokey-name-year-separator, - bibtex-autokey-year-title-separator): New variables related to + (bibtex-autokey-names, bibtex-autokey-name-change-strings) + (bibtex-autokey-name-length, bibtex-autokey-name-separator) + (bibtex-autokey-year-length, bibtex-autokey-titlewords) + (bibtex-autokey-title-terminators) + (bibtex-autokey-titlewords-stretch) + (bibtex-autokey-titleword-first-ignore) + (bibtex-autokey-titleword-abbrevs) + (bibtex-autokey-titleword-change-strings) + (bibtex-autokey-titleword-length) + (bibtex-autokey-titleword-separator) + (bibtex-autokey-name-year-separator) + (bibtex-autokey-year-title-separator): New variables related to bibtex-generate-autokey. (bibtex-find-entry-location): Optional second parameter maybedup to tell it that entering a duplicate entry isn't to report by an @@ -4591,14 +4591,14 @@ (validate-bibtex-buffer): Completely rewritten to validate, if buffer is syntactically correct. (find-bibtex-duplicates): Moved into validate-bibtex-buffer. - (ispell-abstract, bibtex-ispell-abstract, ispell-bibtex-entry, - bibtex-ispell-entry, beginning-of-bibtex-entry, - bibtex-beginning-of-entry, end-of-bibtex-entry, - bibtex-end-of-entry, hide-bibtex-entry-bodies, - bibtex-hide-entry-bodies, narrow-to-bibtex-entry, - bibtex-narrow-to-entry, sort-bibtex-entries, bibtex-sort-entries, - validate-bibtex-buffer, bibtex-validate-buffer, - find-bibtex-entry-location, bibtex-find-entry-location): All + (ispell-abstract, bibtex-ispell-abstract, ispell-bibtex-entry) + (bibtex-ispell-entry, beginning-of-bibtex-entry) + (bibtex-beginning-of-entry, end-of-bibtex-entry) + (bibtex-end-of-entry, hide-bibtex-entry-bodies) + (bibtex-hide-entry-bodies, narrow-to-bibtex-entry) + (bibtex-narrow-to-entry, sort-bibtex-entries, bibtex-sort-entries) + (validate-bibtex-buffer, bibtex-validate-buffer) + (find-bibtex-entry-location, bibtex-find-entry-location): All interactive functions are renamed, so that any interface function begins with "bibtex-". Mapping: ispell-abstract --> bibtex-ispell-abstract @@ -4610,8 +4610,8 @@ sort-bibtex-entries --> bibtex-sort-entries validate-bibtex-buffer --> bibtex-validate-buffer find-bibtex-entry-location --> bibtex-find-entry-location - (bibtex-maintain-sorted-entries, - bibtex-sort-ignore-string-entries): Default is now t. + (bibtex-maintain-sorted-entries) + (bibtex-sort-ignore-string-entries): Default is now t. (bibtex-complete-string): String list is built from additional string list bibtex-predefined-string and current strings in file. (string-equalp): Deleted and substituted by string-equal. @@ -4633,8 +4633,8 @@ (bibtex-current-entry-label, put-string-on-kill-ring): Deleted (AUCTeX provides all the functionality needed for citation completion). - (bibtex-enclosing-reference, bibtex-pop-previous, bibtex-pop-next, - bibtex-clean-entry): Hacked for speed (bibtex-pop-previous and + (bibtex-enclosing-reference, bibtex-pop-previous, bibtex-pop-next) + (bibtex-clean-entry): Hacked for speed (bibtex-pop-previous and bibtex-pop-next were to slow for larger BibTeX files). (bibtex-pop-previous, bibtex-pop-next): Delimiters from previous or next entry are changed to actual delimiters if necessary. @@ -4657,7 +4657,7 @@ bibtex-pop-next didn't work, probably due to a bug in re-search-forward). (several functions): Added support for {} as field delimiters - (better than '"' for accented characters. + (better than '"' for accented characters). (bibtex-clean-entry): If optional field crossref is empty or missing, former optional fields (if bibtex-include-OPTcrossref was t) are necessary again. bibtex-clean-entry complains if they are @@ -4825,8 +4825,8 @@ 1994-12-09 Ken Stevens <stevensk@afit.af.mil> * ispell.el: Added ispell-offset for version consistency. - (ispell-dictionary-alist): Updated dictionaries & better match defaults - (ispell-alternate-dictionary): Added /usr/shar path + (ispell-dictionary-alist): Updated dictionaries & better match defaults. + (ispell-alternate-dictionary): Added /usr/shar path. (ispell-menu-map-needed): Redo changes that made this incompatible with earlier versions of Emacs19. (ispell-required-version): Changed to assure version 3.1.12 accessed. @@ -6112,7 +6112,7 @@ 1994-10-07 Richard Stallman <rms@mole.gnu.ai.mit.edu> * mouse.el (mouse-major-mode-menu): New function, on C-mouse-3. - (mouse-major-mode-menu-1): New function + (mouse-major-mode-menu-1): New function. (mouse-set-font): Move it to C-mouse-2. * font-lock.el (font-lock-defaults-alist): Delete most modes--all @@ -6534,7 +6534,7 @@ * cc-mode.el (c-progress-info, c-progress-init) (c-progress-update, c-progress-fini): - New vars/defuns for better long indentation progress reporting + New vars/defuns for better long indentation progress reporting. (c-indent-exp, c-indent-region): Use them. * cc-mode.el (c-guess-basic-syntax): @@ -6542,7 +6542,7 @@ find proper relpos of an arglist-cont. * cc-mode.el (c-offset-alist-default): - statement-case-open default offset is zero + statement-case-open default offset is zero. (c-skip-case-statement-forward): New function. (c-guess-basic-syntax): CASE 15: use c-skip-case-statement-forward in proper places to find the real relpos of statement's inside switch @@ -8795,9 +8795,9 @@ `gnus-uu-asynchronous' variable set. (gnus-uu-ctl-map): Removed the keystrokes `C-c C-v C-h' and `C-c C-v h' from the keymap. - (gnus-uu-decode-and-view-all-articles, - (gnus-uu-decode-and-view-all-unread-articles, - (gnus-uu-decode-and-save-all-unread-articles, + (gnus-uu-decode-and-view-all-articles) + (gnus-uu-decode-and-view-all-unread-articles) + (gnus-uu-decode-and-save-all-unread-articles) (gnus-uu-decode-and-save-all-articles): Accept prefix arg for # files. (gnus-uu-uustrip-article-as): Waits for uudecode to finish before further treatment of the resulting files. diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6 index 45c832c5e24..e5bd7fa9d27 100644 --- a/lisp/ChangeLog.6 +++ b/lisp/ChangeLog.6 @@ -1420,7 +1420,7 @@ Added default constants. (simula-emacs-features): New constant to hold information on which flavor if emacs is running (from cc-mode.el). - (simula-mode-menu): Menu definition for Lucid Emacs + (simula-mode-menu): Menu definition for Lucid Emacs. (simula-mode-map): Bound new command simula-indent-exp to C-M-q and added lots of commands to [menu-bar]. (simula-popup-menu): New function for Lucid menus. @@ -1577,7 +1577,7 @@ (gomoku-winning-qtuple-beg, gomoku-winning-qtuple-end) (gomoku-winning-qtuple-dx, gomoku-winning-qtuple-dy): Pseudo variables only used for non-functional argument passing deleted. - (gomoku-cross-winning-qtuple): Accordingly deleted function and + (gomoku-cross-winning-qtuple): Accordingly deleted function. (gomoku-check-filled-qtuple): Accordingly adapted. (gomoku-cross-qtuple): Don't be confused by tabs. (gomoku-move-down, gomoku-move-up): Simplified because point is always @@ -2455,7 +2455,7 @@ * ediff-init.el (ediff-hide-face): New function. (ediff-collect-diffs-metajob): Fixed. - (ediff-check-for-cl-seq): Function deleted + (ediff-check-for-cl-seq): Function deleted. (ediff-abbreviate-file-name): Now a defun. (ediff-has-face-support-p): New function. Ediff now supports faces whenever possible. @@ -2475,7 +2475,7 @@ (run-ediff-from-cvs-buffer): New function. Moved all version-control-related stuff to a new file, ediff-vers.el. - * ediff-util.el (ediff-save-buffer-in-file): New function + * ediff-util.el (ediff-save-buffer-in-file): New function. (ediff-visible-region): No longer narrows the merge buffer. (ediff-status-info): Now tells if we are focusing on regions where both buffers differ from the ancestor. @@ -5884,7 +5884,7 @@ * ediff-meta.el: New file. * ediff-hook.el: New file. - * ediff.el: Moved menubar definitions to a new file, ediff-hook.el + * ediff.el: Moved menubar definitions to a new file, ediff-hook.el. (ediff-files, ediff-merge-files): Better file-name defaults. (ediff-split-string): New function. (ediff-exec-process): Now handles diff args separated by space. @@ -6855,11 +6855,11 @@ 1995-08-15 Daniel Pfeiffer <Daniel.Pfeiffer@Informatik.START.dbp.de> - * skeleton.el (skeleton-pair-insert-maybe): Plain insert in Ovwrt mode + * skeleton.el (skeleton-pair-insert-maybe): Plain insert in Ovwrt mode. (skeleton-insert): If skeleton doesn't fit in window, put beginning at top before going to _ point. (skeleton-internal-list): Rewritten so that resume: sections pertain - only to inferior skeletons and make str available there + only to inferior skeletons and make str available there. (skeleton-read): Don't quit and remove partial skeleton when empty string entered for outer iterator. Added implicit argument `input'. (define-skeleton, skeleton-insert, skeleton-internal-list): Use `x @@ -7301,7 +7301,7 @@ 1995-07-22 Daniel Pfeiffer <Daniel.Pfeiffer@Informatik.START.dbp.de> * apropos.el: Add latest changes of old library and some more. - (apropos): Only show unbound symbols when do-all + (apropos): Only show unbound symbols when do-all. (apropos-documentation-check-elc-file): New copied function. (apropos-command): Also use `apropos-do-all' when called as function. (apropos-print-doc): Renamed from `apropos-print-documentation', i @@ -7632,7 +7632,7 @@ (apropos-use-faces, apropos-local-map): New variables. (apropos-command): New name for `command-apropos' no longer in help.el. (apropos-value): New command. - (apropos-documentation): New name for `super-apropos' + (apropos-documentation): New name for `super-apropos'. (apropos-follow, apropos-mouse-follow): New commands for hypertext. (apropos-describe-plist): New function. @@ -7644,8 +7644,8 @@ * skeleton.el: Partly rewritten and extended. (skeleton-filter, skeleton-untabify, skeleton-further-elements) - (skeleton-abbrev-cleanup): New variables - (skeleton-proxy, skeleton-abbrev-cleanup): New functions + (skeleton-abbrev-cleanup): New variables. + (skeleton-proxy, skeleton-abbrev-cleanup): New functions. (skeleton-insert): Sublanguage element < must now be handled via `skeleton-further-elements' (used only in sh-script and ada). Lisp expressions can be quoted to ignore the return value. @@ -7798,7 +7798,7 @@ 1995-06-29 David M. Smith <D.M.Smith@lancaster.ac.uk> - * ielm.el (ielm-font-lock-keywords): New variable + * ielm.el (ielm-font-lock-keywords): New variable. (inferior-emacs-lisp-mode): Use it for font-lock support 1995-06-29 Bryan O'Sullivan <bos@Eng.Sun.COM> diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7 index de40b71f080..2e96063eb81 100644 --- a/lisp/ChangeLog.7 +++ b/lisp/ChangeLog.7 @@ -7738,7 +7738,7 @@ 1997-12-09 Kenichi HANDA <handa@nora.etl.go.jp> * language/korea-util.el (setup-korean-environment): - Bind C-f9 (intead of C-f10) to quail-hangul-switch-symbol-ksc. + Bind C-f9 (instead of C-f10) to quail-hangul-switch-symbol-ksc. * language/korean.el: Documentation for "Korean" language environment adjusted for the above change. diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8 index 8ecf3f0e33a..6e1de200f7c 100644 --- a/lisp/ChangeLog.8 +++ b/lisp/ChangeLog.8 @@ -104,7 +104,7 @@ version numbering regexp list change-log-version-number-regexp-list. (change-log-find-version): Renamed to - change-log-version-number-search + change-log-version-number-search. (add-log-file-name-function): New. (change-log-search-vc-number): Added END parameter. Added doc string to function. @@ -338,7 +338,7 @@ 1999-12-15 Carsten Dominik <dominik@astro.uva.nl> * textmodes/reftex.el (reftex-compile-variables): Respect new - structure of `reftex-index-macro' + structure of `reftex-index-macro'. (reftex-compile-variables): Use the changed structure of `reftex-label-alist'. @@ -448,7 +448,7 @@ ps-mule-prepare-cmpchar-font): Deleted. (ps-mule-string-encoding): New arg NO-SETFONT. (ps-mule-bitmap-prologue): In Postscript code of BuildGlyphCommon, - check Composing, not Cmpchar + check Composing, not Cmpchar. (ps-mule-initialize): Set ps-mule-composition-prologue-generated to nil. (ps-mule-begin-job): Check existence of new composition. @@ -978,7 +978,7 @@ (font-lock-add-keywords): Rename `major-mode' into `mode'. (font-lock-remove-keywords): Added a dummy `mode' argument for potential future support. - (font-lock-fontify-anchored-keywords, + (font-lock-fontify-anchored-keywords) (font-lock-fontify-keywords-region): Only handle multiline strings if necessary (avoids a pathological behavior in (f.ex) diff-mode). @@ -1603,7 +1603,7 @@ the new backquote syntax. (smbclient-program, smbclient-program-options) (smbclient-prompt-regexp, smbclient-font-lock-keywords): New - variables + variables. (smbclient, smbclient-list-shares): New functions 1999-11-12 Sam Steingold <sds@ksp.com> @@ -1858,7 +1858,7 @@ * whitespace.el: Test for existence of `defcustom' and `defgroup' using fboundp instead of assuming that these are not present in particular flavors of emacs. - (whitespace-version): Update to 2.8 + (whitespace-version): Update to 2.8. (whitespace-display-in-modeline): Add custom variable to control displaying the whitespace errors on the modeline based on suggestion from <klaus.berndl@sdm.de> @@ -2136,17 +2136,17 @@ 1999-10-19 Peter Kleiweg <kleiweg@let.rug.nl> * progmodes/ps-mode.el (ps-mode-print-function): Fix default - value: \"lpr\" changed to "lpr" - (ps-mode-version): New constant - (ps-mode-show-version): New function, added key in ps-mode-map - (ps-run-messages): Removed + value: \"lpr\" changed to "lpr". + (ps-mode-version): New constant. + (ps-mode-show-version): New function, added key in ps-mode-map. + (ps-run-messages): Removed. (ps-run-font-lock-keywords-2): New defcustom variable replacing ps-run-messages. These keywords now include the value of ps-run-prompt, making its fontification customizable. (ps-run-init): Removed \\n from docstring, it is now added when - the value is used + the value is used. (ps-run-font-lock-keywords-1): Added checking for initial ^ in - ps-run-prompt + ps-run-prompt. (ps-mode): Added ps-run-font-lock-keywords-2 to list of customizable variables in doc-string (its equivalent ps-run-messages was missing in previous version of the doc-string). @@ -2271,7 +2271,7 @@ 1999-10-14 Stefan Monnier <monnier@cs.yale.edu> * ange-ftp.el (ange-ftp-make-tmp-name, ange-ftp-del-tmp-name): - * browse-url.el (browse-url-of-buffer, browse-url-delete-temp-file), + * browse-url.el (browse-url-of-buffer, browse-url-delete-temp-file) (browse-url-temp-file-list, browse-url-delete-temp-file-list): * ediff-util.el (ediff-make-temp-file): * ediff-vers.el (ediff-pcl-cvs-view-revision): @@ -2830,7 +2830,7 @@ (custom-buffer-create-internal): Obey custom-raised-buttons, Custom-buffer-done. (custom-button-face): Make it `released-button'. - (custom-button-pressed-face): Make it `pressed-button' + (custom-button-pressed-face): Make it `pressed-button'. (custom-mode-map): Bind "q" to Custom-buffer-done. (custom-mode): Deal with raised/pressed buttons. @@ -2987,7 +2987,7 @@ font-lock-defaults setting. (java-properties-generic-mode): Supports both ! and # as comment characters. - (java-properties-generic-mode): Added an imenu-generic-expression + (java-properties-generic-mode): Added an imenu-generic-expression. (java-properties-generic-mode): Reworked to support the various different ways to separate name and value (viz, '=', ':' and whitespace). @@ -3483,7 +3483,7 @@ (reftex-toc-find-section): Use new version of `reftex-nearest-match'. (reftex-insert-docstruct): Adapted to work with the index stuff. (reftex-parse-from-file): Find index entries as well. - (reftex-toc-toggle-index): New function + (reftex-toc-toggle-index): New function. (reftex-toc-map): `i' is now used to toggle the index, File boundaries has been moved to `F'. (reftex-select-label-map): Toggling display of file boundaries is @@ -3506,7 +3506,7 @@ (reftex-index-section-letters, reftex-index-include-context) (reftex-index-follow-mode, reftex-index-header-face) (reftex-index-section-face, reftex-index-tag-face) - (reftex-index-face): New options + (reftex-index-face): New options. (reftex-index-map, reftex-index-menu, reftex-last-index-file) (reftex-index-tag, reftex-index-return-marker) (reftex-index-restriction-indicator, reftex-index-restriction-data) @@ -3514,9 +3514,9 @@ (reftex-index-key-end-re, reftex-find-index-entry-regexp-format) (reftex-everything-regexp-no-index, reftex-index-re) (reftex-macros-with-index, reftex-index-macro-alist): New variables. - (reftex-index-help, reftex-index-macros-builtin, + (reftex-index-help, reftex-index-macros-builtin) (reftex-key-to-index-macro-alist, reftex-query-index-macro-prompt) - (reftex-query-index-macro-help): New constants + (reftex-query-index-macro-help): New constants. (reftex-index-selection-or-word, reftex-index) (reftex-default-index, reftex-update-default-index) (reftex-index-complete-tag, reftex-index-select-tag) @@ -3607,7 +3607,7 @@ window; and poles can be oriented horizontally. Face support is thrown in gratuitously. (hanoi): Changed default number of rings back to 3. - (hanoi-unix, hanoi-unix-64): New commands + (hanoi-unix, hanoi-unix-64): New commands. (hanoi-horizontal-flag, hanoi-move-period, hanoi-use-faces, hanoi-pole-face, hanoi-base-face, hanoi-even-ring-face, hanoi-odd-ring-face): New variables. @@ -5777,20 +5777,20 @@ 1999-03-12 Eric M. Ludlam <zappo@ultranet.com> * speedbar.el: Added commentary about stealthy functions. - (speedbar-message) new function. - (speedbar-y-or-n-p): New function - (speedbar-with-attached-buffer) Moved macro before reference. + (speedbar-message): New function. + (speedbar-y-or-n-p): New function. + (speedbar-with-attached-buffer): Moved macro before reference. Now uses `save-selected-window'. - (speedbar-mouse-hscroll, speedbar-track-mouse, speedbar-refresh, - speedbar-generic-item-info, speedbar-item-info-file-helper, - speedbar-item-delete, speedbar-insert-generic-list, - speedbar-timer-fn, speedbar-check-vc-this-line, - speedbar-check-obj-this-line, speedbar-fetch-dynamic-etags, - speedbar-buffers-item-info) Use speedbar-message. - (speedbar-item-info) Limit `message-log-max'. - (speedbar-item-load, speedbar-item-copy, speedbar-item-rename, - speedbar-item-delete, speedbar-item-object-delete, - speedbar-buffer-kill-buffer) Use speedbar-y-or-n-p. + (speedbar-mouse-hscroll, speedbar-track-mouse, speedbar-refresh) + (speedbar-generic-item-info, speedbar-item-info-file-helper) + (speedbar-item-delete, speedbar-insert-generic-list) + (speedbar-timer-fn, speedbar-check-vc-this-line) + (speedbar-check-obj-this-line, speedbar-fetch-dynamic-etags) + (speedbar-buffers-item-info): Use speedbar-message. + (speedbar-item-info): Limit `message-log-max'. + (speedbar-item-load, speedbar-item-copy, speedbar-item-rename) + (speedbar-item-delete, speedbar-item-object-delete) + (speedbar-buffer-kill-buffer): Use speedbar-y-or-n-p. 1999-03-10 Kenichi Handa <handa@mulelab.etl.go.jp> @@ -6230,7 +6230,7 @@ 1999-02-12 Alex Schroeder <a.schroeder@bsiag.ch> - * sql.el: Set version to 1.3.2 + * sql.el: Set version to 1.3.2. (sql-solid-program): Added support for solid. (sql-help): Doc mentions sql-solid. (sql-solid): Entry function for Solid. @@ -6384,7 +6384,7 @@ coding-system-list here. * international/mule.el (coding-system-lessp): Moved here from - mule-util.el + mule-util.el. (add-to-coding-system-list): New function. (make-subsidiary-coding-system, make-coding-system, define-coding-system-alias): Use it instead of setting @@ -6721,7 +6721,7 @@ (speedbar-add-mode-functions-list) Improve doc. (speedbar-line-token) New function. (speedbar-dired) Fix order of directories in -shown-directories. - (speedbar-line-path): Default return is default-directory + (speedbar-line-path): Default return is default-directory. (speedbar-buffers-line-path): Return is dir name only. (speedbar-mode-functions-list): New variable. (speedbar-mouse-item-info): Rewrote to be a replaceable fn. @@ -7321,7 +7321,7 @@ 1998-12-29 Masatake Yamato <masata-y@tori.aist-nara.ac.jp> * page-ext.el: Added mouse-selection feature for pages directory buffer. - (pages-directory-map): Bind mouse-2 + (pages-directory-map): Bind mouse-2. (pages-copy-header-and-position): Put text property. (pages-directory-goto-with-mouse): New function. @@ -7399,7 +7399,7 @@ (cperl-after-block-p): Likewise. (cperl-after-block-and-statement-beg): Likewise. (cperl-after-block-p): After END/BEGIN we are a block. - (cperl-after-expr-p): Skip labels when checking + (cperl-after-expr-p): Skip labels when checking. (cperl-indent-region): Make a marker for END - text added/removed. Disable hooks during the call (how to call them later?). Now indents 820-line-long function in 6.5 sec (including @@ -7462,7 +7462,7 @@ (cperl-fix-line-spacing): Sped up to bail out early. (x-color-defined-p): Was not compiling on XEmacs Was defmacro'ed with a tick. Remove another def. - (cperl-clobber-lisp-bindings): If set, C-c variants are the old ones + (cperl-clobber-lisp-bindings): If set, C-c variants are the old ones. (cperl-unwind-to-safe): New function. (cperl-fontify-syntaxically): Use `cperl-unwind-to-safe' to start at reasonable position. @@ -7512,7 +7512,7 @@ (cperl-etags-goto-tag-location): New macro. (cperl-version): New variable. New menu entry random docstrings: References to "future" 20.3 removed. - Menu was described as `CPerl' instead of `Perl' + Menu was described as `CPerl' instead of `Perl'. (perl-font-lock-keywords): Would not highlight `sub foo($$);'. (cperl-toggle-construct-fix): Was toggling to t instead of 1. (cperl-ps-print-init): Associate `cperl-array-face', `cperl-hash-face' @@ -8808,14 +8808,14 @@ enable-kinsoku. * simple.el (do-auto-fill): Don't check kinsoku-enable here. - Don't call kinsoku directly, intead call fill-find-break-point. + Don't call kinsoku directly, instead call fill-find-break-point. * textmodes/fill.el: Setup `fill-find-break-point-function' property to character sets which require `kinsoku' processing for filling. (fill-find-break-point): New function. (fill-region-as-paragraph): Don't check kinsoku-enable here. - Don't call kinsoku directly, intead call fill-find-break-point. + Don't call kinsoku directly, instead call fill-find-break-point. 1998-10-18 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -8972,7 +8972,7 @@ set unconditional-jump to nil. (ccl-compile-read-multibyte-character): Return nil. (ccl-compile-write-multibyte-character): Likewise. - (ccl-compile-translate-character): Likewise + (ccl-compile-translate-character): Likewise. (ccl-compile-map-multiple): Likewise. (ccl-compile-map-single): Likewise. @@ -9055,7 +9055,7 @@ * net-utils.el (ftp, nslookup): Require comint. (network-service-connection): Likewise. - (whois-server-name): Defaults to whois.arin.net + (whois-server-name): Defaults to whois.arin.net. (whois-server-list, whois-server-tld, whois-guess-server): New var. (whois): Tries to guess the appropriate top-level domain server. (whois-get-tld): New function. @@ -9599,7 +9599,7 @@ (reftex-view-cr-cite, reftex-view-cr-ref, reftex-end-of-bib-entry): New functions. (reftex-auto-view-crossref): New value `window' allowed. - (reftex-view-crossref-when-idle): Process new `window' option in + (reftex-view-crossref-when-idle): Process new `window' option. (reftex-translate-to-ascii-function): New default. (reftex-label-illegal-re): Default changed, removed Latin1. (reftex-latin1-to-ascii): New function. @@ -9639,7 +9639,7 @@ (checkdoc-this-string-valid): When converting a comment into a doc string, make sure " chars are \". (checkdoc-sentencespace-region-engine): Only do double space check - if based on the variable `sentence-end-double-space' + if based on the variable `sentence-end-double-space'. (checkdoc-this-string-valid-engine): ? ends valid sentence. (checkdoc-proper-noun-region-engine): Exclude items in URLs diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9 index d008640cbe3..56239cd3104 100644 --- a/lisp/ChangeLog.9 +++ b/lisp/ChangeLog.9 @@ -242,8 +242,8 @@ (cperl-find-pods-heres): Could access `font-lock-comment-face' in -nw. No -nw-compile time warnings now. (cperl-find-tags): TAGS file had too short substring-to-search. - Be less verbose in non-interactive mode - (imenu-example--create-perl-index): Set index-marker after name + Be less verbose in non-interactive mode. + (imenu-example--create-perl-index): Set index-marker after name. (cperl-outline-regexp): New variable. (cperl-outline-level): Made compatible with `cperl-outline-regexp'. (cperl-mode): Made use `cperl-outline-regexp'. @@ -479,7 +479,7 @@ (help-setup-xref, help-xref-following, help-make-xrefs) (help-xref-button, help-insert-xref-button, help-xref-interned) (help-xref-go-back, help-go-back, help-do-xref, help-follow) - (help-xref-on-pp): Functions moved into `help-mode.el' + (help-xref-on-pp): Functions moved into `help-mode.el'. (help-mode-map, help-xref-stack, help-xref-stack-item) (help-highlight-p, help-highlight-face, help-back-label) (help-xref-symbol-regexp, help-xref-mule-regexp) @@ -1188,7 +1188,7 @@ 2001-09-07 Eli Zaretskii <eliz@is.elta.co.il> * textmodes/ispell.el (ispell-dictionary-alist-4): Add "german" - and "german8", for the new German orthography dictionaries, + and "german8", for the new German orthography dictionaries. (ispell-dictionary-alist-5, ispell-dictionary-alist-6): Rearrange the entries, to keep the line length balanced for loaddefs.el. @@ -1667,7 +1667,7 @@ * Makefile.in (finder_setwins): Renamed from nonobsolete_setwins. Don't include term/. - * mail/sc.el: Moved to obsolete/. + * mail/sc.el: Moved to obsolete/. 2001-08-14 Vinicius Jose Latorre <vinicius@cpqd.com.br> @@ -2072,7 +2072,7 @@ * ediff-init.el (ediff-with-syntax-table): New macro, uses with-syntax-table. - (ediff-coding-system-for-read): From ediff-diff.el + (ediff-coding-system-for-read): From ediff-diff.el. (ediff-coding-system-for-write): New variable. (ediff-highest-priority): Fixed the bug having to do with disappearing overlays. @@ -5547,7 +5547,7 @@ 2001-02-12 Dave Love <d.love@dl.ac.uk> - * international/latin1-disp.el: Doc fixes. + * international/latin1-disp.el: Doc fixes. (latin1-display) <defgroup>: Add :link. (latin1-display) <function>: Set variable latin1-display. @@ -5978,7 +5978,7 @@ * shell.el (shell-write-history-on-exit): Make sure that we are in the shell buffer (M-x tex-file RET inserted the error message into - the TeX buffer). + the TeX buffer). 2001-01-27 Eli Zaretskii <eliz@is.elta.co.il> @@ -6812,7 +6812,7 @@ to nil. * tooltip.el (tooltip-frame-parameters): Remove colors. - (tooltip): New face + (tooltip): New face. (tooltip-set-param): New function. (tooltip-show): Set up color frame parameters from face `tooltip'. Display the tooltip text in face `tooltip'. @@ -8747,7 +8747,7 @@ 2000-11-13 Miles Bader <miles@gnu.org> * textmodes/fill.el (skip-line-prefix): New function. - (fill-region-as-paragraph, fill-region): Return the fill-prefix. + (fill-region-as-paragraph, fill-region): Return the fill-prefix. (fill-paragraph): Don't leave point inside the fill-prefix. * textmodes/refill.el (refill-fill-paragraph-at): Don't leave point inside the fill-prefix. @@ -8804,7 +8804,7 @@ 2000-11-12 Dave Love <fx@gnu.org> - * mail/feedmail.el: Fix header, + * mail/feedmail.el: Fix header. (feedmail) <defgroup>: Add :link. * view.el: Use local-map property, not keymap on mode-line string. @@ -10715,7 +10715,7 @@ * iswitchb.el (iswitchb-mode): Add :require. * info.el (Info-goto-node, Info-menu): Doc fix. - (Info-mode-menu): Bind beginning-of-buffer, Info-edit + (Info-mode-menu): Bind beginning-of-buffer, Info-edit. (info-tool-bar-map): New variable. (Info-mode): Use it. (Info-edit-map): Define all in defvar. @@ -10795,7 +10795,7 @@ 2000-10-06 Dave Love <fx@gnu.org> * textmodes/fill.el (sentence-end-double-space) - (sentence-end-without-period): Doc fix. + (sentence-end-without-period): Doc fix. (adaptive-fill-regexp): Purecopy. (unjustify-current-line): Use line-end-position. (fill-individual-paragraphs-prefix): Use line-beginning-position. @@ -11010,7 +11010,7 @@ * net/net-utils.el (nslookup-font-lock-keywords) (ftp-font-lock-keywords, smbclient-font-lock-keywords): - Only set if window-system is non-nil + Only set if window-system is non-nil. (net-utils-run-program): Returns buffer. (network-connection-reconnect): Added this function. @@ -11025,13 +11025,13 @@ (generic-mode-alist): Renamed to generic-mode-list. (generic-find-file-regexp): Default changed to "^#". (generic-read-type): Uses completing read on generic-mode-list. - (generic-mode-sanity-check): removed this function. - (generic-add-to-auto-mode): Removed this function + (generic-mode-sanity-check): Removed this function. + (generic-add-to-auto-mode): Removed this function. (generic-mode-internal): Bind mode-specific definitions into function instead of putting them in alist. (generic-mode-set-comments): Reworked extensively. - (generic-mode-find-file-hook): Simplified regexp searching - (generic-make-keywords-list): Omit extra pair of parens + (generic-mode-find-file-hook): Simplified regexp searching. + (generic-make-keywords-list): Omit extra pair of parens. * find-lisp.el (find-lisp-find-files-internal): Make sure directory name ends with "/". @@ -11040,7 +11040,7 @@ Regexp now allows leading whitespace. (rc-generic-mode): Added eval-when-compile around generic-make-keywords-list. - Deleted duplicate regexp + Deleted duplicate regexp. (rul-generic-mode): Added eval-when-compile around generic-make-keywords-list. (etc-fstab-generic-mode): New generic mode. @@ -11356,7 +11356,7 @@ (comint-insert-clicked-input): Be more careful to find the overlay. Use this-command-keys rather than hardcoding mouse-2. - * font-lock.el: Replace confusing (,@ with , + * font-lock.el: Replace confusing (,@ with ,. (tex-font-lock-keywords-1, tex-font-lock-keywords-2): Don't use regexp-opt-depth. Spice up the regexp for args. Don't distinguish between cmds that can take an opt arg or not. @@ -11871,7 +11871,7 @@ * strokes.el: Sync with maintainer's current version with changes for Emacs, but avoid runtime cl and levents. - (toplevel): Change autoloads and compilation requires. + (toplevel): Change autoloads and compilation requires. (strokes-version, strokes-bug-address, strokes-lift): Values changed. (strokes-xpm-header, strokes-insinuated): New variable. @@ -11885,7 +11885,7 @@ New functions, used instead of non-`strokes-' versions.. (strokes-mouse-event-p): Rewritten. (strokes-event-closest-point): Avoid event-point. - (strokes-get-grid-position): Avoid cdadr, caadr + (strokes-get-grid-position): Avoid cdadr, caadr. (strokes-read-stroke, strokes-read-complex-stroke): Avoid levents functions. (strokes-help): Use with-output-to-temp-buffer. @@ -11934,12 +11934,12 @@ 2000-09-14 Dave Love <fx@gnu.org> * toolbar/cancel.xpm, toolbar/close.xpm, toolbar/copy.xpm, - toolbar/cut.xpm, toolbar/exit.xpm, toolbar/fld_open.xpm, - toolbar/help.xpm, toolbar/info.xpm, toolbar/mail.xpm, - toolbar/mail_compose.xpm, toolbar/new.xpm, toolbar/open.xpm, - toolbar/paste.xpm, toolbar/preferences.xpm, toolbar/print.xpm, - toolbar/save.xpm, toolbar/saveas.xpm, toolbar/search-replace.xpm, - toolbar/search.xpm, toolbar/spell.xpm, toolbar/undo.xpm: New. + * toolbar/cut.xpm, toolbar/exit.xpm, toolbar/fld_open.xpm, + * toolbar/help.xpm, toolbar/info.xpm, toolbar/mail.xpm, + * toolbar/mail_compose.xpm, toolbar/new.xpm, toolbar/open.xpm, + * toolbar/paste.xpm, toolbar/preferences.xpm, toolbar/print.xpm, + * toolbar/save.xpm, toolbar/saveas.xpm, toolbar/search-replace.xpm, + * toolbar/search.xpm, toolbar/spell.xpm, toolbar/undo.xpm: New. From Tuomas Kuosmanen <tigert@gimp.org>. (Gnome icons fetched from <URL:http://tigert.gimp.org/gnome/gnome-stock/>.) @@ -14110,14 +14110,14 @@ * locate.el (locate): Cleaned up locate command's interactive prompting Thanks to François_Pinard <pinard@iro.umontreal.ca> for suggestions. - * filecache.el (file-cache-case-fold-search): New variable - (file-cache-assoc-function): New variable + * filecache.el (file-cache-case-fold-search): New variable. + (file-cache-assoc-function): New variable. (file-cache-minibuffer-complete): Use file-cache-assoc-function. - Use file-cache-case-fold-search variable - (file-cache-add-file): Use file-cache-assoc-function - (file-cache-delete-file): likewise - (file-cache-directory-name): likewise - (file-cache-debug-read-from-minibuffer): likewise + Use file-cache-case-fold-search variable. + (file-cache-add-file): Use file-cache-assoc-function. + (file-cache-delete-file): Likewise. + (file-cache-directory-name): Likewise. + (file-cache-debug-read-from-minibuffer): Likewise. 2000-08-28 Gerd Moellmann <gerd@gnu.org> @@ -14191,12 +14191,12 @@ * international/ja-dic-cnv.el: Renamed from skkdic-cnv.el. Provide ja-dic-cnv instead of skkdic-cnv. - (ja-dic-filename): Renamed from skkdic-filename. Referers changed + (ja-dic-filename): Renamed from skkdic-filename. Referers changed. (iso-2022-7bit-short): Add safe-charsets property. (skkdic-convert-postfix): Search Japanese chou-on character in addition to Hiragana character. (skkdic-convert-prefix, skkdic-collect-okuri-nasi): Likewise. - (skkdic-convert): Change file names from skkdic.el to ja-dic.el + (skkdic-convert): Change file names from skkdic.el to ja-dic.el. (batch-skkdic-convert): Likewise. * international/ja-dic-utl.el: Renamed from skkdic-utl.el. @@ -14389,12 +14389,12 @@ (ispell-dictionary-alist-4): Fixed regexp in francais-tex dictionary, added italiano dictionary. (ispell-skip-region-alist): Removed regexp thrashing when `-' is a - word character + word character. (ispell-tex-skip-alists): Added psfig support. (ispell-skip-html): Renamed from ispell-skip-sgml. (ispell-begin-skip-region-regexp, ispell-skip-region) (ispell-minor-check): Improved html skipping support to skip across - code, and recognize `&' commands without proper `;' syntax; + code, and recognize `&' commands without proper `;' syntax. (ispell-process-line): Fix alignment error when manually correcting spelling. (ispell): Fix comment string. @@ -14515,7 +14515,7 @@ (goto-address-url-face, goto-address-url-mouse-face) (goto-address-mail-face, goto-address-mail-mouse-face): Doc fix. (goto-address-url-regexp): Use thing-at-point-url-regexp. - (goto-address-fontify, goto-address-at-mouse): Simplify, + (goto-address-fontify, goto-address-at-mouse): Simplify. (goto-address-at-point): browse-url-url-at-point, goto-address-find-address-at-point can return nil. (goto-address-find-address-at-point): Return nil on failure. @@ -14832,7 +14832,7 @@ (comint-replace-by-expanded-history) (comint-get-old-input-default, comint-show-output) (comint-backward-matching-input, comint-forward-matching-input) - (comint-next-prompt, comint-previous-prompt): Use field + (comint-next-prompt, comint-previous-prompt): Use field properties if comint-use-prompt-regexp-instead-of-fields is nil. (comint-line-beginning-position): New function. (comint-bol): Use comint-line-beginning-position. Make ARG optional. @@ -15501,23 +15501,23 @@ ada-xref.el before ada-prj.el, so that the Project menu is created when ada-prj tries to add to it. (ada-activate-keys-for-case): Suppress the characters that are not - part of the Ada syntax. Better compatibility with else-mode + part of the Ada syntax. Better compatibility with else-mode. (ada-adjust-case-interactive): When auto-casing is not active, correctly insert newlines (used to insert only ^M). Prevent the syntax table from being changed in case of an error (or '_' becomes part of a word and some commands are confused). Do nothing if ada-auto-case is nil. - (ada-after-keyword-p): Ignore keywords that are also attributes - (ada-batch-reformat): Update usage comment - (ada-call-from-contextual-menu): New function + (ada-after-keyword-p): Ignore keywords that are also attributes. + (ada-batch-reformat): Update usage comment. + (ada-call-from-contextual-menu): New function. (ada-case-read-exceptions): Reinitialize the casing exception list first to nil first, so that the casing exception file can be shared. (ada-check-defun-name): Handles "configure" keyword for gnatdist files. (ada-compile-goto-error): Fix regexp used to detect a file:line - anywhere in the error message - (ada-contextual-menu-last-point): New variable + anywhere in the error message. + (ada-contextual-menu-last-point): New variable. (ada-create-keymap): If the variable delete-key-deletes-forward is t on XEmacs, it means that DEL should delete one character forward. @@ -15544,21 +15544,21 @@ are not in fact seeing "end if". Ignore "when" statements except when initial keyword was "begin". Fix handling of nested procedures. Add a recursive call to this function to skip over - other 'end' statmts. Fix indentation for "when .. => begin" + other 'end' statmts. Fix indentation for "when .. => begin". (ada-in-open-paren-p): Fix indentation for complex boolean expressions, where 'and then', 'or else' and parenthesis statements are mixed up. (ada-in-paramlist-p): Skip comments while searching for the beginning Fix handling of operator declarations. - (ada-indent-align-comments): New variable + (ada-indent-align-comments): New variable. (ada-indent-current): Change the syntax table only in the protected section, so that we are sure it is restored correctly. (ada-indent-on-previous-lines): Use ada-use-indent and - ada-with-indent Correctly indent "select ... then" + ada-with-indent. Correctly indent "select ... then". (ada-indent-region): Slight speedup. (ada-indent-renames): New variable. (ada-last-which-function-subprog, ada-last-which-function-line): - New variables + New variables. (ada-looking-at-semi-private): Correctly indent the 'private' keyword when it is the first word in a package declaration. (ada-loose-case-word): Stop searching if at the end of the buffer. @@ -15568,8 +15568,8 @@ (ada-mode): Add support for abbrev-mode, outline-mode and which-func-mode Override the old find-file.el entry in ff-special-constructs since it is using the obsolete - ada-spec-suffix variable - (ada-no-auto-case): New function + ada-spec-suffix variable. + (ada-no-auto-case): New function. (ada-scan-paramlist): When parsing the argument type, accept spaces (as in "X 'Class", generated by Rational Rose). (ada-other-file-name): No longer loads the other file. @@ -15578,41 +15578,41 @@ (ada-search-ignore-complex-boolean): New function. (ada-uncomment-region): Emacs21 already knows how to delete comments not starting in the first column. - (ada-use-indent): New variable + (ada-use-indent): New variable. (ada-which-function): New function. - (ada-with-indent): New variable - (ada-xemacs): evaluate it at compile time too, so that ada-mode.el + (ada-with-indent): New variable. + (ada-xemacs): Evaluate it at compile time too, so that ada-mode.el can be batch-compiled from the command line. * ada-xref.el: Got rid of all byte-compiler warnings on Emacs. Add to the menu when the file is loaded, not in ada-mode-hook. Add -toolbar to the default ddd command Switches moved from ada-prj-default-comp-cmd and ada-prj-default-make-cmd to - ada-prj-default-comp-opt - (ada-add-ada-menu): Remove the map and name parameters Add the Ada - Reference Manual to the menu - (ada-check-current): rewritten as a call to ada-compile-current + ada-prj-default-comp-opt. + (ada-add-ada-menu): Remove the map and name parameters. Add the Ada + Reference Manual to the menu. + (ada-check-current): Rewritten as a call to ada-compile-current. (ada-compile): Removed. (ada-compile-application, ada-compile-current, ada-check-current): Set the compilation-search-path so that compile.el automatically finds the sources in src_dir. Automatic scrolling of the compilation buffer. C-uC-cC-c asks for confirmation before - compiling - (ada-compile-current): New parameter, prj-field + compiling. + (ada-compile-current): New parameter, prj-field. (ada-complete-identifier): Load the .ali file before doing - processing + processing. (ada-find-ali-file-in-dir): prepend build_dir to obj_dir to conform to gnatmake's behavior. - (ada-find-file-in-dir): New function - (ada-find-references): Set the environment variables for gnatfind + (ada-find-file-in-dir): New function. + (ada-find-references): Set the environment variables for gnatfind. (ada-find-src-file-in-dir): New function. - (ada-first-non-nil): Removed + (ada-first-non-nil): Removed. (ada-gdb-application): Add support for jdb, the java debugger. (ada-get-ada-file-name): Load the original-file first if not done yet. (ada-get-all-references): Handles the new ali syntax (parent types are found between <>). - (ada-initialize-runtime-library): New function + (ada-initialize-runtime-library): New function. (ada-mode-hook): Always load a project file when a file is opened, so that the casing exceptions are correctly read. (ada-operator-re): Add all missing operators ("abs", "rem", "**"). @@ -15623,36 +15623,36 @@ src_dir to initialize ada-search-directories and compilation-search-path,... Add the standard runtime library to the search path for find-file. - (ada-prj-default-debugger): Was missing an opening '{' + (ada-prj-default-debugger): Was missing an opening '{'. (ada-prj-default-bind-opt, ada-prj-default-link-opt): New variables. - (ada-prj-default-gnatmake-opt): New variable + (ada-prj-default-gnatmake-opt): New variable. (ada-prj-find-prj-file): Handles non-file buffers For non-Ada buffers, the project file is the default one Save the windows configuration before displaying the menu. - (ada-prj-src-dir, ada-prj-obj-dir, ada-prj-comp-opt,...): Removed + (ada-prj-src-dir, ada-prj-obj-dir, ada-prj-comp-opt,...): Removed. (ada-read-identifier): Fix xrefs on operators (for "mod", "and", ...) regexp-quote identifiers names to support operators +, -,... in regexps. (ada-remote): New function. (ada-run-application): Erase the output buffer before starting the run Support remote execution of the application. Use - call-process, or the arguments are incorrectly parsed + call-process, or the arguments are incorrectly parsed. (ada-set-default-project-file): Reread the content of the active project file, not the one from the current buffer When a project file is set as the default project, all directories are automatically associated with it. - (ada-set-environment): New function - (ada-treat-cmd-string): New special variable ${current} + (ada-set-environment): New function. + (ada-treat-cmd-string): New special variable ${current}. (ada-treat-cmd-string): Revised. The substitution is now done for - any ${...} substring + any ${...} substring. (ada-xref-current): If no body was found, compiles the spec instead. Setup ADA_{SOURCE,OBJECTS}_PATH before running the compiler to get rid of command line length limitations. - (ada-xref-get-project-field): New function - (ada-xref-project-files): New variable + (ada-xref-get-project-field): New function. + (ada-xref-project-files): New variable. (ada-xref-runtime-library-specs-path) - (ada-xref-runtime-library-ali-path): New variables + (ada-xref-runtime-library-ali-path): New variables. (ada-xref-set-default-prj-values): Default run command now does a cd to the build directory. New field: main_unit Provide a default file name even if the current buffer has no prj file. @@ -15661,10 +15661,10 @@ Rewritten to show a tabbed-dialog. (ada-prj-add-ada-menu): Remove the map and name parameters. (ada-prj-display-page, ada-prj-field, ada-prj-initialize-values): - New function - (ada-prj-load-directory, ada-prj-subdirs-of): New functions - (ada-prj-load-from-file): New function - (ada-prj-save): Always save fields that depend on the current buffer + New function. + (ada-prj-load-directory, ada-prj-subdirs-of): New functions. + (ada-prj-load-from-file): New function. + (ada-prj-save): Always save fields that depend on the current buffer. (ada-prj-show-value): New function * ada-stmt.el (ada-stmt-add-to-ada-menu): Hide the menu if not in @@ -16918,7 +16918,7 @@ (cyrillic-koi8-r-encode-table): Define it as a translation table made from the reverse map of above. (ccl-decode-koi8): Use translate-character. - (ccl-encode-koi8, ccl-encode-koi8-font): Likewize + (ccl-encode-koi8, ccl-encode-koi8-font): Likewise. (cyrillic-alternativnyj-nonascii-translation-table): Define it as a translation table made from cyrillic-alternativnyj-decode-table. (cyrillic-alternativnyj-encode-table): Define it as a translation @@ -17470,14 +17470,14 @@ * speedbar.el (speedbar-easymenu-definition-base): Image toggle fix. (speedbar-insert-button): Invisible text property fix. - (speedbar-directory-plus): Renamed from speedbar-directory-+ - (speedbar-directory-minus): Renamed from speedbar-directory-- - (speedbar-page-plus): Renamed from speedbar-file-+ - (speedbar-page-minus): Renamed from speedbar-file-- - (speedbar-page): Renamed from speedbar-file- - (speedbar-tag): Renamed from speedbar-tag- - (speedbar-tag-plus): Renamed from speedbar-tag-+ - (speedbar-tag-minus): Renamed from speedbar-tag-- + (speedbar-directory-plus): Renamed from speedbar-directory-+. + (speedbar-directory-minus): Renamed from speedbar-directory--. + (speedbar-page-plus): Renamed from speedbar-file-+. + (speedbar-page-minus): Renamed from speedbar-file--. + (speedbar-page): Renamed from speedbar-file-. + (speedbar-tag): Renamed from speedbar-tag-. + (speedbar-tag-plus): Renamed from speedbar-tag-+. + (speedbar-tag-minus): Renamed from speedbar-tag--. (speedbar-expand-image-button-alist): Use above renames. * sb-dir-plus.xpm: Renamed from sb-dir+.xpm @@ -17861,7 +17861,7 @@ (speedbar-visiting-tag-hook): Set new defaults. Added options. (speedbar-reconfigure-keymaps-hook): New variable. (speedbar-frame-parameters): Updated documentation. - (speedbar-use-imenu-flag): Updated custom tag + (speedbar-use-imenu-flag): Updated custom tag. (speedbar-dynamic-tags-function-list): New variable. (speedbar-tag-hierarchy-method): Updated doc & custom. (speedbar-indentation-width, speedbar-indentation-width) New @@ -17877,7 +17877,7 @@ `force-mode-line-update'. (speedbar-mode, speedbar-quick-mouse, speedbar-click) (speedbar-double-click): Use `speedbar-mouse-set-point' instead of - `mouse-set-point' + `mouse-set-point'. (speedbar-reconfigure-keymaps): Run configure keymap hooks. (speedbar-item-info-tag-helper): Revamped to handle a wider range of arbitrary text, and new helper functions. @@ -17893,11 +17893,11 @@ (speedbar-apply-one-tag-hierarchy-method): Deleted (and replaced). (speedbar-sort-tag-hierarchy, speedbar-prefix-group-tag-hierarchy) (speedbar-trim-words-tag-hierarchy) - (speedbar-simple-group-tag-hierarchy): New functions + (speedbar-simple-group-tag-hierarchy): New functions. (speedbar-create-tag-hierarchy): Update doc, use new tag hooks. (speedbar-insert-imenu-list, speedbar-insert-etags-list): New functions. - (speedbar-mouse-set-point): New function + (speedbar-mouse-set-point): New function. (speedbar-power-click): Updated documentation. (speedbar-line-token, speedbar-goto-this-file): Handle more types of tag prefix text. @@ -17916,7 +17916,7 @@ "Revert Buffer" menu items. (speedbar-buffer-buttons-engine): Be smarter when creating a filename tag (for expansion purposes.). - (speedbar-highlight-one-tag-line, + (speedbar-highlight-one-tag-line) (speedbar-unhighlight-one-tag-line, speedbar-recenter-to-top) (speedbar-recenter): New functions. (defimage-speedbar): Image loading abstraction. @@ -18040,7 +18040,7 @@ (help-xref-interned): Maybe insert face doc too. Separate sections with a line of hyphens. - * faces.el: Some doc fixes. Declare some functions obsolete. + * faces.el: Some doc fixes. Declare some functions obsolete. (describe-face): Add customize button. Return the help text. Fix prompt. @@ -18748,13 +18748,13 @@ 2000-03-30 Peter Breton <pbreton@ne.mediaone.net> * net/net-utils.el: - (network-connection-host, network-connection-service): New variables - (network-connection-mode): New mode, derived from comint-mode + (network-connection-host, network-connection-service): New variables. + (network-connection-mode): New mode, derived from comint-mode. (network-connection-mode-setup): New function, saves host and service information in local variables. * lisp/locate.el: - (locate-word-at-point): Added this function + (locate-word-at-point): Added this function. (locate): Default to using locate-word-at-point as input Run dired-mode-hook @@ -20347,7 +20347,7 @@ * simple.el (eval-expression): Don't bind debug-on-error if eval-expression-debug-on-error is nil. Detect changed debug-on-error, and propagate new value to global binding, if - eval-expression-debug-on-error is non-nil, + eval-expression-debug-on-error is non-nil. (eval-expression-debug-on-error): Change doc string. 2000-01-11 Richard M. Stallman <rms@gnu.org> @@ -20406,7 +20406,7 @@ 2000-01-10 Ken Stevens <k.stevens@ieee.org> - * ispell.el: Only define dictionaries in menus when they exist. + * ispell.el: Only define dictionaries in menus when they exist. (version18p): New variable. (version20p): New variable. (xemacsp): New variable. diff --git a/lisp/align.el b/lisp/align.el index 83ed0f4693a..9d811327021 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -140,8 +140,8 @@ "An integer that represents the default amount of padding to use. If `align-to-tab-stop' is non-nil, this will represent the number of tab stops to use for alignment, rather than the number of spaces. -Each alignment rule can optionally override both this variable. See -`align-mode-alist'." +Each alignment rule can optionally override both this variable and +`align-to-tab-stop'. See `align-rules-list'." :type 'integer :group 'align) @@ -157,8 +157,8 @@ Since each alignment rule can possibly have its own set of alignment sections (whenever `align-region-separate' is non-nil, and not a string), this heuristic is used to determine how far before and after point we should search in looking for a region separator. Larger -values can mean slower perform in large files, although smaller values -may cause unexpected behavior at times." +values can mean slower performance in large files, although smaller +values may cause unexpected behavior at times." :type 'integer :group 'align) @@ -926,7 +926,7 @@ align them so that the opening parentheses would line up: Joe (123) 456-7890 There is no predefined rule to handle this, but you could easily do it -using a REGEXP like \"(\". All you would have to do is to mark the +using a REGEXP like \"(\". All you would have to do is to mark the region, call `align-regexp' and type in that regular expression." (interactive (append diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index fb6155dfd41..6dda7b2e40b 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1811,10 +1811,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (t (archive-extract-by-stdout archive - ;; unzip expands wildcards in NAME, so we need to quote it. + ;; unzip expands wildcards in NAME, so we need to quote it. But + ;; not on DOS/Windows, since that fails extraction on those + ;; systems, and file names with wildcards in zip archives don't + ;; work there anyway. ;; FIXME: Does pkunzip need similar treatment? - ;; (7z doesn't need to quote wildcards) - (if (equal (car archive-zip-extract) "unzip") + (if (and (not (memq system-type '(windows-nt ms-dos))) + (equal (car archive-zip-extract) "unzip")) (shell-quote-argument name) name) archive-zip-extract)))) diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index b3a594d31d4..9a8001875e0 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -126,10 +126,10 @@ If this contains a %s, that will be replaced by the matching rule." _ "\n\\begin{document}\n" _ "\n\\end{document}") - (("/bin/.*[^/]\\'" . "Shell-Script mode magic number") - lambda () + (("/bin/.*[^/]\\'" . "Shell-Script mode magic number") . + (lambda () (if (eq major-mode (default-value 'major-mode)) - (sh-mode))) + (sh-mode)))) (ada-mode . ada-header) diff --git a/lisp/bindings.el b/lisp/bindings.el index f9d3e75cf6e..eba6bf7a78a 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -822,6 +822,9 @@ if `inhibit-field-text-motion' is non-nil." (setq i (1+ i)))) (define-key global-map [?\C-\M--] 'negative-argument) +(define-key global-map "\177" 'delete-backward-char) +(define-key global-map "\C-d" 'delete-forward-char) + (define-key global-map "\C-k" 'kill-line) (define-key global-map "\C-w" 'kill-region) (define-key esc-map "w" 'kill-ring-save) @@ -1051,6 +1054,9 @@ if `inhibit-field-text-motion' is non-nil." ;; so we can't distinguish those two keys, but usually we consider C-SPC ;; (rather than C-@) as the "canonical" binding. (define-key function-key-map [?\C-@] [?\C-\s]) +;; Many keyboards don't have a `backtab' key, so by convention the user +;; can use S-tab instead to access that binding. +(define-key function-key-map [S-tab] [backtab]) (define-key global-map [mouse-movement] 'ignore) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index cfc7d7af5c8..0eec76f4da7 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -528,26 +528,36 @@ old one." (setq bookmark-current-bookmark stripped-name) (bookmark-bmenu-surreptitiously-rebuild-list))) -(defun bookmark-make-record-default (&optional point-only) +(defun bookmark-make-record-default (&optional no-file no-context posn) "Return the record describing the location of a new bookmark. -Must be at the correct position in the buffer in which the bookmark is -being set. -If POINT-ONLY is non-nil, then only return the subset of the -record that pertains to the location within the buffer." - `(,@(unless point-only `((filename . ,(bookmark-buffer-file-name)))) - (front-context-string - . ,(if (>= (- (point-max) (point)) bookmark-search-size) - (buffer-substring-no-properties - (point) - (+ (point) bookmark-search-size)) - nil)) - (rear-context-string - . ,(if (>= (- (point) (point-min)) bookmark-search-size) - (buffer-substring-no-properties - (point) - (- (point) bookmark-search-size)) - nil)) - (position . ,(point)))) +Point should be at the buffer in which the bookmark is being set, +and normally should be at the position where the bookmark is desired, +but see the optional arguments for other possibilities. + +If NO-FILE is non-nil, then only return the subset of the +record that pertains to the location within the buffer, leaving off +the part that records the filename. + +If NO-CONTEXT is non-nil, do not include the front- and rear-context +strings in the record -- the position is enough. + +If POSN is non-nil, record POSN as the point instead of `(point)'." + `(,@(unless no-file `((filename . ,(bookmark-buffer-file-name)))) + ,@(unless no-context `((front-context-string + . ,(if (>= (- (point-max) (point)) + bookmark-search-size) + (buffer-substring-no-properties + (point) + (+ (point) bookmark-search-size)) + nil)))) + ,@(unless no-context `((rear-context-string + . ,(if (>= (- (point) (point-min)) + bookmark-search-size) + (buffer-substring-no-properties + (point) + (- (point) bookmark-search-size)) + nil)))) + (position . ,(or posn (point))))) ;;; File format stuff @@ -773,27 +783,34 @@ Use \\[bookmark-delete] to remove bookmarks (you give it a name and it removes only the first instance of a bookmark with that name from the list of bookmarks.)" (interactive (list nil current-prefix-arg)) - (let* ((record (bookmark-make-record)) - (default (car record))) + (unwind-protect + (let* ((record (bookmark-make-record)) + (default (car record))) + + (bookmark-maybe-load-default-file) + ;; Don't set `bookmark-yank-point' and `bookmark-current-buffer' + ;; if they have been already set in another buffer. (e.g gnus-art). + (unless (and bookmark-yank-point + bookmark-current-buffer) + (setq bookmark-yank-point (point)) + (setq bookmark-current-buffer (current-buffer))) + + (let ((str + (or name + (read-from-minibuffer + (format "Set bookmark (%s): " default) + nil + bookmark-minibuffer-read-name-map + nil nil default)))) + (and (string-equal str "") (setq str default)) + (bookmark-store str (cdr record) no-overwrite) + + ;; Ask for an annotation buffer for this bookmark + (when bookmark-use-annotations + (bookmark-edit-annotation str)))) + (setq bookmark-yank-point nil) + (setq bookmark-current-buffer nil))) - (bookmark-maybe-load-default-file) - - (setq bookmark-yank-point (point)) - (setq bookmark-current-buffer (current-buffer)) - - (let ((str - (or name - (read-from-minibuffer - (format "Set bookmark (%s): " default) - nil - bookmark-minibuffer-read-name-map - nil nil default)))) - (and (string-equal str "") (setq str default)) - (bookmark-store str (cdr record) no-overwrite) - - ;; Ask for an annotation buffer for this bookmark - (when bookmark-use-annotations - (bookmark-edit-annotation str))))) (defun bookmark-kill-line (&optional newline-too) "Kill from point to end of line. @@ -1733,15 +1750,15 @@ last full line, move to the last full line. The return value is undefined." "Display the annotation for bookmark named BOOKMARK in a buffer, if an annotation exists." (let ((annotation (bookmark-get-annotation bookmark))) - (if (and annotation (not (string-equal annotation ""))) - (save-excursion - (let ((old-buf (current-buffer))) - (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t) - (delete-region (point-min) (point-max)) - ;; (insert (concat "Annotation for bookmark '" bookmark "':\n\n")) - (insert annotation) - (goto-char (point-min)) - (pop-to-buffer old-buf)))))) + (when (and annotation (not (string-equal annotation ""))) + (save-excursion + (let ((old-buf (current-buffer))) + (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t) + (delete-region (point-min) (point-max)) + ;; (insert (concat "Annotation for bookmark '" bookmark "':\n\n")) + (insert annotation) + (goto-char (point-min)) + (switch-to-buffer-other-window old-buf)))))) (defun bookmark-show-all-annotations () @@ -1860,8 +1877,7 @@ With a prefix arg, prompts for a file to save them in." (pop-up-windows t)) (delete-other-windows) (switch-to-buffer (other-buffer)) - (let ((bookmark-automatically-show-annotations nil)) ;FIXME: needed? - (bookmark--jump-via bmrk 'pop-to-buffer)) + (bookmark--jump-via bmrk 'pop-to-buffer) (bury-buffer menu))) @@ -1875,8 +1891,7 @@ With a prefix arg, prompts for a file to save them in." "Select this line's bookmark in other window, leaving bookmark menu visible." (interactive) (let ((bookmark (bookmark-bmenu-bookmark))) - (let ((bookmark-automatically-show-annotations t)) ;FIXME: needed? - (bookmark--jump-via bookmark 'switch-to-buffer-other-window)))) + (bookmark--jump-via bookmark 'switch-to-buffer-other-window))) (defun bookmark-bmenu-switch-other-window () @@ -1887,8 +1902,7 @@ The current window remains selected." (pop-up-windows t) same-window-buffer-names same-window-regexps) - (let ((bookmark-automatically-show-annotations t)) ;FIXME: needed? - (bookmark--jump-via bookmark 'display-buffer)))) + (bookmark--jump-via bookmark 'display-buffer))) (defun bookmark-bmenu-other-window-with-mouse (event) "Select bookmark at the mouse pointer in other window, leaving bookmark menu visible." @@ -2182,7 +2196,7 @@ strings returned are not." ;; Load Hook (defvar bookmark-load-hook nil - "Hook run at the end of loading bookmark.") + "Hook run at the end of loading library `bookmark.el'.") ;; Exit Hook, called from kill-emacs-hook (defvar bookmark-exit-hook nil diff --git a/lisp/bs.el b/lisp/bs.el index 3fa91b49178..0ce7670201d 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -195,7 +195,7 @@ return a string representing the column's value." 'font-lock-constant-face 'font-lock-comment-face)) ;; Dired-Buffers - '("^..\\(.*Dired by .*\\)$" 1 font-lock-function-name-face) + '("^..\\(.*Dired .*\\)$" 1 font-lock-function-name-face) ;; the star for modified buffers '("^.\\(\\*\\) +[^\\*]" 1 font-lock-comment-face)) "Default font lock expressions for Buffer Selection Menu.") diff --git a/lisp/calc/README b/lisp/calc/README index 4b32ada63ad..cf3a697c5d7 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -74,6 +74,8 @@ Summary of changes to "Calc" Emacs 24.1 +* Added option to highlight selections using faces. + * Gave `calc-histogram' the option of using a vector to determine the bins. * Added "O" option prefix. diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 77a02b58c73..30f15f04905 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -1,7 +1,7 @@ ;;; calc-aent.el --- algebraic entry functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -609,9 +609,9 @@ in Calc algebraic input.") (setq math-exp-str (math-remove-percentsigns math-exp-str))) (if calc-language-input-filter (setq math-exp-str (funcall calc-language-input-filter math-exp-str))) - (while (setq math-exp-token + (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) - (setq math-exp-str + (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots" (substring math-exp-str (+ math-exp-token 2))))) (math-build-parse-table) @@ -712,7 +712,7 @@ in Calc algebraic input.") (math-read-token))) ((and (memq ch calc-user-token-chars) (let ((case-fold-search nil)) - (eq (string-match + (eq (string-match calc-user-tokens math-exp-str math-exp-pos) math-exp-pos))) (setq math-exp-token 'punc @@ -722,7 +722,7 @@ in Calc algebraic input.") (and (>= ch ?A) (<= ch ?Z)) (and (>= ch ?α) (<= ch ?ω)) (and (>= ch ?Α) (<= ch ?Ω))) - (string-match + (string-match (cond ((and (memq calc-language calc-lang-allow-underscores) (memq calc-language calc-lang-allow-percentsigns)) @@ -745,7 +745,7 @@ in Calc algebraic input.") (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos) math-exp-pos) (or (eq math-exp-pos 0) - (and (not (memq calc-language + (and (not (memq calc-language calc-lang-allow-underscores)) (eq (string-match "[^])}\"a-zA-Zα-ωΑ-Ω0-9'$]_" math-exp-str (1- math-exp-pos)) @@ -757,7 +757,7 @@ in Calc algebraic input.") (setq math-exp-token 'number math-expr-data (math-match-substring math-exp-str 0) math-exp-pos (match-end 0))) - ((and (setq adfn + ((and (setq adfn (assq ch (get calc-language 'math-lang-read-symbol))) (eval (nth 1 adfn))) (eval (nth 2 adfn))) @@ -810,8 +810,8 @@ in Calc algebraic input.") (defun math-read-expr-level (exp-prec &optional exp-term) (let* ((math-expr-opers (math-expr-ops)) - (x (math-read-factor)) - (first t) + (x (math-read-factor)) + (first t) op op2) (while (and (or (and calc-user-parse-table (setq op (calc-check-user-syntax x exp-prec)) @@ -832,8 +832,8 @@ in Calc algebraic input.") (memq math-exp-token '(symbol number dollar hash)) (equal math-expr-data "(") (and (equal math-expr-data "[") - (not (equal - (get calc-language + (not (equal + (get calc-language 'math-function-open) "[")) (not (and math-exp-keep-spaces (eq (car-safe x) 'vec))))) @@ -1141,8 +1141,8 @@ If the current Calc language does not use placeholders, return nil." (eq math-exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) - (if (and (memq calc-language - calc-lang-parens-are-subscripts) + (if (and (memq calc-language + calc-lang-parens-are-subscripts) args (require 'calc-ext) (let ((calc-matrix-mode 'scalar)) @@ -1184,7 +1184,7 @@ If the current Calc language does not use placeholders, return nil." (substring (symbol-name (cdr v)) 4)) (cdr v)))))) - (while (and (memq calc-language + (while (and (memq calc-language calc-lang-brackets-are-subscripts) (equal math-expr-data "[")) (math-read-token) @@ -1284,6 +1284,7 @@ If the current Calc language does not use placeholders, return nil." (provide 'calc-aent) ;; Local variables: +;; coding: utf-8 ;; generated-autoload-file: "calc-loaddefs.el" ;; End: diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 17dc9293237..18e63655ecf 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1,7 +1,7 @@ ;;; calc-ext.el --- various extension functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -960,7 +960,7 @@ math-read-brackets math-reduce-cols math-reduce-vec math-transpose) ("calc-yank" calc-alg-edit calc-clean-newlines calc-do-grab-rectangle calc-do-grab-region calc-finish-stack-edit -calc-copy-to-register calc-insert-register +calc-copy-to-register calc-insert-register calc-append-to-register calc-prepend-to-register calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) @@ -989,7 +989,7 @@ calc-floor calc-idiv calc-increment calc-mant-part calc-max calc-min calc-round calc-scale-float calc-sign calc-trunc calc-xpon-part) ("calc-bin" calc-and calc-binary-radix calc-clip calc-twos-complement-mode -calc-decimal-radix calc-diff calc-hex-radix calc-leading-zeros +calc-decimal-radix calc-diff calc-hex-radix calc-leading-zeros calc-lshift-arith calc-lshift-binary calc-not calc-octal-radix calc-or calc-radix calc-rotate-binary calc-rshift-arith calc-rshift-binary calc-word-size calc-xor) @@ -1415,7 +1415,7 @@ calc-kill calc-kill-region calc-yank)))) (with-current-buffer calc-main-buffer calc-option-flag) calc-option-flag)) - (msg + (msg (cond ((and opt-flag hyp-flag) "Option Inverse Hyperbolic...") (hyp-flag "Inverse Hyperbolic...") @@ -1505,8 +1505,8 @@ calc-kill calc-kill-region calc-yank)))) (with-current-buffer calc-main-buffer calc-option-flag) calc-option-flag)) - (msg - (cond + (msg + (cond ((and opt-flag inv-flag) "Option Inverse Hyperbolic...") (opt-flag "Option Hyperbolic...") (inv-flag "Inverse Hyperbolic...") @@ -1537,8 +1537,8 @@ calc-kill calc-kill-region calc-yank)))) (with-current-buffer calc-main-buffer calc-hyperbolic-flag) calc-hyperbolic-flag)) - (msg - (cond + (msg + (cond ((and hyp-flag inv-flag) "Option Inverse Hyperbolic...") (hyp-flag "Option Hyperbolic...") (inv-flag "Option Inverse...") @@ -1702,8 +1702,8 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-execute-extended-command (n) (interactive "P") (let* ((prompt (concat (calc-num-prefix-name n) "M-x ")) - (cmd (intern - (completing-read prompt obarray 'commandp t "calc-" + (cmd (intern + (completing-read prompt obarray 'commandp t "calc-" 'calc-extended-command-history)))) (setq prefix-arg n) (command-execute cmd))) @@ -3500,5 +3500,9 @@ A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.") (provide 'calc-ext) +;; Local variables: +;; coding: utf-8 +;; End: + ;; arch-tag: 1814ba7f-a390-49dc-9e25-a5adc205e97e ;;; calc-ext.el ends here diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 0ebf1a18fef..f461c47aafd 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -1,7 +1,7 @@ ;;; calc-lang.el --- calc language functions -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -335,7 +335,7 @@ (add-to-list 'calc-lang-allow-underscores 'fortran) (add-to-list 'calc-lang-parens-are-subscripts 'fortran) -;; The next few variables are local to math-read-exprs in calc-aent.el +;; The next few variables are local to math-read-exprs in calc-aent.el ;; and math-read-expr in calc-ext.el, but are set in functions they call. (defvar math-exp-token) @@ -379,12 +379,12 @@ ((= n 1) (message "TeX language mode with \\hbox{func}(\\hbox{var})")) ((> n 1) - (message + (message "TeX language mode with \\hbox{func}(\\hbox{var}) and multiline matrices")) ((= n -1) (message "TeX language mode with \\func(\\hbox{var})")) ((< n -1) - (message + (message "TeX language mode with \\func(\\hbox{var}) and multiline matrices"))))) (defun calc-latex-language (n) @@ -399,12 +399,12 @@ ((= n 1) (message "LaTeX language mode with \\text{func}(\\text{var})")) ((> n 1) - (message + (message "LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices")) ((= n -1) (message "LaTeX language mode with \\func(\\text{var})")) ((< n -1) - (message + (message "LaTeX language mode with \\func(\\text{var}) and multiline matrices"))))) (put 'tex 'math-lang-name "TeX") @@ -498,7 +498,7 @@ (intv . math-compose-tex-intv))) (put 'tex 'math-variable-table - '( + '( ;; The Greek letters ( \\alpha . var-alpha ) ( \\beta . var-beta ) @@ -630,7 +630,7 @@ (defun math-compose-tex-matrix (a &optional ltx) (if (cdr a) - (cons (append (math-compose-vector (cdr (car a)) " & " 0) + (cons (append (math-compose-vector (cdr (car a)) " & " 0) (if ltx '(" \\\\ ") '(" \\cr "))) (math-compose-tex-matrix (cdr a) ltx)) (list (math-compose-vector (cdr (car a)) " & " 0)))) @@ -722,7 +722,7 @@ (setq left "{" right "}")) (t (setq left calc-function-open right calc-function-close))) - (list 'horiz func + (list 'horiz func left (math-compose-vector (cdr a) ", " 0) right))) @@ -866,7 +866,7 @@ (and right (setq math-exp-str (copy-sequence math-exp-str)) (aset math-exp-str right ?\])))))))))) - + (defun math-latex-parse-frac (f val) (let (numer denom) (setq numer (car (math-read-expr-list))) @@ -988,7 +988,7 @@ (cdr (math-transpose a))) '("}"))))) -(put 'eqn 'math-var-formatter +(put 'eqn 'math-var-formatter (function (lambda (a prec) (let (v) @@ -1011,7 +1011,7 @@ (intern (substring (symbol-name (nth 2 a)) 0 -1)))) prec) (symbol-name (nth 1 a)))))))) - + (defconst math-eqn-special-funcs '( calcFunc-log calcFunc-ln calcFunc-exp @@ -1022,7 +1022,7 @@ calcFunc-arcsin calcFunc-arccos calcFunc-arctan calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) -(put 'eqn 'math-func-formatter +(put 'eqn 'math-func-formatter (function (lambda (func a) (let (left right) @@ -1035,8 +1035,8 @@ (not (math-tex-expr-is-flat (nth 1 a)))) (setq left "{left ( " right " right )}")) - - ((and + + ((and (memq (car a) math-eqn-special-funcs) (= (length a) 2) (or (Math-realp (nth 1 a)) @@ -1069,7 +1069,7 @@ ("above" punc ","))) (put 'eqn 'math-lang-adjust-words - (function + (function (lambda () (let ((code (assoc math-expr-data math-eqn-ignore-words))) (cond ((null code)) @@ -1189,21 +1189,21 @@ ( Gamma . var-gamma))) (put 'yacas 'math-parse-table - '((("Deriv(" 0 ")" 0) + '((("Deriv(" 0 ")" 0) calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA)) - (("D(" 0 ")" 0) + (("D(" 0 ")" 0) calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA)) - (("Integrate(" 0 ")" 0) + (("Integrate(" 0 ")" 0) calcFunc-integ (var ArgB var-ArgB)(var ArgA var-ArgA)) - (("Integrate(" 0 "," 0 "," 0 ")" 0) - calcFunc-integ (var ArgD var-ArgD) (var ArgA var-ArgA) + (("Integrate(" 0 "," 0 "," 0 ")" 0) + calcFunc-integ (var ArgD var-ArgD) (var ArgA var-ArgA) (var ArgB var-ArgB) (var ArgC var-ArgC)) - (("Subst(" 0 "," 0 ")" 0) - calcFunc-subst (var ArgC var-ArgC) (var ArgA var-ArgA) + (("Subst(" 0 "," 0 ")" 0) + calcFunc-subst (var ArgC var-ArgC) (var ArgA var-ArgA) (var ArgB var-ArgB)) - (("Taylor(" 0 "," 0 "," 0 ")" 0) - calcFunc-taylor (var ArgD var-ArgD) - (calcFunc-eq (var ArgA var-ArgA) (var ArgB var-ArgB)) + (("Taylor(" 0 "," 0 "," 0 ")" 0) + calcFunc-taylor (var ArgD var-ArgD) + (calcFunc-eq (var ArgA var-ArgA) (var ArgB var-ArgB)) (var ArgC var-ArgC)))) (put 'yacas 'math-oper-table @@ -1356,7 +1356,7 @@ (math-compose-expr (nth 2 a) -1) (if (not (nth 3 a)) ")" - (concat + (concat "," (math-compose-expr (nth 3 a) -1) "," @@ -1393,7 +1393,7 @@ '(("+" + 100 100) ("-" - 100 134) ("*" * 120 120) - ("." * 130 129) + ("." * 130 129) ("/" / 120 120) ("u-" neg -1 180) ("u+" ident -1 180) @@ -1494,9 +1494,9 @@ (nth 3 args)))) (put 'maxima 'math-parse-table - '((("if" 0 "then" 0 "else" 0) - calcFunc-if - (var ArgA var-ArgA) + '((("if" 0 "then" 0 "else" 0) + calcFunc-if + (var ArgA var-ArgA) (var ArgB var-ArgB) (var ArgC var-ArgC)))) @@ -1572,7 +1572,7 @@ (lambda (a) (list 'horiz "matrix(" - (math-compose-vector (cdr a) + (math-compose-vector (cdr a) (concat math-comp-comma " ") math-comp-vector-prec) ")")))) @@ -1734,7 +1734,7 @@ order to Calc's." (nth 0 args)))) (put 'giac 'math-parse-table - '((("set" 0) + '((("set" 0) calcFunc-rdup (var ArgA var-ArgA)))) @@ -1748,7 +1748,7 @@ order to Calc's." "Compose the arguments to a Calc function in reverse order. This is used for various language modes which have functions in reverse order to Calc's." - (list 'horiz (nth 1 fn) + (list 'horiz (nth 1 fn) "(" (math-compose-expr (nth 2 a) 0) "," @@ -1770,7 +1770,7 @@ order to Calc's." (list 'horiz (math-compose-expr (nth 1 a) 1000) "[" - (math-compose-expr + (math-compose-expr (calc-normalize (list '- (nth 2 a) 1)) 0) "]"))))) @@ -2001,7 +2001,7 @@ order to Calc's." (list 'horiz "matrix(" math-comp-left-bracket - (math-compose-vector (cdr a) + (math-compose-vector (cdr a) (concat math-comp-comma " ") math-comp-vector-prec) math-comp-right-bracket @@ -2044,9 +2044,9 @@ order to Calc's." (defvar math-read-big-baseline) (defvar math-read-big-h2) -;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2 -;; are local to math-read-big-rec, but are used by math-read-big-char, -;; math-read-big-emptyp and math-read-big-balance which are called by +;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2 +;; are local to math-read-big-rec, but are used by math-read-big-char, +;; math-read-big-emptyp and math-read-big-balance which are called by ;; math-read-big-rec. ;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el, ;; which calls math-read-big-balance. @@ -2055,40 +2055,40 @@ order to Calc's." (defvar math-rb-v1) (defvar math-rb-v2) -(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 +(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 &optional baseline prec short) (or prec (setq prec 0)) ;; Clip whitespace above or below. - (while (and (< math-rb-v1 math-rb-v2) + (while (and (< math-rb-v1 math-rb-v2) (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1))) (setq math-rb-v1 (1+ math-rb-v1))) - (while (and (< math-rb-v1 math-rb-v2) + (while (and (< math-rb-v1 math-rb-v2) (math-read-big-emptyp math-rb-h1 (1- math-rb-v2) math-rb-h2 math-rb-v2)) (setq math-rb-v2 (1- math-rb-v2))) ;; If formula is a single line high, normal parser can handle it. (if (<= math-rb-v2 (1+ math-rb-v1)) (if (or (<= math-rb-v2 math-rb-v1) - (> math-rb-h1 (length (setq math-rb-v2 + (> math-rb-h1 (length (setq math-rb-v2 (nth math-rb-v1 math-read-big-lines))))) (math-read-big-error math-rb-h1 math-rb-v1) (setq math-read-big-baseline math-rb-v1 math-read-big-h2 math-rb-h2 math-rb-v2 (nth math-rb-v1 math-read-big-lines) - math-rb-h2 (math-read-expr - (substring math-rb-v2 math-rb-h1 + math-rb-h2 (math-read-expr + (substring math-rb-v2 math-rb-h1 (min math-rb-h2 (length math-rb-v2))))) (if (eq (car-safe math-rb-h2) 'error) - (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2)) + (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2)) math-rb-v1 (nth 2 math-rb-h2)) math-rb-h2)) ;; Clip whitespace at left or right. - (while (and (< math-rb-h1 math-rb-h2) + (while (and (< math-rb-h1 math-rb-h2) (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) math-rb-v2)) (setq math-rb-h1 (1+ math-rb-h1))) - (while (and (< math-rb-h1 math-rb-h2) + (while (and (< math-rb-h1 math-rb-h2) (math-read-big-emptyp (1- math-rb-h2) math-rb-v1 math-rb-h2 math-rb-v2)) (setq math-rb-h2 (1- math-rb-h2))) @@ -2107,7 +2107,7 @@ order to Calc's." (/= (aref line math-rb-h1) ?\ ) (if (and (= (aref line math-rb-h1) ?\-) ;; Make sure it's not a minus sign. - (or (and (< (1+ math-rb-h1) len) + (or (and (< (1+ math-rb-h1) len) (= (aref line (1+ math-rb-h1)) ?\-)) (/= (math-read-big-char math-rb-h1 (1- v)) ?\ ) (/= (math-read-big-char math-rb-h1 (1+ v)) ?\ ))) @@ -2166,7 +2166,7 @@ order to Calc's." ;; Binomial coefficient. ((and (= other-char ?\() (= (math-read-big-char (1+ math-rb-h1) v) ?\ ) - (= (string-match "( *)" (nth v math-read-big-lines) + (= (string-match "( *)" (nth v math-read-big-lines) math-rb-h1) math-rb-h1)) (setq h (match-end 0)) (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) @@ -2180,7 +2180,7 @@ order to Calc's." ;; Minus sign. ((= other-char ?\-) - (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1 + (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1 math-rb-h2 math-rb-v2 v 250 t)) v math-read-big-baseline h math-read-big-h2)) @@ -2199,10 +2199,10 @@ order to Calc's." (if (= sep ?\]) (math-read-big-error (1- h) v "Expected `)'")) (if (= sep ?\)) - (setq p (math-read-big-rec + (setq p (math-read-big-rec (1+ math-rb-h1) math-rb-v1 (1- h) math-rb-v2 v)) (setq hmid (math-read-big-balance h v "(") - p (list p + p (list p (math-read-big-rec h math-rb-v1 (1- hmid) math-rb-v2 v)) h hmid) (cond ((= sep ?\.) @@ -2347,7 +2347,7 @@ order to Calc's." (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t))) - ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2; + ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2; ;; baseline = v. (if baseline (or (= v baseline) @@ -2389,12 +2389,12 @@ order to Calc's." (cond ((eq (nth 3 widest) -1) (setq p (list (nth 1 widest) p))) ((equal (car widest) "?") - (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2 + (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2 math-rb-v2 baseline nil t))) (or (= (math-read-big-char math-read-big-h2 baseline) ?\:) (math-read-big-error math-read-big-h2 baseline "Expected `:'")) (setq p (list (nth 1 widest) p y - (math-read-big-rec + (math-read-big-rec (1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2 baseline (nth 3 widest) t)) h math-read-big-h2))) @@ -2483,5 +2483,9 @@ order to Calc's." (provide 'calc-lang) +;; Local variables: +;; coding: utf-8 +;; End: + ;; arch-tag: 483bfe15-f290-4fef-bb7d-ce65be687f2e ;;; calc-lang.el ends here diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index a994ace6fb6..f268a032d14 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -663,7 +663,7 @@ (cons 'vec (cons (nth 1 facs) (cons (list 'vec fac pow) (cdr (cdr facs))))) (cons 'vec (cons (list 'vec fac pow) (cdr facs)))))))) - (math-mul (math-pow fac pow) facs))) + (math-mul (math-pow fac pow) (math-factor-protect facs)))) (defun math-factor-poly-coefs (p &optional square-free) ; uses "x" (let (t1 t2 temp) diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index 084b9ea2b6a..c485fdd168a 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -309,6 +309,8 @@ (setq n (1+ n)))) (calc-clear-command-flag 'position-point))) +(defvar calc-highlight-selections-with-faces) + (defun calc-show-selections (arg) (interactive "P") (calc-wrapper @@ -330,8 +332,12 @@ (setcar (nthcdr 2 calc-selection-cache-entry) nil) (calc-change-current-selection sel))))) (message (if calc-show-selections - "Displaying only selected part of formulas" - "Displaying all but selected part of formulas")))) + (if calc-highlight-selections-with-faces + "De-emphasizing all but selected part of formulas" + "Displaying only selected part of formulas") + (if calc-highlight-selections-with-faces + "Emphasizing selected part of formulas" + "Displaying all but selected part of formulas"))))) ;; The variables calc-final-point-line and calc-final-point-column ;; are declared in calc.el, and are used throughout. diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index 8f73e71b0f9..b82ed08c557 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el @@ -1,7 +1,7 @@ ;;; calc-store.el --- value storage functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -197,8 +197,8 @@ (minibuffer-completion-predicate (lambda (x) (boundp (intern (concat "var-" x))))) (minibuffer-completion-confirm t)) - (read-from-minibuffer - prompt nil calc-var-name-map nil + (read-from-minibuffer + prompt nil calc-var-name-map nil 'calc-read-var-name-history))))) (setq calc-aborted-prefix "") (and (not (equal var "var-")) @@ -677,5 +677,9 @@ (provide 'calc-store) +;; Local variables: +;; coding: utf-8 +;; End: + ;; arch-tag: 2fbfec82-a521-42ca-bcd8-4f254ae6313e ;;; calc-store.el ends here diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 6881db3fb12..a88e87dffbc 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -1,7 +1,7 @@ ;;; calc-units.el --- unit conversion functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -323,7 +323,7 @@ that the combined units table will be rebuilt.") ( ?c (^ 10 -2) "Centi" ) ( ?m (^ 10 -3) "Milli" ) ( ?u (^ 10 -6) "Micro" ) - ( ?μ (^ 10 -6) "Micro" ) + ( ?μ (^ 10 -6) "Micro" ) ( ?n (^ 10 -9) "Nano" ) ( ?p (^ 10 -12) "Pico" ) ( ?f (^ 10 -15) "Femto" ) @@ -1548,5 +1548,9 @@ If EXPR is nil, return nil." (provide 'calc-units) +;; Local variables: +;; coding: utf-8 +;; End: + ;; arch-tag: e993314f-3adc-4191-be61-4ef8874881c4 ;;; calc-units.el ends here diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 587e376245b..e0560465a99 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -419,12 +419,33 @@ in normal mode." :group 'calc :type 'boolean) -(defcustom calc-undo-length +(defcustom calc-undo-length 100 "The number of undo steps that will be preserved when Calc is quit." :group 'calc :type 'integer) +(defcustom calc-highlight-selections-with-faces + nil + "If non-nil, use a separate face to indicate selected sub-formulas. +If `calc-show-selections' is non-nil, then selected sub-formulas are shown +by displaying the rest of the formula in `calc-nonselected-face'. +If `calc-show-selections' is nil, then selected sub-formulas are shown +by displaying the sub-formula in `calc-selected-face'." + :group 'calc + :type 'boolean) + +(defface calc-nonselected-face + '((t :inherit shadow + :slant italic)) + "Face used to show the non-selected portion of a formula." + :group 'calc) + +(defface calc-selected-face + '((t :weight bold)) + "Face used to show the selected portion of a formula." + :group 'calc) + (defvar calc-bug-address "jay.p.belanger@gmail.com" "Address of the maintainer of Calc, for use by `report-calc-bug'.") @@ -1233,7 +1254,7 @@ the trail buffer." ;; Eventually, prompt user with a list of buffers using embedded mode. (when (and info-list - (yes-or-no-p + (yes-or-no-p (concat "This Calc stack is being used for embedded mode. Kill anyway?"))) (while info-list (with-current-buffer (car (car info-list)) @@ -1385,8 +1406,7 @@ commands given here will actually operate on the *Calculator* stack." (set (make-local-variable 'calc-main-buffer) buf)) (when (= (buffer-size) 0) (let ((buffer-read-only nil)) - (insert (propertize (concat "Emacs Calculator Trail\n") - 'font-lock-face 'italic)))) + (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))) (run-mode-hooks 'calc-trail-mode-hook)) (defun calc-create-buffer () @@ -1976,7 +1996,7 @@ See calc-keypad for details." (erase-buffer) (when calc-show-banner (insert (propertize "--- Emacs Calculator Mode ---\n" - 'font-lock-face 'italic))) + 'face 'italic))) (while thing (goto-char (point-min)) (when calc-show-banner @@ -3409,7 +3429,7 @@ largest Emacs integer.") (Math-lessp a math-half-2-word-size)) (and (Math-integer-negp a) (require 'calc-ext) - (let ((comparison + (let ((comparison (math-compare (Math-integer-neg a) math-half-2-word-size))) (or (= comparison 0) (= comparison -1)))))) @@ -3553,7 +3573,7 @@ largest Emacs integer.") (math-normalize (save-match-data (cond - + ;; Integers (most common case) ((string-match "\\` *\\([0-9]+\\) *\\'" s) (let ((digs (math-match-substring s 1))) @@ -3565,22 +3585,22 @@ largest Emacs integer.") (if (<= (length digs) (* 2 math-bignum-digit-length)) (string-to-number digs) (cons 'bigpos (math-read-bignum digs)))))) - + ;; Clean up the string if necessary ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s) (math-read-number (concat (math-match-substring s 1) (math-match-substring s 2)))) - + ;; Plus and minus signs ((string-match "^[-_+]\\(.*\\)$" s) (let ((val (math-read-number (math-match-substring s 1)))) (and val (if (eq (aref s 0) ?+) val (math-neg val))))) - + ;; Forms that require extensions module ((string-match "[^-+0-9eE.]" s) (require 'calc-ext) (math-read-number-fancy s)) - + ;; Decimal point ((string-match "^\\([0-9]*\\)\\.\\([0-9]*\\)$" s) (let ((int (math-match-substring s 1)) @@ -3593,7 +3613,7 @@ largest Emacs integer.") (list 'float (math-add (math-scale-int int flen) frac) (- flen))))))) - + ;; "e" notation ((string-match "^\\(.*\\)[eE]\\([-+]?[0-9]+\\)$" s) (let ((mant (math-match-substring s 1)) @@ -3604,7 +3624,7 @@ largest Emacs integer.") (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000) (let ((mant (math-float mant))) (list 'float (nth 1 mant) (+ (nth 2 mant) exp))))))) - + ;; Syntax error! (t nil))))) @@ -3797,7 +3817,7 @@ See Info node `(calc)Defining Functions'." (setq unread-command-event nil) (setq unread-command-events nil))) -(defcalcmodevar math-2-word-size +(defcalcmodevar math-2-word-size (math-read-number-simple "4294967296") "Two to the power of `calc-word-size'.") @@ -3814,5 +3834,9 @@ See Info node `(calc)Defining Functions'." (provide 'calc) +;; Local variables: +;; coding: utf-8 +;; End: + ;; arch-tag: 0c3b170c-4ce6-4eaf-8d9b-5834d1fe938f ;;; calc.el ends here diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index c8efded9270..6923cd7693a 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -1,7 +1,7 @@ ;;; calccomp.el --- composition functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -50,19 +50,19 @@ ;;; ;;; (tag X C) Composition C corresponds to sub-expression X -;; math-comp-just and math-comp-comma-spc are local to -;; math-compose-expr, but are used by math-compose-matrix, which is +;; math-comp-just and math-comp-comma-spc are local to +;; math-compose-expr, but are used by math-compose-matrix, which is ;; called by math-compose-expr (defvar math-comp-just) (defvar math-comp-comma-spc) -;; math-comp-vector-prec is local to math-compose-expr, but is used by -;; math-compose-matrix and math-compose-rows, which are called by +;; math-comp-vector-prec is local to math-compose-expr, but is used by +;; math-compose-matrix and math-compose-rows, which are called by ;; math-compose-expr. (defvar math-comp-vector-prec) -;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are -;; local to math-compose-expr, but are used by math-compose-rows, which is +;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are +;; local to math-compose-expr, but are used by math-compose-rows, which is ;; called by math-compose-expr. (defvar math-comp-left-bracket) (defvar math-comp-right-bracket) @@ -100,7 +100,7 @@ (list 'tag a (math-compose-expr a prec)))) ((and (not (consp a)) (not (integerp a))) (concat "'" (prin1-to-string a))) - ((setq spfn (assq (car-safe a) + ((setq spfn (assq (car-safe a) (get calc-language 'math-special-function-table))) (setq spfn (cdr spfn)) (if (consp spfn) @@ -111,12 +111,12 @@ (and (nth 1 calc-frac-format) (Math-integerp a))) (if (and calc-language - (not (memq calc-language + (not (memq calc-language '(flat big unform)))) (let ((aa (math-adjust-fraction a)) (calc-frac-format nil)) (math-compose-expr (list '/ - (if (memq calc-language + (if (memq calc-language calc-lang-slash-idiv) (math-float (nth 1 aa)) (nth 1 aa)) @@ -281,22 +281,22 @@ (cdr a) (if full rows 3) t))))) (if (or calc-full-vectors (< (length a) 7)) - (if (and + (if (and (setq spfn (get calc-language 'math-matrix-formatter)) (math-matrixp a)) (funcall spfn a) (list 'horiz math-comp-left-bracket - (math-compose-vector (cdr a) + (math-compose-vector (cdr a) (concat math-comp-comma " ") math-comp-vector-prec) math-comp-right-bracket)) (list 'horiz math-comp-left-bracket (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a)) - (concat math-comp-comma " ") + (concat math-comp-comma " ") math-comp-vector-prec) - math-comp-comma + math-comp-comma (if (setq spfn (get calc-language 'math-dots)) (concat " " spfn) " ...") @@ -869,7 +869,7 @@ math-comp-vector-prec) (if (= col cols) "" - (concat + (concat math-comp-comma-spc " "))))) a))) res))) @@ -880,7 +880,7 @@ (if (<= count 0) (if (< count 0) (math-compose-rows (cdr a) -1 nil) - (cons (concat + (cons (concat (let ((mdots (get calc-language 'math-dots))) (if mdots (concat " " mdots) @@ -1119,7 +1119,7 @@ (if (memq prec '(196 201)) ")" ""))))) ;; The variables math-svo-c, math-svo-wid and math-svo-off are local -;; to math-stack-value-offset in calc.el, but are used by +;; to math-stack-value-offset in calc.el, but are used by ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset.. (defvar math-svo-c) (defvar math-svo-wid) @@ -1195,11 +1195,11 @@ ;;; of the formula. ;; The variables math-comp-full-width, math-comp-highlight, math-comp-word, -;; math-comp-level, math-comp-margin and math-comp-buf are local to -;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term, +;; math-comp-level, math-comp-margin and math-comp-buf are local to +;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term, ;; which is called by math-comp-to-string-flat. -;; math-comp-highlight and math-comp-buf are also local to -;; math-comp-simplify-term and math-comp-simplify respectively, but are used +;; math-comp-highlight and math-comp-buf are also local to +;; math-comp-simplify-term and math-comp-simplify respectively, but are used ;; by math-comp-add-string. (defvar math-comp-full-width) (defvar math-comp-highlight) @@ -1244,7 +1244,7 @@ (cond ((not (consp c)) (if math-comp-highlight (setq c (math-comp-highlight-string c))) - (setq math-comp-word (if (= (length math-comp-word) 0) c + (setq math-comp-word (if (= (length math-comp-word) 0) c (concat math-comp-word c)) math-comp-pos (+ math-comp-pos (length c)))) @@ -1339,16 +1339,19 @@ (defun math-comp-highlight-string (s) (setq s (copy-sequence s)) - (let ((i (length s))) - (while (>= (setq i (1- i)) 0) - (or (memq (aref s i) '(32 ?\n)) - (aset s i (if calc-show-selections ?\. ?\#))))) - s) - + (if calc-highlight-selections-with-faces + (if (not calc-show-selections) + (propertize s 'face 'calc-selected-face) + (propertize s 'face 'calc-nonselected-face)) + (let ((i (length s))) + (while (>= (setq i (1- i)) 0) + (or (memq (aref s i) '(32 ?\n)) + (aset s i (if calc-show-selections ?\. ?\#))))) + s)) ;; The variable math-comp-sel-tag is local to calc-find-selected-part -;; in calc-sel.el, but is used by math-comp-sel-flat-term and -;; math-comp-add-string-sel, which are called (indirectly) by +;; in calc-sel.el, but is used by math-comp-sel-flat-term and +;; math-comp-add-string-sel, which are called (indirectly) by ;; calc-find-selected-part. (defvar math-comp-sel-tag) @@ -1668,5 +1671,9 @@ (provide 'calccomp) +;; Local variables: +;; coding: utf-8 +;; End: + ;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78 ;;; calccomp.el ends here diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index b403b7043d8..7fcaab9da34 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -183,16 +183,25 @@ Only relevant if reminders are being displayed in a window." (defconst appt-buffer-name "*appt-buf*" "Name of the appointments buffer.") +;; TODO Turn this into an alist? It would be easier to add more +;; optional elements. +;; TODO There should be a way to set WARNTIME (and other properties) +;; from the diary-file. Implementing that would be a good reason +;; to change this to an alist. (defvar appt-time-msg-list nil "The list of appointments for today. Use `appt-add' and `appt-delete' to add and delete appointments. The original list is generated from today's `diary-entries-list', and can be regenerated using the function `appt-check'. -Each element of the generated list has the form (MINUTES STRING [FLAG]); where -MINUTES is the time in minutes of the appointment after midnight, and -STRING is the description of the appointment. -FLAG, if non-nil, says that the element was made with `appt-add' -so calling `appt-make-list' again should preserve it.") +Each element of the generated list has the form +\(MINUTES STRING [FLAG] [WARNTIME]) +where MINUTES is the time in minutes of the appointment after midnight, +and STRING is the description of the appointment. +FLAG and WARNTIME can only be present if the element was made +with `appt-add'. A non-nil FLAG indicates that the element was made +with `appt-add', so calling `appt-make-list' again should preserve it. +If WARNTIME is non-nil, it is an integer to use in place +of `appt-message-warning-time'.") (defconst appt-max-time (1- (* 24 60)) "11:59pm in minutes - number of minutes in a day minus 1.") @@ -313,7 +322,7 @@ displayed in a window: (zerop (mod prev-appt-display-count appt-display-interval)))) ;; Non-nil means only update the interval displayed in the mode line. (mode-line-only (unless full-check appt-now-displayed)) - now cur-comp-time appt-comp-time) + now cur-comp-time appt-comp-time appt-warn-time) (when (or full-check mode-line-only) (save-excursion ;; Convert current time to minutes after midnight (12.01am = 1). @@ -353,6 +362,8 @@ displayed in a window: ;; calculate the number of minutes until the appointment. (when (and appt-issue-message appt-time-msg-list) (setq appt-comp-time (caar (car appt-time-msg-list)) + appt-warn-time (or (nth 3 (car appt-time-msg-list)) + appt-message-warning-time) min-to-app (- appt-comp-time cur-comp-time)) (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) @@ -360,21 +371,21 @@ displayed in a window: (if appt-time-msg-list (setq appt-comp-time (caar (car appt-time-msg-list))))) ;; If we have an appointment between midnight and - ;; `appt-message-warning-time' minutes after midnight, we + ;; `appt-warn-time' minutes after midnight, we ;; must begin to issue a message before midnight. Midnight ;; is considered 0 minutes and 11:59pm is 1439 ;; minutes. Therefore we must recalculate the minutes to ;; appointment variable. It is equal to the number of ;; minutes before midnight plus the number of minutes after ;; midnight our appointment is. - (if (and (< appt-comp-time appt-message-warning-time) - (> (+ cur-comp-time appt-message-warning-time) + (if (and (< appt-comp-time appt-warn-time) + (> (+ cur-comp-time appt-warn-time) appt-max-time)) (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time) appt-comp-time))) ;; Issue warning if the appointment time is within ;; appt-message-warning time. - (when (and (<= min-to-app appt-message-warning-time) + (when (and (<= min-to-app appt-warn-time) (>= min-to-app 0)) (setq appt-now-displayed t appt-display-count (1+ prev-appt-display-count)) @@ -470,14 +481,28 @@ Usually just deletes the appointment buffer." "[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?") ;;;###autoload -(defun appt-add (new-appt-time new-appt-msg) - "Add an appointment for today at NEW-APPT-TIME with message NEW-APPT-MSG. -The time should be in either 24 hour format or am/pm format." - (interactive "sTime (hh:mm[am/pm]): \nsMessage: ") - (unless (string-match appt-time-regexp new-appt-time) +(defun appt-add (time msg &optional warntime) + "Add an appointment for today at TIME with message MSG. +The time should be in either 24 hour format or am/pm format. +Optional argument WARNTIME is an integer (or string) giving the number +of minutes before the appointment at which to start warning. +The default is `appt-message-warning-time'." + (interactive "sTime (hh:mm[am/pm]): \nsMessage: +sMinutes before the appointment to start warning: ") + (unless (string-match appt-time-regexp time) (error "Unacceptable time-string")) - (let ((time-msg (list (list (appt-convert-time new-appt-time)) - (concat new-appt-time " " new-appt-msg) t))) + (and (stringp warntime) + (setq warntime (unless (string-equal warntime "") + (string-to-number warntime)))) + (and warntime + (not (integerp warntime)) + (error "Argument WARNTIME must be an integer, or nil")) + (let ((time-msg (list (list (appt-convert-time time)) + (concat time " " msg) t))) + ;; It is presently non-sensical to have multiple warnings about + ;; the same appointment with just different delays, but it might + ;; not always be so. TODO + (if warntime (setq time-msg (append time-msg (list warntime)))) (unless (member time-msg appt-time-msg-list) (setq appt-time-msg-list (appt-sort-list (nconc appt-time-msg-list (list time-msg))))))) diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index bbddc1ff38c..46fb0869787 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -1,7 +1,7 @@ ;;; cal-tex.el --- calendar functions for printing calendars with LaTeX -;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Steve Fisk <fisk@bowdoin.edu> ;; Edward M. Reingold <reingold@cs.uiuc.edu> @@ -507,6 +507,7 @@ indicates a buffer position to use instead of point." (year (calendar-extract-year date)) (end-month month) (end-year year) + ;; FIXME -landscape sets cal-tex-which-days? (d1 (calendar-absolute-from-gregorian (list month 1 year))) (d2 (progn (calendar-increment-month end-month end-year (1- n)) @@ -515,8 +516,7 @@ indicates a buffer position to use instead of point." (calendar-last-day-of-month end-month end-year) end-year)))) (diary-list (if cal-tex-diary (cal-tex-list-diary-entries d1 d2))) - (holidays (if cal-tex-holidays (cal-tex-list-holidays d1 d2))) - other-month other-year) + (holidays (if cal-tex-holidays (cal-tex-list-holidays d1 d2)))) (cal-tex-insert-preamble (cal-tex-number-weeks month year n) nil "12pt") (if (> n 1) (cal-tex-cmd cal-tex-cal-multi-month) @@ -526,14 +526,12 @@ indicates a buffer position to use instead of point." (cal-tex-nl ".2cm") (cal-tex-insert-blank-days month year cal-tex-day-prefix) (dotimes (idummy n) - (setq other-month month - other-year year) (cal-tex-insert-days month year diary-list holidays cal-tex-day-prefix) - (when (= 6 (mod (calendar-absolute-from-gregorian - (list month - (calendar-last-day-of-month month year) - year)) - 7)) ; last day of month was Saturday + (when (= (calendar-week-end-day) + (calendar-day-of-week + (list month + (calendar-last-day-of-month month year) + year))) ; last day of month was last day of week (cal-tex-hfill) (cal-tex-nl)) (calendar-increment-month month year 1)) @@ -570,13 +568,14 @@ are included. Each day is formatted using format DAY-FORMAT." (defun cal-tex-insert-day-names () "Insert the names of the days at top of a monthly calendar." - (dotimes (i 7) - (if (memq i cal-tex-which-days) - (insert (format cal-tex-day-name-format - (cal-tex-LaTeXify-string - (aref calendar-day-name-array - (mod (+ calendar-week-start-day i) 7)))))) - (cal-tex-comment))) + (let (j) + (dotimes (i 7) + (if (memq (setq j (mod (+ calendar-week-start-day i) 7)) + cal-tex-which-days) + (insert (format cal-tex-day-name-format + (cal-tex-LaTeXify-string + (aref calendar-day-name-array j))))) + (cal-tex-comment)))) (defun cal-tex-insert-month-header (n month year end-month end-year) "Create a title for a calendar. @@ -603,7 +602,7 @@ blank, no days are inserted." calendar-week-start-day) 7))) (dotimes (i blank-days) - (if (memq i cal-tex-which-days) + (if (memq (mod (+ calendar-week-start-day i) 7) cal-tex-which-days) (insert (format day-format " " " ") "{}{}{}{}%\n")))))) (defun cal-tex-insert-blank-days-at-end (month year day-format) @@ -619,38 +618,37 @@ The entry is formatted using DAY-FORMAT." 7)) (i blank-days)) (while (<= (setq i (1+ i)) 6) - (if (memq i cal-tex-which-days) + (if (memq (mod (+ calendar-week-start-day i) 7) cal-tex-which-days) (insert (format day-format "" "") "{}{}{}{}%\n")))))) (defun cal-tex-first-blank-p (month year) "Determine if any days of the first week will be printed. Return t if there will there be any days of the first week printed in the calendar starting in MONTH YEAR." - (let (any-days the-saturday) ; the day of week of 1st Saturday - (dotimes (i 7) - (if (= 6 (calendar-day-of-week (list month (1+ i) year))) - (setq the-saturday (1+ i)))) - (dotimes (i the-saturday) - (if (memq (calendar-day-of-week (list month (1+ i) year)) - cal-tex-which-days) - (setq any-days t))) - any-days)) + ;; Check days 1-7 of the month, until we find the last day of the week. + (catch 'found + (let (dow) + (dotimes (i 7) + (if (memq (setq dow (calendar-day-of-week (list month (1+ i) year))) + cal-tex-which-days) + (throw 'found t) + (if (= dow (calendar-week-end-day)) (throw 'found nil))))))) (defun cal-tex-last-blank-p (month year) "Determine if any days of the last week will be printed. Return t if there will there be any days of the last week printed in the calendar starting in MONTH YEAR." - (let* ((last-day (calendar-last-day-of-month month year)) - (i (- last-day 7)) - any-days the-sunday) ; the day of week of last Sunday - (while (<= (setq i (1+ i)) last-day) - (if (zerop (calendar-day-of-week (list month i year))) - (setq the-sunday i))) - (setq i (1- the-sunday)) - (while (<= (setq i (1+ i)) last-day) - (if (memq (calendar-day-of-week (list month i year)) cal-tex-which-days) - (setq any-days t))) - any-days)) + ;; Check backwards from the last day of the month, until we find the + ;; start of the last week in the month. + (catch 'found + (let ((last-day (calendar-last-day-of-month month year)) + day dow) + (dotimes (i 7) + (if (memq (setq dow (calendar-day-of-week + (list month (- last-day i) year))) + cal-tex-which-days) + (throw 'found t) + (if (= dow calendar-week-start-day) (throw 'found nil))))))) (defun cal-tex-number-weeks (month year n) "Determine the number of weeks in a range of dates. @@ -1499,7 +1497,7 @@ Optional string COLSEP gives the column separation (default \"1mm\")." (- (calendar-day-of-week (list month 1 year)) calendar-week-start-day) 7)) - (last (calendar-last-day-of-month month year)) + (last( calendar-last-day-of-month month year)) (str (concat "\\def\\" name "{\\hbox to" width "{%\n" "\\vbox to" height "{%\n" "\\vfil \\hbox to" width "{%\n" diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index d92942d003f..418f740bb83 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -2226,6 +2226,10 @@ DATE is a list of the form (month day year). A negative year is interpreted as BC; -1 being 1 BC, and so on." (mod (calendar-absolute-from-gregorian date) 7)) +(defun calendar-week-end-day () + "Return the index (0 for Sunday, etc.) of the last day of the week." + (mod (+ calendar-week-start-day 6) 7)) + (defun calendar-unmark () "Delete all diary/holiday marks/highlighting from the calendar." (interactive) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index a07402aa031..03535abbb77 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -212,15 +212,15 @@ if nil they are ignored." (defcustom icalendar-uid-format "emacs%t%c" - "Format of unique ID code (UID) for each iCalendar object. -The following specifiers are available: + "Format of unique ID code (UID) for each iCalendar object. +The following specifiers are available: %c COUNTER, an integer value that is increased each time a uid is - generated. This may be necessary for systems which do not + generated. This may be necessary for systems which do not provide time-resolution finer than a second. %h HASH, a hash value of the diary entry, %s DTSTART, the start date (excluding time) of the diary entry, %t TIMESTAMP, a unique creation timestamp, -%u USERNAME, the user-login-name. +%u USERNAME, the variable `user-login-name'. For example, a value of \"%s_%h@mydomain.com\" will generate a UID code for each entry composed of the time of the event, a hash @@ -427,7 +427,7 @@ children." (goto-char (point-min)) (while (re-search-forward - "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?" + "\\([A-Za-z0-9-]+\\)=\\(\\([^;:]+\\)\\|\"\\([^\"]+\\)\"\\);?" nil t) (setq param-name (intern (match-string 1))) (setq param-value (match-string 2)) @@ -744,6 +744,20 @@ Note that this silently ignores seconds." ;; Error: -1)) +(defun icalendar--get-weekday-numbers (abbrevweekdays) + "Return the list of numbers for the comma-separated ABBREVWEEKDAYS." + (when abbrevweekdays + (let* ((num -1) + (weekday-alist (mapcar (lambda (day) + (progn + (setq num (1+ num)) + (cons (downcase day) num))) + icalendar--weekday-array))) + (delq nil + (mapcar (lambda (abbrevday) + (cdr (assoc abbrevday weekday-alist))) + (split-string (downcase abbrevweekdays) ",")))))) + (defun icalendar--get-weekday-abbrev (weekday) "Return the abbreviated WEEKDAY." (catch 'found @@ -912,21 +926,21 @@ current iCalendar object, as a string. Increase `icalendar--uid-count'. Returns the UID string." (let ((uid icalendar-uid-format)) - (setq uid (replace-regexp-in-string - "%c" + (setq uid (replace-regexp-in-string + "%c" (format "%d" icalendar--uid-count) uid t t)) (setq icalendar--uid-count (1+ icalendar--uid-count)) - (setq uid (replace-regexp-in-string + (setq uid (replace-regexp-in-string "%t" (format "%d%d%d" (car (current-time)) (cadr (current-time)) - (car (cddr (current-time)))) + (car (cddr (current-time)))) uid t t)) - (setq uid (replace-regexp-in-string - "%h" + (setq uid (replace-regexp-in-string + "%h" (format "%d" (abs (sxhash entry-full))) uid t t)) - (setq uid (replace-regexp-in-string + (setq uid (replace-regexp-in-string "%u" (or user-login-name "UNKNOWN_USER") uid t t)) (let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents) (substring contents (match-beginning 1) (match-end 1)) @@ -1008,7 +1022,7 @@ FExport diary data into iCalendar file: ") (if url (setq contents (concat contents "\nURL:" url)))) - (setq header (concat "\nBEGIN:VEVENT\nUID:" + (setq header (concat "\nBEGIN:VEVENT\nUID:" (icalendar--create-uid entry-full contents))) (setq result (concat result header contents "\nEND:VEVENT"))) ;; handle errors @@ -1126,7 +1140,7 @@ Returns an alist." (list "%u" (concat "\\(" icalendar-import-format-url "\\)??")))) ;; Need the \' regexp in order to detect multi-line items - (setq s (concat "\\`" + (setq s (concat "\\`" (icalendar--rris "%s" "\\(.*?\\)" s nil t) "\\'")) (if (string-match s summary-and-rest) @@ -2057,39 +2071,48 @@ END-T is the event's end time in diary format." )) ) (cond ((string-equal frequency "WEEKLY") - (if (not start-t) - (progn - ;; weekly and all-day - (icalendar--dmsg "weekly all-day") - (if until - (setq result - (format - (concat "%%%%(and " - "(diary-cyclic %d %s) " - "(diary-block %s %s))") - (* interval 7) - dtstart-conv - dtstart-conv - (if count until-1-conv until-conv) - )) - (setq result - (format "%%%%(and (diary-cyclic %d %s))" - (* interval 7) - dtstart-conv)))) - ;; weekly and not all-day - (let* ((byday (cadr (assoc 'BYDAY rrule-props))) - (weekday - (icalendar--get-weekday-number byday))) + (let* ((byday (cadr (assoc 'BYDAY rrule-props))) + (weekdays + (icalendar--get-weekday-numbers byday)) + (weekday-clause + (when (> (length weekdays) 1) + (format "(memq (calendar-day-of-week date) '%s) " + weekdays)))) + (if (not start-t) + (progn + ;; weekly and all-day + (icalendar--dmsg "weekly all-day") + (if until + (setq result + (format + (concat "%%%%(and " + "%s" + "(diary-block %s %s))") + (or weekday-clause + (format "(diary-cyclic %d %s) " + (* interval 7) + dtstart-conv)) + dtstart-conv + (if count until-1-conv until-conv) + )) + (setq result + (format "%%%%(and %s(diary-cyclic %d %s))" + (or weekday-clause "") + (if weekday-clause 1 (* interval 7)) + dtstart-conv)))) + ;; weekly and not all-day (icalendar--dmsg "weekly not-all-day") (if until (setq result (format (concat "%%%%(and " - "(diary-cyclic %d %s) " + "%s" "(diary-block %s %s)) " "%s%s%s") - (* interval 7) - dtstart-conv + (or weekday-clause + (format "(diary-cyclic %d %s) " + (* interval 7) + dtstart-conv)) dtstart-conv until-conv (or start-t "") @@ -2100,10 +2123,11 @@ END-T is the event's end time in diary format." ;; DTEND;VALUE=DATE-TIME:20030919T113000 (setq result (format - "%%%%(and (diary-cyclic %s %s)) %s%s%s" - (* interval 7) - dtstart-conv - (or start-t "") + "%%%%(and %s(diary-cyclic %d %s)) %s%s%s" + (or weekday-clause "") + (if weekday-clause 1 (* interval 7)) + dtstart-conv + (or start-t "") (if end-t "-" "") (or end-t ""))))))) ;; yearly ((string-equal frequency "YEARLY") diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index 85b0d75338d..95d634920b5 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -277,7 +277,7 @@ to prevent overload.") (defmethod object-write ((obj semanticdb-table)) "When writing a table, we have to make sure we deoverlay it first. -Restore the overlays after writting. +Restore the overlays after writing. Argument OBJ is the object to write." (when (semanticdb-live-p obj) (when (semanticdb-in-buffer-p obj) diff --git a/lisp/comint.el b/lisp/comint.el index b097baad189..128965fc11f 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -674,6 +674,9 @@ Entry to this mode runs the hooks on `comint-mode-hook'." (make-local-variable 'comint-process-echoes) (make-local-variable 'comint-file-name-chars) (make-local-variable 'comint-file-name-quote-list) + ;; dir tracking on remote files + (set (make-local-variable 'comint-file-name-prefix) + (or (file-remote-p default-directory) "")) (make-local-variable 'comint-accum-marker) (setq comint-accum-marker (make-marker)) (make-local-variable 'font-lock-defaults) @@ -701,7 +704,9 @@ a running process in that buffer, it is not restarted. Optional fourth arg STARTFILE is the name of a file, whose contents are sent to the process as its initial input. -If PROGRAM is a string, any more args are arguments to PROGRAM." +If PROGRAM is a string, any more args are arguments to PROGRAM. + +Returns the (possibly newly created) process buffer." (or (fboundp 'start-file-process) (error "Multi-processing is not supported for this system")) (setq buffer (get-buffer-create (or buffer (concat "*" name "*")))) @@ -725,7 +730,9 @@ a running process in that buffer, it is not restarted. Optional third arg STARTFILE is the name of a file, whose contents are sent to the process as its initial input. -If PROGRAM is a string, any more args are arguments to PROGRAM." +If PROGRAM is a string, any more args are arguments to PROGRAM. + +Returns the (possibly newly created) process buffer." (apply #'make-comint-in-buffer name nil program startfile switches)) ;;;###autoload diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index bb2f67422e3..9fa817bd102 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4404,10 +4404,10 @@ This function does not save the buffer." (unless (bolp) (princ "\n")) (princ "(custom-set-variables - ;; custom-set-variables was added by Custom. - ;; If you edit it by hand, you could mess it up, so be careful. - ;; Your init file should contain only one such instance. - ;; If there is more than one, they won't work right.\n") + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right.\n") (dolist (symbol saved-list) (let ((spec (car-safe (get symbol 'theme-value))) (value (get symbol 'saved-value)) @@ -4480,10 +4480,10 @@ This function does not save the buffer." (unless (bolp) (princ "\n")) (princ "(custom-set-faces - ;; custom-set-faces was added by Custom. - ;; If you edit it by hand, you could mess it up, so be careful. - ;; Your init file should contain only one such instance. - ;; If there is more than one, they won't work right.\n") + ;; custom-set-faces was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right.\n") (dolist (symbol saved-list) (let ((spec (car-safe (get symbol 'theme-face))) (value (get symbol 'saved-face)) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index bc48aa88cc5..ec05eb7c9b0 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -197,6 +197,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (help-char keyboard character) (help-event-list keyboard (repeat (sexp :format "%v"))) (menu-prompting menu boolean) + (select-active-regions killing + (choice (const :tag "always" t) + (const :tag "only shift-selection or mouse-drag" only) + (const :tag "off" nil)) + "24.1") (suggest-key-bindings keyboard (choice (const :tag "off" nil) (integer :tag "time" 2) (other :tag "on"))) @@ -345,6 +350,7 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Text" :value text) (const :tag "Both" :value both) (const :tag "Both-horiz" :value both-horiz) + (const :tag "Text-image-horiz" :value text-image-horiz) (const :tag "System default" :value nil)) "23.3") (tool-bar-max-label-size frames integer "23.3") @@ -357,6 +363,7 @@ since it could result in memory overflow and make Emacs crash." (x-gtk-show-hidden-files menu boolean "22.1") (x-gtk-file-dialog-help-text menu boolean "22.1") (x-gtk-whole-detached-tool-bar x boolean "22.1") + (x-gtk-use-system-tooltips tooltip boolean "23.3") ;; xterm.c (x-use-underline-position-properties display boolean "22.1") (x-underline-at-descent-line display boolean "22.1") diff --git a/lisp/custom.el b/lisp/custom.el index 726f70492b3..273c67dc66d 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -143,7 +143,9 @@ set to nil, as the value is no longer rogue." (when (get symbol 'force-value) (put symbol 'force-value nil)) (when doc - (put symbol 'variable-documentation doc)) + (if (keywordp doc) + (error "Doc string is missing") + (put symbol 'variable-documentation doc))) (let ((initialize 'custom-initialize-reset) (requests nil)) (unless (memq :group args) diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 3ba9d56af16..1127181dca2 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -377,7 +377,7 @@ With a prefix argument ARG, it searches all buffers accepted by the function pointed out by `dabbrev-friend-buffer-function' to find the completions. -If the prefix argument is 16 (which comes from \\[prefix-argument] \\[prefix-argument]), +If the prefix argument is 16 (which comes from \\[universal-argument] \\[universal-argument]), then it searches *all* buffers." (interactive "*P") (dabbrev--reset-global-variables) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 218f2a51d7f..93c69e0eea5 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -301,7 +301,7 @@ This function is semi-obsolete. Use `get-char-code-property'." (lambda (arg) (string (string-to-number arg 16))) parts " ")) - (concat info parts)))) + (concat info (if info " ") parts)))) (list "Decimal digit value" (nth 5 fields)) (list "Digit value" @@ -618,7 +618,7 @@ as well as widgets, buttons, overlays, and text properties." ,@(if (not eight-bit-p) (let ((unicodedata (describe-char-unicode-data char))) (if unicodedata - (cons (list "Unicode data" " ") unicodedata)))))) + (cons (list "Unicode data" "") unicodedata)))))) (setq max-width (apply 'max (mapcar (lambda (x) (if (cadr x) (length (car x)) 0)) item-list))) @@ -642,7 +642,8 @@ as well as widgets, buttons, overlays, and text properties." (window-width)) (insert "\n") (indent-to (1+ max-width))) - (insert " " clm))) + (unless (zerop (length clm)) + (insert " " clm)))) (insert "\n")))) (when overlays diff --git a/lisp/dired.el b/lisp/dired.el index 4fe804dd46d..fa3a15b97be 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1380,10 +1380,8 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map ">" 'dired-next-dirline) (define-key map "^" 'dired-up-directory) (define-key map " " 'dired-next-line) - (define-key map "\C-n" 'dired-next-line) - (define-key map "\C-p" 'dired-previous-line) - (define-key map [down] 'dired-next-line) - (define-key map [up] 'dired-previous-line) + (define-key map [remap next-line] 'dired-next-line) + (define-key map [remap previous-line] 'dired-previous-line) ;; hiding (define-key map "$" 'dired-hide-subdir) (define-key map "\M-$" 'dired-hide-all) @@ -1393,7 +1391,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map (kbd "M-s f C-s") 'dired-isearch-filenames) (define-key map (kbd "M-s f M-C-s") 'dired-isearch-filenames-regexp) ;; misc - (define-key map "\C-x\C-q" 'dired-toggle-read-only) + (define-key map [remap toggle-read-only] 'dired-toggle-read-only) (define-key map "?" 'dired-summary) (define-key map "\177" 'dired-unmark-backward) (define-key map [remap undo] 'dired-undo) @@ -2227,31 +2225,33 @@ You can then feed the file name(s) to other commands with \\[yank]." ;; Keeping Dired buffers in sync with the filesystem and with each other (defun dired-buffers-for-dir (dir &optional file) -;; Return a list of buffers that dired DIR (top level or in-situ subdir). +;; Return a list of buffers for DIR (top level or in-situ subdir). ;; If FILE is non-nil, include only those whose wildcard pattern (if any) ;; matches FILE. ;; The list is in reverse order of buffer creation, most recent last. ;; As a side effect, killed dired buffers for DIR are removed from ;; dired-buffers. (setq dir (file-name-as-directory dir)) - (let ((alist dired-buffers) result elt buf) - (while alist - (setq elt (car alist) - buf (cdr elt)) - (if (buffer-name buf) - (if (dired-in-this-tree dir (car elt)) - (with-current-buffer buf - (and (assoc dir dired-subdir-alist) - (or (null file) - (let ((wildcards - (file-name-nondirectory dired-directory))) - (or (= 0 (length wildcards)) - (string-match (dired-glob-regexp wildcards) - file)))) - (setq result (cons buf result))))) - ;; else buffer is killed - clean up: + (let (result buf) + (dolist (elt dired-buffers) + (setq buf (cdr elt)) + (cond + ((null (buffer-name buf)) + ;; Buffer is killed - clean up: (setq dired-buffers (delq elt dired-buffers))) - (setq alist (cdr alist))) + ((dired-in-this-tree dir (car elt)) + (with-current-buffer buf + (and (assoc dir dired-subdir-alist) + (or (null file) + (if (stringp dired-directory) + (let ((wildcards (file-name-nondirectory + dired-directory))) + (or (= 0 (length wildcards)) + (string-match (dired-glob-regexp wildcards) + file))) + (member (expand-file-name file dir) + (cdr dired-directory)))) + (setq result (cons buf result))))))) result)) (defun dired-glob-regexp (pattern) @@ -2765,17 +2765,19 @@ name, or the marker and a count of marked files." (fit-window-to-buffer (get-buffer-window buf) nil 1))) (defcustom dired-no-confirm nil - "A list of symbols for commands Dired should not confirm. + "A list of symbols for commands Dired should not confirm, or t. Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress', `copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink', -`touch' and `uncompress'." +`touch' and `uncompress'. +If t, confirmation is never needed." :group 'dired - :type '(set (const byte-compile) (const chgrp) - (const chmod) (const chown) (const compress) - (const copy) (const delete) (const hardlink) - (const load) (const move) (const print) - (const shell) (const symlink) (const touch) - (const uncompress))) + :type '(choice (const :tag "Confirmation never needed" t) + (set (const byte-compile) (const chgrp) + (const chmod) (const chown) (const compress) + (const copy) (const delete) (const hardlink) + (const load) (const move) (const print) + (const shell) (const symlink) (const touch) + (const uncompress)))) (defun dired-mark-pop-up (bufname op-symbol files function &rest args) "Return FUNCTION's result on ARGS after showing which files are marked. diff --git a/lisp/dnd.el b/lisp/dnd.el index c064aa9897a..d7cbb641bab 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -1,8 +1,9 @@ -;;; dnd.el --- drag and drop support. +;;; dnd.el --- drag and drop support. -*- coding: utf-8 -*- -;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. -;; Author: Jan Dj,Ad(Brv <jan.h.d@swipnet.se> +;; Author: Jan Djärv <jan.h.d@swipnet.se> ;; Maintainer: FSF ;; Keywords: window, drag, drop diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 528d5979ce1..4f183f4b9dc 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1349,8 +1349,8 @@ See the command `doc-view-mode' for more information on this mode." ;;;; Bookmark integration -(declare-function bookmark-make-record-default "bookmark" - (&optional point-only)) +(declare-function bookmark-make-record-default + "bookmark" (&optional no-file no-context posn)) (declare-function bookmark-prop-get "bookmark" (bookmark prop)) (declare-function bookmark-default-handler "bookmark" (bmk)) diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el index 37a95999562..790aaf7170e 100644 --- a/lisp/dynamic-setting.el +++ b/lisp/dynamic-setting.el @@ -65,7 +65,6 @@ current form for the frame (i.e. hinting or somesuch changed)." frame-font))) (if font-to-set (progn - (message "setting %s" font-to-set) (set-frame-parameter f 'font-parameter font-to-set) (set-face-attribute 'default f :width 'normal @@ -97,6 +96,11 @@ Changes can be ((eq type 'font-render) (font-setting-change-default-font display-name nil)) + ;; This is a bit heavy, ideally we would just clear faces + ;; on the affected display, and perhaps only the relevant + ;; faces. Oh well. + ((eq type 'theme-name) (clear-face-cache)) + ((eq type 'tool-bar-style) (force-mode-line-update t))))) (define-key special-event-map [config-changed-event] diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 020729e2c76..5aea033fc78 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -354,7 +354,7 @@ Changes to files in this list are not listed.") ;; No longer distributed. ;;; ("Viktor Dukhovni" :wrote "unexsunos4.c") ("Paul Eggert" :wrote "rcs2log" "vcdiff") - ("Fred Fish" :changed "unexec.c") + ("Fred Fish" :changed "unexcoff.c") ;; No longer distributed. ;;; ("Tim Fleehart" :wrote "makefile.nt") ("Keith Gabryelski" :wrote "hexl.c") @@ -377,13 +377,13 @@ Changes to files in this list are not listed.") "indent.c" "search.c" "xdisp.c" "region-cache.c" "region-cache.h") ;; ibmrt.h, ibmrt-aix.h no longer distributed. ("International Business Machines" :changed "emacs.c" "fileio.c" - "process.c" "sysdep.c" "unexec.c") + "process.c" "sysdep.c" "unexcoff.c") ;; No longer distributed. ;;; ("Ishikawa Chiaki" :changed "aviion.h" "dgux.h") ;; ymakefile no longer distributed. ("Michael K. Johnson" :changed "configure.in" "emacs.c" "intel386.h" "mem-limits.h" "process.c" "template.h" "sysdep.c" "syssignal.h" - "systty.h" "unexec.c" "linux.h") + "systty.h" "unexcoff.c" "linux.h") ;; No longer distributed. ;;; ("Kyle Jones" :wrote "mldrag.el") ("Henry Kautz" :wrote "bib-mode.el") @@ -408,7 +408,7 @@ Changes to files in this list are not listed.") "rmail.el" "rmailedit.el" "rmailkwd.el" "rmailmsc.el" "rmailout.el" "rmailsum.el" "scribe.el" ;; It was :wrote for xmenu.c, but it has been rewritten since. - "server.el" "lisp.h" "sysdep.c" "unexec.c" "xmenu.c") + "server.el" "lisp.h" "sysdep.c" "unexcoff.c" "xmenu.c") ("Niall Mansfield" :changed "etags.c") ("Brian Marick" :cowrote "hideif.el") ("Marko Kohtala" :changed "info.el") @@ -463,9 +463,9 @@ Changes to files in this list are not listed.") ("Kayvan Sylvan" :changed "supercite.el") ;; No longer distributed: emacsserver.c, tcp.c. ("Spencer Thomas" :changed "emacsclient.c" "server.el" - "dabbrev.el" "unexec.c" "gnus.texi") + "dabbrev.el" "unexcoff.c" "gnus.texi") ("Jonathan Vail" :changed "vc.el") - ("James Van Artsdalen" :changed "usg5-4.h" "unexec.c") + ("James Van Artsdalen" :changed "usg5-4.h" "unexcoff.c") ;; No longer distributed: src/makefile.nt, lisp/makefile.nt ;; winnt.el renamed to w32-fns.el; nt.[ch] to w32.[ch]; ;; ntheap.[ch] to w32heap.[ch]; ntinevt.c to w32inevt.c; diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 325c7b1479f..b14c879fcf7 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -282,7 +282,7 @@ Not documented ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* -;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "fbeedbf769c72fee9b4e0671957c1077") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "36cafd5054969b5bb0b1ce6a21605fed") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 444178edb0c..694a06f8338 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -438,7 +438,7 @@ It is a list of elements of the form either: ;;;###autoload (defmacro destructuring-bind (args expr &rest body) (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) - (bind-defs nil) (bind-block 'cl-none)) + (bind-defs nil) (bind-block 'cl-none) (bind-enquote nil)) (cl-do-arglist (or args '(&aux)) expr) (append '(progn) bind-inits (list (nconc (list 'let* (nreverse bind-lets)) diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 6f7a43af844..43eb61b0bee 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -158,13 +158,15 @@ When this is `function', only ask when called non-interactively." (unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3)) (substring copyright-current-year -2)) (if (or noquery - ;; Fixes some point-moving oddness (bug#2209). - (save-excursion - (y-or-n-p (if replace - (concat "Replace copyright year(s) by " - copyright-current-year "? ") - (concat "Add " copyright-current-year - " to copyright? "))))) + (save-window-excursion + (switch-to-buffer (current-buffer)) + ;; Fixes some point-moving oddness (bug#2209). + (save-excursion + (y-or-n-p (if replace + (concat "Replace copyright year(s) by " + copyright-current-year "? ") + (concat "Add " copyright-current-year + " to copyright? ")))))) (if replace (replace-match copyright-current-year t t nil 3) (let ((size (save-excursion (skip-chars-backward "0-9")))) @@ -224,8 +226,10 @@ version \\([0-9]+\\), or (at" (string-to-number copyright-current-gpl-version)) (or noquery (save-match-data - (y-or-n-p (format "Replace GPL version by %s? " - copyright-current-gpl-version)))) + (save-window-excursion + (switch-to-buffer (current-buffer)) + (y-or-n-p (format "Replace GPL version by %s? " + copyright-current-gpl-version))))) (progn (if (match-end 2) ;; Esperanto bilingual comment in two-column.el diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 8bf20b0ccef..43fb5762647 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -885,17 +885,12 @@ already is one.)" (edebug-storing-offsets (1- (point)) 'quote) (edebug-read-storing-offsets stream))) -(defvar edebug-read-backquote-level 0 - "If non-zero, we're in a new-style backquote. -It should never be negative. This controls how we read comma constructs.") - (defun edebug-read-backquote (stream) ;; Turn `thing into (\` thing) (forward-char 1) (list (edebug-storing-offsets (1- (point)) '\`) - (let ((edebug-read-backquote-level (1+ edebug-read-backquote-level))) - (edebug-read-storing-offsets stream)))) + (edebug-read-storing-offsets stream))) (defun edebug-read-comma (stream) ;; Turn ,thing into (\, thing). Handle ,@ and ,. also. @@ -910,12 +905,9 @@ It should never be negative. This controls how we read comma constructs.") (forward-char 1))) ;; Generate the same structure of offsets we would have ;; if the resulting list appeared verbatim in the input text. - (if (zerop edebug-read-backquote-level) - (edebug-storing-offsets opoint symbol) - (list - (edebug-storing-offsets opoint symbol) - (let ((edebug-read-backquote-level (1- edebug-read-backquote-level))) - (edebug-read-storing-offsets stream))))))) + (list + (edebug-storing-offsets opoint symbol) + (edebug-read-storing-offsets stream))))) (defun edebug-read-function (stream) ;; Turn #'thing into (function thing) @@ -937,17 +929,7 @@ It should never be negative. This controls how we read comma constructs.") (prog1 (let ((elements)) (while (not (memq (edebug-next-token-class) '(rparen dot))) - (if (and (eq (edebug-next-token-class) 'backquote) - (null elements) - (zerop edebug-read-backquote-level)) - (progn - ;; Old style backquote. - (forward-char 1) ; Skip backquote. - ;; Call edebug-storing-offsets here so that we - ;; produce the same offsets we would have had - ;; if the backquote were an ordinary symbol. - (push (edebug-storing-offsets (1- (point)) '\`) elements)) - (push (edebug-read-storing-offsets stream) elements))) + (push (edebug-read-storing-offsets stream) elements)) (setq elements (nreverse elements)) (if (eq 'dot (edebug-next-token-class)) (let (dotted-form) @@ -4455,7 +4437,7 @@ With prefix argument, make it a temporary breakpoint." (add-hook 'cl-load-hook (function (lambda () (require 'cl-specs))))) -;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu +;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu (if (featurep 'cl-read) (add-hook 'edebug-setup-hook (function (lambda () (require 'edebug-cl-read)))) @@ -4466,8 +4448,8 @@ With prefix argument, make it a temporary breakpoint." ;;; Finalize Loading -;;; Finally, hook edebug into the rest of Emacs. -;;; There are probably some other things that could go here. +;; Finally, hook edebug into the rest of Emacs. +;; There are probably some other things that could go here. ;; Install edebug read and eval functions. (edebug-install-read-eval-functions) diff --git a/lisp/emacs-lisp/find-gc.el b/lisp/emacs-lisp/find-gc.el index 3ca1df466b9..49d3a7075d4 100644 --- a/lisp/emacs-lisp/find-gc.el +++ b/lisp/emacs-lisp/find-gc.el @@ -60,7 +60,7 @@ Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).") "indent.c" "search.c" "regex.c" "undo.c" "alloc.c" "data.c" "doc.c" "editfns.c" "callint.c" "eval.c" "fns.c" "print.c" "lread.c" - "abbrev.c" "syntax.c" "unexec.c" + "abbrev.c" "syntax.c" "unexcoff.c" "bytecode.c" "process.c" "callproc.c" "doprnt.c" "x11term.c" "x11fns.c")) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 02477baf74f..21a9f80fa90 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -85,7 +85,7 @@ (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) (modify-syntax-entry ?\[ "_ " table) (modify-syntax-entry ?\] "_ " table) - (modify-syntax-entry ?# "' 14b" table) + (modify-syntax-entry ?# "' 14" table) (modify-syntax-entry ?| "\" 23bn" table) table) "Syntax table used in `lisp-mode'.") diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 364e3540703..876b9a468ac 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -134,7 +134,7 @@ Assumes the caller has bound `macroexpand-all-environment'." (maybe-cons fun (maybe-cons (macroexpand-all-forms (cadr form) 2) nil - (cadr form)) + (cdr form)) form) form)) ((memq fun '(let let*)) @@ -146,7 +146,7 @@ Assumes the caller has bound `macroexpand-all-environment'." ((eq fun 'quote) form) ((and (consp fun) (eq (car fun) 'lambda)) - ;; embedded lambda + ;; Embedded lambda in function position. (maybe-cons (macroexpand-all-forms fun 2) (macroexpand-all-forms (cdr form)) form)) diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el new file mode 100644 index 00000000000..b93950049e0 --- /dev/null +++ b/lisp/emacs-lisp/package-x.el @@ -0,0 +1,226 @@ +;;; package-x.el --- Package extras + +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +;; Author: Tom Tromey <tromey@redhat.com> +;; Created: 10 Mar 2007 +;; Version: 0.9 +;; Keywords: tools + +;; 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, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file currently contains parts of the package system most +;; people won't need, such as package uploading. + +;;; Code: + +(require 'package) +(defvar gnus-article-buffer) + +;; Note that this only works if you have the password, which you +;; probably don't :-). +(defvar package-archive-upload-base nil + "Base location for uploading to package archive.") + +(defun package--encode (string) + "Encode a string by replacing some characters with XML entities." + ;; We need a special case for translating "&" to "&". + (let ((index)) + (while (setq index (string-match "[&]" string index)) + (setq string (replace-match "&" t nil string)) + (setq index (1+ index)))) + (while (string-match "[<]" string) + (setq string (replace-match "<" t nil string))) + (while (string-match "[>]" string) + (setq string (replace-match ">" t nil string))) + (while (string-match "[']" string) + (setq string (replace-match "'" t nil string))) + (while (string-match "[\"]" string) + (setq string (replace-match """ t nil string))) + string) + +(defun package--make-rss-entry (title text archive-url) + (let ((date-string (format-time-string "%a, %d %B %Y %T %z"))) + (concat "<item>\n" + "<title>" (package--encode title) "</title>\n" + ;; FIXME: should have a link in the web page. + "<link>" archive-url "news.html</link>\n" + "<description>" (package--encode text) "</description>\n" + "<pubDate>" date-string "</pubDate>\n" + "</item>\n"))) + +(defun package--make-html-entry (title text) + (concat "<li> " (format-time-string "%B %e") " - " + title " - " (package--encode text) + " </li>\n")) + +(defun package--update-file (file location text) + (save-excursion + (let ((old-buffer (find-buffer-visiting file))) + (with-current-buffer (let ((find-file-visit-truename t)) + (or old-buffer (find-file-noselect file))) + (goto-char (point-min)) + (search-forward location) + (forward-line) + (insert text) + (let ((file-precious-flag t)) + (save-buffer)) + (unless old-buffer + (kill-buffer (current-buffer))))))) + +(defun package-maint-add-news-item (title description archive-url) + "Add a news item to the ELPA web pages. +TITLE is the title of the news item. +DESCRIPTION is the text of the news item. +You need administrative access to ELPA to use this." + (interactive "sTitle: \nsText: ") + (package--update-file (concat package-archive-upload-base "elpa.rss") + "<description>" + (package--make-rss-entry title description archive-url)) + (package--update-file (concat package-archive-upload-base "news.html") + "New entries go here" + (package--make-html-entry title description))) + +(defun package--update-news (package version description archive-url) + "Update the ELPA web pages when a package is uploaded." + (package-maint-add-news-item (concat package " version " version) + description + archive-url)) + +(defun package-upload-buffer-internal (pkg-info extension &optional archive-url) + "Upload a package whose contents are in the current buffer. +PKG-INFO is the package info, see `package-buffer-info'. +EXTENSION is the file extension, a string. It can be either +\"el\" or \"tar\". + +Optional arg ARCHIVE-URL is the URL of the destination archive. +If nil, the \"gnu\" archive is used." + (unless archive-url + (or (setq archive-url (cdr (assoc "gnu" package-archives))) + (error "No destination URL"))) + (save-excursion + (save-restriction + (let* ((file-type (cond + ((equal extension "el") 'single) + ((equal extension "tar") 'tar) + (t (error "Unknown extension `%s'" extension)))) + (file-name (aref pkg-info 0)) + (pkg-name (intern file-name)) + (requires (aref pkg-info 1)) + (desc (if (string= (aref pkg-info 2) "") + (read-string "Description of package: ") + (aref pkg-info 2))) + (pkg-version (aref pkg-info 3)) + (commentary (aref pkg-info 4)) + (split-version (version-to-list pkg-version)) + (pkg-buffer (current-buffer)) + + ;; Download latest archive-contents. + (buffer (url-retrieve-synchronously + (concat archive-url "archive-contents")))) + + ;; Parse archive-contents. + (set-buffer buffer) + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (delete-region (point-min) (point)) + (let ((contents (package-read-from-string + (buffer-substring-no-properties (point-min) + (point-max)))) + (new-desc (vector split-version requires desc file-type))) + (if (> (car contents) package-archive-version) + (error "Unrecognized archive version %d" (car contents))) + (let ((elt (assq pkg-name (cdr contents)))) + (if elt + (if (version-list-<= split-version + (package-desc-vers (cdr elt))) + (error "New package has smaller version: %s" pkg-version) + (setcdr elt new-desc)) + (setq contents (cons (car contents) + (cons (cons pkg-name new-desc) + (cdr contents)))))) + + ;; Now CONTENTS is the updated archive contents. Upload + ;; this and the package itself. For now we assume ELPA is + ;; writable via file primitives. + (let ((print-level nil) + (print-length nil)) + (write-region (concat (pp-to-string contents) "\n") + nil + (concat package-archive-upload-base + "archive-contents"))) + + ;; If there is a commentary section, write it. + (when commentary + (write-region commentary nil + (concat package-archive-upload-base + (symbol-name pkg-name) "-readme.txt"))) + + (set-buffer pkg-buffer) + (kill-buffer buffer) + (write-region (point-min) (point-max) + (concat package-archive-upload-base + file-name "-" pkg-version + "." extension) + nil nil nil 'excl) + + ;; Write a news entry. + (package--update-news (concat file-name "." extension) + pkg-version desc archive-url) + + ;; special-case "package": write a second copy so that the + ;; installer can easily find the latest version. + (if (string= file-name "package") + (write-region (point-min) (point-max) + (concat package-archive-upload-base + file-name "." extension) + nil nil nil 'ask))))))) + +(defun package-upload-buffer () + "Upload a single .el file to ELPA from the current buffer." + (interactive) + (save-excursion + (save-restriction + ;; Find the package in this buffer. + (let ((pkg-info (package-buffer-info))) + (package-upload-buffer-internal pkg-info "el"))))) + +(defun package-upload-file (file) + (interactive "fPackage file name: ") + (with-temp-buffer + (insert-file-contents-literally file) + (let ((info (cond + ((string-match "\\.tar$" file) (package-tar-file-info file)) + ((string-match "\\.el$" file) (package-buffer-info)) + (t (error "Unrecognized extension `%s'" + (file-name-extension file)))))) + (package-upload-buffer-internal info (file-name-extension file))))) + +(defun package-gnus-summary-upload () + "Upload a package contained in the current *Article* buffer. +This should be invoked from the gnus *Summary* buffer." + (interactive) + (with-current-buffer gnus-article-buffer + (package-upload-buffer))) + +(provide 'package-x) + +;;; package.el ends here diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el new file mode 100644 index 00000000000..2e8c7dc7d4f --- /dev/null +++ b/lisp/emacs-lisp/package.el @@ -0,0 +1,1569 @@ +;;; package.el --- Simple package system for Emacs + +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +;; Author: Tom Tromey <tromey@redhat.com> +;; Created: 10 Mar 2007 +;; Version: 0.9 +;; Keywords: tools + +;; 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, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Change Log: + +;; 2 Apr 2007 - now using ChangeLog file +;; 15 Mar 2007 - updated documentation +;; 14 Mar 2007 - Changed how obsolete packages are handled +;; 13 Mar 2007 - Wrote package-install-from-buffer +;; 12 Mar 2007 - Wrote package-menu mode + +;;; Commentary: + +;; The idea behind package.el is to be able to download packages and +;; install them. Packages are versioned and have versioned +;; dependencies. Furthermore, this supports built-in packages which +;; may or may not be newer than user-specified packages. This makes +;; it possible to upgrade Emacs and automatically disable packages +;; which have moved from external to core. (Note though that we don't +;; currently register any of these, so this feature does not actually +;; work.) + +;; A package is described by its name and version. The distribution +;; format is either a tar file or a single .el file. + +;; A tar file should be named "NAME-VERSION.tar". The tar file must +;; unpack into a directory named after the package and version: +;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el" +;; which consists of a call to define-package. It may also contain a +;; "dir" file and the info files it references. + +;; A .el file is named "NAME-VERSION.el" in the remote archive, but is +;; installed as simply "NAME.el" in a directory named "NAME-VERSION". + +;; The downloader downloads all dependent packages. By default, +;; packages come from the official GNU sources, but others may be +;; added by customizing the `package-archives' alist. Packages get +;; byte-compiled at install time. + +;; At activation time we will set up the load-path and the info path, +;; and we will load the package's autoloads. If a package's +;; dependencies are not available, we will not activate that package. + +;; Conceptually a package has multiple state transitions: +;; +;; * Download. Fetching the package from ELPA. +;; * Install. Untar the package, or write the .el file, into +;; ~/.emacs.d/elpa/ directory. +;; * Byte compile. Currently this phase is done during install, +;; but we may change this. +;; * Activate. Evaluate the autoloads for the package to make it +;; available to the user. +;; * Load. Actually load the package and run some code from it. + +;; Other external functions you may want to use: +;; +;; M-x package-list-packages +;; Enters a mode similar to buffer-menu which lets you manage +;; packages. You can choose packages for install (mark with "i", +;; then "x" to execute) or deletion (not implemented yet), and you +;; can see what packages are available. This will automatically +;; fetch the latest list of packages from ELPA. +;; +;; M-x package-list-packages-no-fetch +;; Like package-list-packages, but does not automatically fetch the +;; new list of packages. +;; +;; M-x package-install-from-buffer +;; Install a package consisting of a single .el file that appears +;; in the current buffer. This only works for packages which +;; define a Version header properly; package.el also supports the +;; extension headers Package-Version (in case Version is an RCS id +;; or similar), and Package-Requires (if the package requires other +;; packages). +;; +;; M-x package-install-file +;; Install a package from the indicated file. The package can be +;; either a tar file or a .el file. A tar file must contain an +;; appropriately-named "-pkg.el" file; a .el file must be properly +;; formatted as with package-install-from-buffer. + +;;; Thanks: +;;; (sorted by sort-lines): + +;; Jim Blandy <jimb@red-bean.com> +;; Karl Fogel <kfogel@red-bean.com> +;; Kevin Ryde <user42@zip.com.au> +;; Lawrence Mitchell +;; Michael Olson <mwolson@member.fsf.org> +;; Sebastian Tennant <sebyte@smolny.plus.com> +;; Stefan Monnier <monnier@iro.umontreal.ca> +;; Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Phil Hagelberg <phil@hagelb.org> + +;;; ToDo: + +;; - putting info dirs at the start of the info path means +;; users see a weird ordering of categories. OTOH we want to +;; override later entries. maybe emacs needs to enforce +;; the standard layout? +;; - put bytecode in a separate directory tree +;; - perhaps give users a way to recompile their bytecode +;; or do it automatically when emacs changes +;; - give users a way to know whether a package is installed ok +;; - give users a way to view a package's documentation when it +;; only appears in the .el +;; - use/extend checkdoc so people can tell if their package will work +;; - "installed" instead of a blank in the status column +;; - tramp needs its files to be compiled in a certain order. +;; how to handle this? fix tramp? +;; - on emacs 21 we don't kill the -autoloads.el buffer. what about 22? +;; - maybe we need separate .elc directories for various emacs versions +;; and also emacs-vs-xemacs. That way conditional compilation can +;; work. But would this break anything? +;; - should store the package's keywords in archive-contents, then +;; let the users filter the package-menu by keyword. See +;; finder-by-keyword. (We could also let people view the +;; Commentary, but it isn't clear how useful this is.) +;; - William Xu suggests being able to open a package file without +;; installing it +;; - Interface with desktop.el so that restarting after an install +;; works properly +;; - Implement M-x package-upgrade, to upgrade any/all existing packages +;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info +;; ... except maybe lisp? +;; - It may be nice to have a macro that expands to the package's +;; private data dir, aka ".../etc". Or, maybe data-directory +;; needs to be a list (though this would be less nice) +;; a few packages want this, eg sokoban +;; - package menu needs: +;; ability to know which packages are built-in & thus not deletable +;; it can sometimes print odd results, like 0.3 available but 0.4 active +;; why is that? +;; - Allow multiple versions on the server...? +;; [ why bother? ] +;; - Don't install a package which will invalidate dependencies overall +;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5)) +;; [ currently thinking, why bother.. KISS ] +;; - Allow optional package dependencies +;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb +;; and just don't compile to add to load path ...? +;; - Have a list of archive URLs? [ maybe there's no point ] +;; - David Kastrup pointed out on the xemacs list that for GPL it +;; is friendlier to ship the source tree. We could "support" that +;; by just having a "src" subdir in the package. This isn't ideal +;; but it probably is not worth trying to support random source +;; tree layouts, build schemes, etc. +;; - Our treatment of the info path is somewhat bogus +;; - perhaps have an "unstable" tree in ELPA as well as a stable one + +;;; Code: + +(defgroup package nil + "Manager for Emacs Lisp packages." + :group 'applications + :version "24.1") + +;;;###autoload +(defcustom package-enable-at-startup t + "Whether to activate installed packages when Emacs starts. +If non-nil, packages are activated after reading the init file +and before `after-init-hook'. Activation is not done if +`user-init-file' is nil (e.g. Emacs was started with \"-q\"). + +Even if the value is nil, you can type \\[package-initialize] to +activate the package system at any time." + :type 'boolean + :group 'package + :version "24.1") + +(defcustom package-load-list '(all) + "List of packages for `package-initialize' to load. +Each element in this list should be a list (NAME VERSION), or the +symbol `all'. The symbol `all' says to load the latest installed +versions of all packages not specified by other elements. + +For an element (NAME VERSION), NAME is a package name (a symbol). +VERSION should be t, a string, or nil. +If VERSION is t, all versions are loaded, though obsolete ones + will be put in `package-obsolete-alist' and not activated. +If VERSION is a string, only that version is ever loaded. + Any other version, even if newer, is silently ignored. + Hence, the package is \"held\" at that version. +If VERSION is nil, the package is not loaded (it is \"disabled\")." + :type '(repeat symbol) + :risky t + :group 'package + :version "24.1") + +(defvar Info-directory-list) +(declare-function info-initialize "info" ()) +(declare-function url-http-parse-response "url-http" ()) +(declare-function lm-header "lisp-mnt" (header)) +(declare-function lm-commentary "lisp-mnt" (&optional file)) +(declare-function dired-delete-file "dired" (file &optional recursive trash)) + +(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/")) + "An alist of archives from which to fetch. +The default value points to the GNU Emacs package repository. +Each element has the form (ID . URL), where ID is an identifier +string for an archive and URL is a http: URL (a string)." + :type '(alist :key-type (string :tag "Archive name") + :value-type (string :tag "Archive URL")) + :risky t + :group 'package + :version "24.1") + +(defconst package-archive-version 1 + "Version number of the package archive understood by this file. +Lower version numbers than this will probably be understood as well.") + +(defconst package-el-version "1.0" + "Version of package.el.") + +;; We don't prime the cache since it tends to get out of date. +(defvar package-archive-contents nil + "Cache of the contents of the Emacs Lisp Package Archive. +This is an alist mapping package names (symbols) to package +descriptor vectors. These are like the vectors for `package-alist' +but have extra entries: one which is 'tar for tar packages and +'single for single-file packages, and one which is the name of +the archive from which it came.") +(put 'package-archive-contents 'risky-local-variable t) + +(defcustom package-user-dir (locate-user-emacs-file "elpa") + "Directory containing the user's Emacs Lisp packages. +The directory name should be absolute. +Apart from this directory, Emacs also looks for system-wide +packages in `package-directory-list'." + :type 'directory + :risky t + :group 'package + :version "24.1") + +(defcustom package-directory-list + ;; Defaults are subdirs named "elpa" in the site-lisp dirs. + (let (result) + (dolist (f load-path) + (if (equal (file-name-nondirectory f) "site-lisp") + (push (expand-file-name "elpa" f) result))) + (nreverse result)) + "List of additional directories containing Emacs Lisp packages. +Each directory name should be absolute. + +These directories contain packages intended for system-wide; in +contrast, `package-user-dir' contains packages for personal use." + :type '(repeat directory) + :risky t + :group 'package + :version "24.1") + +(defconst package--builtins-base + ;; We use package-version split here to make sure to pick up the + ;; minor version. + `((emacs . [,(version-to-list emacs-version) nil + "GNU Emacs"]) + (package . [,(version-to-list package-el-version) + nil "Simple package system for GNU Emacs"])) + "Packages which are always built-in.") + +(defvar package--builtins + (delq nil + (append + package--builtins-base + (if (>= emacs-major-version 22) + ;; FIXME: emacs 22 includes tramp, rcirc, maybe + ;; other things... + '((erc . [(5 2) nil "Internet Relay Chat client"]) + ;; The external URL is version 1.15, so make sure the + ;; built-in one looks newer. + (url . [(1 16) nil "URL handling libary"]))) + (if (>= emacs-major-version 23) + '(;; Strangely, nxml-version is missing in Emacs 23. + ;; We pick the merge date as the version. + (nxml . [(20071123) nil "Major mode for XML documents"]) + (bubbles . [(0 5) nil "A puzzle game"]))))) + "Alist of all built-in packages. +Maps the package name to a vector [VERSION REQS DOCSTRING].") +(put 'package--builtins 'risky-local-variable t) + +(defvar package-alist package--builtins + "Alist of all packages available for activation. +This maps the package name to a vector [VERSION REQS DOCSTRING]. + +The value is generated by `package-load-descriptor', usually +called via `package-initialize'. For user customizations of +which packages to load/activate, see `package-load-list'.") +(put 'package-archive-contents 'risky-local-variable t) + +(defvar package-activated-list + (mapcar #'car package-alist) + "List of the names of currently activated packages.") +(put 'package-activated-list 'risky-local-variable t) + +(defvar package-obsolete-alist nil + "Representation of obsolete packages. +Like `package-alist', but maps package name to a second alist. +The inner alist is keyed by version.") +(put 'package-obsolete-alist 'risky-local-variable t) + +(defconst package-subdirectory-regexp + "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" + "Regular expression matching the name of a package subdirectory. +The first subexpression is the package name. +The second subexpression is the version string.") + +(defun package-version-join (l) + "Turn a list of version numbers into a version string." + (mapconcat 'int-to-string l ".")) + +(defun package-strip-version (dirname) + "Strip the version from a combined package name and version. +E.g., if given \"quux-23.0\", will return \"quux\"" + (if (string-match package-subdirectory-regexp dirname) + (match-string 1 dirname))) + +(defun package-load-descriptor (dir package) + "Load the description file in directory DIR for package PACKAGE." + (let* ((pkg-dir (expand-file-name package dir)) + (pkg-file (expand-file-name + (concat (package-strip-version package) "-pkg") + pkg-dir))) + (when (and (file-directory-p pkg-dir) + (file-exists-p (concat pkg-file ".el"))) + (load pkg-file nil t)))) + +(defun package-load-all-descriptors () + "Load descriptors for installed Emacs Lisp packages. +This looks for package subdirectories in `package-user-dir' and +`package-directory-list'. The variable `package-load-list' +controls which package subdirectories may be loaded. + +In each valid package subdirectory, this function loads the +description file containing a call to `define-package', which +updates `package-alist' and `package-obsolete-alist'." + (let ((all (memq 'all package-load-list)) + name version force) + (dolist (dir (cons package-user-dir package-directory-list)) + (when (file-directory-p dir) + (dolist (subdir (directory-files dir)) + (when (and (file-directory-p (expand-file-name subdir dir)) + (string-match package-subdirectory-regexp subdir)) + (setq name (intern (match-string 1 subdir)) + version (match-string 2 subdir) + force (assq name package-load-list)) + (when (cond + ((null force) + all) ; not in package-load-list + ((null (setq force (cadr force))) + nil) ; disabled + ((eq force t) + t) + ((stringp force) ; held + (version-list-= (version-to-list version) + (version-to-list force))) + (t + (error "Invalid element in `package-load-list'"))) + (package-load-descriptor dir subdir)))))))) + +(defsubst package-desc-vers (desc) + "Extract version from a package description vector." + (aref desc 0)) + +(defsubst package-desc-reqs (desc) + "Extract requirements from a package description vector." + (aref desc 1)) + +(defsubst package-desc-doc (desc) + "Extract doc string from a package description vector." + (aref desc 2)) + +(defsubst package-desc-kind (desc) + "Extract the kind of download from an archive package description vector." + (aref desc 3)) + +(defun package--dir (name version-string) + (let* ((subdir (concat name "-" version-string)) + (dir-list (cons package-user-dir package-directory-list)) + pkg-dir) + (while dir-list + (let ((subdir-full (expand-file-name subdir (car dir-list)))) + (if (file-directory-p subdir-full) + (setq pkg-dir subdir-full + dir-list nil) + (setq dir-list (cdr dir-list))))) + pkg-dir)) + +(defun package-activate-1 (package pkg-vec) + (let* ((name (symbol-name package)) + (version-str (package-version-join (package-desc-vers pkg-vec))) + (pkg-dir (package--dir name version-str))) + (unless pkg-dir + (error "Internal error: could not find directory for %s-%s" + name version-str)) + ;; Add info node. + (if (file-exists-p (expand-file-name "dir" pkg-dir)) + (progn + ;; FIXME: not the friendliest, but simple. + (require 'info) + (info-initialize) + (setq Info-directory-list (cons pkg-dir Info-directory-list)))) + ;; Add to load path, add autoloads, and activate the package. + (setq load-path (cons pkg-dir load-path)) + (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) + (setq package-activated-list (cons package package-activated-list)) + ;; Don't return nil. + t)) + +(defun package--built-in (package version) + "Return true if the package is built-in to Emacs." + (let ((elt (assq package package--builtins))) + (and elt (version-list-= (package-desc-vers (cdr elt)) version)))) + +;; FIXME: return a reason instead? +(defun package-activate (package version) + "Activate a package, and recursively activate its dependencies. +Return nil if the package could not be activated." + ;; Assume the user knows what he is doing -- go ahead and activate a + ;; newer version of a package if an older one has already been + ;; activated. This is not ideal; we'd at least need to check to see + ;; if the package has actually been loaded, and not merely + ;; activated. However, don't try to activate 'emacs', as that makes + ;; no sense. + (unless (eq package 'emacs) + (let* ((pkg-desc (assq package package-alist)) + (this-version (package-desc-vers (cdr pkg-desc))) + (req-list (package-desc-reqs (cdr pkg-desc))) + ;; If the package was never activated, do it now. + (keep-going (or (not (memq package package-activated-list)) + (version-list-< version this-version)))) + (while (and req-list keep-going) + (let* ((req (car req-list)) + (req-name (car req)) + (req-version (cadr req))) + (or (package-activate req-name req-version) + (setq keep-going nil))) + (setq req-list (cdr req-list))) + (if keep-going + (package-activate-1 package (cdr pkg-desc)) + ;; We get here if a dependency failed to activate -- but we + ;; can also get here if the requested package was already + ;; activated. Return non-nil in the latter case. + (and (memq package package-activated-list) + (version-list-<= version this-version)))))) + +(defun package-mark-obsolete (package pkg-vec) + "Put package on the obsolete list, if not already there." + (let ((elt (assq package package-obsolete-alist))) + (if elt + ;; If this obsolete version does not exist in the list, update + ;; it the list. + (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) + (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) + (cdr elt)))) + ;; Make a new association. + (setq package-obsolete-alist + (cons (cons package (list (cons (package-desc-vers pkg-vec) + pkg-vec))) + package-obsolete-alist))))) + +;; (define-package "emacs" "21.4.1" "GNU Emacs core package.") +;; (define-package "erc" "5.1" "ERC - irc client" '((emacs "21.0"))) +(defun define-package (name-str version-string + &optional docstring requirements) + "Define a new package. +NAME is the name of the package, a string. +VERSION-STRING is the version of the package, a dotted sequence +of integers. +DOCSTRING is the optional description. +REQUIREMENTS is a list of requirements on other packages. +Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." + (let* ((name (intern name-str)) + (pkg-desc (assq name package-alist)) + (new-version (version-to-list version-string)) + (new-pkg-desc + (cons name + (vector new-version + (mapcar + (lambda (elt) + (list (car elt) + (version-to-list (car (cdr elt))))) + requirements) + docstring)))) + ;; Only redefine a package if the redefinition is newer. + (if (or (not pkg-desc) + (version-list-< (package-desc-vers (cdr pkg-desc)) + new-version)) + (progn + (when pkg-desc + ;; Remove old package and declare it obsolete. + (setq package-alist (delq pkg-desc package-alist)) + (package-mark-obsolete (car pkg-desc) (cdr pkg-desc))) + ;; Add package to the alist. + (setq package-alist (cons new-pkg-desc package-alist))) + ;; You can have two packages with the same version, for instance + ;; one in the system package directory and one in your private + ;; directory. We just let the first one win. + (unless (version-list-= new-version + (package-desc-vers (cdr pkg-desc))) + ;; The package is born obsolete. + (package-mark-obsolete (car new-pkg-desc) (cdr new-pkg-desc)))))) + +;; From Emacs 22. +(defun package-autoload-ensure-default-file (file) + "Make sure that the autoload file FILE exists and if not create it." + (unless (file-exists-p file) + (write-region + (concat ";;; " (file-name-nondirectory file) + " --- automatically extracted autoloads\n" + ";;\n" + ";;; Code:\n\n" + " \n;; Local Variables:\n" + ";; version-control: never\n" + ";; no-byte-compile: t\n" + ";; no-update-autoloads: t\n" + ";; End:\n" + ";;; " (file-name-nondirectory file) + " ends here\n") + nil file)) + file) + +(defun package-generate-autoloads (name pkg-dir) + (let* ((auto-name (concat name "-autoloads.el")) + (ignore-name (concat name "-pkg.el")) + (generated-autoload-file (expand-file-name auto-name pkg-dir)) + (version-control 'never)) + (require 'autoload) + (unless (fboundp 'autoload-ensure-default-file) + (package-autoload-ensure-default-file generated-autoload-file)) + (update-directory-autoloads pkg-dir))) + +(defun package-untar-buffer () + "Untar the current buffer. +This uses `tar-untar-buffer' if it is available. +Otherwise it uses an external `tar' program. +`default-directory' should be set by the caller." + (require 'tar-mode) + (if (fboundp 'tar-untar-buffer) + (progn + ;; tar-mode messes with narrowing, so we just let it have the + ;; whole buffer to play with. + (delete-region (point-min) (point)) + (tar-mode) + (tar-untar-buffer)) + ;; FIXME: check the result. + (call-process-region (point) (point-max) "tar" nil '(nil nil) nil + "xf" "-"))) + +(defun package-unpack (name version) + (let ((pkg-dir (expand-file-name (concat (symbol-name name) "-" version) + package-user-dir))) + ;; Be careful!! + (make-directory package-user-dir t) + (if (file-directory-p pkg-dir) + (mapc (lambda (file) nil) ; 'delete-file -- FIXME: when we're + ; more confident + (directory-files pkg-dir t "^[^.]"))) + (let* ((default-directory (file-name-as-directory package-user-dir))) + (package-untar-buffer) + (package-generate-autoloads (symbol-name name) pkg-dir) + (let ((load-path (cons pkg-dir load-path))) + (byte-recompile-directory pkg-dir 0 t))))) + +(defun package--write-file-no-coding (file-name excl) + (let ((buffer-file-coding-system 'no-conversion)) + (write-region (point-min) (point-max) file-name nil nil nil excl))) + +(defun package-unpack-single (file-name version desc requires) + "Install the contents of the current buffer as a package." + ;; Special case "package". + (if (string= file-name "package") + (package--write-file-no-coding + (expand-file-name (concat file-name ".el") package-user-dir) + nil) + (let* ((pkg-dir (expand-file-name (concat file-name "-" version) + package-user-dir)) + (el-file (expand-file-name (concat file-name ".el") pkg-dir)) + (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) + (make-directory pkg-dir t) + (package--write-file-no-coding el-file 'excl) + (let ((print-level nil) + (print-length nil)) + (write-region + (concat + (prin1-to-string + (list 'define-package + file-name + version + desc + (list 'quote + ;; Turn version lists into string form. + (mapcar + (lambda (elt) + (list (car elt) + (package-version-join (car (cdr elt))))) + requires)))) + "\n") + nil + pkg-file + nil nil nil 'excl)) + (package-generate-autoloads file-name pkg-dir) + (let ((load-path (cons pkg-dir load-path))) + (byte-recompile-directory pkg-dir 0 t))))) + +(defun package-handle-response () + "Handle the response from the server. +Parse the HTTP response and throw if an error occurred. +The url package seems to require extra processing for this. +This should be called in a `save-excursion', in the download buffer. +It will move point to somewhere in the headers." + ;; We assume HTTP here. + (require 'url-http) + (let ((response (url-http-parse-response))) + (when (or (< response 200) (>= response 300)) + (display-buffer (current-buffer)) + (error "Error during download request:%s" + (buffer-substring-no-properties (point) (progn + (end-of-line) + (point))))))) + +(defun package-download-single (name version desc requires) + "Download and install a single-file package." + (let ((buffer (url-retrieve-synchronously + (concat (package-archive-url name) + (symbol-name name) "-" version ".el")))) + (with-current-buffer buffer + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (delete-region (point-min) (point)) + (package-unpack-single (symbol-name name) version desc requires) + (kill-buffer buffer)))) + +(defun package-download-tar (name version) + "Download and install a tar package." + (let ((tar-buffer (url-retrieve-synchronously + (concat (package-archive-url name) + (symbol-name name) "-" version ".tar")))) + (with-current-buffer tar-buffer + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (package-unpack name version) + (kill-buffer tar-buffer)))) + +(defun package-installed-p (package &optional min-version) + (let ((pkg-desc (assq package package-alist))) + (and pkg-desc + (version-list-<= min-version + (package-desc-vers (cdr pkg-desc)))))) + +(defun package-compute-transaction (result requirements) + (dolist (elt requirements) + (let* ((next-pkg (car elt)) + (next-version (cadr elt))) + (unless (package-installed-p next-pkg next-version) + ;; A package is required, but not installed. It might also be + ;; blocked via `package-load-list'. + (let ((pkg-desc (assq next-pkg package-archive-contents)) + hold) + (when (setq hold (assq next-pkg package-load-list)) + (setq hold (cadr hold)) + (cond ((eq hold nil) + (error "Required package '%s' is disabled" + (symbol-name next-pkg))) + ((null (stringp hold)) + (error "Invalid element in `package-load-list'")) + ((version-list-< (version-to-list hold) next-version) + (error "Package '%s' held at version %s, \ +but version %s required" + (symbol-name next-pkg) hold + (package-version-join next-version))))) + (unless pkg-desc + (error "Package '%s' is not available for installation" + (symbol-name next-pkg))) + (unless (version-list-<= next-version + (package-desc-vers (cdr pkg-desc))) + (error + "Need package '%s' with version %s, but only %s is available" + (symbol-name next-pkg) (package-version-join next-version) + (package-version-join (package-desc-vers (cdr pkg-desc))))) + ;; Only add to the transaction if we don't already have it. + (unless (memq next-pkg result) + (setq result (cons next-pkg result))) + (setq result + (package-compute-transaction result + (package-desc-reqs + (cdr pkg-desc)))))))) + result) + +(defun package-read-from-string (str) + "Read a Lisp expression from STR. +Signal an error if the entire string was not used." + (let* ((read-data (read-from-string str)) + (more-left + (condition-case nil + ;; The call to `ignore' suppresses a compiler warning. + (progn (ignore (read-from-string + (substring str (cdr read-data)))) + t) + (end-of-file nil)))) + (if more-left + (error "Can't read whole string") + (car read-data)))) + +(defun package--read-archive-file (file) + "Re-read archive file FILE, if it exists. +Will return the data from the file, or nil if the file does not exist. +Will throw an error if the archive version is too new." + (let ((filename (expand-file-name file package-user-dir))) + (if (file-exists-p filename) + (with-temp-buffer + (insert-file-contents-literally filename) + (let ((contents (package-read-from-string + (buffer-substring-no-properties (point-min) + (point-max))))) + (if (> (car contents) package-archive-version) + (error "Package archive version %d is greater than %d - upgrade package.el" + (car contents) package-archive-version)) + (cdr contents)))))) + +(defun package-read-all-archive-contents () + "Re-read `archive-contents' and `builtin-packages', if they exist. +Set `package-archive-contents' and `package--builtins' if successful. +Throw an error if the archive version is too new." + (dolist (archive package-archives) + (package-read-archive-contents (car archive))) + (let ((builtins (package--read-archive-file "builtin-packages"))) + (if builtins + ;; Version 1 of 'builtin-packages' is a list where the car is + ;; a split emacs version and the cdr is an alist suitable for + ;; package--builtins. + (let ((our-version (version-to-list emacs-version)) + (result package--builtins-base)) + (setq package--builtins + (dolist (elt builtins result) + (if (version-list-<= (car elt) our-version) + (setq result (append (cdr elt) result))))))))) + +(defun package-read-archive-contents (archive) + "Re-read `archive-contents' and `builtin-packages' for ARCHIVE. +If successful, set `package-archive-contents' and `package--builtins'. +If the archive version is too new, signal an error." + (let ((archive-contents (package--read-archive-file + (concat "archives/" archive + "/archive-contents")))) + (if archive-contents + ;; Version 1 of 'archive-contents' is identical to our + ;; internal representation. + ;; TODO: merge archive lists + (dolist (package archive-contents) + (package--add-to-archive-contents package archive))))) + +(defun package--add-to-archive-contents (package archive) + "Add the PACKAGE from the given ARCHIVE if necessary. +Also, add the originating archive to the end of the package vector." + (let* ((name (car package)) + (version (aref (cdr package) 0)) + (entry (cons (car package) + (vconcat (cdr package) (vector archive)))) + (existing-package (cdr (assq name package-archive-contents)))) + (when (or (not existing-package) + (version-list-< (aref existing-package 0) version)) + (add-to-list 'package-archive-contents entry)))) + +(defun package-download-transaction (transaction) + "Download and install all the packages in the given transaction." + (dolist (elt transaction) + (let* ((desc (cdr (assq elt package-archive-contents))) + ;; As an exception, if package is "held" in + ;; `package-load-list', download the held version. + (hold (cadr (assq elt package-load-list))) + (v-string (or (and (stringp hold) hold) + (package-version-join (package-desc-vers desc)))) + (kind (package-desc-kind desc))) + (cond + ((eq kind 'tar) + (package-download-tar elt v-string)) + ((eq kind 'single) + (package-download-single elt v-string + (package-desc-doc desc) + (package-desc-reqs desc))) + (t + (error "Unknown package kind: %s" (symbol-name kind))))))) + +;;;###autoload +(defun package-install (name) + "Install the package named NAME. +Interactively, prompt for the package name. +The package is found on one of the archives in `package-archives'." + (interactive + (list (intern (completing-read "Install package: " + (mapcar (lambda (elt) + (cons (symbol-name (car elt)) + nil)) + package-archive-contents) + nil t)))) + (let ((pkg-desc (assq name package-archive-contents))) + (unless pkg-desc + (error "Package '%s' is not available for installation" + (symbol-name name))) + (package-download-transaction + (package-compute-transaction (list name) + (package-desc-reqs (cdr pkg-desc))))) + ;; Try to activate it. + (package-initialize)) + +(defun package-strip-rcs-id (v-str) + "Strip RCS version ID from the version string. +If the result looks like a dotted numeric version, return it. +Otherwise return nil." + (if v-str + (if (string-match "^[ \t]*[$]Revision:[ \t]\([0-9.]+\)[ \t]*[$]$" v-str) + (match-string 1 v-str) + (if (string-match "^[0-9.]*$" v-str) + v-str)))) + +(defun package-buffer-info () + "Return a vector of information about the package in the current buffer. +The vector looks like [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] +FILENAME is the file name, a string. It does not have the \".el\" extension. +REQUIRES is a requires list, or nil. +DESCRIPTION is the package description (a string). +VERSION is the version, a string. +COMMENTARY is the commentary section, a string, or nil if none. +Throws an exception if the buffer does not contain a conforming package. +If there is a package, narrows the buffer to the file's boundaries. +May narrow buffer or move point even on failure." + (goto-char (point-min)) + (if (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t) + (let ((file-name (match-string 1)) + (desc (match-string 2)) + (start (progn (beginning-of-line) (point)))) + (if (search-forward (concat ";;; " file-name ".el ends here")) + (progn + ;; Try to include a trailing newline. + (forward-line) + (narrow-to-region start (point)) + (require 'lisp-mnt) + ;; Use some headers we've invented to drive the process. + (let* ((requires-str (lm-header "package-requires")) + (requires (if requires-str + (package-read-from-string requires-str))) + ;; Prefer Package-Version, because if it is + ;; defined the package author probably wants us + ;; to use it. Otherwise try Version. + (pkg-version + (or (package-strip-rcs-id (lm-header "package-version")) + (package-strip-rcs-id (lm-header "version")))) + (commentary (lm-commentary))) + (unless pkg-version + (error + "Package does not define a usable \"Version\" or \"Package-Version\" header")) + ;; Turn string version numbers into list form. + (setq requires + (mapcar + (lambda (elt) + (list (car elt) + (version-to-list (car (cdr elt))))) + requires)) + (set-text-properties 0 (length file-name) nil file-name) + (set-text-properties 0 (length pkg-version) nil pkg-version) + (set-text-properties 0 (length desc) nil desc) + (vector file-name requires desc pkg-version commentary))) + (error "Package missing a terminating comment"))) + (error "No starting comment for package"))) + +(defun package-tar-file-info (file) + "Find package information for a tar file. +FILE is the name of the tar file to examine. +The return result is a vector like `package-buffer-info'." + (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file) + (error "`%s' doesn't have a package-ish name" file)) + (let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 file))) + (pkg-version (match-string-no-properties 2 file)) + ;; Extract the package descriptor. + (pkg-def-contents (shell-command-to-string + ;; Requires GNU tar. + (concat "tar -xOf " file " " + pkg-name "-" pkg-version "/" + pkg-name "-pkg.el"))) + (pkg-def-parsed (package-read-from-string pkg-def-contents))) + (unless (eq (car pkg-def-parsed) 'define-package) + (error "%s-pkg.el doesn't contain `define-package' sexp" pkg-name)) + (let ((name-str (nth 1 pkg-def-parsed)) + (version-string (nth 2 pkg-def-parsed)) + (docstring (nth 3 pkg-def-parsed)) + (requires (nth 4 pkg-def-parsed)) + + (readme (shell-command-to-string + ;; Requires GNU tar. + (concat "tar -xOf " file " " + pkg-name "-" pkg-version "/README")))) + (unless (equal pkg-version version-string) + (error "Inconsistent versions!")) + (unless (equal pkg-name name-str) + (error "Inconsistent names!")) + ;; Kind of a hack. + (if (string-match ": Not found in archive" readme) + (setq readme nil)) + ;; Turn string version numbers into list form. + (if (eq (car requires) 'quote) + (setq requires (car (cdr requires)))) + (setq requires + (mapcar + (lambda (elt) + (list (car elt) + (version-to-list (car (cdr elt))))) + requires)) + (vector pkg-name requires docstring version-string readme)))) + +(defun package-install-buffer-internal (pkg-info type) + (save-excursion + (save-restriction + (let* ((file-name (aref pkg-info 0)) + (requires (aref pkg-info 1)) + (desc (if (string= (aref pkg-info 2) "") + "No description available." + (aref pkg-info 2))) + (pkg-version (aref pkg-info 3))) + ;; Download and install the dependencies. + (let ((transaction (package-compute-transaction nil requires))) + (package-download-transaction transaction)) + ;; Install the package itself. + (cond + ((eq type 'single) + (package-unpack-single file-name pkg-version desc requires)) + ((eq type 'tar) + (package-unpack (intern file-name) pkg-version)) + (t + (error "Unknown type: %s" (symbol-name type)))) + ;; Try to activate it. + (package-initialize))))) + +;;;###autoload +(defun package-install-from-buffer () + "Install a package from the current buffer. +The package is assumed to be a single .el file which +follows the elisp comment guidelines; see +info node `(elisp)Library Headers'." + (interactive) + (package-install-buffer-internal (package-buffer-info) 'single)) + +;;;###autoload +(defun package-install-file (file) + "Install a package from a file. +The file can either be a tar file or an Emacs Lisp file." + (interactive "fPackage file name: ") + (with-temp-buffer + (insert-file-contents-literally file) + (cond + ((string-match "\\.el$" file) (package-install-from-buffer)) + ((string-match "\\.tar$" file) + (package-install-buffer-internal (package-tar-file-info file) 'tar)) + (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) + +(defun package-delete (name version) + (require 'dired) ; for dired-delete-file + (dired-delete-file (expand-file-name (concat name "-" version) + package-user-dir) + ;; FIXME: query user? + 'always)) + +(defun package-archive-url (name) + "Return the archive containing the package NAME." + (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) + (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) + +(defun package--download-one-archive (archive file) + "Download an archive file FILE from ARCHIVE, and cache it locally." + (let* ((archive-name (car archive)) + (archive-url (cdr archive)) + (dir (expand-file-name "archives" package-user-dir)) + (dir (expand-file-name archive-name dir)) + (buffer (url-retrieve-synchronously (concat archive-url file)))) + (with-current-buffer buffer + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (delete-region (point-min) (point)) + (make-directory dir t) + (setq buffer-file-name (expand-file-name file dir)) + (let ((version-control 'never)) + (save-buffer))) + (kill-buffer buffer))) + +(defun package-refresh-contents () + "Download the ELPA archive description if needed. +Invoking this will ensure that Emacs knows about the latest versions +of all packages. This will let Emacs make them available for +download." + (interactive) + (unless (file-exists-p package-user-dir) + (make-directory package-user-dir t)) + (dolist (archive package-archives) + (package--download-one-archive archive "archive-contents")) + (package-read-all-archive-contents)) + +;;;###autoload +(defun package-initialize () + "Load Emacs Lisp packages, and activate them. +The variable `package-load-list' controls which packages to load." + (interactive) + (setq package-obsolete-alist nil) + (package-load-all-descriptors) + (package-read-all-archive-contents) + ;; Try to activate all our packages. + (mapc (lambda (elt) + (package-activate (car elt) (package-desc-vers (cdr elt)))) + package-alist)) + + +;;;; Package description buffer. + +;;;###autoload +(defun describe-package (package) + "Display the full documentation of PACKAGE (a symbol)." + (interactive + (let* ((packages (append (mapcar 'car package-alist) + (mapcar 'car package-archive-contents))) + (guess (function-called-at-point)) + val) + (unless (memq guess packages) + (setq guess nil)) + (setq packages (mapcar 'symbol-name packages)) + (setq val + (completing-read (if guess + (format "Describe package (default %s): " + guess) + "Describe package: ") + packages nil t nil nil guess)) + (list (if (equal val "") + guess + (intern val))))) + (if (or (null package) (null (symbolp package))) + (message "You did not specify a package") + (help-setup-xref (list #'describe-package package) + (called-interactively-p 'interactive)) + (with-help-window (help-buffer) + (with-current-buffer standard-output + (describe-package-1 package))))) + +(defun describe-package-1 (package) + (let ((desc (cdr (assq package package-alist))) + reqs version installable) + (prin1 package) + (princ " is ") + (cond + (desc + ;; This package is loaded (i.e. in `package-alist'). + (let (pkg-dir) + (setq version (package-version-join (package-desc-vers desc))) + (if (assq package package--builtins) + (princ "a built-in package.\n\n") + (setq pkg-dir (package--dir (symbol-name package) version)) + (if pkg-dir + (progn + (insert "a package installed in `") + (help-insert-xref-button (file-name-as-directory pkg-dir) + 'help-package-def pkg-dir) + (insert "'.\n\n")) + ;; This normally does not happen. + (insert "a deleted package.\n\n") + (setq version nil))))) + (t + ;; An uninstalled package. + (setq desc (cdr (assq package package-archive-contents)) + version (package-version-join (package-desc-vers desc)) + installable t) + (insert "an installable package.\n\n"))) + (if version + (insert " Version: " version "\n")) + (setq reqs (package-desc-reqs desc)) + (when reqs + (insert " Requires: ") + (let ((first t) + name vers text) + (dolist (req reqs) + (setq name (car req) + vers (cadr req) + text (format "%s-%s" (symbol-name name) + (package-version-join vers))) + (cond (first (setq first nil)) + ((>= (+ 2 (current-column) (length text)) + (window-width)) + (insert ",\n ")) + (t (insert ", "))) + (help-insert-xref-button text 'help-package name)) + (insert "\n"))) + (insert " Description: " (package-desc-doc desc) "\n") + ;; Todo: button for uninstalling a package. + (when installable + (let ((button-text (if (display-graphic-p) + "Install" + "[Install]")) + (button-face (if (display-graphic-p) + '(:box (:line-width 2 :color "dark grey") + :background "light grey" + :foreground "black") + 'link))) + (insert "\n") + (insert-text-button button-text + 'face button-face + 'follow-link t + 'package-symbol package + 'action (lambda (button) + (package-install + (button-get button 'package-symbol)) + (revert-buffer nil t) + (goto-char (point-min)))) + (insert "\n"))))) + + +;;;; Package menu mode. + +(defvar package-menu-mode-map + (let ((map (make-keymap)) + (menu-map (make-sparse-keymap "Package"))) + (suppress-keymap map) + (define-key map "\C-m" 'package-menu-describe-package) + (define-key map "q" 'quit-window) + (define-key map "n" 'next-line) + (define-key map "p" 'previous-line) + (define-key map "u" 'package-menu-mark-unmark) + (define-key map "\177" 'package-menu-backup-unmark) + (define-key map "d" 'package-menu-mark-delete) + (define-key map "i" 'package-menu-mark-install) + (define-key map "g" 'package-menu-revert) + (define-key map "r" 'package-menu-refresh) + (define-key map "~" 'package-menu-mark-obsolete-for-deletion) + (define-key map "x" 'package-menu-execute) + (define-key map "h" 'package-menu-quick-help) + (define-key map "?" 'package-menu-view-commentary) + (define-key map [menu-bar package-menu] (cons "Package" menu-map)) + (define-key menu-map [mq] + '(menu-item "Quit" quit-window + :help "Quit package selection")) + (define-key menu-map [s1] '("--")) + (define-key menu-map [mn] + '(menu-item "Next" next-line + :help "Next Line")) + (define-key menu-map [mp] + '(menu-item "Previous" previous-line + :help "Previous Line")) + (define-key menu-map [s2] '("--")) + (define-key menu-map [mu] + '(menu-item "Unmark" package-menu-mark-unmark + :help "Clear any marks on a package and move to the next line")) + (define-key menu-map [munm] + '(menu-item "Unmark backwards" package-menu-backup-unmark + :help "Back up one line and clear any marks on that package")) + (define-key menu-map [md] + '(menu-item "Mark for deletion" package-menu-mark-delete + :help "Mark a package for deletion and move to the next line")) + (define-key menu-map [mi] + '(menu-item "Mark for install" package-menu-mark-install + :help "Mark a package for installation and move to the next line")) + (define-key menu-map [s3] '("--")) + (define-key menu-map [mg] + '(menu-item "Update package list" package-menu-revert + :help "Update the list of packages")) + (define-key menu-map [mr] + '(menu-item "Refresh package list" package-menu-refresh + :help "Download the ELPA archive")) + (define-key menu-map [s4] '("--")) + (define-key menu-map [mt] + '(menu-item "Mark obsolete packages" package-menu-mark-obsolete-for-deletion + :help "Mark all obsolete packages for deletion")) + (define-key menu-map [mx] + '(menu-item "Execute actions" package-menu-execute + :help "Perform all the marked actions")) + (define-key menu-map [s5] '("--")) + (define-key menu-map [mh] + '(menu-item "Help" package-menu-quick-help + :help "Show short key binding help for package-menu-mode")) + (define-key menu-map [mc] + '(menu-item "View Commentary" package-menu-view-commentary + :help "Display information about this package")) + map) + "Local keymap for `package-menu-mode' buffers.") + +(defvar package-menu-sort-button-map + (let ((map (make-sparse-keymap))) + (define-key map [header-line mouse-1] 'package-menu-sort-by-column) + (define-key map [follow-link] 'mouse-face) + map) + "Local keymap for package menu sort buttons.") + +(put 'package-menu-mode 'mode-class 'special) + +(defun package-menu-mode () + "Major mode for browsing a list of packages. +Letters do not insert themselves; instead, they are commands. +\\<package-menu-mode-map> +\\{package-menu-mode-map}" + (kill-all-local-variables) + (use-local-map package-menu-mode-map) + (setq major-mode 'package-menu-mode) + (setq mode-name "Package Menu") + (setq truncate-lines t) + (setq buffer-read-only t) + ;; Support Emacs 21. + (if (fboundp 'run-mode-hooks) + (run-mode-hooks 'package-menu-mode-hook) + (run-hooks 'package-menu-mode-hook))) + +(defun package-menu-refresh () + "Download the ELPA archive. +This fetches the file describing the current contents of +the Emacs Lisp Package Archive, and then refreshes the +package menu. This lets you see what new packages are +available for download." + (interactive) + (package-refresh-contents) + (package-list-packages-internal)) + +(defun package-menu-revert () + "Update the list of packages." + (interactive) + (package-list-packages-internal)) + +(defun package-menu-describe-package () + "Describe the package in the current line." + (interactive) + (let ((name (package-menu-get-package))) + (if name + (describe-package (intern name)) + (message "No package on this line")))) + +(defun package-menu-mark-internal (what) + (unless (eobp) + (let ((buffer-read-only nil)) + (beginning-of-line) + (delete-char 1) + (insert what) + (forward-line)))) + +;; fixme numeric argument +(defun package-menu-mark-delete (num) + "Mark a package for deletion and move to the next line." + (interactive "p") + (package-menu-mark-internal "D")) + +(defun package-menu-mark-install (num) + "Mark a package for installation and move to the next line." + (interactive "p") + (package-menu-mark-internal "I")) + +(defun package-menu-mark-unmark (num) + "Clear any marks on a package and move to the next line." + (interactive "p") + (package-menu-mark-internal " ")) + +(defun package-menu-backup-unmark () + "Back up one line and clear any marks on that package." + (interactive) + (forward-line -1) + (package-menu-mark-internal " ") + (forward-line -1)) + +(defun package-menu-mark-obsolete-for-deletion () + "Mark all obsolete packages for deletion." + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (while (not (eobp)) + (if (looking-at ".*\\s obsolete\\s ") + (package-menu-mark-internal "D") + (forward-line 1))))) + +(defun package-menu-quick-help () + "Show short key binding help for package-menu-mode." + (interactive) + (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp")) + +(defun package-menu-view-commentary () + "Display information about this package. +For single-file packages, shows the commentary section from the header. +For larger packages, shows the README file." + (interactive) + (let* ((pkg-name (package-menu-get-package)) + (buffer (url-retrieve-synchronously + (concat (package-archive-url pkg-name) + pkg-name + "-readme.txt"))) + start-point ok) + (with-current-buffer buffer + ;; FIXME: it would be nice to work with any URL type. + (setq start-point url-http-end-of-headers) + (setq ok (eq (url-http-parse-response) 200))) + (let ((new-buffer (get-buffer-create "*Package Info*"))) + (with-current-buffer new-buffer + (let ((buffer-read-only nil)) + (erase-buffer) + (insert "Package information for " pkg-name "\n\n") + (if ok + (insert-buffer-substring buffer start-point) + (insert "This package lacks a README file or commentary.\n")) + (goto-char (point-min)) + (view-mode))) + (display-buffer new-buffer t)))) + +;; Return the name of the package on the current line. +(defun package-menu-get-package () + (save-excursion + (beginning-of-line) + (if (looking-at ". \\([^ \t]*\\)") + (match-string-no-properties 1)))) + +;; Return the version of the package on the current line. +(defun package-menu-get-version () + (save-excursion + (beginning-of-line) + (if (looking-at ". [^ \t]*[ \t]*\\([0-9.]*\\)") + (match-string 1)))) + +(defun package-menu-get-status () + (save-excursion + (if (looking-at ". [^ \t]*[ \t]*[^ \t]*[ \t]*\\([^ \t]*\\)") + (match-string 1) + ""))) + +(defun package-menu-execute () + "Perform all the marked actions. +Packages marked for installation will be downloaded and +installed. Packages marked for deletion will be removed. +Note that after installing packages you will want to restart +Emacs." + (interactive) + (goto-char (point-min)) + (while (not (eobp)) + (let ((cmd (char-after)) + (pkg-name (package-menu-get-package)) + (pkg-vers (package-menu-get-version)) + (pkg-status (package-menu-get-status))) + (cond + ((eq cmd ?D) + (when (and (string= pkg-status "installed") + (string= pkg-name "package")) + ;; FIXME: actually, we could be tricky and remove all info. + ;; But that is drastic and the user can do that instead. + (error "Can't delete most recent version of `package'")) + ;; Ask for confirmation here? Maybe if package status is ""? + ;; Or if any lisp from package is actually loaded? + (message "Deleting %s-%s..." pkg-name pkg-vers) + (package-delete pkg-name pkg-vers) + (message "Deleting %s-%s... done" pkg-name pkg-vers)) + ((eq cmd ?I) + (package-install (intern pkg-name))))) + (forward-line)) + (package-menu-revert)) + +(defun package-print-package (package version key desc) + (let ((face + (cond ((string= key "built-in") 'font-lock-builtin-face) + ((string= key "available") 'default) + ((string= key "held") 'font-lock-constant-face) + ((string= key "disabled") 'font-lock-warning-face) + ((string= key "installed") 'font-lock-comment-face) + (t ; obsolete, but also the default. + 'font-lock-warning-face)))) + (insert (propertize " " 'font-lock-face face)) + (insert-text-button (symbol-name package) + 'face 'link + 'follow-link t + 'package-symbol package + 'action (lambda (button) + (describe-package + (button-get button 'package-symbol)))) + (indent-to 20 1) + (insert (propertize (package-version-join version) 'font-lock-face face)) + (indent-to 32 1) + (insert (propertize key 'font-lock-face face)) + ;; FIXME: this 'when' is bogus... + (when desc + (indent-to 43 1) + (let ((opoint (point))) + (insert (propertize desc 'font-lock-face face)) + (upcase-region opoint (min (point) (1+ opoint))))) + (insert "\n"))) + +(defun package-list-maybe-add (package version status description result) + (unless (assoc (cons package version) result) + (setq result (cons (list (cons package version) status description) + result))) + result) + +;; This decides how we should sort; nil means by package name. +(defvar package-menu-sort-key nil) + +(defun package-list-packages-internal () + (package-initialize) ; FIXME: do this here? + (with-current-buffer (get-buffer-create "*Packages*") + (setq buffer-read-only nil) + (erase-buffer) + (let ((info-list) + name desc hold + builtin) + ;; List installed packages + (dolist (elt package-alist) + ;; Ignore the Emacs package. + (setq name (car elt) + desc (cdr elt) + hold (assq name package-load-list)) + (unless (eq name 'emacs) + (setq info-list + (package-list-maybe-add + name (package-desc-vers desc) + ;; FIXME: it turns out to be tricky to see if this + ;; package is presently activated. + (cond ((stringp (cadr hold)) + "held") + ((and (setq builtin (assq name package--builtins)) + (version-list-= + (package-desc-vers (cdr builtin)) + (package-desc-vers desc))) + "built-in") + (t "installed")) + (package-desc-doc desc) + info-list)))) + ;; List available packages + (dolist (elt package-archive-contents) + (setq name (car elt) + desc (cdr elt) + hold (assq name package-load-list)) + (unless (and hold (stringp (cadr hold)) + (package-installed-p + name (version-to-list (cadr hold)))) + (setq info-list + (package-list-maybe-add name + (package-desc-vers desc) + (if (and hold (null (cadr hold))) + "disabled" + "available") + (package-desc-doc (cdr elt)) + info-list)))) + ;; List obsolete packages + (mapc (lambda (elt) + (mapc (lambda (inner-elt) + (setq info-list + (package-list-maybe-add (car elt) + (package-desc-vers + (cdr inner-elt)) + "obsolete" + (package-desc-doc + (cdr inner-elt)) + info-list))) + (cdr elt))) + package-obsolete-alist) + (let ((selector (cond + ((string= package-menu-sort-key "Version") + ;; FIXME this doesn't work. + #'(lambda (e) (cdr (car e)))) + ((string= package-menu-sort-key "Status") + #'(lambda (e) (car (cdr e)))) + ((string= package-menu-sort-key "Description") + #'(lambda (e) (car (cdr (cdr e))))) + (t ; "Package" is default. + #'(lambda (e) (symbol-name (car (car e)))))))) + (setq info-list + (sort info-list + (lambda (left right) + (let ((vleft (funcall selector left)) + (vright (funcall selector right))) + (string< vleft vright)))))) + (mapc (lambda (elt) + (package-print-package (car (car elt)) + (cdr (car elt)) + (car (cdr elt)) + (car (cdr (cdr elt))))) + info-list)) + (goto-char (point-min)) + (current-buffer))) + +(defun package-menu-sort-by-column (&optional e) + "Sort the package menu by the last column clicked on." + (interactive (list last-input-event)) + (if e (mouse-select-window e)) + (let* ((pos (event-start e)) + (obj (posn-object pos)) + (col (if obj + (get-text-property (cdr obj) 'column-name (car obj)) + (get-text-property (posn-point pos) 'column-name)))) + (setq package-menu-sort-key col)) + (package-list-packages-internal)) + +(defun package--list-packages () + "Display a list of packages. +Helper function that does all the work for the user-facing functions." + (with-current-buffer (package-list-packages-internal) + (package-menu-mode) + ;; Set up the header line. + (setq header-line-format + (mapconcat + (lambda (pair) + (let ((column (car pair)) + (name (cdr pair))) + (concat + ;; Insert a space that aligns the button properly. + (propertize " " 'display (list 'space :align-to column) + 'face 'fixed-pitch) + ;; Set up the column button. + (if (string= name "Version") + name + (propertize name + 'column-name name + 'help-echo "mouse-1: sort by column" + 'mouse-face 'highlight + 'keymap package-menu-sort-button-map))))) + ;; We take a trick from buff-menu and have a dummy leading + ;; space to align the header line with the beginning of the + ;; text. This doesn't really work properly on Emacs 21, + ;; but it is close enough. + '((0 . "") + (2 . "Package") + (20 . "Version") + (32 . "Status") + (43 . "Description")) + "")) + + ;; It's okay to use pop-to-buffer here. The package menu buffer + ;; has keybindings, and the user just typed 'M-x + ;; package-list-packages', suggesting that they might want to use + ;; them. + (pop-to-buffer (current-buffer)))) + +;;;###autoload +(defun package-list-packages () + "Display a list of packages. +Fetches the updated list of packages before displaying. +The list is displayed in a buffer named `*Packages*'." + (interactive) + (package-refresh-contents) + (package--list-packages)) + +(defun package-list-packages-no-fetch () + "Display a list of packages. +Does not fetch the updated list of packages before displaying. +The list is displayed in a buffer named `*Packages*'." + (interactive) + (package--list-packages)) + +(provide 'package) + +;;; package.el ends here diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el new file mode 100644 index 00000000000..0b46eb2a301 --- /dev/null +++ b/lisp/emacs-lisp/pcase.el @@ -0,0 +1,489 @@ +;;; pcase.el --- ML-style pattern-matching macro for Elisp + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> +;; Keywords: + +;; 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: + +;; ML-style pattern matching. +;; The entry points are autoloaded. + +;;; Code: + +(eval-when-compile (require 'cl)) + +;; Macro-expansion of pcase is reasonably fast, so it's not a problem +;; when byte-compiling a file, but when interpreting the code, if the pcase +;; is in a loop, the repeated macro-expansion becomes terribly costly, so we +;; memoize previous macro expansions to try and avoid recomputing them +;; over and over again. +(defconst pcase-memoize (make-hash-table :weakness t :test 'equal)) + +;;;###autoload +(defmacro pcase (exp &rest cases) + "Perform ML-style pattern matching on EXP. +CASES is a list of elements of the form (UPATTERN CODE...). + +UPatterns can take the following forms: + _ matches anything. + SYMBOL matches anything and binds it to SYMBOL. + (or UPAT...) matches if any of the patterns matches. + (and UPAT...) matches if all the patterns match. + `QPAT matches if the QPattern QPAT matches. + (pred PRED) matches if PRED applied to the object returns non-nil. + +QPatterns can take the following forms: + (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. + ,UPAT matches if the UPattern UPAT matches. + ATOM matches if the object is `eq' to ATOM. +QPatterns for vectors are not implemented yet. + +PRED can take the form + FUNCTION in which case it gets called with one argument. + (FUN ARG1 .. ARGN) in which case it gets called with N+1 arguments. +A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION). +PRED patterns can refer to variables bound earlier in the pattern. +E.g. you can match pairs where the cdr is larger than the car with a pattern +like `(,a . ,(pred (< a))) or, with more checks: +`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))" + (declare (indent 1) (debug case)) + (or (gethash (cons exp cases) pcase-memoize) + (puthash (cons exp cases) + (pcase-expand exp cases) + pcase-memoize))) + +;;;###autoload +(defmacro pcase-let* (bindings body) + "Like `let*' but where you can use `pcase' patterns for bindings. +BODY should be an expression, and BINDINGS should be a list of bindings +of the form (UPAT EXP)." + (if (null bindings) body + `(pcase ,(cadr (car bindings)) + (,(caar bindings) (plet* ,(cdr bindings) ,body)) + (t (error "Pattern match failure in `plet'"))))) + +;;;###autoload +(defmacro pcase-let (bindings body) + "Like `let' but where you can use `pcase' patterns for bindings. +BODY should be an expression, and BINDINGS should be a list of bindings +of the form (UPAT EXP)." + (if (null (cdr bindings)) + `(plet* ,bindings ,body) + (setq bindings (mapcar (lambda (x) (cons (make-symbol "x") x)) bindings)) + `(let ,(mapcar (lambda (binding) (list (nth 0 binding) (nth 2 binding))) + bindings) + (plet* ,(mapcar (lambda (binding) (list (nth 1 binding) (nth 0 binding))) + bindings) + ,body)))) + +(defun pcase-expand (exp cases) + (let* ((defs (if (symbolp exp) '() + (let ((sym (make-symbol "x"))) + (prog1 `((,sym ,exp)) (setq exp sym))))) + (seen '()) + (codegen + (lambda (code vars) + (let ((prev (assq code seen))) + (if (not prev) + (let ((res (pcase-codegen code vars))) + (push (list code vars res) seen) + res) + ;; Since we use a tree-based pattern matching + ;; technique, the leaves (the places that contain the + ;; code to run once a pattern is matched) can get + ;; copied a very large number of times, so to avoid + ;; code explosion, we need to keep track of how many + ;; times we've used each leaf and move it + ;; to a separate function if that number is too high. + ;; + ;; We've already used this branch. So it is shared. + (destructuring-bind (code prevvars res) prev + (unless (symbolp res) + ;; This is the first repeat, so we have to move + ;; the branch to a separate function. + (let ((bsym + (make-symbol (format "pcase-%d" (length defs))))) + (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) defs) + (setcar res 'funcall) + (setcdr res (cons bsym (mapcar #'cdr prevvars))) + (setcar (cddr prev) bsym) + (setq res bsym))) + (setq vars (copy-sequence vars)) + (let ((args (mapcar (lambda (pa) + (let ((v (assq (car pa) vars))) + (setq vars (delq v vars)) + (cdr v))) + prevvars))) + (when vars ;New additional vars. + (error "The vars %s are only bound in some paths" + (mapcar #'car vars))) + `(funcall ,res ,@args))))))) + (main + (pcase-u + (mapcar (lambda (case) + `((match ,exp . ,(car case)) + ,(apply-partially + (if (pcase-small-branch-p (cdr case)) + ;; Don't bother sharing multiple + ;; occurrences of this leaf since it's small. + #'pcase-codegen codegen) + (cdr case)))) + cases)))) + `(let ,defs ,main))) + +(defun pcase-codegen (code vars) + `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) + ,@code)) + +(defun pcase-small-branch-p (code) + (and (= 1 (length code)) + (or (not (consp (car code))) + (let ((small t)) + (dolist (e (car code)) + (if (consp e) (setq small nil))) + small)))) + +;; Try to use `cond' rather than a sequence of `if's, so as to reduce +;; the depth of the generated tree. +(defun pcase-if (test then else) + (cond + ((eq else :pcase-dontcare) then) + ((eq (car-safe else) 'if) + `(cond (,test ,then) + (,(nth 1 else) ,(nth 2 else)) + (t ,@(nthcdr 3 else)))) + ((eq (car-safe else) 'cond) + `(cond (,test ,then) + ,@(cdr else))) + (t `(if ,test ,then ,else)))) + +(defun pcase-upat (qpattern) + (cond + ((eq (car-safe qpattern) '\,) (cadr qpattern)) + (t (list '\` qpattern)))) + +;; Note about MATCH: +;; When we have patterns like `(PAT1 . PAT2), after performing the `consp' +;; check, we want to turn all the similar patterns into ones of the form +;; (and (match car PAT1) (match cdr PAT2)), so you naturally need conjunction. +;; Earlier code hence used branches of the form (MATCHES . CODE) where +;; MATCHES was a list (implicitly a conjunction) of (SYM . PAT). +;; But if we have a pattern of the form (or `(PAT1 . PAT2) PAT3), there is +;; no easy way to eliminate the `consp' check in such a representation. +;; So we replaced the MATCHES by the MATCH below which can be made up +;; of conjunctions and disjunctions, so if we know `foo' is a cons, we can +;; turn (match foo . (or `(PAT1 . PAT2) PAT3)) into +;; (or (and (match car . `PAT1) (match cdr . `PAT2)) (match foo . PAT3)). +;; The downside is that we now have `or' and `and' both in MATCH and +;; in PAT, so there are different equivalent representations and we +;; need to handle them all. We do not try to systematically +;; canonicalize them to one form over another, but we do occasionally +;; turn one into the other. + +(defun pcase-u (branches) + "Expand matcher for rules BRANCHES. +Each BRANCH has the form (MATCH CODE . VARS) where +CODE is the code generator for that branch. +VARS is the set of vars already bound by earlier matches. +MATCH is the pattern that needs to be matched, of the form: + (match VAR . UPAT) + (and MATCH ...) + (or MATCH ...)" + (when (setq branches (delq nil branches)) + (destructuring-bind (match code &rest vars) (car branches) + (pcase-u1 (list match) code vars (cdr branches))))) + +(defun pcase-and (match matches) + (if matches `(and ,match ,@matches) match)) + +(defun pcase-split-match (sym splitter match) + (case (car match) + ((match) + (if (not (eq sym (cadr match))) + (cons match match) + (let ((pat (cddr match))) + (cond + ;; Hoist `or' and `and' patterns to `or' and `and' matches. + ((memq (car-safe pat) '(or and)) + (pcase-split-match sym splitter + (cons (car pat) + (mapcar (lambda (alt) + `(match ,sym . ,alt)) + (cdr pat))))) + (t (let ((res (funcall splitter (cddr match)))) + (cons (or (car res) match) (or (cdr res) match)))))))) + ((or and) + (let ((then-alts '()) + (else-alts '()) + (neutral-elem (if (eq 'or (car match)) :pcase-fail :pcase-succeed)) + (zero-elem (if (eq 'or (car match)) :pcase-succeed :pcase-fail))) + (dolist (alt (cdr match)) + (let ((split (pcase-split-match sym splitter alt))) + (unless (eq (car split) neutral-elem) + (push (car split) then-alts)) + (unless (eq (cdr split) neutral-elem) + (push (cdr split) else-alts)))) + (cons (cond ((memq zero-elem then-alts) zero-elem) + ((null then-alts) neutral-elem) + ((null (cdr then-alts)) (car then-alts)) + (t (cons (car match) (nreverse then-alts)))) + (cond ((memq zero-elem else-alts) zero-elem) + ((null else-alts) neutral-elem) + ((null (cdr else-alts)) (car else-alts)) + (t (cons (car match) (nreverse else-alts))))))) + (t (error "Uknown MATCH %s" match)))) + +(defun pcase-split-rest (sym splitter rest) + (let ((then-rest '()) + (else-rest '())) + (dolist (branch rest) + (let* ((match (car branch)) + (code&vars (cdr branch)) + (splitted + (pcase-split-match sym splitter match))) + (unless (eq (car splitted) :pcase-fail) + (push (cons (car splitted) code&vars) then-rest)) + (unless (eq (cdr splitted) :pcase-fail) + (push (cons (cdr splitted) code&vars) else-rest)))) + (cons (nreverse then-rest) (nreverse else-rest)))) + +(defun pcase-split-consp (syma symd pat) + (cond + ;; A QPattern for a cons, can only go the `then' side. + ((and (eq (car-safe pat) '\`) (consp (cadr pat))) + (let ((qpat (cadr pat))) + (cons `(and (match ,syma . ,(pcase-upat (car qpat))) + (match ,symd . ,(pcase-upat (cdr qpat)))) + :pcase-fail))) + ;; A QPattern but not for a cons, can only go the `else' side. + ((eq (car-safe pat) '\`) (cons :pcase-fail nil)))) + +(defun pcase-split-eq (elem pat) + (cond + ;; The same match will give the same result. + ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem)) + (cons :pcase-succeed :pcase-fail)) + ;; A different match will fail if this one succeeds. + ((and (eq (car-safe pat) '\`) + ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) + ;; (consp (cadr pat))) + ) + (cons :pcase-fail nil)))) + +(defun pcase-split-memq (elems pat) + ;; Based on pcase-split-eq. + (cond + ;; The same match will give the same result. + ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) + (cons :pcase-succeed nil)) + ;; A different match will fail if this one succeeds. + ((and (eq (car-safe pat) '\`) + ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) + ;; (consp (cadr pat))) + ) + (cons :pcase-fail nil)))) + +(defun pcase-split-pred (upat pat) + ;; FIXME: For predicates like (pred (> a)), two such predicates may + ;; actually refer to different variables `a'. + (if (equal upat pat) + (cons :pcase-succeed :pcase-fail))) + +(defun pcase-fgrep (vars sexp) + "Check which of the symbols VARS appear in SEXP." + (let ((res '())) + (while (consp sexp) + (dolist (var (pcase-fgrep vars (pop sexp))) + (unless (memq var res) (push var res)))) + (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) + res)) + +;; It's very tempting to use `pcase' below, tho obviously, it'd create +;; bootstrapping problems. +(defun pcase-u1 (matches code vars rest) + "Return code that runs CODE (with VARS) if MATCHES match. +and otherwise defers to REST which is a list of branches of the form +\(ELSE-MATCH ELSE-CODE . ELSE-VARS)." + ;; Depending on the order in which we choose to check each of the MATCHES, + ;; the resulting tree may be smaller or bigger. So in general, we'd want + ;; to be careful to chose the "optimal" order. But predicate + ;; patterns make this harder because they create dependencies + ;; between matches. So we don't bother trying to reorder anything. + (cond + ((null matches) (funcall code vars)) + ((eq :pcase-fail (car matches)) (pcase-u rest)) + ((eq :pcase-succeed (car matches)) + (pcase-u1 (cdr matches) code vars rest)) + ((eq 'and (caar matches)) + (pcase-u1 (append (cdar matches) (cdr matches)) code vars rest)) + ((eq 'or (caar matches)) + (let* ((alts (cdar matches)) + (var (if (eq (caar alts) 'match) (cadr (car alts)))) + (simples '()) (others '())) + (when var + (dolist (alt alts) + (if (and (eq (car alt) 'match) (eq var (cadr alt)) + (let ((upat (cddr alt))) + (and (eq (car-safe upat) '\`) + (or (integerp (cadr upat)) (symbolp (cadr upat)))))) + (push (cddr alt) simples) + (push alt others)))) + (cond + ((null alts) (error "Please avoid it") (pcase-u rest)) + ((> (length simples) 1) + ;; De-hoist the `or' MATCH into an `or' pattern that will be + ;; turned into a `memq' below. + (pcase-u1 (cons `(match ,var or . ,(nreverse simples)) (cdr matches)) + code vars + (if (null others) rest + (cons (list* + (pcase-and (if (cdr others) + (cons 'or (nreverse others)) + (car others)) + (cdr matches)) + code vars) + rest)))) + (t + (pcase-u1 (cons (pop alts) (cdr matches)) code vars + (if (null alts) (progn (error "Please avoid it") rest) + (cons (list* + (pcase-and (if (cdr alts) + (cons 'or alts) (car alts)) + (cdr matches)) + code vars) + rest))))))) + ((eq 'match (caar matches)) + (destructuring-bind (op sym &rest upat) (pop matches) + (cond + ((memq upat '(t _)) (pcase-u1 matches code vars rest)) + ((eq upat 'dontcare) :pcase-dontcare) + ((functionp upat) (error "Feature removed, use (pred %s)" upat)) + ((eq (car-safe upat) 'pred) + (destructuring-bind (then-rest &rest else-rest) + (pcase-split-rest + sym (apply-partially 'pcase-split-pred upat) rest) + (pcase-if (if (symbolp (cadr upat)) + `(,(cadr upat) ,sym) + (let* ((exp (cadr upat)) + ;; `vs' is an upper bound on the vars we need. + (vs (pcase-fgrep (mapcar #'car vars) exp))) + (if vs + ;; Let's not replace `vars' in `exp' since it's + ;; too difficult to do it right, instead just + ;; let-bind `vars' around `exp'. + `(let ,(mapcar (lambda (var) + (list var (cdr (assq var vars)))) + vs) + ;; FIXME: `vars' can capture `sym'. E.g. + ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) + (,@exp ,sym)) + `(,@exp ,sym)))) + (pcase-u1 matches code vars then-rest) + (pcase-u else-rest)))) + ((symbolp upat) + (pcase-u1 matches code (cons (cons upat sym) vars) rest)) + ((eq (car-safe upat) '\`) + (pcase-q1 sym (cadr upat) matches code vars rest)) + ((eq (car-safe upat) 'or) + (let ((all (> (length (cdr upat)) 1))) + (when all + (dolist (alt (cdr upat)) + (unless (and (eq (car-safe alt) '\`) + (or (symbolp (cadr alt)) (integerp (cadr alt)))) + (setq all nil)))) + (if all + ;; Use memq for (or `a `b `c `d) rather than a big tree. + (let ((elems (mapcar 'cadr (cdr upat)))) + (destructuring-bind (then-rest &rest else-rest) + (pcase-split-rest + sym (apply-partially 'pcase-split-memq elems) rest) + (pcase-if `(memq ,sym ',elems) + (pcase-u1 matches code vars then-rest) + (pcase-u else-rest)))) + (pcase-u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars + (append (mapcar (lambda (upat) + `((and (match ,sym . ,upat) ,@matches) + ,code ,@vars)) + (cddr upat)) + rest))))) + ((eq (car-safe upat) 'and) + (pcase-u1 (append (mapcar (lambda (upat) `(match ,sym ,@upat)) (cdr upat)) + matches) + code vars rest)) + ((eq (car-safe upat) 'not) + ;; FIXME: The implementation below is naive and results in + ;; inefficient code. + ;; To make it work right, we would need to turn pcase-u1's + ;; `code' and `vars' into a single argument of the same form as + ;; `rest'. We would also need to split this new `then-rest' argument + ;; for every test (currently we don't bother to do it since + ;; it's only useful for odd patterns like (and `(PAT1 . PAT2) + ;; `(PAT3 . PAT4)) which the programmer can easily rewrite + ;; to the more efficient `(,(and PAT1 PAT3) . ,(and PAT2 PAT4))). + (pcase-u1 `((match ,sym . ,(cadr upat))) + (lexical-let ((rest rest)) + ;; FIXME: This codegen is not careful to share its + ;; code if used several times: code blow up is likely. + (lambda (vars) + ;; `vars' will likely contain bindings which are + ;; not always available in other paths to + ;; `rest', so there' no point trying to pass + ;; them down. + (pcase-u rest))) + vars + (list `((and . ,matches) ,code . ,vars)))) + (t (error "Unknown upattern `%s'" upat))))) + (t (error "Incorrect MATCH %s" (car matches))))) + +(defun pcase-q1 (sym qpat matches code vars rest) + "Return code that runs CODE if SYM matches QPAT and if MATCHES match. +and if not, defers to REST which is a list of branches of the form +\(OTHER_MATCH OTHER-CODE . OTHER-VARS)." + (cond + ((eq (car-safe qpat) '\,) (error "Can't use `,UPATTERN")) + ((floatp qpat) (error "Floating point patterns not supported")) + ((vectorp qpat) + ;; FIXME. + (error "Vector QPatterns not implemented yet")) + ((consp qpat) + (let ((syma (make-symbol "xcar")) + (symd (make-symbol "xcdr"))) + (destructuring-bind (then-rest &rest else-rest) + (pcase-split-rest sym (apply-partially 'pcase-split-consp syma symd) + rest) + (pcase-if `(consp ,sym) + `(let ((,syma (car ,sym)) + (,symd (cdr ,sym))) + ,(pcase-u1 `((match ,syma . ,(pcase-upat (car qpat))) + (match ,symd . ,(pcase-upat (cdr qpat))) + ,@matches) + code vars then-rest)) + (pcase-u else-rest))))) + ((or (integerp qpat) (symbolp qpat)) + (destructuring-bind (then-rest &rest else-rest) + (pcase-split-rest sym (apply-partially 'pcase-split-eq qpat) rest) + (pcase-if `(eq ,sym ',qpat) + (pcase-u1 matches code vars then-rest) + (pcase-u else-rest)))) + (t (error "Unkown QPattern %s" qpat)))) + + +(provide 'pcase) +;;; pcase.el ends here diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index ec1a704ce0b..1845effd5bb 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -61,14 +61,12 @@ ;; this limit allowing an easy way to see all matches. ;; Currently `re-builder' understands five different forms of input, -;; namely `read', `string', `rx', `sregex' and `lisp-re' syntax. Read +;; namely `read', `string', `rx', and `sregex' syntax. Read ;; syntax and string syntax are both delimited by `"'s and behave ;; according to their name. With the `string' syntax there's no need ;; to escape the backslashes and double quotes simplifying the editing ;; somewhat. The other three allow editing of symbolic regular -;; expressions supported by the packages of the same name. (`lisp-re' -;; is a package by me and its support may go away as it is nearly the -;; same as the `sregex' package in Emacs) +;; expressions supported by the packages of the same name. ;; Editing symbolic expressions is done through a major mode derived ;; from `emacs-lisp-mode' so you'll get all the good stuff like @@ -128,12 +126,11 @@ (defcustom reb-re-syntax 'read "Syntax for the REs in the RE Builder. -Can either be `read', `string', `sregex', `lisp-re', `rx'." +Can either be `read', `string', `sregex', or `rx'." :group 're-builder :type '(choice (const :tag "Read syntax" read) (const :tag "String syntax" string) (const :tag "`sregex' syntax" sregex) - (const :tag "`lisp-re' syntax" lisp-re) (const :tag "`rx' syntax" rx))) (defcustom reb-auto-match-limit 200 @@ -281,9 +278,8 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (define-derived-mode reb-lisp-mode emacs-lisp-mode "RE Builder Lisp" "Major mode for interactively building symbolic Regular Expressions." - (cond ((eq reb-re-syntax 'lisp-re) ; Pull in packages - (require 'lisp-re)) ; as needed - ((eq reb-re-syntax 'sregex) ; sregex is not autoloaded + ;; Pull in packages as needed + (cond ((eq reb-re-syntax 'sregex) ; sregex is not autoloaded (require 'sregex)) ; right now.. ((eq reb-re-syntax 'rx) ; rx-to-string is autoloaded (require 'rx))) ; require rx anyway @@ -329,7 +325,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (defsubst reb-lisp-syntax-p () "Return non-nil if RE Builder uses a Lisp syntax." - (memq reb-re-syntax '(lisp-re sregex rx))) + (memq reb-re-syntax '(sregex rx))) (defmacro reb-target-binding (symbol) "Return binding for SYMBOL in the RE Builder target buffer." @@ -489,10 +485,10 @@ Optional argument SYNTAX must be specified if called non-interactively." (list (intern (completing-read "Select syntax: " (mapcar (lambda (el) (cons (symbol-name el) 1)) - '(read string lisp-re sregex rx)) + '(read string sregex rx)) nil t (symbol-name reb-re-syntax))))) - (if (memq syntax '(read string lisp-re sregex rx)) + (if (memq syntax '(read string sregex rx)) (let ((buffer (get-buffer reb-buffer))) (setq reb-re-syntax syntax) (when buffer @@ -616,10 +612,7 @@ optional fourth argument FORCE is non-nil." (defun reb-cook-regexp (re) "Return RE after processing it according to `reb-re-syntax'." - (cond ((eq reb-re-syntax 'lisp-re) - (when (fboundp 'lre-compile-string) - (lre-compile-string (eval (car (read-from-string re)))))) - ((eq reb-re-syntax 'sregex) + (cond ((eq reb-re-syntax 'sregex) (apply 'sregex (eval (car (read-from-string re))))) ((eq reb-re-syntax 'rx) (rx-to-string (eval (car (read-from-string re))))) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 5d04494ecb6..85fe3514b01 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1053,9 +1053,6 @@ CHAR like `and', but makes the match accessible with `match-end', `match-beginning', and `match-string'. -`(group SEXP1 SEXP2 ...)' - another name for `submatch'. - `(or SEXP1 SEXP2 ...)' `(| SEXP1 SEXP2 ...)' matches anything that matches SEXP1 or SEXP2, etc. If all diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index a3110f8d8c5..5cc89596ef5 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -52,7 +52,7 @@ (defun syntax-ppss-toplevel-pos (ppss) "Get the latest syntactically outermost position found in a syntactic scan. -PPSS is a scan state, as returned by `partial-parse-sexp' or `syntax-ppss'. +PPSS is a scan state, as returned by `parse-partial-sexp' or `syntax-ppss'. An \"outermost position\" means one that it is outside of any syntactic entity: outside of any parentheses, comments, or strings encountered in the scan. If no such position is recorded in PPSS (because the end of the scan was diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index f3b8ddcd123..94f39940b66 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -321,7 +321,11 @@ This function is called, by name, directly by the C code." ;; We do this after rescheduling so that the handler function ;; can cancel its own timer successfully with cancel-timer. (condition-case nil - (apply (timer--function timer) (timer--args timer)) + ;; Timer functions should not change the current buffer. + ;; If they do, all kinds of nasty surprises can happen, + ;; and it can be hellish to track down their source. + (save-current-buffer + (apply (timer--function timer) (timer--args timer))) (error nil)) (if retrigger (setf (timer--triggered timer) nil))) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index c2ac7e3b3d0..f6749cd9e97 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -4,7 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Kim F. Storm <storm@cua.dk> -;; Keywords: keyboard emulation convenience cua +;; Keywords: keyboard emulations convenience cua ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/pc-select.el b/lisp/emulation/pc-select.el index 529ba290cb8..fcff6a7eb60 100644 --- a/lisp/emulation/pc-select.el +++ b/lisp/emulation/pc-select.el @@ -6,7 +6,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE> -;; Keywords: convenience emulation +;; Keywords: convenience emulations ;; Created: 26 Sep 1995 ;; This file is part of GNU Emacs. @@ -110,7 +110,7 @@ This gives mostly Emacs-like behavior with only the selection keys enabled." :group 'pc-select) (defcustom pc-selection-mode-hook nil - "The hook to run when pc-selection-mode is toggled." + "The hook to run when PC Selection mode is toggled." :type 'hook :group 'pc-select) @@ -261,7 +261,7 @@ association.") (provide 'pc-select) (defun copy-region-as-kill-nomark (beg end) - "Save the region as if killed; but don't kill it; deactivate mark. + "Save the region as if killed, but don't kill it; deactivate mark. If `interprogram-cut-function' is non-nil, also save the text for a window system cut and paste. @@ -569,7 +569,7 @@ Don't use this command in Lisp programs! ;;;;;;;;;;;;;;;;;;;; (defun backward-char-mark (&optional arg) -"Ensure mark is active; move point left ARG characters (right if ARG negative). + "Ensure mark is active; move point left ARG characters (right if ARG negative). On attempt to pass beginning or end of buffer, stop and signal error." (interactive "p") (pc-select-ensure-mark) @@ -633,7 +633,7 @@ If scan reaches end of buffer, stop there without error." (defun scroll-up-mark (&optional arg) -"Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG. + "Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. When calling from a program, supply a number as argument or nil. @@ -654,7 +654,7 @@ If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer. Don't use this command in Lisp programs! -\(goto-char (p\oint-min)) is faster and avoids clobbering the mark." +\(goto-char (point-min)) is faster and avoids clobbering the mark." (interactive "P") (pc-select-ensure-mark) (let ((size (- (point-max) (point-min)))) @@ -841,7 +841,7 @@ If the value is non-nil, call the function MODE with an argument of ;;;###autoload (define-minor-mode pc-selection-mode - "Change mark behavior to emulate Motif, MAC or MS-Windows cut and paste style. + "Change mark behavior to emulate Motif, Mac or MS-Windows cut and paste style. This mode enables Delete Selection mode and Transient Mark mode. diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 8c216d9aca6..602b442a045 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -4247,7 +4247,7 @@ Null string will repeat previous search." (setq viper-use-register nil))) (if (and (bolp) viper-ex-style-editing) (ding)) - (delete-backward-char val t))) + (delete-char (- val) t))) (defun viper-del-backward-char-in-insert () @@ -4256,7 +4256,7 @@ Null string will repeat previous search." (if (and viper-ex-style-editing (bolp)) (beep 1) ;; don't put on kill ring - (delete-backward-char 1 nil))) + (delete-char -1 nil))) (defun viper-del-backward-char-in-replace () @@ -4269,14 +4269,14 @@ cursor move past the beginning of line." (cond (viper-delete-backwards-in-replace (cond ((not (bolp)) ;; don't put on kill ring - (delete-backward-char 1 nil)) + (delete-char -1 nil)) (viper-ex-style-editing (beep 1)) ((bobp) (beep 1)) (t ;; don't put on kill ring - (delete-backward-char 1 nil)))) + (delete-char -1 nil)))) (viper-ex-style-editing (if (bolp) (beep 1) @@ -4344,7 +4344,7 @@ cursor move past the beginning of line." (insert-before-markers "@") ; put placeholder after the TAB (untabify (viper-replace-start) (point)) ;; del @, don't put on kill ring - (delete-backward-char 1) + (delete-char -1) (viper-set-replace-overlay-glyphs viper-replace-region-start-delimiter @@ -4622,7 +4622,7 @@ One can use `` and '' to temporarily jump 1 step back." (progn (if (eq ?^ (preceding-char)) (setq viper-preserve-indent t)) - (delete-backward-char 1) + (delete-char -1) (setq p (point)) (setq indent nil))) (save-excursion diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 2bbb0aa6455..af016eb20be 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -101,6 +101,14 @@ way." (insert (epa-file--decode-coding-string string (or coding-system-for-read 'undecided))))) +(defvar epa-file-error nil) +(defun epa-file--find-file-not-found-function () + (let ((error epa-file-error)) + (save-window-excursion + (kill-buffer)) + (signal 'file-error + (cons "Opening input file" (cdr error))))) + (defvar last-coding-system-used) (defun epa-file-insert-file-contents (file &optional visit beg end replace) (barf-if-buffer-read-only) @@ -131,6 +139,16 @@ way." (error (if (setq entry (assoc file epa-file-passphrase-alist)) (setcdr entry nil)) + ;; Hack to prevent find-file from opening empty buffer + ;; when decryption failed (bug#6568). See the place + ;; where `find-file-not-found-functions' are called in + ;; `find-file-noselect-1'. + (when (file-exists-p local-file) + (make-local-variable 'epa-file-error) + (setq epa-file-error error) + (add-hook 'find-file-not-found-functions + 'epa-file--find-file-not-found-function + nil t)) (signal 'file-error (cons "Opening input file" (cdr error))))) (make-local-variable 'epa-file-encrypt-to) diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index b3c31fe4354..69fb6d7d7e8 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -32,6 +32,12 @@ (define-key keymap "\C-c\C-ee" 'epa-mail-encrypt) (define-key keymap "\C-c\C-ei" 'epa-mail-import-keys) (define-key keymap "\C-c\C-eo" 'epa-insert-keys) + (define-key keymap "\C-c\C-e\C-d" 'epa-mail-decrypt) + (define-key keymap "\C-c\C-e\C-v" 'epa-mail-verify) + (define-key keymap "\C-c\C-e\C-s" 'epa-mail-sign) + (define-key keymap "\C-c\C-e\C-e" 'epa-mail-encrypt) + (define-key keymap "\C-c\C-e\C-i" 'epa-mail-import-keys) + (define-key keymap "\C-c\C-e\C-o" 'epa-insert-keys) keymap)) (defvar epa-mail-mode-hook nil) diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 7a29e3d0776..90b3131ebd8 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,18 @@ +2010-08-14 Vivek Dasmohapatra <vivek@etla.org> + + * erc-join.el (erc-autojoin-timing, erc-autojoin-delay): New vars. + (erc-autojoin-channels-delayed, erc-autojoin-after-ident): New + functions. + (erc-autojoin-channels): Allow autojoining after ident (Bug#5521). + +2010-08-08 Fran Litterio <flitterio@gmail.com> + + * erc-backend.el (erc-server-filter-function): Call + erc-log-irc-protocol. + + * erc.el (erc-toggle-debug-irc-protocol): Bind + erc-toggle-debug-irc-protocol to t. + 2010-05-07 Chong Yidong <cyd@stupidchicken.com> * Version 23.2 released. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 8b533b4c255..9a237d47d55 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -574,6 +574,7 @@ Make sure you are in an ERC buffer when running this." nil (substring erc-server-filter-data (match-end 0)))) + (erc-log-irc-protocol line nil) (erc-parse-server-response process line))))))) (defsubst erc-server-reconnect-p (event) diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index 7081d97fc4b..c54c2c534f3 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -42,9 +42,11 @@ (define-erc-module autojoin nil "Makes ERC autojoin on connects and reconnects." ((add-hook 'erc-after-connect 'erc-autojoin-channels) + (add-hook 'erc-nickserv-identified-hook 'erc-autojoin-after-ident) (add-hook 'erc-server-JOIN-functions 'erc-autojoin-add) (add-hook 'erc-server-PART-functions 'erc-autojoin-remove)) ((remove-hook 'erc-after-connect 'erc-autojoin-channels) + (remove-hook 'erc-nickserv-identified-hook 'erc-autojoin-after-ident) (remove-hook 'erc-server-JOIN-functions 'erc-autojoin-add) (remove-hook 'erc-server-PART-functions 'erc-autojoin-remove))) @@ -66,6 +68,24 @@ time is used again." (repeat :tag "Channels" (string :tag "Name"))))) +(defcustom erc-autojoin-timing 'connect + "When ERC should attempt to autojoin a channel. +If the value is `connect', autojoin immediately on connecting. +If the value is `ident', autojoin after successful NickServ +identification, or after `erc-autojoin-delay' seconds. +Any other value means the same as `connect'." + :group 'erc-autojoin + :type '(choice (const :tag "On Connection" 'connect) + (const :tag "When Identified" 'ident))) + +(defcustom erc-autojoin-delay 30 + "Number of seconds to wait before attempting to autojoin channels. +This only takes effect if `erc-autojoin-timing' is `ident'. +If NickServ identification occurs before this delay expires, ERC +autojoins immediately at that time." + :group 'erc-autojoin + :type 'integer) + (defcustom erc-autojoin-domain-only t "Truncate host name to the domain name when joining a server. If non-nil, and a channel on the server a.b.c is joined, then @@ -75,12 +95,60 @@ servers, presumably in the same domain." :group 'erc-autojoin :type 'boolean) +(defvar erc--autojoin-timer nil) +(make-variable-buffer-local 'erc--autojoin-timer) + +(defun erc-autojoin-channels-delayed (server nick buffer) + "Attempt to autojoin channels. +This is called from a timer set up by `erc-autojoin-channels'." + (if erc--autojoin-timer + (setq erc--autojoin-timer + (erc-cancel-timer erc--autojoin-timer))) + (with-current-buffer buffer + ;; Don't kick of another delayed autojoin or try to wait for + ;; another ident response: + (let ((erc-autojoin-delay -1) + (erc-autojoin-timing 'connect)) + (erc-log "Delayed autojoin started (no ident success detected yet)") + (erc-autojoin-channels server nick)))) + +(defun erc-autojoin-after-ident (network nick) + "Autojoin channels in `erc-autojoin-channels-alist'. +This function is run from `erc-nickserv-identified-hook'." + (if erc--autojoin-timer + (setq erc--autojoin-timer + (erc-cancel-timer erc--autojoin-timer))) + (when (eq erc-autojoin-timing 'ident) + (let ((server (or erc-server-announced-name erc-session-server)) + (joined (mapcar (lambda (buf) + (with-current-buffer buf (erc-default-target))) + (erc-channel-list erc-server-process)))) + ;; We may already be in these channels, e.g. because the + ;; autojoin timer went off. + (dolist (l erc-autojoin-channels-alist) + (when (string-match (car l) server) + (dolist (chan (cdr l)) + (unless (erc-member-ignore-case chan joined) + (erc-server-send (concat "join " chan)))))))) + nil) + (defun erc-autojoin-channels (server nick) "Autojoin channels in `erc-autojoin-channels-alist'." - (dolist (l erc-autojoin-channels-alist) - (when (string-match (car l) server) - (dolist (chan (cdr l)) - (erc-server-send (concat "join " chan)))))) + (if (eq erc-autojoin-timing 'ident) + ;; Prepare the delayed autojoin timer, in case ident doesn't + ;; happen within the allotted time limit: + (when (> erc-autojoin-delay 0) + (setq erc--autojoin-timer + (run-with-timer erc-autojoin-delay nil + 'erc-autojoin-channels-delayed + server nick (current-buffer)))) + ;; `erc-autojoin-timing' is `connect': + (dolist (l erc-autojoin-channels-alist) + (when (string-match (car l) server) + (dolist (chan (cdr l)) + (erc-server-send (concat "join " chan)))))) + ;; Return nil to avoid stomping on any other hook funcs. + nil) (defun erc-autojoin-add (proc parsed) "Add the channel being joined to `erc-autojoin-channels-alist'." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index b76f486f155..ce4c9a46f5b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2306,14 +2306,14 @@ If ARG is non-nil, show the *erc-protocol* buffer." (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n")) (insert (erc-make-notice "Kill this buffer to terminate protocol logging.\n\n"))) (use-local-map (make-sparse-keymap)) - (local-set-key (kbd "RET") 'erc-toggle-debug-irc-protocol)) + (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol)) (add-hook 'kill-buffer-hook #'(lambda () (setq erc-debug-irc-protocol nil)) nil 'local) (goto-char (point-max)) (let ((inhibit-read-only t)) (insert (erc-make-notice - (format "IRC protocol logging %s at %s -- Press ENTER to toggle logging.\n" + (format "IRC protocol logging %s at %s -- Press `t' to toggle logging.\n" (if erc-debug-irc-protocol "disabled" "enabled") (current-time-string)))))) (setq erc-debug-irc-protocol (not erc-debug-irc-protocol)) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 1bcfe2b46e7..3aa785c7c1b 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -343,8 +343,9 @@ it defaults to `insert'." (let* ((exists (get-file-buffer target)) (buf (find-file-noselect target t))) (with-current-buffer buf - (if buffer-read-only + (if buffer-file-read-only (error "Cannot write to read-only file `%s'" target)) + (setq buffer-read-only nil) (set (make-local-variable 'eshell-output-file-buffer) (if (eq exists buf) 0 t)) (cond ((eq mode 'overwrite) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 187383d44e2..20b86676ea9 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -479,6 +479,73 @@ These special properties include `invisible', `intangible' and `read-only'." nil col))) +(defun color-rgb-to-hsv (r g b) + "For R, G, B color components return a list of hue, saturation, value. +R, G, B input values should be in [0..65535] range. +Output values for hue are integers in [0..360] range. +Output values for saturation and value are integers in [0..100] range." + (let* ((r (/ r 65535.0)) + (g (/ g 65535.0)) + (b (/ b 65535.0)) + (max (max r g b)) + (min (min r g b)) + (h (cond ((= max min) 0) + ((= max r) (mod (+ (* 60 (/ (- g b) (- max min))) 360) 360)) + ((= max g) (+ (* 60 (/ (- b r) (- max min))) 120)) + ((= max b) (+ (* 60 (/ (- r g) (- max min))) 240)))) + (s (cond ((= max 0) 0) + (t (- 1 (/ min max))))) + (v max)) + (list (round h) (round s 0.01) (round v 0.01)))) + +(defcustom list-colors-sort nil + "Color sort order for `list-colors-display'. +`nil' means default implementation-dependent order (defined in `x-colors'). +`name' sorts by color name. +`rgb' sorts by red, green, blue components. +`(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." + :type '(choice (const :tag "Unsorted" nil) + (const :tag "Color Name" name) + (const :tag "Red-Green-Blue" rgb) + (cons :tag "Distance on RGB cube" + (const :tag "Distance from Color" rgb-dist) + (color :tag "Source Color Name")) + (const :tag "Hue-Saturation-Value" hsv) + (cons :tag "Distance on HSV cylinder" + (const :tag "Distance from Color" hsv-dist) + (color :tag "Source Color Name"))) + :group 'facemenu + :version "24.1") + +(defun list-colors-sort-key (color) + "Return a list of keys for sorting colors depending on `list-colors-sort'. +COLOR is the name of the color. When return value is nil, +filter out the color from the output." + (cond + ((null list-colors-sort) color) + ((eq list-colors-sort 'name) + (downcase color)) + ((eq list-colors-sort 'rgb) + (color-values color)) + ((eq (car-safe list-colors-sort) 'rgb-dist) + (color-distance color (cdr list-colors-sort))) + ((eq list-colors-sort 'hsv) + (apply 'color-rgb-to-hsv (color-values color))) + ((eq (car-safe list-colors-sort) 'hsv-dist) + (let* ((c-rgb (color-values color)) + (c-hsv (apply 'color-rgb-to-hsv c-rgb)) + (o-hsv (apply 'color-rgb-to-hsv + (color-values (cdr list-colors-sort))))) + (unless (and (eq (nth 0 c-rgb) (nth 1 c-rgb)) ; exclude grayscale + (eq (nth 1 c-rgb) (nth 2 c-rgb))) + ;; 3D Euclidean distance (sqrt is not needed for sorting) + (+ (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))))))) (defun list-colors-display (&optional list buffer-name callback) "Display names of defined colors, and show what they look like. @@ -492,10 +559,38 @@ If the optional argument BUFFER-NAME is nil, it defaults to If the optional argument CALLBACK is non-nil, it should be a function to call each time the user types RET or clicks on a color. The function should accept a single argument, the color -name." +name. + +You can change the color sort order by customizing `list-colors-sort'." (interactive) (when (and (null list) (> (display-color-cells) 0)) (setq list (list-colors-duplicates (defined-colors))) + (when list-colors-sort + ;; Schwartzian transform with `(color key1 key2 key3 ...)'. + (setq list (mapcar + 'car + (sort (delq nil (mapcar + (lambda (c) + (let ((key (list-colors-sort-key + (car c)))) + (when key + (cons c (if (consp key) key + (list key)))))) + list)) + (lambda (a b) + (let* ((a-keys (cdr a)) + (b-keys (cdr b)) + (a-key (car a-keys)) + (b-key (car b-keys))) + ;; Skip common keys at the beginning of key lists. + (while (and a-key b-key (equal a-key b-key)) + (setq a-keys (cdr a-keys) a-key (car a-keys) + b-keys (cdr b-keys) b-key (car b-keys))) + (cond + ((and (numberp a-key) (numberp b-key)) + (< a-key b-key)) + ((and (stringp a-key) (stringp b-key)) + (string< a-key b-key))))))))) (when (memq (display-visual-class) '(gray-scale pseudo-color direct-color)) ;; Don't show more than what the display can handle. (let ((lc (nthcdr (1- (display-color-cells)) list))) @@ -505,9 +600,11 @@ name." (with-current-buffer buf (erase-buffer) (setq truncate-lines t) + ;; Display buffer before generating content to allow + ;; `list-colors-print' to get the right window-width. + (pop-to-buffer buf) (list-colors-print list callback) - (set-buffer-modified-p nil)) - (pop-to-buffer buf)) + (set-buffer-modified-p nil))) (if callback (message "Click on a color to select it."))) @@ -550,9 +647,16 @@ name." (point) 'face (list :foreground (car color))) (indent-to (max (- (window-width) 8) 44)) - (insert (apply 'format "#%02x%02x%02x" - (mapcar (lambda (c) (lsh c -8)) - color-values))) + (insert (propertize + (apply 'format "#%02x%02x%02x" + (mapcar (lambda (c) (lsh c -8)) + color-values)) + 'mouse-face 'highlight + 'help-echo + (let ((hsv (apply 'color-rgb-to-hsv + (color-values (car color))))) + (format "H:%d S:%d V:%d" + (nth 0 hsv) (nth 1 hsv) (nth 2 hsv))))) (when callback (make-text-button opoint (point) diff --git a/lisp/faces.el b/lisp/faces.el index 900e96ed048..d8b6f20035c 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -376,7 +376,7 @@ FRAME nil or not specified means do it for all frames." (defun face-all-attributes (face &optional frame) "Return an alist stating the attributes of FACE. Each element of the result has the form (ATTR-NAME . ATTR-VALUE). -Normally the value describes the default attributes, +If FRAME is omitted or nil the value describes the default attributes, but if you specify FRAME, the value describes the attributes of FACE on FRAME." (mapcar (lambda (pair) @@ -915,13 +915,14 @@ of the default face. Value is FACE." ;;; Interactively modifying faces. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun read-face-name (prompt &optional string-describing-default multiple) +(defun read-face-name (prompt &optional default multiple) "Read a face, defaulting to the face or faces on the char after point. If it has the property `read-face-name', that overrides the `face' property. PROMPT should be a string that describes what the caller will do with the face; it should not end in a space. -STRING-DESCRIBING-DEFAULT should describe what default the caller will use if -the user just types RET; you can omit it. +The optional argument DEFAULT provides the value to display in the +minibuffer prompt that is returned if the user just types RET +unless DEFAULT is a string (in which case nil is returned). If MULTIPLE is non-nil, return a list of faces (possibly only one). Otherwise, return a single face." (let ((faceprop (or (get-char-property (point) 'read-face-name) @@ -960,10 +961,10 @@ Otherwise, return a single face." (let* ((input ;; Read the input. (completing-read-multiple - (if (or faces string-describing-default) - (format "%s (default %s): " prompt + (if (or faces default) + (format "%s (default `%s'): " prompt (if faces (mapconcat 'symbol-name faces ",") - string-describing-default)) + default)) (format "%s: " prompt)) (completion-table-in-turn nonaliasfaces aliasfaces) nil t nil 'face-name-history @@ -971,7 +972,7 @@ Otherwise, return a single face." ;; Canonicalize the output. (output (cond ((or (equal input "") (equal input '(""))) - faces) + (or faces (unless (stringp default) default))) ((stringp input) (mapcar 'intern (split-string input ", *" t))) ((listp input) @@ -1334,7 +1335,7 @@ and FRAME defaults to the selected frame. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." - (interactive (list (read-face-name "Describe face" "= `default' face" t))) + (interactive (list (read-face-name "Describe face" 'default t))) (let* ((attrs '((:family . "Family") (:foundry . "Foundry") (:width . "Width") @@ -1948,8 +1949,7 @@ according to the `background-mode' and `display-type' frame parameters." "Add geometry parameters for a named frame to parameter list PARAMETERS. Value is the new parameter list." ;; Note that `x-resource-name' has a global meaning. - (let ((x-resource-name (or (cdr (assq 'name parameters)) - (cdr (assq 'name default-frame-alist))))) + (let ((x-resource-name (cdr (assq 'name parameters)))) (when x-resource-name ;; Before checking X resources, we must have an X connection. (or (window-system) @@ -1960,7 +1960,7 @@ Value is the new parameter list." (and (setq res-geometry (x-get-resource "geometry" "Geometry")) (setq parsed (x-parse-geometry res-geometry)) (setq parameters - (append parameters default-frame-alist parsed + (append parameters parsed ;; If the resource specifies a position, ;; take note of that. (if (or (assq 'top parsed) (assq 'left parsed)) @@ -1972,7 +1972,6 @@ Value is the new parameter list." "Handle the reverse-video frame parameter and X resource. `x-create-frame' does not handle this one." (when (cdr (or (assq 'reverse parameters) - (assq 'reverse default-frame-alist) (let ((resource (x-get-resource "reverseVideo" "ReverseVideo"))) (if resource @@ -1998,13 +1997,10 @@ Value is the new parameter list." (declare-function x-setup-function-keys "term/x-win" (frame)) (defun x-create-frame-with-faces (&optional parameters) - "Create a frame from optional frame parameters PARAMETERS. -Parameters not specified by PARAMETERS are taken from -`default-frame-alist'. If PARAMETERS specify a frame name, -handle X geometry resources for that name. If either PARAMETERS -or `default-frame-alist' contains a `reverse' parameter, or -the X resource ``reverseVideo'' is present, handle that. -Value is the new frame created." + "Create and return a frame with frame parameters PARAMETERS. +If PARAMETERS specify a frame name, handle X geometry resources +for that name. If PARAMETERS includes a `reverse' parameter, or +the X resource ``reverseVideo'' is present, handle that." (setq parameters (x-handle-named-frame-geometry parameters)) (let* ((params (copy-tree parameters)) (visibility-spec (assq 'visibility parameters)) @@ -2035,7 +2031,7 @@ Value is the new frame created." Calculate the face definitions using the face specs, custom theme settings, X resources, and `face-new-frame-defaults'. Finally, apply any relevant face attributes found amongst the -frame parameters in PARAMETERS and `default-frame-alist'." +frame parameters in PARAMETERS." (dolist (face (nreverse (face-list))) ;Why reverse? --Stef (condition-case () (progn @@ -2061,16 +2057,14 @@ frame parameters in PARAMETERS and `default-frame-alist'." (mouse-color mouse :background)))) (dolist (param face-params) (let* ((param-name (nth 0 param)) - (value (cdr (or (assq param-name parameters) - (assq param-name default-frame-alist))))) + (value (cdr (assq param-name parameters)))) (if value (set-face-attribute (nth 1 param) frame (nth 2 param) value)))))) (defun tty-handle-reverse-video (frame parameters) "Handle the reverse-video frame parameter for terminal frames." - (when (cdr (or (assq 'reverse parameters) - (assq 'reverse default-frame-alist))) + (when (cdr (assq 'reverse parameters)) (let* ((params (frame-parameters frame)) (bg (cdr (assq 'foreground-color params))) (fg (cdr (assq 'background-color params)))) @@ -2086,11 +2080,8 @@ frame parameters in PARAMETERS and `default-frame-alist'." (defun tty-create-frame-with-faces (&optional parameters) - "Create a frame from optional frame parameters PARAMETERS. -Parameters not specified by PARAMETERS are taken from -`default-frame-alist'. If either PARAMETERS or `default-frame-alist' -contains a `reverse' parameter, handle that. Value is the new frame -created." + "Create and return a frame from optional frame parameters PARAMETERS. +If PARAMETERS contains a `reverse' parameter, handle that." (let ((frame (make-terminal-frame parameters)) success) (unwind-protect @@ -2290,6 +2281,9 @@ terminal type to a different value." (defface region '((((class color) (min-colors 88) (background dark)) :background "blue3") + (((class color) (min-colors 88) (background light) (type gtk)) + :foreground "gtk_selection_fg_color" + :background "gtk_selection_bg_color") (((class color) (min-colors 88) (background light) (type ns)) :background "ns_selection_color") (((class color) (min-colors 88) (background light)) diff --git a/lisp/files.el b/lisp/files.el index d30531b17e5..8b131e04ebc 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2784,6 +2784,9 @@ asking you for confirmation." (truncate-lines . booleanp) ;; C source code (bidi-display-reordering . booleanp))) ;; C source code +(put 'bidi-paragraph-direction 'safe-local-variable + (lambda (v) (memq v '(nil right-to-left left-to-right)))) + (put 'c-set-style 'safe-local-eval-function t) (defvar file-local-variables-alist nil diff --git a/lisp/font-core.el b/lisp/font-core.el index be3a2a3eaca..d33295b3c34 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -97,7 +97,7 @@ It will be passed one argument, which is the current value of `font-lock-mode'.") ;; The mode for which font-lock was initialized, or nil if none. -(defvar font-lock-mode-major-mode) +(defvar font-lock-major-mode) (define-minor-mode font-lock-mode "Toggle Font Lock mode. With arg, turn Font Lock mode off if and only if arg is a non-positive @@ -159,9 +159,7 @@ your own function which is called when `font-lock-mode' is toggled via ;; Arrange to unfontify this buffer if we change major mode later. (if font-lock-mode (add-hook 'change-major-mode-hook 'font-lock-change-mode nil t) - (remove-hook 'change-major-mode-hook 'font-lock-change-mode t)) - (when font-lock-mode - (setq font-lock-mode-major-mode major-mode))) + (remove-hook 'change-major-mode-hook 'font-lock-change-mode t))) ;; Get rid of fontification for the old major mode. ;; We do this when changing major modes. @@ -213,8 +211,8 @@ this function onto `change-major-mode-hook'." (and mode (boundp 'font-lock-set-defaults) font-lock-set-defaults - font-lock-mode-major-mode - (not (eq font-lock-mode-major-mode major-mode)))) + font-lock-major-mode + (not (eq font-lock-major-mode major-mode)))) (font-lock-mode-internal mode))) (defun turn-on-font-lock () diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 7e8562c433a..9d9a2da834c 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1783,15 +1783,18 @@ preserve `hi-lock-mode' highlighting patterns." (kill-local-variable 'font-lock-set-defaults) (font-lock-mode 1)) -(defvar font-lock-mode-major-mode) +(defvar font-lock-major-mode nil + "Major mode for which the font-lock settings have been setup.") +(make-variable-buffer-local 'font-lock-major-mode) + (defun font-lock-set-defaults () "Set fontification defaults appropriately for this mode. Sets various variables using `font-lock-defaults' (or, if nil, using `font-lock-defaults-alist') and `font-lock-maximum-decoration'." ;; Set fontification defaults if not previously set for correct major mode. (unless (and font-lock-set-defaults - (eq font-lock-mode-major-mode major-mode)) - (setq font-lock-mode-major-mode major-mode) + (eq font-lock-major-mode major-mode)) + (setq font-lock-major-mode major-mode) (set (make-local-variable 'font-lock-set-defaults) t) (make-local-variable 'font-lock-fontified) (make-local-variable 'font-lock-multiline) @@ -2280,14 +2283,17 @@ in which C preprocessor directives are used. e.g. `asm-mode' and "inline" "lambda" "save-restriction" "save-excursion" "save-selected-window" "save-window-excursion" "save-match-data" "save-current-buffer" - "unwind-protect" "condition-case" "track-mouse" - "eval-after-load" "eval-and-compile" "eval-when-compile" - "eval-when" "eval-next-after-load" + "combine-after-change-calls" "unwind-protect" + "condition-case" "condition-case-no-debug" + "track-mouse" "eval-after-load" "eval-and-compile" + "eval-when-compile" "eval-when" "eval-next-after-load" "with-case-table" "with-category-table" - "with-current-buffer" "with-electric-help" + "with-current-buffer" "with-demoted-errors" + "with-electric-help" "with-local-quit" "with-no-warnings" "with-output-to-string" "with-output-to-temp-buffer" - "with-selected-window" "with-selected-frame" "with-syntax-table" + "with-selected-window" "with-selected-frame" + "with-silent-modifications" "with-syntax-table" "with-temp-buffer" "with-temp-file" "with-temp-message" "with-timeout" "with-timeout-handler") t) "\\>") diff --git a/lisp/frame.el b/lisp/frame.el index 7456db4021c..8b5be93791e 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -39,13 +39,6 @@ as its argument.") (defvar window-system-default-frame-alist nil "Alist of window-system dependent default frame parameters. -You can set this in your init file; for example, - - ;; Disable menubar and toolbar on the console, but enable them under X. - (setq window-system-default-frame-alist - '((x (menu-bar-lines . 1) (tool-bar-lines . 1)) - (nil (menu-bar-lines . 0) (tool-bar-lines . 0)))) - Parameters specified here supersede the values given in `default-frame-alist'.") @@ -287,36 +280,6 @@ and (cdr ARGS) as second." React to settings of `initial-frame-alist', `window-system-default-frame-alist' and `default-frame-alist' there (in decreasing order of priority)." - ;; Make menu-bar-mode and default-frame-alist consistent. - (when (boundp 'menu-bar-mode) - (let ((default (assq 'menu-bar-lines default-frame-alist))) - (if default - (setq menu-bar-mode (not (eq (cdr default) 0))) - (setq default-frame-alist - (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0)) - default-frame-alist))))) - - ;; Make tool-bar-mode and default-frame-alist consistent. Don't do - ;; it in batch mode since that would leave a tool-bar-lines - ;; parameter in default-frame-alist in a dumped Emacs, which is not - ;; what we want. - (when (and (boundp 'tool-bar-mode) - (not noninteractive)) - (let ((default (assq 'tool-bar-lines default-frame-alist))) - (if default - (setq tool-bar-mode (not (eq (cdr default) 0))) - ;; If Emacs was started on a tty, changing default-frame-alist - ;; would disable the toolbar on X frames created later. We - ;; want to keep the default of showing a toolbar under X even - ;; in this case. - ;; - ;; If the user explicitly called `tool-bar-mode' in .emacs, - ;; then default-frame-alist is already changed anyway. - (when initial-window-system - (setq default-frame-alist - (cons (cons 'tool-bar-lines (if tool-bar-mode 1 0)) - default-frame-alist)))))) - ;; Creating and deleting frames may shift the selected frame around, ;; and thus the current buffer. Protect against that. We don't ;; want to use save-excursion here, because that may also try to set @@ -720,15 +683,17 @@ The functions are run with one arg, the newly created frame.") (defun make-frame (&optional parameters) "Return a newly created frame displaying the current buffer. -Optional argument PARAMETERS is an alist of parameters for the new frame. -Each element of PARAMETERS should have the form (NAME . VALUE), for example: +Optional argument PARAMETERS is an alist of frame parameters for +the new frame. Each element of PARAMETERS should have the +form (NAME . VALUE), for example: (name . STRING) The frame should be named STRING. (width . NUMBER) The frame should be NUMBER characters in width. (height . NUMBER) The frame should be NUMBER text lines high. -You cannot specify either `width' or `height', you must use neither or both. +You cannot specify either `width' or `height', you must specify +neither or both. (minibuffer . t) The frame should have a minibuffer. (minibuffer . nil) The frame should have no minibuffer. @@ -740,15 +705,17 @@ You cannot specify either `width' or `height', you must use neither or both. (terminal . TERMINAL) The frame should use the terminal object TERMINAL. -Before the frame is created (via `frame-creation-function-alist'), functions on the -hook `before-make-frame-hook' are run. After the frame is created, functions -on `after-make-frame-functions' are run with one arg, the newly created frame. +In addition, any parameter specified in `default-frame-alist', +but not present in PARAMETERS, is applied. + +Before creating the frame (via `frame-creation-function-alist'), +this function runs the hook `before-make-frame-hook'. After +creating the frame, it runs the hook `after-make-frame-functions' +with one arg, the newly created frame. -This function itself does not make the new frame the selected frame. -The previously selected frame remains selected. However, the -window system may select the new frame for its own reasons, for -instance if the frame appears under the mouse pointer and your -setup is for focus to follow the pointer." +On graphical displays, this function does not itself make the new +frame the selected frame. However, the window system may select +the new frame according to its own rules." (interactive) (let* ((w (cond ((assq 'terminal parameters) @@ -763,14 +730,21 @@ setup is for focus to follow the pointer." (t window-system))) (frame-creation-function (cdr (assq w frame-creation-function-alist))) (oldframe (selected-frame)) + (params parameters) frame) (unless frame-creation-function (error "Don't know how to create a frame on window system %s" w)) + ;; Add parameters from `window-system-default-frame-alist'. + (dolist (p (cdr (assq w window-system-default-frame-alist))) + (unless (assq (car p) params) + (push p params))) + ;; Add parameters from `default-frame-alist'. + (dolist (p default-frame-alist) + (unless (assq (car p) params) + (push p params))) + ;; Now make the frame. (run-hooks 'before-make-frame-hook) - (setq frame - (funcall frame-creation-function - (append parameters - (cdr (assq w window-system-default-frame-alist))))) + (setq frame (funcall frame-creation-function params)) (normal-erase-is-backspace-setup-frame frame) ;; Inherit the original frame's parameters. (dolist (param frame-inherited-parameters) @@ -1457,23 +1431,6 @@ In the 3rd, 4th, and 6th examples, the returned value is relative to the opposite frame edge from the edge indicated in the input spec." (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec)))) -;;;; Aliases for backward compatibility with Emacs 18. -(define-obsolete-function-alias 'screen-height 'frame-height "19.7") -(define-obsolete-function-alias 'screen-width 'frame-width "19.7") - -(defun set-screen-width (cols &optional pretend) - "Change the size of the screen to COLS columns. -Optional second arg non-nil means that redisplay should use COLS columns -but that the idea of the actual width of the frame should not be changed. -This function is provided only for compatibility with Emacs 18." - (set-frame-width (selected-frame) cols pretend)) - -(defun set-screen-height (lines &optional pretend) - "Change the height of the screen to LINES lines. -Optional second arg non-nil means that redisplay should use LINES lines -but that the idea of the actual height of the screen should not be changed. -This function is provided only for compatibility with Emacs 18." - (set-frame-height (selected-frame) lines pretend)) (defun delete-other-frames (&optional frame) "Delete all frames except FRAME. @@ -1499,9 +1456,6 @@ left untouched. FRAME nil or omitted means use the selected frame." (when (eq (frame-parameter frame 'minibuffer) 'only) (delete-frame frame))))) -(make-obsolete 'set-screen-width 'set-frame-width "19.7") -(make-obsolete 'set-screen-height 'set-frame-height "19.7") - ;; miscellaneous obsolescence declarations (define-obsolete-variable-alias 'delete-frame-hook 'delete-frame-functions "22.1") diff --git a/lisp/generic-x.el b/lisp/generic-x.el index a96ab5cbbe9..0083989c75a 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -508,8 +508,7 @@ like an INI file. You can add this hook to `find-file-hook'." '("^[ \t]*\\(:\\sw+\\)" 1 font-lock-function-name-face t) '("\\(%\\sw+%\\)" 1 font-lock-variable-name-face t) '("\\(%[0-9]\\)" 1 font-lock-variable-name-face t) - '("\\(/[^/ \"\t\n]+\\)" 1 font-lock-type-face) - '("[\t ]+\\([+-][^\t\n\" ]+\\)" 1 font-lock-type-face) + '("[\t ]+\\([+-/][^\t\n\" ]+\\)" 1 font-lock-type-face) '("[ \t\n|]\\<\\([gG][oO][tT][oO]\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 78d3d234285..5db2c3fa98e 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,151 @@ +2010-08-17 Glenn Morris <rgm@gnu.org> + + * gnus-sync.el: Require gnus components whose functions are used. + + * gnus-art.el (bookmark-make-record-function): + * gnus-sum.el (bookmark-yank-point, bookmark-current-bookmark): + Declare for compiler. + + * mm-url.el (mml-compute-boundary): Autoload. + +2010-08-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-start-draft-setup): Move doc string forward. + +2010-08-14 Teodor Zlatanov <tzz@lifelogs.com> + + Typo fix "hoo4a" -> "hook". + + * gnus-sync.el (gnus-sync-install-hooks): Typo fix. + +2010-08-14 Glenn Morris <rgm@gnu.org> + + * gnus-sync.el (gnus-sync): Fix defgroup version. + +2010-08-13 Teodor Zlatanov <tzz@lifelogs.com> + + Doc fixes and keep unknown groups (ammended for nunion bug fix). + + * gnus-sync.el: Fix docs. + (gnus-sync-save): Keep unknown groups in `gnus-sync-newsrc-loader'. + (gnus-sync-read): Don't wipe `gnus-sync-newsrc-loader' after reading. + +2010-08-12 Teodor Zlatanov <tzz@lifelogs.com> + + Optimizations for gnus-sync.el. + + * gnus-sync.el: Add docs about gnus-sync-backend + possibilities. + (gnus-sync-save): Remove unnecessary message. + (gnus-sync-read): Optimize and show what groups were skipped. + +2010-08-12 Teodor Zlatanov <tzz@lifelogs.com> + + Minor bug fixes for gnus-sync.el. + + * gnus-sync.el (gnus-sync-unload-hook, gnus-sync-install-hooks): Don't + read the sync on get-new-news. + + * gnus-sync.el (gnus-sync-save): Define `variable' so the compiler is + quiet. + + * gnus-sync.el (gnus-sync-read): Use `gnus-sync-newsrc-offsets' (fix typo). + +2010-07-30 Lawrence Mitchell <wence@gmx.li> + + Make saving and restoring of hidden threads work with overlays. + Patch applied by Ted Zlatanov. + + * gnus-sum.el (gnus-hidden-threads-configuration) + (gnus-restore-hidden-threads-configuration): Update to deal with text + properties, rather than searching for a magic character. + +2010-08-12 Teodor Zlatanov <tzz@lifelogs.com> + + New gnus-sync.el library for synchronization of marks. + + * gnus-sync.el: New library for synchronization of marks. + + * gnus-util.el (gnus-grep-in-list): Moved from gnus-registry.el and + renamed from `gnus-registry-grep-in-list'. + + * gnus-registry.el (gnus-registry-follow-group-p): Use `gnus-grep-in-list'. + + * gnus-start.el (gnus-start-draft-setup): Make it interactive. + +2010-08-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * rfc2047.el (rfc2047-encode): Use utf-8 as a last resort if + determining charset of text fails. + +2010-08-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnmail.el (nnmail-get-new-mail-1): Revert. + + * nnml.el (nnml-active-number): Make sure names of newly created groups + in nnml-group-alist are encoded. + +2010-07-30 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnmail.el (nnmail-get-new-mail-1): Encode group names possibly + containing non-ASCII characters in active file for nnml back end. + +2010-07-24 David Engster <dengste@eml.cc> + + * mml-smime.el (mml-smime-epg-verify): Also accept the older + x-pkcs7-signature MIME type as signature (RFC 2311, C.1). + +2010-07-21 Daiki Ueno <ueno@unixuser.org> + + * mml.el (mml-parse-1): Collect "certfile" attributes in "<#secure>" + tag (Bug#6654). + +2010-07-20 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-summary-bookmark-make-record): Bookmark position in + the article buffer, not the summary buffer. + +2010-07-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-summary-bookmark-make-record): Make it work for + Emacs 23 as well. + +2010-07-13 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + Allow C-w when setting a bookmark in a Gnus Article buffer (Bug#5975). + Patch applied by Karl Fogel. + + * gnus-sum.el (gnus-summary-bookmark-make-record): Set + `bookmark-yank-point' and `bookmark-current-buffer' to allow C-w. + +2010-07-13 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + Allow bookmarks to be set from Gnus Article buffers (Bug #5975). + Patch applied (with minor tweaks) by Karl Fogel. Note this leaves + C-w still not working correctly from Article buffers; Thierry's + patch to fix that will be applied after this. + + * gnus-art.el (bookmark-make-record-function): New local variable. + + * gnus-sum.el (gnus-summary-bookmark-make-record): Allow setting from + article buffer. + (gnus-summary-bookmark-jump): Maybe jump to article buffer. + +2010-07-13 Karl Fogel <kfogel@red-bean.com> + + * gnus-sum.el (bookmark-make-record-default): Adjust declaration, based + on changes in bookmark.el. + +2010-06-22 Mark A. Hershberger <mah@everybody.org> + + * mm-url.el (mm-url-encode-multipart-form-data): New function to handle + the *other* type of HTML form submission. + +2010-06-15 Michael Albinus <michael.albinus@gmx.de> + + * auth-source.el (auth-source-pick): If choice does not contain a + questioned keyword, set the check to t. + 2010-06-12 Romain Francoise <romain@orebokech.com> * gnus-util.el (gnus-date-get-time): Move up before first use. @@ -64,7 +212,7 @@ 2010-05-12 Andreas Seltenreich <seltenreich@gmx.de> * gnus-sum.el (gnus-summary-read-group-1): Don't jump to next group - when catching the `C-g'. Reported by: "Leo" + when catching the `C-g'. Reported by "Leo". 2010-05-12 Katsumi Yamaoka <yamaoka@jpl.org> @@ -198,7 +346,7 @@ * mml.el (mml-generate-mime-1,mml-compute-boundary-1): Update 'mml handles on recursive mml-to-mime translation and check them for - boundary delimiter collisions. Reported by: Greg Troxel. + boundary delimiter collisions. Reported by Greg Troxel. 2010-04-27 Katsumi Yamaoka <yamaoka@jpl.org> @@ -346,7 +494,7 @@ (nnimap-retrieve-groups, nnimap-verify-uidvalidity) (nnimap-update-unseen): Significantly improved speed of Gnus startup with many imap folders. This is done by caching the group status from - the imap server persistently in a group parameter `imap-status'. (This + the imap server persistently in a group parameter `imap-status'. (This was cached before too if `nnimap-retrieve-groups-asynchronous' was set, but not persistently, so every Gnus startup was still very slow.) @@ -471,7 +619,7 @@ * nneething.el (mailcap): Require mailcap. - * nnheader.el: (declare-function): Add compatibility stub. + * nnheader.el (declare-function): Add compatibility stub. (message-remove-header): Declare rather than autoload. (nnheader-replace-header): Require message. @@ -5054,7 +5202,7 @@ 2006-11-06 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-strip-subject-encoded-words): New function + * message.el (message-strip-subject-encoded-words): New function. (message-simplify-subject-functions): New variable. (message-simplify-subject): Use it. Fix typo in doc string. Support message-strip-subject-encoded-words. @@ -5257,8 +5405,9 @@ 2006-09-20 Maxime Edouard Robert Froumentin <max@lapin-bleu.net> - (gnus-insert-mime-button, gnus-insert-mime-security-button): Apply - gnus-article-button-face to MIME and security buttons. + * gnus-art.el (gnus-insert-mime-button) + (gnus-insert-mime-security-button): + Apply gnus-article-button-face to MIME and security buttons. 2006-09-20 Reiner Steib <Reiner.Steib@gmx.de> @@ -5724,7 +5873,7 @@ * gnus-agent.el: Added gnus-agent-flush* to purge agent info. (gnus-agent-read-agentview): Fixed handling of end-of-file error. - (gnus-agent-read-local): All symbols allocated in my-obarray + (gnus-agent-read-local): All symbols allocated in my-obarray. (gnus-agent-set-local): Skip invalid entries (min and/or max is nil). (gnus-agent-regenerate-group): Check numeric names to see if they are messages or groups. @@ -9387,7 +9536,7 @@ to get all the groups a message ID is in. * spam-stat.el (spam-stat-split-fancy-spam-threshold) - (spam-stat-split-fancy): Change "threshhold" to "threshold" + (spam-stat-split-fancy): Change "threshhold" to "threshold". (spam-stat-score-buffer-user-functions): Add :number custom type. 2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org> @@ -10371,21 +10520,21 @@ 2004-11-14 Magnus Henoch <mange@freemail.hu> - * hashcash.el (hashcash-default-payment): Change default to 20 - (hashcash-default-accept-payment): Change default to 20 - (hashcash-process-alist): New variable - (hashcash-generate-payment-async): Add - (hashcash-already-paid-p): Add - (hashcash-insert-payment): Don't generate payments twice - (hashcash-insert-payment-async): Add - (hashcash-insert-payment-async-2): Add - (hashcash-cancel-async): Add - (hashcash-wait-async): Add - (hashcash-processes-running-p): Add - (hashcash-wait-or-cancel): Add + * hashcash.el (hashcash-default-payment): Change default to 20. + (hashcash-default-accept-payment): Change default to 20. + (hashcash-process-alist): New variable. + (hashcash-generate-payment-async): Add. + (hashcash-already-paid-p): Add. + (hashcash-insert-payment): Don't generate payments twice. + (hashcash-insert-payment-async): Add. + (hashcash-insert-payment-async-2): Add. + (hashcash-cancel-async): Add. + (hashcash-wait-async): Add. + (hashcash-processes-running-p): Add. + (hashcash-wait-or-cancel): Add. (mail-add-payment): New optional argument. Conditionally start asynchronous calculation. - (mail-add-payment-async): Add + (mail-add-payment-async): Add. * message.el (message-send-mail): Wait for asynchronous hashcash results. Don't clobber existing X-Hashcash headers. @@ -10873,7 +11022,7 @@ (nnsoup-unpack-packets, nnsoup-make-active): Simplify. * nnspool.el (nnspool-find-id): Use with-temp-buffer. - (nnspool-sift-nov-with-sed): Use last + (nnspool-sift-nov-with-sed): Use last. (nnspool-retrieve-headers-with-nov): Use mapc. (nnspool-request-newgroups): Use dolist. (nnspool-request-group): Use last. @@ -11574,7 +11723,7 @@ * gnus-registry.el (gnus-registry-split-fancy-with-parent): Try to append in-reply-to: data to the references: header. - * netrc.el: Remove old encryption support, autoload gnus-encrypt.el + * netrc.el: Remove old encryption support, autoload gnus-encrypt.el. (netrc-parse): Use gnus-encrypt.el functions. * gnus-encrypt.el: Add new file for encryption support; currently @@ -12071,7 +12220,7 @@ 2004-05-26 Adam Sjøgren <asjo@koldfront.dk> (tiny change) - (spam-ham-copy-or-move-routine): Don't declare `todo' twice. + * spam.el (spam-ham-copy-or-move-routine): Don't declare `todo' twice. 2004-05-26 Katsumi Yamaoka <yamaoka@jpl.org> @@ -12786,7 +12935,7 @@ * gnus-group.el: Require gnus-sum and autoload functions to resolve warnings when gnus-group.el compiled alone. - (gnus-group-line-format): Documented new %F + (gnus-group-line-format): Documented new %F. (size of Fetched data) group line format; identifies disk space used by agent and cache. (gnus-group-line-format-alist): Defined new F format. @@ -13563,8 +13712,8 @@ is "nndraft:queue". Suggested by Gaute Strokkenes <gs234@srcf.ucam.org> - * gnus-agent.el (agent-disable-undownloaded-faces): Removed - (agent-enable-undownloaded-faces): Added + * gnus-agent.el (agent-disable-undownloaded-faces): Removed. + (agent-enable-undownloaded-faces): Added. (gnus-agent-cat-groups): Use eval-and-compile, not eval-when-compile, to define gnus-agent-set-cat-groups as the setf method of gnus-agent-cat-groups even when the buffer has been @@ -13589,8 +13738,8 @@ active file (local makes it unnecessary). (gnus-agent-regenerate-group): Fixed XEmacs compatibility. - * gnus-cus.el (agent-disable-undownloaded-faces): Removed - (agent-enable-undownloaded-faces): Added + * gnus-cus.el (agent-disable-undownloaded-faces): Removed. + (agent-enable-undownloaded-faces): Added. * gnus-draft.el (gnus-draft-send): Bind gnus-agent-queue-mail to disable it when sending to "nndraft:queue". @@ -13724,7 +13873,7 @@ 2004-01-14 Kai Grossjohann <kai@emptydomain.de> - (message-kill-to-signature): Change docstring. + * message.el (message-kill-to-signature): Change docstring. 2004-01-14 Katsumi Yamaoka <yamaoka@jpl.org> @@ -14143,7 +14292,7 @@ 2004-01-05 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-treat-ansi-sequences, + * gnus-art.el (gnus-treat-ansi-sequences) (article-treat-ansi-sequences): New variable and function. Suggested by Dan Jacobson <jidanni@jidanni.org>. @@ -14322,7 +14471,7 @@ 2004-01-04 Mario Lang <lang@zid.tugraz.at> * dns.el (dns-query-types): Fix typo. - (dns-query-types): New function + (dns-query-types): New function. (dns-read-type): Add support for AAAA records, see RFC 3596. Parse MX, PTR and SOA replies, see RFC 1035. diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1 index 795df6f95a7..520b3a4b735 100644 --- a/lisp/gnus/ChangeLog.1 +++ b/lisp/gnus/ChangeLog.1 @@ -506,10 +506,10 @@ 1998-08-13 Simon Josefsson <jas@pdc.kth.se> - * gnus-msg.el (gnus-setup-message): use message-setup-hook - instead - (gnus-configure-posting-styles): new posting-style 'body - (gnus-configure-posting-styles): insert headers immediately + * gnus-msg.el (gnus-setup-message): Use message-setup-hook + instead. + (gnus-configure-posting-styles): New posting-style 'body. + (gnus-configure-posting-styles): Insert headers immediately 1998-08-13 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -524,9 +524,9 @@ 1998-08-12 Simon Josefsson <jas@pdc.kth.se> - * gnus-cache.el (gnus-uncacheable-groups): doc change - (gnus-cacheable-groups): new variable - (gnus-cache-possibly-enter-article): use it + * gnus-cache.el (gnus-uncacheable-groups): Doc change. + (gnus-cacheable-groups): New variable. + (gnus-cache-possibly-enter-article): Use it. 1998-08-12 Lars Magne Ingebrigtsen <larsi@gnus.org> diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index b05ff5fc8ef..140df493b7c 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -694,11 +694,11 @@ (gnus-agent-regenerate): Uses new gnus-agent-covered-methods function as gnus-agent-covered-methods variable no longer provides methods. - (gnus-agent-covered-methods): New function + (gnus-agent-covered-methods): New function. (gnus-agent-expire-group, gnus-agent-expire): Final message will, if gnus-verbose is greater than 4, report statistics of NOV entries and files deleted as well as total bytes recovered. - (gnus-agent-expire-done-message): New function + (gnus-agent-expire-done-message): New function. (gnus-agent-unread-articles): Bug fix. No longer drops last unread article onto read list. (gnus-agent-regenerate-group): Changed prompt to use typical @@ -900,7 +900,7 @@ * spam.el (spam-log-processing-to-registry): Improved message and comments. - (spam-log-unregistration-needed-p): New function + (spam-log-unregistration-needed-p): New function. (spam-ifile-register-spam-routine) (spam-ifile-register-ham-routine, spam-stat-register-spam-routine) (spam-stat-register-ham-routine) @@ -1120,7 +1120,7 @@ * message.el (message-mode-field-menu): Added message-generate-unsubscribed-mail-followup-to. - (message-forward-subject-fwd): Avoid double "Fwd: " + (message-forward-subject-fwd): Avoid double "Fwd: ". (message-change-subject): Added comment. 2003-10-19 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -2084,7 +2084,7 @@ (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): New functions. * gnus.el (gnus-group-spam-exit-processor-spamoracle) - (gnus-group-ham-exit-processor-spamoracle): New variables for SpamOracle + (gnus-group-ham-exit-processor-spamoracle): New variables for SpamOracle. (spam-process, ham-process): Added spamoracle spam/ham processors. 2003-06-08 Jesper Harder <harder@ifa.au.dk> @@ -2603,7 +2603,7 @@ * message.el (message-use-idna): Use mm-coding-system-p. (message-tokenize-header, message-make-organization) - (message-make-from): Use with-temp-buffer. + (message-make-from): Use with-temp-buffer. (message-set-work-buffer): Deleted. (message-fill-paragraph): Use `if' not `and' for compiler warning. (message-check-news-header-syntax): Remove useless lambda. @@ -2781,7 +2781,7 @@ * gnus-registry.el (gnus-registry-split-fancy-with-parent): Added diagnostic message. (gnus-registry-grep-in-list): Don't run when word is nil. - (gnus-registry-fetch-message-id-fast): New function + (gnus-registry-fetch-message-id-fast): New function. (gnus-registry-delete-group, gnus-registry-add-group): Make sure the id and group are not nil. (gnus-registry-register-message-ids): New function. @@ -3561,7 +3561,7 @@ `message-valid-fqdn-regexp' for initialization. (gnus-button-handle-info-url): Renamed and extended version of `gnus-button-handle-info'. - (gnus-button-message-level): Renamed from `gnus-button-mail-level' + (gnus-button-message-level): Renamed from `gnus-button-mail-level'. (gnus-button-handle-symbol, gnus-button-handle-library) (gnus-button-handle-info-keystrokes): New functions. (gnus-button-browse-level): New variable. @@ -5643,7 +5643,7 @@ 2003-01-12 Raymond Scholz <ray-2003@zonix.de> - * gnus-msg.el (gnus-confirm-mail-reply-to-news): May be a + * gnus-msg.el (gnus-confirm-mail-reply-to-news): May be a regexp or a function too. (gnus-confirm-treat-mail-like-news): New variable. Ask for confirmation even if the original article is mail. @@ -6296,8 +6296,8 @@ 2003-01-02 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-url-regexp, - (gnus-button-mid-or-mail-regexp, gnus-button-alist, + * gnus-art.el (gnus-button-url-regexp) + (gnus-button-mid-or-mail-regexp, gnus-button-alist) (gnus-header-button-alist): Regexps are case insensitive here. 2003-01-02 Simon Josefsson <jas@extundo.com> @@ -7195,7 +7195,7 @@ 2002-10-31 Alex Schroeder <alex@emacswiki.org> - * spam-stat.el (spam-stat-process-directory): Add dir to message + * spam-stat.el (spam-stat-process-directory): Add dir to message. (spam-stat-reduce-size): No longer remove words with values close to 0.5, because the default value is 0.2. @@ -12403,7 +12403,7 @@ Support "Importance:" header in Message. * message.el (message-mode-map): Bind C-c C-p to - `message-insert-or-toggle-importance' + `message-insert-or-toggle-importance'. (message-mode-menu): Add message-insert-importance-{high,low}. (message-insert-importance-high, message-insert-importance-low) (message-insert-or-toggle-importance): New functions. @@ -12871,7 +12871,7 @@ 2001-10-21 Simon Josefsson <jas@extundo.com> - * nnimap.el (nnimap): Defgroup + * nnimap.el (nnimap): Defgroup. (nnimap-strict-function, nnimap-strict-function-match): New widget, from Per Abrahamsen <abraham@dina.kvl.dk>. (nnimap-split-crosspost, nnimap-split-inbox) @@ -16689,7 +16689,7 @@ * gnus-cus.el (gnus-group-customize): Use it. * gnus.el (gnus-define-group-parameter): New macro. - (auto-expire): Use it + (auto-expire): Use it. (total-expire): Use it. * gnus-art.el (banner): Use it. @@ -16855,7 +16855,7 @@ * gnus-msg.el (gnus-summary-mail-forward): ??? - * message.el (message-forward): Move mime-to-mml here. + * message.el (message-forward): Move mime-to-mml here. 2000-12-20 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -17157,7 +17157,7 @@ * nnheader.el: Wrap subst-char-in-string def in eval-and-compile. Put some defvars in eval-when-compile. - (gnus-intersection, gnus-sorted-complement): Autoload. + (gnus-intersection, gnus-sorted-complement): Autoload. * imap.el (imap-point-at-eol): New, replacing gnus-point-at-eol. @@ -17329,7 +17329,7 @@ * qp.el (mm-decode-coding-region, mm-encode-coding-region): Autoload. - (quoted-printable-decode-region): Rename arg which confused + (quoted-printable-decode-region): Rename arg which confused charset with coding-system. Don't use nonascii-insert-offset. Coding-system encode the region initially. Don't recognize `==' as valid QP. Coding-system decode the region finally. @@ -17384,7 +17384,7 @@ 2000-09-29 Gerd Moellmann <gerd@gnu.org> - * smiley-ems.el (smiley-update-cache): Use `:ascent center'. + * smiley-ems.el (smiley-update-cache): Use `:ascent center'. 2000-09-21 Dave Love <fx@gnu.org> @@ -18036,7 +18036,7 @@ * gnus-art.el (gnus-mime-display-part): Show MIME security button. (gnus-insert-mime-security-button): New function. * mm-decode.el (mm-possibly-verify-or-decrypt): Add security info. - * mml2015.el: Add security info when verify or decrypt. + * mml2015.el: Add security info when verify or decrypt. * mm-uu.el (mm-uu-pgp-signed-extract): Use multipart. (mm-uu-pgp-encrypted-extract): Ditto. @@ -18433,7 +18433,7 @@ (mm-dissect-multipart): Use it. * mml2015.el (mml2015-fix-micalg): New function. (mml2015-decrypt): Use new interface. - (mml2015-verify): Use new interface. + (mml2015-verify): Use new interface. (mml2015-setup): Make it bogus. 2000-10-28 16:54:45 ShengHuo ZHU <zsh@cs.rochester.edu> diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 89b2ef3d11d..e43f09e5ed1 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -229,7 +229,8 @@ matched as a regex." ;; Check keywords. (dolist (k keys match) (let* ((v (plist-get spec k)) - (choicev (plist-get choice k))) + (choicev (if (plist-member choice k) + (plist-get choice k) t))) (setq match (and match (or diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 6b20fa678d0..618d8e410cb 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4414,6 +4414,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (gnus-run-hooks 'gnus-article-menu-hook))) +(defvar bookmark-make-record-function) + (defun gnus-article-mode () "Major mode for displaying an article. @@ -4452,6 +4454,8 @@ commands: (make-local-variable 'gnus-article-image-alist) (make-local-variable 'gnus-article-charset) (make-local-variable 'gnus-article-ignored-charsets) + (set (make-local-variable 'bookmark-make-record-function) + 'gnus-summary-bookmark-make-record) ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space' ;; face. (set (make-local-variable 'nobreak-char-display) nil) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index db10440116b..e3af088278c 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -661,10 +661,10 @@ necessary." "Determines if a group name should be followed. Consults `gnus-registry-unfollowed-groups' and `nnmail-split-fancy-with-parent-ignore-groups'." - (not (or (gnus-registry-grep-in-list + (not (or (gnus-grep-in-list group gnus-registry-unfollowed-groups) - (gnus-registry-grep-in-list + (gnus-grep-in-list group nnmail-split-fancy-with-parent-ignore-groups)))) @@ -745,14 +745,6 @@ Consults `gnus-registry-unfollowed-groups' and (assoc article (gnus-data-list nil))))) nil)) -(defun gnus-registry-grep-in-list (word list) -"Find if a WORD matches any regular expression in the given LIST." - (when (and word list) - (catch 'found - (dolist (r list) - (when (string-match r word) - (throw 'found r)))))) - (defun gnus-registry-do-marks (type function) "For each known mark, call FUNCTION for each cell of type TYPE. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 9ef251f2147..491926dc331 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -814,6 +814,7 @@ prompt the user for the name of an NNTP server to use." (defun gnus-start-draft-setup () "Make sure the draft group exists." + (interactive) (gnus-request-create-group "drafts" '(nndraft "")) (unless (gnus-group-entry "nndraft:drafts") (let ((gnus-level-default-subscribed 1)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 98a0556d499..ba3f6a910ea 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3406,8 +3406,10 @@ marks of articles." (save-excursion (let (config) (goto-char (point-min)) - (while (search-forward "\r" nil t) - (push (1- (point)) config)) + (while (not (eobp)) + (when (eq (get-char-property (point-at-eol) 'invisible) 'gnus-sum) + (push (save-excursion (forward-line 0) (point)) config)) + (forward-line 1)) config))) (defun gnus-restore-hidden-threads-configuration (config) @@ -3415,10 +3417,8 @@ marks of articles." (save-excursion (let (point (inhibit-read-only t)) (while (setq point (pop config)) - (when (and (< point (point-max)) - (goto-char point) - (eq (char-after) ?\n)) - (subst-char-in-region point (1+ point) ?\n ?\r)))))) + (goto-char point) + (gnus-summary-hide-thread))))) ;; Various summary mode internalish functions. @@ -12621,25 +12621,39 @@ If ALL is a number, fetch this number of articles." (gnus-summary-position-point))) ;;; Bookmark support for Gnus. -(declare-function bookmark-make-record-default "bookmark" (&optional pos-only)) +(declare-function bookmark-make-record-default + "bookmark" (&optional no-file no-context posn)) (declare-function bookmark-prop-get "bookmark" (bookmark prop)) (declare-function bookmark-default-handler "bookmark" (bmk)) (declare-function bookmark-get-bookmark-record "bookmark" (bmk)) +(defvar bookmark-yank-point) +(defvar bookmark-current-bookmark) (defun gnus-summary-bookmark-make-record () "Make a bookmark entry for a Gnus summary buffer." - (unless (and (derived-mode-p 'gnus-summary-mode) gnus-article-current) - (error "Please retry from the Gnus summary buffer")) ;[1] - (let* ((subject (elt (gnus-summary-article-header) 1)) - (grp (car gnus-article-current)) - (art (cdr gnus-article-current)) - (head (gnus-summary-article-header art)) - (id (mail-header-id head))) - `(,subject - ,@(bookmark-make-record-default 'point-only) - (location . ,(format "Gnus %s:%d:%s" grp art id)) - (group . ,grp) (article . ,art) - (message-id . ,id) (handler . gnus-summary-bookmark-jump)))) + (let (pos buf) + (unless (and (derived-mode-p 'gnus-summary-mode) gnus-article-current) + (save-restriction ; FIXME is it necessary to widen? + (widen) (setq pos (point))) ; Set position in gnus-article buffer. + (setq buf "art") ; We are recording bookmark from article buffer. + (setq bookmark-yank-point (point)) + (setq bookmark-current-buffer (current-buffer)) + (gnus-article-show-summary)) ; Go back in summary buffer. + ;; We are now recording bookmark from summary buffer. + (unless buf (setq buf "sum")) + (let* ((subject (elt (gnus-summary-article-header) 1)) + (grp (car gnus-article-current)) + (art (cdr gnus-article-current)) + (head (gnus-summary-article-header art)) + (id (mail-header-id head))) + `(,subject + ,@(condition-case nil + (bookmark-make-record-default 'no-file 'no-context pos) + (wrong-number-of-arguments + (bookmark-make-record-default 'point-only))) + (location . ,(format "Gnus-%s %s:%d:%s" buf grp art id)) + (group . ,grp) (article . ,art) + (message-id . ,id) (handler . gnus-summary-bookmark-jump))))) ;;;###autoload (defun gnus-summary-bookmark-jump (bookmark) @@ -12647,10 +12661,18 @@ If ALL is a number, fetch this number of articles." BOOKMARK is a bookmark name or a bookmark record." (let ((group (bookmark-prop-get bookmark 'group)) (article (bookmark-prop-get bookmark 'article)) - (id (bookmark-prop-get bookmark 'message-id))) + (id (bookmark-prop-get bookmark 'message-id)) + (buf (car (split-string (bookmark-prop-get bookmark 'location))))) (gnus-fetch-group group (list article)) (gnus-summary-insert-cached-articles) (gnus-summary-goto-article id nil 'force) + ;; FIXME we have to wait article buffer is ready (only large buffer) + ;; Is there a better solution to know that? + ;; If we don't wait `bookmark-default-handler' will have no chance + ;; to set position. However there is no error, just wrong pos. + (sit-for 1) + (when (string= buf "Gnus-art") + (other-window 1)) (bookmark-default-handler `("" (buffer . ,(current-buffer)) diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el new file mode 100644 index 00000000000..c0e52b6a8b2 --- /dev/null +++ b/lisp/gnus/gnus-sync.el @@ -0,0 +1,233 @@ +;;; gnus-sync.el --- synchronization facility for Gnus + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Ted Zlatanov <tzz@lifelogs.com> +;; Keywords: news synchronization nntp nnrss + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This is the gnus-sync.el package. + +;; Put this in your startup file (~/.gnus.el for instance) + +;; possibilities for gnus-sync-backend: +;; Tramp over SSH: /ssh:user@host:/path/to/filename +;; Tramp over IMAP: /imaps:user@yourhosthere.com:/INBOX.test/filename +;; ...or any other file Tramp and Emacs can handle... + +;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded +;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date) +;; gnus-sync-newsrc-groups `("nntp" "nnrss") +;; gnus-sync-newsrc-offsets `(2 3)) + +;; TODO: + +;; - after gnus-sync-read, the message counts are wrong + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'gnus) +(require 'gnus-start) +(require 'gnus-util) + +(defgroup gnus-sync nil + "The Gnus synchronization facility." + :version "24.1" + :group 'gnus) + +(defcustom gnus-sync-newsrc-groups `("nntp" "nnrss") + "List of groups to be synchronized in the gnus-newsrc-alist. +The group names are matched, they don't have to be fully +qualified. Typically you would choose all of these. That's the +default because there is no active sync backend by default, so +this setting is harmless until the user chooses a sync backend." + :group 'gnus-sync + :type '(repeat regexp)) + +(defcustom gnus-sync-newsrc-offsets '(2 3) + "List of per-group data to be synchronized." + :group 'gnus-sync + :type '(set (const :tag "Read ranges" 2) + (const :tag "Marks" 3))) + +(defcustom gnus-sync-global-vars nil + "List of global variables to be synchronized. +You may want to sync `gnus-newsrc-last-checked-date' but pretty +much any symbol is fair game. You could additionally sync +`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology', +and `gnus-topic-alist' to cover all the variables in +newsrc.eld (except for `gnus-format-specs' which should not be +synchronized, I believe). Also see `gnus-variable-list'." + :group 'gnus-sync + :type '(repeat (choice (variable :tag "A known variable") + (symbol :tag "Any symbol")))) + +(defcustom gnus-sync-backend nil + "The synchronization backend." + :group 'gnus-sync + :type '(radio (const :format "None" nil) + (string :tag "Sync to a file"))) + +(defvar gnus-sync-newsrc-loader nil + "Carrier for newsrc data") + +(defun gnus-sync-save () +"Save the Gnus sync data to the backend." + (interactive) + (cond + ((stringp gnus-sync-backend) + (gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend) + ;; populate gnus-sync-newsrc-loader from all but the first dummy + ;; entry in gnus-newsrc-alist whose group matches any of the + ;; gnus-sync-newsrc-groups + ;; TODO: keep the old contents for groups we don't have! + (let ((gnus-sync-newsrc-loader + (loop for entry in (cdr gnus-newsrc-alist) + when (gnus-grep-in-list + (car entry) ;the group name + gnus-sync-newsrc-groups) + collect (cons (car entry) + (mapcar (lambda (offset) + (cons offset (nth offset entry))) + gnus-sync-newsrc-offsets))))) + (with-temp-file gnus-sync-backend + (progn + (let ((coding-system-for-write gnus-ding-file-coding-system) + (standard-output (current-buffer))) + (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" + gnus-ding-file-coding-system)) + (princ ";; Gnus sync data v. 0.0.1\n") + (let* ((print-quoted t) + (print-readably t) + (print-escape-multibyte nil) + (print-escape-nonascii t) + (print-length nil) + (print-level nil) + (print-circle nil) + (print-escape-newlines t) + (variables (cons 'gnus-sync-newsrc-loader + gnus-sync-global-vars)) + variable) + (while variables + (if (and (boundp (setq variable (pop variables))) + (symbol-value variable)) + (progn + (princ "\n(setq ") + (princ (symbol-name variable)) + (princ " '") + (prin1 (symbol-value variable)) + (princ ")\n")) + (princ "\n;;; skipping empty variable ") + (princ (symbol-name variable))))) + (gnus-message + 7 + "gnus-sync: stored variables %s and %d groups in %s" + gnus-sync-global-vars + (length gnus-sync-newsrc-loader) + gnus-sync-backend) + + ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu> + ;; Save the .eld file with extra line breaks. + (gnus-message 8 "gnus-sync: adding whitespace to %s" + gnus-sync-backend) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^(\\|(\\\"" nil t) + (replace-match "\n\\&" t)) + (goto-char (point-min)) + (while (re-search-forward " $" nil t) + (replace-match "" t t)))))))) + ;; the pass-through case: gnus-sync-backend is not a known choice + (nil))) + +(defun gnus-sync-read () +"Load the Gnus sync data from the backend." + (interactive) + (when gnus-sync-backend + (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend) + (cond ((stringp gnus-sync-backend) + ;; read data here... + (if (or debug-on-error debug-on-quit) + (load gnus-sync-backend nil t) + (condition-case var + (load gnus-sync-backend nil t) + (error + (error "Error in %s: %s" gnus-sync-backend (cadr var))))) + (let ((valid-count 0) + invalid-groups) + (dolist (node gnus-sync-newsrc-loader) + (if (gnus-gethash (car node) gnus-newsrc-hashtb) + (progn + (incf valid-count) + (loop for store in (cdr node) + do (setf (nth (car store) + (assoc (car node) gnus-newsrc-alist)) + (cdr store)))) + (push (car node) invalid-groups))) + (gnus-message + 7 + "gnus-sync: loaded %d groups (out of %d) from %s" + valid-count (length gnus-sync-newsrc-loader) + gnus-sync-backend) + (when invalid-groups + (gnus-message + 7 + "gnus-sync: skipped %d groups (out of %d) from %s" + (length invalid-groups) + (length gnus-sync-newsrc-loader) + gnus-sync-backend) + (gnus-message 9 "gnus-sync: skipped groups: %s" + (mapconcat 'identity invalid-groups ", "))))) + (nil)) + ;; make the hashtable again because the newsrc-alist may have been modified + (when gnus-sync-newsrc-offsets + (gnus-message 9 "gnus-sync: remaking the newsrc hashtable") + (gnus-make-hashtable-from-newsrc-alist)))) + +;;;###autoload +(defun gnus-sync-initialize () +"Initialize the Gnus sync facility." + (interactive) + (gnus-message 5 "Initializing the sync facility") + (gnus-sync-install-hooks)) + +;;;###autoload +(defun gnus-sync-install-hooks () + "Install the sync hooks." + (interactive) + ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read) + (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save) + (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) + +(defun gnus-sync-unload-hook () + "Uninstall the sync hooks." + (interactive) + ;; (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read) + (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save) + (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) + +(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook) + +;; this is harmless by default, until the gnus-sync-backend is set +(gnus-sync-initialize) + +(provide 'gnus-sync) + +;;; gnus-sync.el ends here diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index b8a1c266c93..93cc1f0a542 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1297,6 +1297,14 @@ Return the modified alist." (setq alist (delq entry alist))) alist))) +(defun gnus-grep-in-list (word list) + "Find if a WORD matches any regular expression in the given LIST." + (when (and word list) + (catch 'found + (dolist (r list) + (when (string-match r word) + (throw 'found r)))))) + (defmacro gnus-pull (key alist &optional assoc-p) "Modify ALIST to be without KEY." (unless (symbolp alist) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index c5a8d9f7fdc..c963bdae00b 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -418,6 +418,50 @@ spaces. Die Die Die." (mm-url-form-encode-xwfu (cdr data)))) pairs "&")) +(autoload 'mml-compute-boundary "mml") + +(defun mm-url-encode-multipart-form-data (pairs &optional boundary) + "Return PAIRS encoded in multipart/form-data." + ;; RFC1867 + + ;; Get a good boundary + (unless boundary + (setq boundary (mml-compute-boundary '()))) + + (concat + + ;; Start with the boundary + "--" boundary "\r\n" + + ;; Create name value pairs + (mapconcat + 'identity + ;; Delete any returned items that are empty + (delq nil + (mapcar (lambda (data) + (when (car data) + ;; For each pair + (concat + + ;; Encode the name + "Content-Disposition: form-data; name=\"" + (car data) "\"\r\n" + "Content-Type: text/plain; charset=utf-8\r\n" + "Content-Transfer-Encoding: binary\r\n\r\n" + + (cond ((stringp (cdr data)) + (cdr data)) + ((integerp (cdr data)) + (int-to-string (cdr data)))) + + "\r\n"))) + pairs)) + ;; use the boundary as a separator + (concat "--" boundary "\r\n")) + + ;; put a boundary at the end. + "--" boundary "--\r\n")) + (defun mm-url-fetch-form (url pairs) "Fetch a form from URL with PAIRS as the data using the POST method." (mm-url-load-url) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index a4541ac5dec..827003f8ec7 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -520,10 +520,14 @@ Content-Disposition: attachment; filename=smime.p7m ctl 'protocol) "application/pkcs7-signature") t))) - (null (setq signature (mm-find-part-by-type - (cdr handle) - "application/pkcs7-signature" - nil t)))) + (null (setq signature (or (mm-find-part-by-type + (cdr handle) + "application/pkcs7-signature" + nil t) + (mm-find-part-by-type + (cdr handle) + "application/x-pkcs7-signature" + nil t))))) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 170bc69fe3a..2ebd7996d77 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -228,7 +228,10 @@ part. This is for the internal use, you should never modify the value.") (let* (secure-mode (taginfo (mml-read-tag)) (keyfile (cdr (assq 'keyfile taginfo))) - (certfile (cdr (assq 'certfile taginfo))) + (certfiles (delq nil (mapcar (lambda (tag) + (if (eq (car-safe tag) 'certfile) + (cdr tag))) + taginfo))) (recipients (cdr (assq 'recipients taginfo))) (sender (cdr (assq 'sender taginfo))) (location (cdr (assq 'tag-location taginfo))) @@ -254,8 +257,10 @@ part. This is for the internal use, you should never modify the value.") ,@tags ,(if keyfile "keyfile") ,keyfile - ,(if certfile "certfile") - ,certfile + ,@(apply #'append + (mapcar (lambda (certfile) + (list "certfile" certfile)) + certfiles)) ,(if recipients "recipients") ,recipients ,(if sender "sender") diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index fb5fb44113f..238e0221b97 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -751,10 +751,9 @@ article number. This function is called narrowed to an article." (defun nnml-active-number (group &optional server) "Compute the next article number in GROUP on SERVER." - (let ((active (cadr (assoc (if nnmail-group-names-not-encoded-p - (nnml-encoded-group-name group server) - group) - nnml-group-alist)))) + (let* ((encoded (if nnmail-group-names-not-encoded-p + (nnml-encoded-group-name group server))) + (active (cadr (assoc (or encoded group) nnml-group-alist)))) ;; The group wasn't known to nnml, so we just create an active ;; entry for it. (unless active @@ -772,7 +771,7 @@ article number. This function is called narrowed to an article." (cons (caar nnml-article-file-alist) (caar (last nnml-article-file-alist))) (cons 1 0))) - (push (list group active) nnml-group-alist)) + (push (list (or encoded group) active) nnml-group-alist)) (setcdr active (1+ (cdr active))) (while (file-exists-p (nnml-group-pathname group (int-to-string (cdr active)) server)) diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index 840b02a26fd..27d34ee5290 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -655,6 +655,9 @@ should not change this value.") Point moves to the end of the region." (let ((mime-charset (or (mm-find-mime-charset-region b e) (list 'us-ascii))) cs encoding tail crest eword) + ;; Use utf-8 as a last resort if determining charset of text fails. + (if (memq nil mime-charset) + (setq mime-charset (list 'utf-8))) (cond ((> (length mime-charset) 1) (error "Can't rfc2047-encode `%s'" (buffer-substring-no-properties b e))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 86e9411b140..18db4f443f6 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -231,8 +231,8 @@ if the variable `help-downcase-arguments' is non-nil." "Guess the file that defined the Lisp object OBJECT, of type TYPE. OBJECT should be a symbol associated with a function, variable, or face; alternatively, it can be a function definition. -If TYPE is `variable', search for a variable definition. -If TYPE is `face', search for a face definition. +If TYPE is `defvar', search for a variable definition. +If TYPE is `defface', search for a face definition. If TYPE is the value returned by `symbol-function' for a function symbol, search for a function definition. diff --git a/lisp/help-mode.el b/lisp/help-mode.el index f115e425325..7a7a1ddaf79 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -244,6 +244,16 @@ The format is (FUNCTION ARGS...).") (message "Unable to find location in file")))) 'help-echo (purecopy "mouse-2, RET: find face's definition")) +(define-button-type 'help-package + :supertype 'help-xref + 'help-function 'describe-package + 'help-echo (purecopy "mouse-2, RET: Describe package")) + +(define-button-type 'help-package-def + :supertype 'help-xref + 'help-function (lambda (file) (dired file)) + 'help-echo (purecopy "mouse-2, RET: visit package directory")) + ;;;###autoload (defun help-mode () @@ -272,6 +282,9 @@ Commands: (with-current-buffer buffer (bury-buffer)))) + (set (make-local-variable 'revert-buffer-function) + 'help-mode-revert-buffer) + (run-mode-hooks 'help-mode-hook)) ;;;###autoload @@ -783,6 +796,17 @@ Show all docs for that symbol as either a variable, function or face." (fboundp sym) (facep sym)) (help-do-xref pos #'help-xref-interned (list sym))))) +(defun help-mode-revert-buffer (ignore-auto noconfirm) + (when (or noconfirm (yes-or-no-p "Revert help buffer? ")) + (let ((pos (point)) + (item help-xref-stack-item) + ;; Pretend there is no current item to add to the history. + (help-xref-stack-item nil) + ;; Use the current buffer. + (help-xref-following t)) + (apply (car item) (cdr item)) + (goto-char pos)))) + (defun help-insert-string (string) "Insert STRING to the help buffer and install xref info for it. This function can be used to restore the old contents of the help buffer diff --git a/lisp/help.el b/lisp/help.el index 899547aa0a1..9434201797e 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -768,9 +768,10 @@ temporarily enables it to allow getting help on disabled items and buttons." ----------------- up-event %s---------------- -<%S>%s%s runs the command %S, which is " +%s%s%s runs the command %S, which is " (if mouse-1-tricky "(short click) " "") - ev-type mouse-msg + (key-description (vector up-event)) + mouse-msg (if mouse-1-remapped " is remapped to <mouse-2>, which" "") defn-up)) diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 755ff696453..9a791076002 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -1,12 +1,12 @@ ;;; hl-line.el --- highlight the current line -;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Dave Love <fx@gnu.org> ;; Maintainer: FSF ;; Created: 1998-09-13 -;; Keywords: faces, frames, emulation +;; Keywords: faces, frames, emulations ;; This file is part of GNU Emacs. diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 12e54972461..035b6d384e7 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -926,7 +926,7 @@ See also `hfy-display-class' for details of valid values for CLASS." new-spec))))) (if (or (memq :inherit face-spec) (eq 'default face)) face-spec - (nconc face-spec (list :inherit 'default))) )) + (append face-spec (list :inherit 'default))))) ;; construct an assoc of (css-tag-name . css-tag-value) pairs ;; from a face or assoc of face attributes: diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 9bd5a76d5da..5bda540fdfe 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -128,6 +128,28 @@ A winprops object has the shape (WINDOW . ALIST)." (declare-function image-size "image.c" (spec &optional pixels frame)) +(defun image-display-size (spec &optional pixels frame) + "Wrapper around `image-size', to handle slice display properties. +If SPEC is an image display property, call `image-size' with the +given arguments. +If SPEC is a list of properties containing `image' and `slice' +properties, calculate the display size from the slice property. +If SPEC contains `image' but not `slice', call `image-size' with +the specified image." + (if (eq (car spec) 'image) + (image-size spec pixels frame) + (let ((image (assoc 'image spec)) + (slice (assoc 'slice spec))) + (cond ((and image slice) + (if pixels + (cons (nth 3 slice) (nth 4 slice)) + (cons (/ (float (nth 3 slice)) (frame-char-width frame)) + (/ (float (nth 4 slice)) (frame-char-height frame))))) + (image + (image-size image pixels frame)) + (t + (error "Invalid image specification: %s" spec)))))) + (defun image-forward-hscroll (&optional n) "Scroll image in current window to the left by N character widths. Stop if the right edge of the image is reached." @@ -139,7 +161,7 @@ Stop if the right edge of the image is reached." (let* ((image (image-get-display-property)) (edges (window-inside-edges)) (win-width (- (nth 2 edges) (nth 0 edges))) - (img-width (ceiling (car (image-size image))))) + (img-width (ceiling (car (image-display-size image))))) (image-set-window-hscroll (min (max 0 (- img-width win-width)) (+ n (window-hscroll)))))))) @@ -160,7 +182,7 @@ Stop if the bottom edge of the image is reached." (let* ((image (image-get-display-property)) (edges (window-inside-edges)) (win-height (- (nth 3 edges) (nth 1 edges))) - (img-height (ceiling (cdr (image-size image))))) + (img-height (ceiling (cdr (image-display-size image))))) (image-set-window-vscroll (min (max 0 (- img-height win-height)) (+ n (window-vscroll)))))))) @@ -233,7 +255,7 @@ stopping if the top or bottom edge of the image is reached." (let* ((image (image-get-display-property)) (edges (window-inside-edges)) (win-width (- (nth 2 edges) (nth 0 edges))) - (img-width (ceiling (car (image-size image))))) + (img-width (ceiling (car (image-display-size image))))) (image-set-window-hscroll (max 0 (- img-width win-width))))) (defun image-bob () @@ -248,9 +270,9 @@ stopping if the top or bottom edge of the image is reached." (let* ((image (image-get-display-property)) (edges (window-inside-edges)) (win-width (- (nth 2 edges) (nth 0 edges))) - (img-width (ceiling (car (image-size image)))) + (img-width (ceiling (car (image-display-size image)))) (win-height (- (nth 3 edges) (nth 1 edges))) - (img-height (ceiling (cdr (image-size image))))) + (img-height (ceiling (cdr (image-display-size image))))) (image-set-window-hscroll (max 0 (- img-width win-width))) (image-set-window-vscroll (max 0 (- img-height win-height))))) @@ -264,7 +286,7 @@ This function assumes the current frame has only one window." (interactive) (let* ((saved (frame-parameter nil 'image-mode-saved-size)) (display (image-get-display-property)) - (size (image-size display))) + (size (image-display-size display))) (if (and saved (eq (caar saved) (frame-width)) (eq (cdar saved) (frame-height))) @@ -519,15 +541,15 @@ the image file and `image-mode' showing the image as an image." ;;; Support for bookmark.el -(declare-function bookmark-make-record-default "bookmark" - (&optional point-only)) +(declare-function bookmark-make-record-default + "bookmark" (&optional no-file no-context posn)) (declare-function bookmark-prop-get "bookmark" (bookmark prop)) (declare-function bookmark-default-handler "bookmark" (bmk)) (defun image-bookmark-make-record () - (nconc (bookmark-make-record-default) - `((image-type . ,image-type) - (handler . image-bookmark-jump)))) + `(,@(bookmark-make-record-default nil 'no-context 0) + (image-type . ,image-type) + (handler . image-bookmark-jump))) ;;;###autoload (defun image-bookmark-jump (bmk) diff --git a/lisp/info.el b/lisp/info.el index e76a8da146e..65b9492e351 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -238,7 +238,9 @@ This only has an effect if `Info-hide-note-references' is non-nil." (defcustom Info-breadcrumbs-depth 4 "Depth of breadcrumbs to display. 0 means do not display breadcrumbs." - :type 'integer) + :version "23.1" + :type 'integer + :group 'info) (defcustom Info-search-whitespace-regexp "\\s-+" "If non-nil, regular expression to match a sequence of whitespace chars. @@ -800,17 +802,22 @@ otherwise, that defaults to `Top'." "Go to an Info node FILENAME and NODENAME, re-reading disk contents. When *info* is already displaying FILENAME and NODENAME, the window position is preserved, if possible." - (pop-to-buffer "*info*") + (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*")) (let ((old-filename Info-current-file) (old-nodename Info-current-node) + (old-buffer-name (buffer-name)) (pcolumn (current-column)) (pline (count-lines (point-min) (line-beginning-position))) (wline (count-lines (point-min) (window-start))) + (old-history-forward Info-history-forward) (old-history Info-history) (new-history (and Info-current-file (list Info-current-file Info-current-node (point))))) (kill-buffer (current-buffer)) + (pop-to-buffer (or old-buffer-name "*info*")) + (Info-mode) (Info-find-node filename nodename) + (setq Info-history-forward old-history-forward) (setq Info-history old-history) (if (and (equal old-filename Info-current-file) (equal old-nodename Info-current-node)) @@ -4894,7 +4901,8 @@ BUFFER is the buffer speedbar is requesting buttons for." '(Info-mode . Info-restore-desktop-buffer)) ;;;; Bookmark support -(declare-function bookmark-make-record-default "bookmark" (&optional pos-only)) +(declare-function bookmark-make-record-default + "bookmark" (&optional no-file no-context posn)) (declare-function bookmark-prop-get "bookmark" (bookmark prop)) (declare-function bookmark-default-handler "bookmark" (bmk)) (declare-function bookmark-get-bookmark-record "bookmark" (bmk)) @@ -4903,7 +4911,7 @@ BUFFER is the buffer speedbar is requesting buttons for." "This implements the `bookmark-make-record-function' type (which see) for Info nodes." `(,Info-current-node - ,@(bookmark-make-record-default 'point-only) + ,@(bookmark-make-record-default 'no-file) (filename . ,Info-current-file) (info-node . ,Info-current-node) (handler . Info-bookmark-jump))) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index f53b69eed8b..9ee8d22463a 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -1410,9 +1410,10 @@ is treated as a character." :flags '(ascii-at-eol ascii-at-cntl designation single-shift composition)) (define-coding-system 'compound-text - "Compound text based generic encoding for decoding unknown messages. - -This coding system does not support extended segments of CTEXT." + "Compound text based generic encoding. +This coding system is an extension of X's \"Compound Text Encoding\". +It encodes many characters using the normal ISO-2022 designation sequences, +but it doesn't support extended segments of CTEXT." :coding-type 'iso-2022 :mnemonic ?x :charset-list 'iso-2022 @@ -1432,7 +1433,7 @@ This coding system does not support extended segments of CTEXT." ;; not have a mime-charset property, to prevent it from showing up ;; close to the beginning of coding systems ordered by priority. (define-coding-system 'ctext-no-compositions - "Compound text based generic encoding for decoding unknown messages. + "Compound text based generic encoding. Like `compound-text', but does not produce escape sequences for compositions." :coding-type 'iso-2022 @@ -1445,8 +1446,9 @@ Like `compound-text', but does not produce escape sequences for compositions." (define-coding-system 'compound-text-with-extensions "Compound text encoding with ICCCM Extended Segment extensions. -See the variable `ctext-non-standard-encodings-alist' for the -detail about how extended segments are handled. +See the variables `ctext-standard-encodings' and +`ctext-non-standard-encodings-alist' for the detail about how +extended segments are handled. This coding system should be used only for X selections. It is inappropriate for decoding and encoding files, process I/O, etc." diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 0569ca4c268..59d6ff42c97 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -282,6 +282,7 @@ attribute." (plist-put props :short-name (symbol-name name))) (or (plist-get props :long-name) (plist-put props :long-name (plist-get props :short-name))) + (plist-put props :base name) ;; We can probably get a worthwhile amount in purespace. (setq props (mapcar (lambda (elt) @@ -1465,7 +1466,9 @@ This function is provided for backward compatibility." '(("big5-0" big5 2 big5) ("ISO8859-14" iso-8859-14 1 latin-iso8859-14) ("ISO8859-15" iso-8859-15 1 latin-iso8859-15) - ("gbk-0" gbk 2 chinese-gbk))) + ("gbk-0" gbk 2 chinese-gbk) + ("koi8-r" koi8-r 1 koi8-r) + ("microsoft-cp1251" windows-1251 1 windows-1251))) "Alist of non-standard encoding names vs the corresponding usages in CTEXT. It controls how extended segments of a compound text are handled @@ -1554,6 +1557,20 @@ Each element must be one of the names listed in the variable (goto-char (point-min)) (- (point-max) (point))))) +(defvar ctext-standard-encodings + '(ascii latin-jisx0201 katakana-jisx0201 + latin-iso8859-1 latin-iso8859-2 latin-iso8859-3 latin-iso8859-4 + greek-iso8859-7 arabic-iso8859-6 hebrew-iso8859-8 cyrillic-iso8859-5 + latin-iso8859-9 + chinese-gb2312 japanese-jisx0208 korean-ksc5601) + "List of approved standard encodings (i.e. charsets) of X's Compound Text. +Coding-system `compound-text-with-extensions' encodes a character +belonging to any of those charsets using the normal ISO2022 +designation sequence unless the current language environment or +the variable `ctext-non-standard-encodings' decide to use an extended +segment of CTEXT for that character. See also the documentation +of `ctext-non-standard-encodings-alist'.") + ;; Return an alist of CHARSET vs CTEXT-USAGE-INFO generated from ;; `ctext-non-standard-encodings' and a list specified by the key ;; `ctext-non-standard-encodings' for the currrent language @@ -1565,115 +1582,94 @@ Each element must be one of the names listed in the variable ;; is encoded using UTF-8 encoding extention. (defun ctext-non-standard-encodings-table () - (let (table) - ;; Setup charsets specified by the key - ;; `ctext-non-standard-encodings' for the current language - ;; environment and in `ctext-non-standard-encodings'. - (dolist (encoding (append - (get-language-info current-language-environment - 'ctext-non-standard-encodings) - ctext-non-standard-encodings)) - (let* ((slot (assoc encoding ctext-non-standard-encodings-alist)) + (let* ((table (append ctext-non-standard-encodings + (copy-sequence + (get-language-info current-language-environment + 'ctext-non-standard-encodings)))) + (tail table) + elt) + (while tail + (setq elt (car tail)) + (let* ((slot (assoc elt ctext-non-standard-encodings-alist)) (charset (nth 3 slot))) (if (charsetp charset) - (push (cons charset slot) table) - (dolist (cs charset) - (push (cons cs slot) table))))) - - ;; Next prepend charsets for ISO2022 designation sequence. - (dolist (charset charset-list) - (let ((final (plist-get (charset-plist charset) :iso-final-char))) - (if (and (integerp final) - (>= final #x40) (<= final #x7e) - ;; Exclude ascii and chinese-cns11643-X. - (not (eq charset 'ascii)) - (not (string-match "cns11643" (symbol-name charset)))) - (push (cons charset nil) table)))) - - ;; Returned reversed list so that the charsets specified by the - ;; key `ctext-non-standard-encodings' for the current language - ;; have the highest priority. - (nreverse table))) + (setcar tail + (cons (plist-get (charset-plist charset) :base) slot)) + (setcar tail (cons (car charset) slot)) + (dolist (cs (cdr charset)) + (setcdr tail + (cons (cons (plist-get (charset-plist (car cs)) :base) slot) + (cdr tail))) + (setq tail (cdr tail)))) + (setq tail (cdr tail)))) + table)) (defun ctext-pre-write-conversion (from to) "Encode characters between FROM and TO as Compound Text w/Extended Segments. -If FROM is a string, or if the current buffer is not the one set up for us -by `encode-coding-string', generate a new temp buffer, insert the text, -and convert it in the temporary buffer. Otherwise, convert in-place." +If FROM is a string, generate a new temp buffer, insert the text, +and convert it in the temporary buffer. Otherwise, convert +in-place." (save-match-data ;; Setup a working buffer if necessary. (when (stringp from) (set-buffer (generate-new-buffer " *temp")) (set-buffer-multibyte (multibyte-string-p from)) - (insert from)) - - ;; Now we can encode the whole buffer. - (let ((encoding-table (ctext-non-standard-encodings-table)) - last-coding-system-used - last-pos last-encoding-info - encoding-info end-pos ch) - (goto-char (setq last-pos (point-min))) - (setq end-pos (point-marker)) - (while (re-search-forward "[^\000-\177]+" nil t) - ;; Found a sequence of non-ASCII characters. - (setq last-pos (match-beginning 0) - ch (char-after last-pos) - last-encoding-info (catch 'tag - (dolist (elt encoding-table) - (if (encode-char ch (car elt)) - (throw 'tag (cdr elt)))) - 'utf-8)) - (set-marker end-pos (match-end 0)) - (goto-char (1+ last-pos)) - (catch 'tag - (while t - (setq encoding-info - (if (< (point) end-pos) - (catch 'tag - (setq ch (following-char)) - (dolist (elt encoding-table) - (if (encode-char ch (car elt)) - (throw 'tag (cdr elt)))) - 'utf-8))) - (unless (eq last-encoding-info encoding-info) - (cond ((consp last-encoding-info) - ;; Encode the previous range using an extended - ;; segment. - (let ((encoding-name (car last-encoding-info)) - (coding-system (nth 1 last-encoding-info)) - (noctets (nth 2 last-encoding-info)) - len) - (encode-coding-region last-pos (point) coding-system) - (setq len (+ (length encoding-name) 1 - (- (point) last-pos))) - ;; According to the spec of CTEXT, it is not - ;; necessary to produce this extra designation - ;; sequence, but some buggy application - ;; (e.g. crxvt-gb) requires it. - (insert "\e(B") - (save-excursion - (goto-char last-pos) - (insert (format "\e%%/%d" noctets)) - (insert-byte (+ (/ len 128) 128) 1) - (insert-byte (+ (% len 128) 128) 1) - (insert encoding-name) - (insert 2)))) - ((eq last-encoding-info 'utf-8) - ;; Encode the previous range using UTF-8 encoding - ;; extention. - (encode-coding-region last-pos (point) 'mule-utf-8) - (save-excursion - (goto-char last-pos) - (insert "\e%G")) - (insert "\e%@"))) - (setq last-pos (point) - last-encoding-info encoding-info)) - (if (< (point) end-pos) - (forward-char 1) - (throw 'tag nil))))) - (set-marker end-pos nil) - (goto-char (point-min)))) + (insert from) + (setq from 1 to (point-max))) + (save-restriction + (narrow-to-region from to) + (goto-char from) + (let ((encoding-table (ctext-non-standard-encodings-table)) + (charset-list (sort-charsets + (copy-sequence ctext-standard-encodings))) + (end-pos (make-marker)) + last-coding-system-used + last-pos charset encoding-info) + (dolist (elt encoding-table) + (push (car elt) charset-list)) + (setq end-pos (point-marker)) + (while (re-search-forward "[^\0-\177]+" nil t) + ;; Found a sequence of non-ASCII characters. + (set-marker end-pos (match-end 0)) + (goto-char (match-beginning 0)) + (setq last-pos (point) + charset (char-charset (following-char) charset-list)) + (forward-char 1) + (while (and (< (point) end-pos) + (eq charset (char-charset (following-char) charset-list))) + (forward-char 1)) + (if charset + (if (setq encoding-info (cdr (assq charset encoding-table))) + ;; Encode this range using an extended segment. + (let ((encoding-name (car encoding-info)) + (coding-system (nth 1 encoding-info)) + (noctets (nth 2 encoding-info)) + len) + (encode-coding-region last-pos (point) coding-system) + (setq len (+ (length encoding-name) 1 + (- (point) last-pos))) + ;; According to the spec of CTEXT, it is not + ;; necessary to produce this extra designation + ;; sequence, but some buggy application + ;; (e.g. crxvt-gb) requires it. + (insert "\e(B") + (save-excursion + (goto-char last-pos) + (insert (format "\e%%/%d" noctets)) + (insert-byte (+ (/ len 128) 128) 1) + (insert-byte (+ (% len 128) 128) 1) + (insert encoding-name) + (insert 2))) + ;; Encode this range as characters in CHARSET. + (put-text-property last-pos (point) 'charset charset)) + ;; Encode this range using UTF-8 encoding extention. + (encode-coding-region last-pos (point) 'mule-utf-8) + (save-excursion + (goto-char last-pos) + (insert "\e%G")) + (insert "\e%@"))) + (goto-char (point-min))))) ;; Must return nil, as build_annotations_2 expects that. nil) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 9959b275943..621f314bf70 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -811,7 +811,7 @@ The format of KBD-LAYOUT is the same as `quail-keyboard-layout'." (setq translation (aref (cdr translation) 0)) (setq translation " "))) (setq done-list (cons translation done-list))) - (setq translation ch)) + (setq translation (aref kbd-layout i))) (aset layout i translation)) (setq i (1+ i))) diff --git a/lisp/isearch.el b/lisp/isearch.el index 89d50d66c76..6f89e0ee817 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2581,6 +2581,7 @@ since they have special meaning in a regexp." (defvar isearch-lazy-highlight-case-fold-search nil) (defvar isearch-lazy-highlight-regexp nil) (defvar isearch-lazy-highlight-space-regexp nil) +(defvar isearch-lazy-highlight-forward nil) (defun lazy-highlight-cleanup (&optional force) "Stop lazy highlighting and remove extra highlighting from current buffer. @@ -2620,7 +2621,9 @@ by other Emacs features." (not (= (window-start) isearch-lazy-highlight-window-start)) (not (= (window-end) ; Window may have been split/joined. - isearch-lazy-highlight-window-end)))) + isearch-lazy-highlight-window-end)) + (not (eq isearch-forward + isearch-lazy-highlight-forward)))) ;; something important did indeed change (lazy-highlight-cleanup t) ;kill old loop & remove overlays (when (not isearch-error) @@ -2635,7 +2638,8 @@ by other Emacs features." isearch-lazy-highlight-case-fold-search isearch-case-fold-search isearch-lazy-highlight-regexp isearch-regexp isearch-lazy-highlight-wrapped nil - isearch-lazy-highlight-space-regexp search-whitespace-regexp) + isearch-lazy-highlight-space-regexp search-whitespace-regexp + isearch-lazy-highlight-forward isearch-forward) (unless (equal isearch-string "") (setq isearch-lazy-highlight-timer (run-with-idle-timer lazy-highlight-initial-delay nil @@ -2651,7 +2655,8 @@ Attempt to do the search exactly the way the pending Isearch would." (search-invisible nil) ; don't match invisible text (retry t) (success nil) - (bound (if isearch-forward + (isearch-forward isearch-lazy-highlight-forward) + (bound (if isearch-lazy-highlight-forward (min (or isearch-lazy-highlight-end-limit (point-max)) (if isearch-lazy-highlight-wrapped isearch-lazy-highlight-start @@ -2687,7 +2692,7 @@ Attempt to do the search exactly the way the pending Isearch would." (select-window isearch-lazy-highlight-window)) (save-excursion (save-match-data - (goto-char (if isearch-forward + (goto-char (if isearch-lazy-highlight-forward isearch-lazy-highlight-end isearch-lazy-highlight-start)) (while looping @@ -2700,7 +2705,7 @@ Attempt to do the search exactly the way the pending Isearch would." (let ((mb (match-beginning 0)) (me (match-end 0))) (if (= mb me) ;zero-length match - (if isearch-forward + (if isearch-lazy-highlight-forward (if (= mb (if isearch-lazy-highlight-wrapped isearch-lazy-highlight-start (window-end))) @@ -2720,7 +2725,7 @@ Attempt to do the search exactly the way the pending Isearch would." (overlay-put ov 'priority 1000) (overlay-put ov 'face lazy-highlight-face) (overlay-put ov 'window (selected-window)))) - (if isearch-forward + (if isearch-lazy-highlight-forward (setq isearch-lazy-highlight-end (point)) (setq isearch-lazy-highlight-start (point))))) @@ -2730,7 +2735,7 @@ Attempt to do the search exactly the way the pending Isearch would." (setq looping nil nomore t) (setq isearch-lazy-highlight-wrapped t) - (if isearch-forward + (if isearch-lazy-highlight-forward (progn (setq isearch-lazy-highlight-end (window-start)) (goto-char (max (or isearch-lazy-highlight-start-limit (point-min)) diff --git a/lisp/kmacro.el b/lisp/kmacro.el index c2bedf35339..439c7383223 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -642,11 +642,13 @@ others, use \\[kmacro-name-last-macro]." kmacro-call-repeat-key))) (setq repeat-key-str (format-kbd-macro (vector repeat-key) nil)) (while repeat-key - (message "(Type %s to repeat macro%s)" - repeat-key-str - (if (and kmacro-call-repeat-with-arg - arg (> arg 1)) - (format " %d times" arg) "")) + ;; Issue a hint to the user, if the echo area isn't in use. + (unless (current-message) + (message "(Type %s to repeat macro%s)" + repeat-key-str + (if (and kmacro-call-repeat-with-arg + arg (> arg 1)) + (format " %d times" arg) ""))) (if (equal repeat-key (read-event)) (progn (clear-this-command-keys t) diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el index 7d2f082579f..b293ad1ff0b 100644 --- a/lisp/language/cyrillic.el +++ b/lisp/language/cyrillic.el @@ -239,13 +239,6 @@ Support for Russian using koi8-r and the russian-computer input method.") (documentation . "Support for Tajik using KOI8-T.")) '("Cyrillic")) -(let ((elt `("microsoft-cp1251" windows-1251 1 - ,(get 'encode-windows-1251 'translation-table))) - (slot (assoc "microsoft-cp1251" ctext-non-standard-encodings-alist))) - (if slot - (setcdr slot (cdr elt)) - (push elt ctext-non-standard-encodings-alist))) - (set-language-info-alist "Bulgarian" `((coding-system windows-1251) (coding-priority windows-1251) diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el index f024251c60b..24ddfb2c11f 100644 --- a/lisp/language/hebrew.el +++ b/lisp/language/hebrew.el @@ -1,4 +1,4 @@ -;;; hebrew.el --- support for Hebrew -*- coding: iso-2022-7bit; no-byte-compile: t -*- +;;; hebrew.el --- support for Hebrew -*- coding: utf-8 -*- ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;; Free Software Foundation, Inc. @@ -46,20 +46,19 @@ (define-coding-system-alias 'iso-8859-8 'hebrew-iso-8bit) ;; These are for Explicit and Implicit directionality information, as -;; defined in RFC 1556. We don't yet support directional information -;; in bidi languages, so these aliases are a lie, especially as far as -;; iso-8859-8-e is concerned. FIXME. +;; defined in RFC 1556. (define-coding-system-alias 'iso-8859-8-e 'hebrew-iso-8bit) (define-coding-system-alias 'iso-8859-8-i 'hebrew-iso-8bit) (set-language-info-alist - "Hebrew" '((charset iso-8859-8) + "Hebrew" '((tutorial . "TUTORIAL.he") + (charset iso-8859-8) (coding-priority hebrew-iso-8bit) (coding-system hebrew-iso-8bit windows-1255 cp862) (nonascii-translation . iso-8859-8) (input-method . "hebrew") (unibyte-display . hebrew-iso-8bit) - (sample-text . "Hebrew ,Hylem(B") + (sample-text . "Hebrew שלום") (documentation . "Bidirectional editing is supported."))) (set-language-info-alist @@ -85,36 +84,177 @@ Bidirectional editing is supported."))) :mime-charset 'cp862) (define-coding-system-alias 'ibm862 'cp862) -;; Composition function for hebrew. +;; Return a nested alist of Hebrew character sequences vs the +;; corresponding glyph of FONT-OBJECT. +(defun hebrew-font-get-precomposed (font-object) + (let ((precomposed (font-get font-object 'hebrew-precomposed)) + ;; Vector of Hebrew precomposed charaters. + (chars [#xFB2A #xFB2B #xFB2C #xFB2D #xFB2E #xFB2F #xFB30 #xFB31 + #xFB32 #xFB33 #xFB34 #xFB35 #xFB36 #xFB38 #xFB39 #xFB3A + #xFB3B #xFB3C #xFB3E #xFB40 #xFB41 #xFB43 #xFB44 #xFB46 + #xFB47 #xFB48 #xFB49 #xFB4A #xFB4B #xFB4C #xFB4D #xFB4E]) + ;; Vector of decomposition character sequences corresponding + ;; to the above vector. + (decomposed + [[#x05E9 #x05C1] + [#x05E9 #x05C2] + [#x05E9 #x05BC #x05C1] + [#x05E9 #x05BC #x05C2] + [#x05D0 #x05B7] + [#x05D0 #x05B8] + [#x05D0 #x05BC] + [#x05D1 #x05BC] + [#x05D2 #x05BC] + [#x05D3 #x05BC] + [#x05D4 #x05BC] + [#x05D5 #x05BC] + [#x05D6 #x05BC] + [#x05D8 #x05BC] + [#x05D9 #x05BC] + [#x05DA #x05BC] + [#x05DB #x05BC] + [#x05DC #x05BC] + [#x05DE #x05BC] + [#x05E0 #x05BC] + [#x05E1 #x05BC] + [#x05E3 #x05BC] + [#x05E4 #x05BC] + [#x05E6 #x05BC] + [#x05E7 #x05BC] + [#x05E8 #x05BC] + [#x05E9 #x05BC] + [#x05EA #x05BC] + [#x05D5 #x05B9] + [#x05D1 #x05BF] + [#x05DB #x05BF] + [#x05E4 #x05BF]])) + (unless precomposed + (setq precomposed (list t)) + (let ((gvec (font-get-glyphs font-object 0 (length chars) chars))) + (dotimes (i (length chars)) + (if (aref gvec i) + (set-nested-alist (aref decomposed i) (aref gvec i) + precomposed)))) + ;; Cache the result in FONT-OBJECT's property. + (font-put font-object 'hebrew-precomposed precomposed)) + precomposed)) + +;; Composition function for hebrew. GSTRING is made of a Hebrew base +;; character followed by Hebrew diacritical marks, or is made of +;; single Hebrew diacritical mark. Adjust GSTRING to display that +;; sequence properly. The basic strategy is: +;; +;; (1) If there's single diacritical, add padding space to the left +;; and right of the glyph. +;; +;; (2) If the font has OpenType features for Hebrew, ask the OTF +;; driver the whole work. +;; +;; (3) If the font has precomposed glyphs, use them as far as +;; possible. Adjust the remaining glyphs artificially. + (defun hebrew-shape-gstring (gstring) - (setq gstring (font-shape-gstring gstring)) - (let ((header (lgstring-header gstring)) - (nchars (lgstring-char-len gstring)) - (nglyphs (lgstring-glyph-len gstring)) - (base-width (lglyph-width (lgstring-glyph gstring 0)))) - (while (and (> nglyphs 1) - (not (lgstring-glyph gstring (1- nglyphs)))) - (setq nglyphs (1- nglyphs))) - (while (> nglyphs 1) - (setq nglyphs (1- nglyphs)) - (let* ((glyph (lgstring-glyph gstring nglyphs)) - (adjust (and glyph (lglyph-adjustment glyph)))) - (if adjust - (setq nglyphs 0) - (if (>= (lglyph-lbearing glyph) 0) - (lglyph-set-adjustment glyph (- base-width) 0 0)))))) - gstring) - -(let ((pattern1 "[\u05D0-\u05F2][\u0591-\u05BF\u05C1-\u05C5\u05C7]+") - (pattern2 "[\u05D0-\u05F2]\u200D[\u0591-\u05BF\u05C1-\u05C5\u05C7]+")) + (let* ((font (lgstring-font gstring)) + (otf (font-get font :otf)) + (nchars (lgstring-char-len gstring)) + header nglyphs base-width glyph precomposed val idx) + (cond + ((= nchars 1) + ;; Independent diacritical mark. Add padding space to left or + ;; right so that the glyph doesn't overlap with the surrounding + ;; chars. + (setq glyph (lgstring-glyph gstring 0)) + (let ((width (lglyph-width glyph)) + bearing) + (if (< (setq bearing (lglyph-lbearing glyph)) 0) + (lglyph-set-adjustment glyph bearing 0 (- width bearing))) + (if (> (setq bearing (lglyph-rbearing glyph)) width) + (lglyph-set-adjustment glyph 0 0 bearing)))) + + ((or (assq 'hebr (car otf)) (assq 'hebr (cdr otf))) + ;; FONT has OpenType features for Hebrew. + (font-shape-gstring gstring)) + + (t + ;; FONT doesn't have OpenType features for Hebrew. + ;; Try a precomposed glyph. + ;; Now GSTRING is in this form: + ;; [[FONT CHAR1 CHAR2 ... CHARn] nil GLYPH1 GLYPH2 ... GLYPHn nil ...] + (setq precomposed (hebrew-font-get-precomposed font) + header (lgstring-header gstring) + val (lookup-nested-alist header precomposed nil 1)) + (if (and (consp val) (vectorp (car val))) + ;; All characters can be displayed by a single precomposed glyph. + ;; Reform GSTRING to [HEADER nil PRECOMPOSED-GLYPH nil ...] + (let ((glyph (copy-sequence (car val)))) + (lglyph-set-from-to glyph 0 (1- nchars)) + (lgstring-set-glyph gstring 0 glyph) + (lgstring-set-glyph gstring 1 nil)) + (if (and (integerp val) (> val 2) + (setq glyph (lookup-nested-alist header precomposed val 1)) + (consp glyph) (vectorp (car glyph))) + ;; The first (1- VAL) characters can be displayed by a + ;; precomposed glyph. Provided that VAL is 3, the first + ;; two glyphs should be replaced by the precomposed glyph. + ;; In that case, reform GSTRING to: + ;; [HEADER nil PRECOMPOSED-GLYPH GLYPH3 ... GLYPHn nil ...] + (let* ((ncmp (1- val)) ; number of composed glyphs + (diff (1- ncmp))) ; number of reduced glyphs + (setq glyph (copy-sequence (car glyph))) + (lglyph-set-from-to glyph 0 (1- nchars)) + (lgstring-set-glyph gstring 0 glyph) + (setq idx ncmp) + (while (< idx nchars) + (setq glyph (lgstring-glyph gstring idx)) + (lglyph-set-from-to glyph 0 (1- nchars)) + (lgstring-set-glyph gstring (- idx diff) glyph) + (setq idx (1+ idx))) + (lgstring-set-glyph gstring (- idx diff) nil) + (setq idx (- ncmp diff) + nglyphs (- nchars diff))) + (setq glyph (lgstring-glyph gstring 0)) + (lglyph-set-from-to glyph 0 (1- nchars)) + (setq idx 1 nglyphs nchars)) + ;; Now IDX is an index to the first non-precomposed glyph. + ;; Adjust positions of the remaining glyphs artificially. + (setq base-width (lglyph-width (lgstring-glyph gstring 0))) + (while (< idx nglyphs) + (setq glyph (lgstring-glyph gstring idx)) + (lglyph-set-from-to glyph 0 (1- nchars)) + (if (>= (lglyph-lbearing glyph) (lglyph-width glyph)) + ;; It seems that this glyph is designed to be rendered + ;; before the base glyph. + (lglyph-set-adjustment glyph (- base-width) 0 0) + (if (>= (lglyph-lbearing glyph) 0) + ;; Align the horizontal center of this glyph to the + ;; horizontal center of the base glyph. + (let ((width (- (lglyph-rbearing glyph) + (lglyph-lbearing glyph)))) + (lglyph-set-adjustment glyph + (- (/ (- base-width width) 2) + (lglyph-lbearing glyph) + base-width) 0 0)))) + (setq idx (1+ idx)))))) + gstring)) + +(let* ((base "[\u05D0-\u05F2]") + (combining "[\u0591-\u05BD\u05BF\u05C1-\u05C2\u05C4-\u05C5\u05C7]+") + (pattern1 (concat base combining)) + (pattern2 (concat base "\u200D" combining))) (set-char-table-range composition-function-table '(#x591 . #x5C7) - (list (vector pattern2 2 'hebrew-shape-gstring) + (list (vector pattern2 3 'hebrew-shape-gstring) + (vector pattern2 2 'hebrew-shape-gstring) (vector pattern1 1 'hebrew-shape-gstring) - ["[\u0591-\u05C7]" 0 font-shape-gstring])) + [nil 0 hebrew-shape-gstring])) + ;; Exclude non-combining characters. + (set-char-table-range + composition-function-table #x5BE nil) (set-char-table-range composition-function-table #x5C0 nil) (set-char-table-range + composition-function-table #x5C3 nil) + (set-char-table-range composition-function-table #x5C6 nil)) (provide 'hebrew) diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el index 1423d298d27..25ac901a642 100644 --- a/lisp/language/tai-viet.el +++ b/lisp/language/tai-viet.el @@ -37,7 +37,7 @@ (coding-system utf-8) (coding-priority utf-8) (input-method . "tai-sonla") - (sample-text . "TaiViet (ꪁꪫꪱꪣ ꪽꪕ)\t\tꪅꪰꪙ ꪨꪮ ꪁꪫꪱ / ꪅꪾ ꪨ� ꪁꪫꪱ") + (sample-text . "TaiViet (ꪁꪫꪱꪣ ꪼꪕ)\t\tꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ ꪁꪫꪱ") (documentation . "\ TaiViet refers to the Tai language used by Tai people in Vietnam, and also refers to the script used for this language. @@ -45,15 +45,15 @@ Both the script and language have the same origin as that of Thai language/script used in Thailand, but now they differ from each other in a significant way (especially the scripts are). -The language name is spelled as \"ꪁꪫꪱꪣ ꪽꪕ\", and the script name is -spelled as \"ꪎ� ꪽꪕ\" in the modern form, \"ꪎꪴ ꪽꪕ\" in the traditional -from. +The language name is spelled as \"ꪁꪫꪱꪣ ꪼꪕ\", and the script name is +spelled as \"ꪎ ꪼꪕ\" in the modern form, \"ꪎꪳ ꪼꪕ\" in the traditional +form. As the proposal for TaiViet script to the Unicode is still on the progress, we use the Private Use Area for TaiViet characters (U+F000..U+F07E). A TaiViet font encoded accordingly is available at this web page: - http://www.m17n.org/TaiViet/ + http://www.m17n.org/viettai/ "))) (provide 'tai-viet) diff --git a/lisp/language/tv-util.el b/lisp/language/tv-util.el index 842366dacbc..67ed6327971 100644 --- a/lisp/language/tv-util.el +++ b/lisp/language/tv-util.el @@ -24,8 +24,7 @@ ;;; Code ;; Regexp matching with a sequence of Tai Viet characters. -(defconst tai-viet-re - (format "[\xaa80-\xaac2\xaadb-\xaadf-]+")) +(defconst tai-viet-re "[\xaa80-\xaac2\xaadb-\xaadf]+") ;; Char-table of information about glyph type of Tai Viet characters. (defconst tai-viet-glyph-info diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 478d7aa075f..91242b98aeb 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -74,6 +74,52 @@ (declare-function message-sort-headers "message" ()) (defvar message-strip-special-text-properties) +(defun report-emacs-bug-can-use-xdg-email () + "Check if xdg-email can be used, i.e. we are on Gnome, KDE or xfce4." + (and (getenv "DISPLAY") + (executable-find "xdg-email") + (or (getenv "GNOME_DESKTOP_SESSION_ID") + ;; GNOME_DESKTOP_SESSION_ID is deprecated, check on Dbus also. + (condition-case nil + (eq 0 (call-process + "dbus-send" nil nil nil + "--dest=org.gnome.SessionManager" + "--print-reply" + "/org/gnome/SessionManager" + "org.gnome.SessionManager.CanShutdown")) + (error nil)) + (equal (getenv "KDE_FULL_SESSION") "true") + (condition-case nil + (eq 0 (call-process + "/bin/sh" nil nil nil + "-c" + "xprop -root _DT_SAVE_MODE|grep xfce4")) + (error nil))))) + +(defun report-emacs-bug-insert-to-mailer () + (interactive) + (save-excursion + (let* ((to (progn + (goto-char (point-min)) + (forward-line) + (and (looking-at "^To: \\(.*\\)") + (match-string-no-properties 1)))) + (subject (progn + (forward-line) + (and (looking-at "^Subject: \\(.*\\)") + (match-string-no-properties 1)))) + (body (progn + (forward-line 2) + (if (> (point-max) (point)) + (buffer-substring-no-properties (point) (point-max)))))) + (if (and to subject body) + (start-process "xdg-email" nil "xdg-email" + "--subject" subject + "--body" body + (concat "mailto:" to)) + (error "Subject, To or body not found"))))) + + ;;;###autoload (defun report-emacs-bug (topic &optional recent-keys) "Report a bug in GNU Emacs. @@ -93,6 +139,7 @@ Prompts for bug subject. Leaves you in a mail buffer." (prompt-properties '(field emacsbug-prompt intangible but-helpful rear-nonsticky t)) + (can-xdg-email (report-emacs-bug-can-use-xdg-email)) user-point message-end-point) (setq message-end-point (with-current-buffer (get-buffer-create "*Messages*") @@ -226,6 +273,9 @@ usually do not have translators to read other languages for them.\n\n") ;; This is so the user has to type something in order to send easily. (use-local-map (nconc (make-sparse-keymap) (current-local-map))) (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info) + (if can-xdg-email + (define-key (current-local-map) "\C-cm" + 'report-emacs-bug-insert-to-mailer)) ;; Could test major-mode instead. (cond ((memq mail-user-agent '(message-user-agent gnus-user-agent)) (setq report-emacs-bug-send-command "message-send-and-exit" @@ -245,6 +295,9 @@ usually do not have translators to read other languages for them.\n\n") report-emacs-bug-send-command)))) (princ (substitute-command-keys " Type \\[kill-buffer] RET to cancel (don't send it).\n")) + (if can-xdg-email + (princ (substitute-command-keys + " Type \\[report-emacs-bug-insert-to-mailer] to insert text to you preferred mail program.\n"))) (terpri) (princ (substitute-command-keys " Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 630c729703b..fbf5c534a28 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4291,7 +4291,7 @@ With prefix argument N moves forward N messages with these labels. ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "93033f2136fcd111e2b52a116ff4cf29") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "4a7502b4aeb3bd5f2111b48cc6512924") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 415bc20cf50..e8ca11ee349 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -112,6 +112,10 @@ automatically display the image in the buffer." (file-name-as-directory filename)))) (with-temp-buffer (set-buffer-file-coding-system 'no-conversion) + ;; Needed e.g. by jka-compr, so if the attachment is a compressed + ;; file, the magic signature compares equal with the unibyte + ;; signature string recorded in jka-compr-compression-info-list. + (set-buffer-multibyte nil) (insert data) (write-region nil nil filename nil nil nil t)))) diff --git a/lisp/man.el b/lisp/man.el index f448795c1cb..88d1aa7c604 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1674,7 +1674,8 @@ Specify which REFERENCE to use; default is based on word at point." complete-path)) ;;; Bookmark Man Support -(declare-function bookmark-make-record-default "bookmark" (&optional pos-only)) +(declare-function bookmark-make-record-default + "bookmark" (&optional no-file no-context posn)) (declare-function bookmark-prop-get "bookmark" (bookmark prop)) (declare-function bookmark-default-handler "bookmark" (bmk)) (declare-function bookmark-get-bookmark-record "bookmark" (bmk)) @@ -1691,7 +1692,7 @@ Uses `Man-name-local-regexp'." (defun Man-bookmark-make-record () "Make a bookmark entry for a Man buffer." `(,(Man-default-bookmark-title) - ,@(bookmark-make-record-default 'point-only) + ,@(bookmark-make-record-default 'no-file) (location . ,(concat "man " Man-arguments)) (man-args . ,Man-arguments) (handler . Man-bookmark-jump))) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index d831744f311..3c1241237f1 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -526,17 +526,6 @@ "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard. Do the same for the keys of the same name." (interactive) - ;; We can't use constant list structure here because it becomes pure, - ;; and because it gets modified with cache data. - (define-key menu-bar-edit-menu [paste] - (cons "Paste" (cons "Paste text from clipboard" 'clipboard-yank))) - (define-key menu-bar-edit-menu [copy] - (cons "Copy" (cons "Copy text in region to the clipboard" - 'clipboard-kill-ring-save))) - (define-key menu-bar-edit-menu [cut] - (cons "Cut" (cons "Delete text in region and copy it to the clipboard" - 'clipboard-kill-region))) - ;; These are Sun server keysyms for the Cut, Copy and Paste keys ;; (also for XFree86 on Sun keyboard): (define-key global-map [f20] 'clipboard-kill-region) @@ -703,6 +692,10 @@ by \"Save Options\" in Custom buffers.") (when need-save (custom-save-all)))) +(define-key menu-bar-options-menu [package] + '(menu-item "Manage Emacs Packages" package-list-packages + :help "Install or uninstall additional Emacs packages")) + (define-key menu-bar-options-menu [save] `(menu-item ,(purecopy "Save Options") menu-bar-options-save :help ,(purecopy "Save options set from the menu above"))) @@ -975,11 +968,99 @@ mail status in mode line")) :help ,(purecopy "Turn menu-bar on/off") :button (:toggle . (> (frame-parameter nil 'menu-bar-lines) 0)))) -(define-key menu-bar-showhide-menu [showhide-tool-bar] - `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame - :help ,(purecopy "Turn tool-bar on/off") - :visible (display-graphic-p) - :button (:toggle . (> (frame-parameter nil 'tool-bar-lines) 0)))) +(defun menu-bar-set-tool-bar-position (position) + (customize-set-variable 'tool-bar-mode t) + (set-frame-parameter nil 'tool-bar-position position) + (customize-set-variable 'default-frame-alist + (cons (cons 'tool-bar-position position) + (assq-delete-all 'tool-bar-position + default-frame-alist)))) + +(defun menu-bar-showhide-tool-bar-menu-customize-disable () + "Do not display tool bars." + (interactive) + (customize-set-variable 'tool-bar-mode nil)) +(defun menu-bar-showhide-tool-bar-menu-customize-enable-left () + "Display tool bars on the left side." + (interactive) + (menu-bar-set-tool-bar-position 'left)) + +(defun menu-bar-showhide-tool-bar-menu-customize-enable-right () + "Display tool bars on the right side." + (interactive) + (menu-bar-set-tool-bar-position 'right)) +(defun menu-bar-showhide-tool-bar-menu-customize-enable-top () + "Display tool bars on the top side." + (interactive) + (menu-bar-set-tool-bar-position 'top)) +(defun menu-bar-showhide-tool-bar-menu-customize-enable-bottom () + "Display tool bars on the bottom side." + (interactive) + (menu-bar-set-tool-bar-position 'bottom)) + +(if (featurep 'move-toolbar) + (progn + (defvar menu-bar-showhide-tool-bar-menu (make-sparse-keymap "Tool-bar")) + + (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-left] + `(menu-item ,(purecopy "On the left") + menu-bar-showhide-tool-bar-menu-customize-enable-left + :help ,(purecopy "Tool-bar at the left side") + :visible (display-graphic-p) + :button + (:radio . (and tool-bar-mode + (eq (frame-parameter nil 'tool-bar-position) + 'left))))) + + (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-right] + `(menu-item ,(purecopy "On the right") + menu-bar-showhide-tool-bar-menu-customize-enable-right + :help ,(purecopy "Tool-bar at the right side") + :visible (display-graphic-p) + :button + (:radio . (and tool-bar-mode + (eq (frame-parameter nil 'tool-bar-position) + 'right))))) + + (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-bottom] + `(menu-item ,(purecopy "On the bottom") + menu-bar-showhide-tool-bar-menu-customize-enable-bottom + :help ,(purecopy "Tool-bar at the bottom") + :visible (display-graphic-p) + :button + (:radio . (and tool-bar-mode + (eq (frame-parameter nil 'tool-bar-position) + 'bottom))))) + + (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-top] + `(menu-item ,(purecopy "On the top") + menu-bar-showhide-tool-bar-menu-customize-enable-top + :help ,(purecopy "Tool-bar at the top") + :visible (display-graphic-p) + :button + (:radio . (and tool-bar-mode + (eq (frame-parameter nil 'tool-bar-position) + 'top))))) + + (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-none] + `(menu-item ,(purecopy "None") + menu-bar-showhide-tool-bar-menu-customize-disable + :help ,(purecopy "Turn tool-bar off") + :visible (display-graphic-p) + :button (:radio . (eq tool-bar-mode nil)))) + + (define-key menu-bar-showhide-menu [showhide-tool-bar] + `(menu-item ,(purecopy "Tool-bar") ,menu-bar-showhide-tool-bar-menu + :visible (display-graphic-p))) + + ) + ;; else not tool bar that can move. + (define-key menu-bar-showhide-menu [showhide-tool-bar] + `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame + :help ,(purecopy "Turn tool-bar on/off") + :visible (display-graphic-p) + :button (:toggle . (> (frame-parameter nil 'tool-bar-lines) 0)))) +) (define-key menu-bar-options-menu [showhide] `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu)) @@ -1055,7 +1136,7 @@ mail status in mode line")) (define-key menu-bar-options-menu [cua-emulation-mode] (menu-bar-make-mm-toggle cua-mode "Shift movement mark region (CUA)" - "Use shifted movement keys to set and extend the region." + "Use shifted movement keys to set and extend the region" (:visible (and (boundp 'cua-enable-cua-keys) (not cua-enable-cua-keys))))) @@ -1920,36 +2001,33 @@ Buffers menu is regenerated." `(menu-item ,(purecopy "Previous History Item") previous-history-element :help ,(purecopy "Put previous minibuffer history element in the minibuffer")))) -;;;###autoload -;; This comment is taken from tool-bar.el near -;; (put 'tool-bar-mode ...) -;; We want to pretend the menu bar by standard is on, as this will make -;; customize consider disabling the menu bar a customization, and save -;; that. We could do this for real by setting :init-value below, but -;; that would overwrite disabling the tool bar from X resources. -(put 'menu-bar-mode 'standard-value '(t)) - (define-minor-mode menu-bar-mode "Toggle display of a menu bar on each frame. This command applies to all frames that exist and frames to be created in the future. With a numeric argument, if the argument is positive, turn on menu bars; otherwise, turn off menu bars." - :init-value nil + :init-value t :global t :group 'frames - ;; Make menu-bar-mode and default-frame-alist consistent. - (modify-all-frames-parameters (list (cons 'menu-bar-lines - (if menu-bar-mode 1 0)))) - + ;; Turn the menu-bars on all frames on or off. + (let ((val (if menu-bar-mode 1 0))) + (dolist (frame (frame-list)) + (set-frame-parameter frame 'menu-bar-lines val)) + ;; If the user has given `default-frame-alist' a `menu-bar-lines' + ;; parameter, replace it. + (if (assq 'menu-bar-lines default-frame-alist) + (setq default-frame-alist + (cons (cons 'menu-bar-lines val) + (assq-delete-all 'menu-bar-lines + default-frame-alist))))) ;; Make the message appear when Emacs is idle. We can not call message ;; directly. The minor-mode message "Menu-bar mode disabled" comes ;; after this function returns, overwriting any message we do here. (when (and (called-interactively-p 'interactive) (not menu-bar-mode)) (run-with-idle-timer 0 nil 'message - "Menu-bar mode disabled. Use M-x menu-bar-mode to make the menu bar appear.")) - menu-bar-mode) + "Menu-bar mode disabled. Use M-x menu-bar-mode to make the menu bar appear."))) (defun toggle-menu-bar-mode-from-frame (&optional arg) "Toggle menu bar on or off, based on the status of the current frame. diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 29a49c45a38..ad1dbc8f024 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -504,8 +504,8 @@ 2006-06-02 Bill Wohler <wohler@newt.com> - (mh-folder-exists-p): Change test from an empty buffer, to one - that contains the actual folder, since GNU mailutils' folder + * mh-search.el (mh-folder-exists-p): Change test from an empty buffer, + to one that contains the actual folder, since GNU mailutils' folder command displays output if the folder doesn't exist (closes SF #1499712). @@ -1415,7 +1415,7 @@ (mh-get-field): Delete ancient alias. * mh-xface.el (mh-face-foreground-compat): Move to mh-compat.el - and rename to mh-face-foreground + and rename to mh-face-foreground. (mh-face-background-compat): Move to mh-compat.el and rename to mh-face-background. (mh-face-display-function): Use the new names. @@ -1732,7 +1732,7 @@ (mh-identity-make-menu-no-autoload): New alias for mh-identity-make-menu which can be called from mh-e.el. (mh-identity-list-set): Move to mh-e.el. - (mh-identity-add-menu): New function + (mh-identity-add-menu): New function. (mh-insert-identity): Add optional argument maybe-insert so that local variable mh-identity-local does not have to be visible. @@ -1891,7 +1891,7 @@ (mh-find-path-run, mh-find-path): Move here from deprecated file mh-init.el. (mh-help-messages): Now an alist of modes to an alist of messages. - (mh-set-help): New function used to set mh-help-messages + (mh-set-help): New function used to set mh-help-messages. (mh-help): Adjust for new format of mh-help-messages. Add help-messages argument. (mh-prefix-help): Refactor to use mh-help. @@ -2460,7 +2460,7 @@ (mh-scan-good-msg-regexp, mh-scan-deleted-msg-regexp) (mh-scan-refiled-msg-regexp, mh-scan-cur-msg-number-regexp) (mh-scan-date-regexp, mh-scan-rcpt-regexp, mh-scan-body-regexp) - (mh-scan-subject-regexp): Sync docstrings with manual + (mh-scan-subject-regexp): Sync docstrings with manual. (mh-scan-format-regexp): Rename to mh-scan-sent-to-me-sender-regexp. Drop date parenthesized expression. Make expression more like the others (anchored at the @@ -2760,7 +2760,7 @@ (mh-mime-save-parts-default-directory, mh-print-background-flag) (mh-show-maximum-size, mh-show-use-goto-addr-flag) (mh-show-use-xface-flag, mh-store-default-directory) - (mh-summary-height, mh-delete-msg-hook + (mh-summary-height, mh-delete-msg-hook) (mh-show-hook, mh-show-mode-hook): Sync docstrings with manual. * mh-e.el (mh-scan-format-mh, mh-scan-good-msg-regexp) diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index 5d08fd73e69..a24489ca9b7 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -333,9 +333,9 @@ Synced with manual. (mh-junk-program): Use double-quotes on non-symbols. - * mh-pick.el: (mh-search-folder): Synced docstrings with manual. + * mh-pick.el (mh-search-folder): Synced docstrings with manual. - * mh-index.el: (mh-index-search, mh-pick-execute-search) + * mh-index.el (mh-index-search, mh-pick-execute-search) (mh-grep-execute-search, mh-mairix-execute-search) (mh-swish-execute-search, mh-swish++-execute-search) (mh-namazu-execute-search): Synced docstrings with manual. Note @@ -659,13 +659,13 @@ * mh-mime.el (mh-display-with-external-viewer): Checkdoc fixes. - * mh-identity.el: (mh-identity-attribution-verb-end): Stripped + * mh-identity.el (mh-identity-attribution-verb-end): Stripped trailing space; checkdoc fixes. * mh-e.el (mh-restore-desktop-buffer): Checkdoc fixes. - * mh-customize.el: (mh-inc-spool-list, - mh-compose-forward-as-mime-flag, defcustom): Stripped trailing + * mh-customize.el (mh-inc-spool-list) + (mh-compose-forward-as-mime-flag, defcustom): Stripped trailing space; checkdoc fixes. * mh-comp.el (mh-reply): Stripped trailing space. @@ -794,7 +794,7 @@ Merged in 7.4.4 changes, described below. - * mh-e.el (Version, mh-version): Set to 7.4.4+cvs. + * mh-e.el (Version, mh-version): Set to 7.4.4+cvs. 2004-07-10 Bill Wohler <wohler@newt.com> @@ -825,7 +825,7 @@ (MH-E-XEMACS-OBJ): New variable to hold XEmacs object files. (clean): Moved XEmacs-specific code to clean-xemacs. (xemacs): Added clean-xemacs prerequisite. Moved down to XEmacs - section of file. Add target to build mh-loaddefs.el in XEmacs + section of file. Add target to build mh-loaddefs.el in XEmacs. (loaddefs-xemacs): New rule to build mh-loaddefs.el in XEmacs. (clean-xemacs): New target to remove XEmacs-specific files. (compile-xemacs): New. It allows for the '-no-autoloads' option @@ -1156,8 +1156,8 @@ mh-loaddefs.el in XEmacs. (XEMACS_LOADDEFS_COOKIE): Ditto. (XEMACS_LOADDEFS_PKG_NAME): Ditto. - (xemacs): Add target to build mh-loaddefs.el in XEmacs - (clean-xemacs): Remove `mh-loaddefs.el*' + (xemacs): Add target to build mh-loaddefs.el in XEmacs. + (clean-xemacs): Remove `mh-loaddefs.el*'. (loaddefs-xemacs): New rule to build mh-loaddefs.el in XEmacs. 2003-11-02 Peter S Galbraith <psg@debian.org> @@ -1214,7 +1214,7 @@ * mh-loaddefs.el: Regenerated. * mh-index.el (mh-indexer-choices): Remove option for the non-free - glimpse indexer (closes SF #831276). + glimpse indexer (closes SF #831276). (mh-glimpse-binary, mh-glimpse-directory) (mh-glimpse-execute-search, mh-glimpse-next-result): Functions and variables to implement glimpse support are removed. @@ -1432,7 +1432,7 @@ (mh-mml-secure-message-signencrypt): Ditto. (mh-mml-secure-message-sign): Ditto. - * mh-comp.el (mh-letter-menu, mh-letter-mode-help-messages, + * mh-comp.el (mh-letter-menu, mh-letter-mode-help-messages) (mh-letter-mode-map): Update to use new functions. 2003-09-26 Satyaki Das <satyakid@stanford.edu> @@ -1485,7 +1485,7 @@ (mh-alias-system-aliases): Moved here from mh-customize.el. By definition, "system" definitions are not user-visible, and user filenames are in the the Aliasfile: profile component, so this - variable really shouldn't be a defcustom + variable really shouldn't be a defcustom. (mh-alias-tstamp, mh-alias-filenames, mh-alias-reload) (mh-alias-add-alias, mh-alias-grab-from-field) (mh-alias-add-address-under-point, mh-alias-apropos): Merge @@ -1819,7 +1819,7 @@ 2003-08-19 Bill Wohler <wohler@newt.com> - * mh-seq.el: (mh-edit-pick-expr): Renamed from mh-read-pick-regexp + * mh-seq.el (mh-edit-pick-expr): Renamed from mh-read-pick-regexp since the new name is more indicative of what the function does. Prompt now says "Pick expression" instead of "Pick regexp". (mh-narrow-to-subject): Rewrote function to behave like other @@ -1980,7 +1980,7 @@ * mh-comp.el (mh-send-letter): Go to the top of the draft so that the user can see which header fields have been inserted. I think this is more important than leaving point alone or going to the - end to see the signature since Mail-Followup-To or Bcc or cc could + end to see the signature since Mail-Followup-To or Bcc or cc could have some deleterious effects. * mh-customize.el (mh-auto-fields-prompt-flag): New variable. @@ -2197,7 +2197,7 @@ * mh-comp.el (mh-extract-rejected-mail, mh-letter-mode-message): Ditto. - * mh-e.el (mh-refile-a-msg): Ditto. + * mh-e.el (mh-refile-a-msg): Ditto. * mh-funcs.el (mh-undo-folder): Ditto. @@ -2509,7 +2509,7 @@ 2003-07-28 Peter S Galbraith <psg@debian.org> - * mh-comp.el (mh-insert-letter): Remove `mh-visible-headers' + * mh-comp.el (mh-insert-letter): Remove `mh-visible-headers' operation. * mh-mime.el (mh-mm-inline-message): Same. @@ -2697,7 +2697,7 @@ 2003-06-24 Bill Wohler <wohler@newt.com> - * mh-e.el (Version, mh-version): Set to 7.4.1+cvs. + * mh-e.el (Version, mh-version): Set to 7.4.1+cvs. 2003-06-25 Bill Wohler <wohler@newt.com> @@ -2719,7 +2719,7 @@ 2003-06-24 Bill Wohler <wohler@newt.com> - * mh-e.el (Version, mh-version): Set to 7.4+cvs. + * mh-e.el (Version, mh-version): Set to 7.4+cvs. 2003-06-24 Bill Wohler <wohler@newt.com> @@ -2763,7 +2763,7 @@ replacement text. (mh-index-parse-search-regexp): Preserve case of search terms. This is needed to take advantage of the acronym indexing in - swish++ (closes SF #755718). + swish++ (closes SF #755718). 2003-06-13 Satyaki Das <satyakid@stanford.edu> @@ -3988,7 +3988,7 @@ fixes germaine to the change whereby we now check for MIME directives before sending. - * mh-xemacs-toolbar.el: Fixed copyright. Added Change Log comment + * mh-xemacs-toolbar.el: Fixed copyright. Added Change Log comment. (lm-verify fix). Added standard MH-E local variables. Removed time-stamp stuff. @@ -4106,7 +4106,7 @@ 2003-04-06 Bill Wohler <wohler@newt.com> - * mh-comp.el (mh-forward): Updated docstrings to indicate that a + * mh-comp.el (mh-forward): Updated docstrings to indicate that a list of messages is acceptable as well. * mh-e.el (mh-delete-msg, mh-delete-msg-no-motion, mh-refile-msg) @@ -4198,7 +4198,7 @@ 2003-04-04 Peter S Galbraith <psg@debian.org> - * mh-e.el (mh-folder-from-address): Minor Fix. Wrong ending of + * mh-e.el (mh-folder-from-address): Minor Fix. Wrong ending of `when' block. 2003-04-04 Satyaki Das <satyaki@theforce.stanford.edu> @@ -5383,7 +5383,7 @@ * import-emacs: MH-E now has its own directory in Emacs. - * mh-e.el: (mh-version): Set to 7.2+cvs. + * mh-e.el (mh-version): Set to 7.2+cvs. 2003-02-03 Bill Wohler <wohler@newt.com> @@ -5807,8 +5807,8 @@ (mh-default-folder-prefix, mh-default-folder-must-exist-flag): In docstring, refer to documentation for mh-prompt-for-refile-folder and mh-folder-from-address. - (mh-highlight-citation-p, mh-compose-insertion, - (mh-insert-mail-followup-to-list, mh-index-program, + (mh-highlight-citation-p, mh-compose-insertion) + (mh-insert-mail-followup-to-list, mh-index-program) (mh-identity-default): Fixed case of tags. * mh-e.el (mh-folder-from-address): Use new variable @@ -6310,7 +6310,7 @@ (mh-alias-insert-file): New function. Return the alias file to write a new entry in. (mh-alias-address-to-alias): New function. Return the ADDRESS - alias if defined, or nil." + alias if defined, or nil. (mh-alias-from-has-no-alias-p): New function. Return t is From has no current alias set. Used as tool-bar button enable function. (mh-alias-add-alias-to-file): New function. Add ALIAS for ADDRESS @@ -6883,7 +6883,7 @@ * mh-e.el (mh-add-cur-notation): New function to mark the current message with the mh-note-cur character. (mh-get-new-mail): Use mh-add-cur-notation to undo the work of - mh-remove-cur-notation if there was no new mail (closes SF #647681). + mh-remove-cur-notation if there was no new mail (closes SF #647681). * mh-e.el (mh-set-cmd-note): Do not update the default mh-cmd-note value (closes SF #643701). @@ -6902,7 +6902,7 @@ (mh-alias-translate): New function. Return translation for alias, checking if in blind or passwd list. (mh-alias-letter-expand-alias): Rewrite using - mail-abbrev-complete-alias from mailabbrev.el + mail-abbrev-complete-alias from mailabbrev.el. (mh-alias-expand-alias-map): New variable. (mh-alias-ali): New function. Return formatted string of translated ALIAS from ali. @@ -7084,7 +7084,7 @@ mh-thread-generate-scan-lines. * mh-mime.el (font-lock): Font-lock required at compile time to - avoid warning about font-lock-maximum-size + avoid warning about font-lock-maximum-size. (mh-display-smileys, mh-display-emphasis): Show graphical smileys and emphasis only if message isn't too large. @@ -7247,7 +7247,7 @@ 2002-11-13 Mark D. Baushke <mdb@gnu.org> - * mh-identity.el (mh-insert-identity): A value of either nil or + * mh-identity.el (mh-insert-identity): A value of either nil or "" should cause the field to be removed. (mh-identity-list): Update the docstring. @@ -7445,7 +7445,7 @@ This addresses part of SF #627015. * mh-utils.el (mh-decode-quoted-printable-flag): Renamed from - mh-decode-quoted-printable + mh-decode-quoted-printable. (mh-display-msg, mh-decode-quoted-printable-have-mimedecode): Use it. This addresses part of SF #627015. @@ -7906,12 +7906,12 @@ 2002-10-28 Peter S Galbraith <psg@debian.org> * mh-e.el (mh-scan-subject-regexp): Add an expression to match an - optional bracketed number after "Re", such as in "Re[2]:" + optional bracketed number after "Re", such as in "Re[2]:". (Patch by Satyaki; I checked it and applied). (mh-folder-font-lock-subject): Adapt to new mh-scan-subject-regexp. * mh-seq.el (mh-subject-to-sequence): Ditto. - * mh-e.el (mh-folder-sequence-menu): Remove "Toggle Subject + * mh-e.el (mh-folder-sequence-menu): Remove "Toggle Subject Thread" from menu. mh-toggle-threads is in the Folder menu. * mh-e.el (mh-folder-sequence-menu): Minor menu text edits. @@ -8250,7 +8250,7 @@ (mh-thread-generate-scan-lines): Renamed dupl-p as dupl-flag. This addresses part of SF #627015. - * mh-index.el (mh-index-advance): Renamed backward-p + * mh-index.el (mh-index-advance): Renamed backward-p local variable as backward-flag. (mh-index-next-button): Renamed backward-p argument as backward-flag. @@ -8882,7 +8882,7 @@ (mh-pick-mode): Set local buffer variable mh-help-messages to mh-pick-mode-help-messages. - * mh-index.el (mh-index-keymap): Added binding for mh-help + * mh-index.el (mh-index-keymap): Added binding for mh-help. (mh-index-folder-mode-help-messages): New variable that contains help messages for MH Index buffer. (mh-index-folder-mode): Set local buffer variable mh-help-messages @@ -9217,7 +9217,7 @@ decide how many buttons to use for replying. * mh-mime.el (mh-file-mime-type-substitutions) - (mh-file-mime-type-substitute): Fix typos and doc strings. + (mh-file-mime-type-substitute): Fix typos and doc strings. 2002-09-30 Peter S Galbraith <psg@debian.org> @@ -9280,7 +9280,7 @@ 2002-09-17 Peter S Galbraith <psg@debian.org> * mh-mime.el (mh-store-mime-parts-default-directory): Renamed from - mh-store-mime-parts-directory + mh-store-mime-parts-directory. (mh-store-mime-parts-directory): Renamed from mh-store-mime-parts-directory-default. @@ -9321,7 +9321,7 @@ 2002-08-19 Peter S Galbraith <psg@debian.org> * reply-to.xpm, reply-to.pbm, reply-from.xpm, reply-from.pbm, - * reply-all.xpm, reply-all.pbm: New icons for various reply methods. + * reply-all.xpm, reply-all.pbm: New icons for various reply methods. * mh-e.el (mh-folder-tool-bar-map): Split reply button into three that won't prompt for "from", "to" and "all". * mh-comp.el (mh-reply): Put variable reply-to in the interactive @@ -9760,13 +9760,13 @@ to `mh-mml-to-mime' in `mh-send-letter'. (mh-mml-secure-message-sign-pgpmime): New function. Front end to mml-secure-message-sign-pgpmime. - (mh-mml-secure-message-encrypt-pgpmime): New function. + (mh-mml-secure-message-encrypt-pgpmime): New function. Front end to mml-secure-message-encrypt-pgpmime. * mh-comp.el (mh-send-letter): automatic call to `mh-mml-to-mime' if mh-mml-compose-insert-p is set. (mh-letter-mode-map): Add keys for new mh-mime functions above. - * mh-comp.el: Added autoloads for new mh-mime functions above. + * mh-comp.el: Added autoloads for new mh-mime functions above. 2002-06-17 Peter S Galbraith <psg@debian.org> @@ -9940,7 +9940,7 @@ compiler warnings. * mh-e.el (compilation): Code rearrangement and extra autoloads to - remove compiler warnings + remove compiler warnings. (mh-quit): Add call to mh-destroy-postponed-handles to remove handles that are associated with external viewers. Also fixed a bug that I accidentally introduced by adding an extra line when @@ -10501,7 +10501,7 @@ * mh-comp.el: Require mh-e and easymenu, moved autoloads to top of file. - * Makefile: (EMACS): New constant to hold emacs calling sequence. + * Makefile (EMACS): New constant to hold emacs calling sequence. (install): Renamed to install-emacs. (compile): New target to compile all files. (dist): Make dependent on compile. @@ -10707,7 +10707,7 @@ 2001-11-29 Peter S Galbraith <psg@debian.org> * mh-e.el (mh-folder-font-lock-subject): New fontifier function - for subject lines in folder-mode + for subject lines in folder-mode. (mh-scan-followup-regexp): Deleted obsolete regexp. Use mh-scan-subject-regexp instead. (mh-folder-font-lock-keywords): Use mh-folder-font-lock-subject @@ -10738,7 +10738,7 @@ 2001-11-29 Jeffrey C Honig <jch@honig.net> - * mh-utils.el: (mh-find-progs): Change mh-find-progs to rely on + * mh-utils.el (mh-find-progs): Change mh-find-progs to rely on the existence of mhparam. The location of mhparam is used to find `mh-progs'. It uses the libdir and etcdir to find the `mh-lib-progs' and `mh-lib' directories. If etcdir doesn't return @@ -10795,7 +10795,7 @@ set mh-page-to-next-msg-p to t. The second time the end of page is hit, go to the next message. - * mh-utils.el: (mh-show-msg): Initialize mh-page-to-next-msg-p to + * mh-utils.el (mh-show-msg): Initialize mh-page-to-next-msg-p to nil. 2001-11-27 Bill Wohler <wohler@newt.com> @@ -11004,8 +11004,8 @@ 2001-11-20 Peter S Galbraith <psg@debian.org> * mh-comp.el (mh-letter-mode): Make font-lock-defaults a local variable - * mh-e.el (mh-folder-mode): Same. - * mh-utils.el (mh-show-mode): Same. + * mh-e.el (mh-folder-mode): Same. + * mh-utils.el (mh-show-mode): Same. * mh-e.el (mh-scan-msg-num-regexp): Delete variable and replace with mh-good-msg-regexp. @@ -11279,7 +11279,7 @@ * mh-e.el (mh-refile-msg): Mark messages in region for refiling if mark is active and in transient-mark-mode. * mh-e.el (mh-undo): Undo message marks for refile or deletion if - region if mark is active and in transient-mark-mode. + region if mark is active and in transient-mark-mode. 2001-11-06 Peter S Galbraith <psg@debian.org> diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 646b773caf2..3f22099bfd1 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -891,13 +891,13 @@ Return nil if there is no valid completion, else t." (defface completions-annotations '((t :inherit italic)) "Face to use for annotations in the *Completions* buffer.") -(defcustom completions-format nil +(defcustom completions-format 'horizontal "Define the appearance and sorting of completions. If the value is `vertical', display completions sorted vertically in columns in the *Completions* buffer. -If the value is `horizontal' or nil, display completions sorted +If the value is `horizontal', display completions sorted horizontally in alphabetical order, rather than down the screen." - :type '(choice (const nil) (const horizontal) (const vertical)) + :type '(choice (const horizontal) (const vertical)) :group 'minibuffer :version "23.2") diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el index d7f4c9bd222..bd3054a5b94 100644 --- a/lisp/mouse-sel.el +++ b/lisp/mouse-sel.el @@ -129,11 +129,6 @@ ;; that the X primary selection is used. Under other windowing systems, ;; alternate functions are used, which simply store the selection value ;; in a variable. -;; -;; * You can change the selection highlight face by altering the properties -;; of mouse-drag-overlay, eg. -;; -;; (overlay-put mouse-drag-overlay 'face 'bold) ;;; Code: @@ -293,8 +288,7 @@ primary selection and region." (overlay-put mouse-secondary-overlay 'face 'secondary-selection)) (defconst mouse-sel-selection-alist - '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing) - (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing)) + '((SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing)) "Alist associating selections with variables. Each element is of the form: diff --git a/lisp/mouse.el b/lisp/mouse.el index d1abb7dd4b1..f404de98ce3 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -41,10 +41,10 @@ :type 'boolean :group 'mouse) -(defcustom mouse-drag-copy-region t +(defcustom mouse-drag-copy-region nil "If non-nil, mouse drag copies region to kill-ring." :type 'boolean - :version "22.1" + :version "24.1" :group 'mouse) (defcustom mouse-1-click-follows-link 450 @@ -697,9 +697,6 @@ This should be bound to a mouse drag event." (window-system) (sit-for 1)) (push-mark) - ;; If `select-active-regions' is non-nil, `set-mark' sets the - ;; primary selection to the buffer's region, overriding the role - ;; of `copy-region-as-kill'; that's why we did the copy first. (set-mark (point)) (if (numberp end) (goto-char end)) (mouse-set-region-1))) @@ -772,13 +769,6 @@ Upon exit, point is at the far edge of the newly visible text." (or (eq window (selected-window)) (goto-char opoint)))) -;; Create an overlay and immediately delete it, to get "overlay in no buffer". -(defconst mouse-drag-overlay - (let ((ol (make-overlay (point-min) (point-min)))) - (delete-overlay ol) - (overlay-put ol 'face 'region) - ol)) - (defvar mouse-selection-click-count 0) (defvar mouse-selection-click-count-buffer nil) @@ -886,8 +876,7 @@ at the same position." (let (mp pos) (if (and mouse-1-click-follows-link (stringp msg) - (save-match-data - (string-match "^mouse-2" msg)) + (string-match-p "\\`mouse-2" msg) (setq mp (mouse-pixel-position)) (consp (setq pos (cdr mp))) (car pos) (>= (car pos) 0) @@ -905,33 +894,14 @@ at the same position." "mouse-1" (substring msg 7))))))) msg) -(defun mouse-move-drag-overlay (ol start end mode) - (unless (= start end) - ;; Go to START first, so that when we move to END, if it's in the middle - ;; of intangible text, point jumps in the direction away from START. - ;; Don't do it if START=END otherwise a single click risks selecting - ;; a region if it's on intangible text. This exception was originally - ;; only applied on entry to mouse-drag-region, which had the problem - ;; that a tiny move during a single-click would cause the intangible - ;; text to be selected. - (goto-char start) - (goto-char end) - (setq end (point))) - (let ((range (mouse-start-end start end mode))) - (move-overlay ol (car range) (nth 1 range)))) - (defun mouse-drag-track (start-event &optional do-mouse-drag-region-post-process) "Track mouse drags by highlighting area between point and cursor. -The region will be defined with mark and point, and the overlay -will be deleted after return. DO-MOUSE-DRAG-REGION-POST-PROCESS -should only be used by mouse-drag-region." +The region will be defined with mark and point. +DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by +`mouse-drag-region'." (mouse-minibuffer-check start-event) (setq mouse-selection-click-count-buffer (current-buffer)) - ;; We must call deactivate-mark before repositioning point. - ;; Otherwise, for select-active-regions non-nil, we get the wrong - ;; selection if the user drags a region, clicks elsewhere to - ;; reposition point, then middle-clicks to paste the selection. (deactivate-mark) (let* ((original-window (selected-window)) ;; We've recorded what we needed from the current buffer and @@ -965,165 +935,146 @@ should only be used by mouse-drag-region." ;; Suppress automatic hscrolling, because that is a nuisance ;; when setting point near the right fringe (but see below). (automatic-hscrolling-saved automatic-hscrolling) - (automatic-hscrolling nil)) + (automatic-hscrolling nil) + event end end-point) + (setq mouse-selection-click-count click-count) ;; In case the down click is in the middle of some intangible text, ;; use the end of that text, and put it in START-POINT. (if (< (point) start-point) (goto-char start-point)) (setq start-point (point)) - (if remap-double-click ;; Don't expand mouse overlay in links + (if remap-double-click (setq click-count 0)) - (mouse-move-drag-overlay mouse-drag-overlay start-point start-point - click-count) - (overlay-put mouse-drag-overlay 'window start-window) - (let (event end end-point last-end-point) - (track-mouse - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - (memq (car-safe event) '(switch-frame select-window)))) - (if (memq (car-safe event) '(switch-frame select-window)) - nil - ;; Automatic hscrolling did not occur during the call to - ;; `read-event'; but if the user subsequently drags the - ;; mouse, go ahead and hscroll. - (let ((automatic-hscrolling automatic-hscrolling-saved)) - (redisplay)) - (setq end (event-end event) - end-point (posn-point end)) - (if (numberp end-point) - (setq last-end-point end-point)) - - (cond - ;; Are we moving within the original window? - ((and (eq (posn-window end) start-window) + + ;; Activate the region, using `mouse-start-end' to determine where + ;; to put point and mark (e.g., double-click will select a word). + (setq transient-mark-mode + (if (eq transient-mark-mode 'lambda) + '(only) + (cons 'only transient-mark-mode))) + (let ((range (mouse-start-end start-point start-point click-count))) + (push-mark (nth 0 range) t t) + (goto-char (nth 1 range))) + + ;; Track the mouse until we get a non-movement event. + (track-mouse + (while (progn + (setq event (read-event)) + (or (mouse-movement-p event) + (memq (car-safe event) '(switch-frame select-window)))) + (unless (memq (car-safe event) '(switch-frame select-window)) + ;; Automatic hscrolling did not occur during the call to + ;; `read-event'; but if the user subsequently drags the + ;; mouse, go ahead and hscroll. + (let ((automatic-hscrolling automatic-hscrolling-saved)) + (redisplay)) + (setq end (event-end event) + end-point (posn-point end)) + (if (and (eq (posn-window end) start-window) (integer-or-marker-p end-point)) - (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count)) - - (t - (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top) - mouse-drag-overlay start-point)) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) - mouse-drag-overlay start-point))))))))) - - ;; In case we did not get a mouse-motion event - ;; for the final move of the mouse before a drag event - ;; pretend that we did get one. - (when (and (memq 'drag (event-modifiers (car-safe event))) - (setq end (event-end event) - end-point (posn-point end)) + (mouse--drag-set-mark-and-point start-point + end-point click-count) + (let ((mouse-row (cdr (cdr (mouse-position))))) + (cond + ((null mouse-row)) + ((< mouse-row top) + (mouse-scroll-subr start-window (- mouse-row top) + nil start-point)) + ((>= mouse-row bottom) + (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) + nil start-point)))))))) + + ;; Handle the terminating event if possible. + (when (consp event) + ;; Ensure that point is on the end of the last event. + (when (and (setq end-point (posn-point (event-end event))) (eq (posn-window end) start-window) - (integer-or-marker-p end-point)) - (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count)) - - ;; Handle the terminating event - (if (consp event) - (let* ((fun (key-binding (vector (car event)))) - (do-multi-click (and (> (event-click-count event) 0) - (functionp fun) - (not (memq fun - '(mouse-set-point - mouse-set-region)))))) - ;; Run the binding of the terminating up-event, if possible. - (if (and (not (= (overlay-start mouse-drag-overlay) - (overlay-end mouse-drag-overlay))) - (not do-multi-click)) - (let* ((stop-point - (if (numberp (posn-point (event-end event))) - (posn-point (event-end event)) - last-end-point)) - ;; The end that comes from where we ended the drag. - ;; Point goes here. - (region-termination - (if (and stop-point (< stop-point start-point)) - (overlay-start mouse-drag-overlay) - (overlay-end mouse-drag-overlay))) - ;; The end that comes from where we started the drag. - ;; Mark goes there. - (region-commencement - (- (+ (overlay-end mouse-drag-overlay) - (overlay-start mouse-drag-overlay)) - region-termination)) - last-command this-command) - ;; We copy the region before setting the mark so - ;; that `select-active-regions' can override - ;; `copy-region-as-kill'. - (and mouse-drag-copy-region - do-mouse-drag-region-post-process - (let (deactivate-mark) - (copy-region-as-kill region-commencement - region-termination))) - (push-mark region-commencement t t) - (goto-char region-termination) - (if (not do-mouse-drag-region-post-process) - ;; Skip all post-event handling, return immediately. - (delete-overlay mouse-drag-overlay) - (let ((buffer (current-buffer))) - (mouse-show-mark) - ;; mouse-show-mark can call read-event, - ;; and that means the Emacs server could switch buffers - ;; under us. If that happened, - ;; avoid trying to use the region. - (and (mark t) mark-active - (eq buffer (current-buffer)) - (mouse-set-region-1))))) - ;; Run the binding of the terminating up-event. - ;; If a multiple click is not bound to mouse-set-point, - ;; cancel the effects of mouse-move-drag-overlay to - ;; avoid producing wrong results. - (if do-multi-click (goto-char start-point)) - (delete-overlay mouse-drag-overlay) - (when (and (functionp fun) - (= start-hscroll (window-hscroll start-window)) - ;; Don't run the up-event handler if the - ;; window start changed in a redisplay after - ;; the mouse-set-point for the down-mouse - ;; event at the beginning of this function. - ;; When the window start has changed, the - ;; up-mouse event will contain a different - ;; position due to the new window contents, - ;; and point is set again. - (or end-point - (= (window-start start-window) - start-window-start))) - (when (and on-link - (or (not end-point) (= end-point start-point)) - (consp event) - (or remap-double-click - (and - (not (eq mouse-1-click-follows-link 'double)) - (= click-count 0) - (= (event-click-count event) 1) - (or (not (integerp mouse-1-click-follows-link)) - (let ((t0 (posn-timestamp (event-start start-event))) - (t1 (posn-timestamp (event-end event)))) - (and (integerp t0) (integerp t1) - (if (> mouse-1-click-follows-link 0) - (<= (- t1 t0) mouse-1-click-follows-link) - (< (- t0 t1) mouse-1-click-follows-link)))))))) - ;; If we rebind to mouse-2, reselect previous selected window, - ;; so that the mouse-2 event runs in the same - ;; situation as if user had clicked it directly. - ;; Fixes the bug reported by juri@jurta.org on 2005-12-27. - (if (or (vectorp on-link) (stringp on-link)) - (setq event (aref on-link 0)) - (select-window original-window) - (setcar event 'mouse-2) - ;; If this mouse click has never been done by - ;; the user, it doesn't have the necessary - ;; property to be interpreted correctly. - (put 'mouse-2 'event-kind 'mouse-click))) - (push event unread-command-events)))) - - ;; Case where the end-event is not a cons cell (it's just a boring - ;; char-key-press). - (delete-overlay mouse-drag-overlay))))) + (integer-or-marker-p end-point) + (/= start-point end-point)) + (mouse--drag-set-mark-and-point start-point + end-point click-count)) + + ;; Find its binding. + (let* ((fun (key-binding (vector (car event)))) + (do-multi-click (and (> (event-click-count event) 0) + (functionp fun) + (not (memq fun '(mouse-set-point + mouse-set-region)))))) + (if (and (/= (mark) (point)) + (not do-multi-click)) + + ;; If point has moved, finish the drag. + (let* (last-command this-command) + (and mouse-drag-copy-region + do-mouse-drag-region-post-process + (let (deactivate-mark) + (copy-region-as-kill (mark) (point))))) + + ;; If point hasn't moved, run the binding of the + ;; terminating up-event. + (if do-multi-click + (goto-char start-point) + (deactivate-mark)) + (when (and (functionp fun) + (= start-hscroll (window-hscroll start-window)) + ;; Don't run the up-event handler if the window + ;; start changed in a redisplay after the + ;; mouse-set-point for the down-mouse event at + ;; the beginning of this function. When the + ;; window start has changed, the up-mouse event + ;; contains a different position due to the new + ;; window contents, and point is set again. + (or end-point + (= (window-start start-window) + start-window-start))) + (when (and on-link + (= start-point (point)) + (mouse--remap-link-click-p start-event event)) + ;; If we rebind to mouse-2, reselect previous selected + ;; window, so that the mouse-2 event runs in the same + ;; situation as if user had clicked it directly. Fixes + ;; the bug reported by juri@jurta.org on 2005-12-27. + (if (or (vectorp on-link) (stringp on-link)) + (setq event (aref on-link 0)) + (select-window original-window) + (setcar event 'mouse-2) + ;; If this mouse click has never been done by the + ;; user, it doesn't have the necessary property to be + ;; interpreted correctly. + (put 'mouse-2 'event-kind 'mouse-click))) + (push event unread-command-events))))))) + +(defun mouse--drag-set-mark-and-point (start click click-count) + (let* ((range (mouse-start-end start click click-count)) + (beg (nth 0 range)) + (end (nth 1 range))) + (cond ((eq (mark) beg) + (goto-char end)) + ((eq (mark) end) + (goto-char beg)) + ((< click (mark)) + (set-mark end) + (goto-char beg)) + (t + (set-mark beg) + (goto-char end))))) + +(defun mouse--remap-link-click-p (start-event end-event) + (or (and (eq mouse-1-click-follows-link 'double) + (= (event-click-count start-event) 2)) + (and + (not (eq mouse-1-click-follows-link 'double)) + (= (event-click-count start-event) 1) + (= (event-click-count end-event) 1) + (or (not (integerp mouse-1-click-follows-link)) + (let ((t0 (posn-timestamp (event-start start-event))) + (t1 (posn-timestamp (event-end end-event)))) + (and (integerp t0) (integerp t1) + (if (> mouse-1-click-follows-link 0) + (<= (- t1 t0) mouse-1-click-follows-link) + (< (- t0 t1) mouse-1-click-follows-link)))))))) + ;; Commands to handle xterm-style multiple clicks. (defun mouse-skip-word (dir) @@ -1224,8 +1175,7 @@ If MODE is 2 then do the same for lines." ((= mode 2) (list (save-excursion (goto-char start) - (beginning-of-line 1) - (point)) + (line-beginning-position 1)) (save-excursion (goto-char end) (forward-line 1) @@ -1263,74 +1213,6 @@ If MODE is 2 then do the same for lines." ;; Momentarily show where the mark is, if highlighting doesn't show it. -(defcustom mouse-region-delete-keys '([delete] [deletechar] [backspace]) - "List of keys that should cause the mouse region to be deleted." - :group 'mouse - :type '(repeat key-sequence)) - -(defun mouse-show-mark () - (let ((inhibit-quit t) - (echo-keystrokes 0) - event events key ignore - (x-lost-selection-functions - (when (boundp 'x-lost-selection-functions) - (copy-sequence x-lost-selection-functions)))) - (add-hook 'x-lost-selection-functions - (lambda (seltype) - (when (eq seltype 'PRIMARY) - (setq ignore t) - (throw 'mouse-show-mark t)))) - (if transient-mark-mode - (delete-overlay mouse-drag-overlay) - (move-overlay mouse-drag-overlay (point) (mark t))) - (catch 'mouse-show-mark - ;; In this loop, execute scroll bar and switch-frame events. - ;; Should we similarly handle `select-window' events? --Stef - ;; Also ignore down-events that are undefined. - (while (progn (setq event (read-event)) - (setq events (append events (list event))) - (setq key (apply 'vector events)) - (or (and (consp event) - (eq (car event) 'switch-frame)) - (and (consp event) - (eq (posn-point (event-end event)) - 'vertical-scroll-bar)) - (and (memq 'down (event-modifiers event)) - (not (key-binding key)) - (not (mouse-undouble-last-event events)) - (not (member key mouse-region-delete-keys))))) - (and (consp event) - (or (eq (car event) 'switch-frame) - (eq (posn-point (event-end event)) - 'vertical-scroll-bar)) - (let ((keys (vector 'vertical-scroll-bar event))) - (and (key-binding keys) - (progn - (call-interactively (key-binding keys) - nil keys) - (setq events nil))))))) - ;; If we lost the selection, just turn off the highlighting. - (unless ignore - ;; For certain special keys, delete the region. - (if (member key mouse-region-delete-keys) - (progn - ;; Since notionally this is a separate command, - ;; run all the hooks that would be run if it were - ;; executed separately. - (run-hooks 'post-command-hook) - (setq last-command this-command) - (setq this-original-command 'delete-region) - (setq this-command (or (command-remapping this-original-command) - this-original-command)) - (run-hooks 'pre-command-hook) - (call-interactively this-command)) - ;; Otherwise, unread the key so it gets executed normally. - (setq unread-command-events - (nconc events unread-command-events)))) - (setq quit-flag nil) - (unless transient-mark-mode - (delete-overlay mouse-drag-overlay)))) - (defun mouse-set-mark (click) "Set mark at the position clicked on with the mouse. Display cursor at that position for a second. @@ -1365,9 +1247,7 @@ Also move point to one end of the text thus inserted (normally the end), and set mark at the beginning. Prefix arguments are interpreted as with \\[yank]. If `mouse-yank-at-point' is non-nil, insert at point -regardless of where you click. -If `select-active-regions' is non-nil, the mark is deactivated -before inserting the text." +regardless of where you click." (interactive "e\nP") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) @@ -1393,10 +1273,17 @@ regardless of where you click." ;; the middle of an active region. (deactivate-mark)) (or mouse-yank-at-point (mouse-set-point click)) - (let ((primary (x-get-selection 'PRIMARY))) + (let ((primary + (cond + ((fboundp 'x-get-selection-value) ; MS-DOS and MS-Windows + (or (x-get-selection-value) + (x-get-selection 'PRIMARY))) + ;; FIXME: What about xterm-mouse-mode etc.? + (t + (x-get-selection 'PRIMARY))))) (if primary - (insert (x-get-selection 'PRIMARY)) - (error "No primary selection")))) + (insert primary) + (error "No selection is available")))) (defun mouse-kill-ring-save (click) "Copy the region between point and the mouse click in the kill ring. @@ -1404,8 +1291,7 @@ This does not delete the region; it acts like \\[kill-ring-save]." (interactive "e") (mouse-set-mark-fast click) (let (this-command last-command) - (kill-ring-save (point) (mark t))) - (mouse-show-mark)) + (kill-ring-save (point) (mark t)))) ;; This function used to delete the text between point and the mouse ;; whenever it was equal to the front of the kill ring, but some @@ -1450,16 +1336,23 @@ This does not delete the region; it acts like \\[kill-ring-save]." (undo-boundary)) (defun mouse-save-then-kill (click) - "Save text to point in kill ring; the second time, kill the text. -If the text between point and the mouse is the same as what's -at the front of the kill ring, this deletes the text. -Otherwise, it adds the text to the kill ring, like \\[kill-ring-save], -which prepares for a second click to delete the text. - -If you have selected words or lines, this command extends the -selection through the word or line clicked on. If you do this -again in a different position, it extends the selection again. -If you do this twice in the same position, the selection is killed." + "Set the region according to CLICK; the second time, kill the region. +Assuming this command is bound to a mouse button, CLICK is the +corresponding input event. + +If the region is already active, adjust it. Normally, this +happens by moving either point or mark, whichever is closer, to +the position of CLICK. But if you have selected words or lines, +the region is adjusted by moving point or mark to the word or +line boundary closest to CLICK. + +If the region is inactive, activate it temporarily; set mark at +the original point, and move click to the position of CLICK. + +However, if this command is being called a second time (i.e. the +value of `last-command' is `mouse-save-then-kill'), kill the +region instead. If the text in the region is the same as the +text in the front of the kill ring, just delete it." (interactive "e") (let ((before-scroll (with-current-buffer (window-buffer (posn-window (event-start click))) @@ -1471,45 +1364,50 @@ If you do this twice in the same position, the selection is killed." (this-command this-command)) (if (and (with-current-buffer (window-buffer (posn-window (event-start click))) - (and (mark t) (> (mod mouse-selection-click-count 3) 0) + (and (mark t) + (> (mod mouse-selection-click-count 3) 0) ;; Don't be fooled by a recent click in some other buffer. (eq mouse-selection-click-count-buffer (current-buffer))))) - (if (not (and (eq last-command 'mouse-save-then-kill) - (equal click-posn - (car (cdr-safe (cdr-safe mouse-save-then-kill-posn)))))) - ;; Find both ends of the object selected by this click. - (let* ((range - (mouse-start-end click-posn click-posn - mouse-selection-click-count))) - ;; Move whichever end is closer to the click. - ;; That's what xterm does, and it seems reasonable. - (if (< (abs (- click-posn (mark t))) - (abs (- click-posn (point)))) - (set-mark (car range)) - (goto-char (nth 1 range))) - ;; We have already put the old region in the kill ring. - ;; Replace it with the extended region. - ;; (It would be annoying to make a separate entry.) - (kill-new (buffer-substring (point) (mark t)) t) - (mouse-set-region-1) - ;; Arrange for a repeated mouse-3 to kill this region. - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn)) - (mouse-show-mark)) - ;; If we click this button again without moving it, - ;; that time kill. - (mouse-save-then-kill-delete-region (mark) (point)) - (setq mouse-selection-click-count 0) - (setq mouse-save-then-kill-posn nil)) + (if (and (eq last-command 'mouse-save-then-kill) + (equal click-posn (nth 2 mouse-save-then-kill-posn))) + ;; If we click this button again without moving it, kill. + (progn + ;; Call `deactivate-mark' to save the primary selection. + (deactivate-mark) + (mouse-save-then-kill-delete-region (mark) (point)) + (setq mouse-selection-click-count 0) + (setq mouse-save-then-kill-posn nil)) + ;; Find both ends of the object selected by this click. + (let* ((range + (mouse-start-end click-posn click-posn + mouse-selection-click-count))) + ;; Move whichever end is closer to the click. + ;; That's what xterm does, and it seems reasonable. + (if (< (abs (- click-posn (mark t))) + (abs (- click-posn (point)))) + (set-mark (car range)) + (goto-char (nth 1 range))) + ;; We have already put the old region in the kill ring. + ;; Replace it with the extended region. + ;; (It would be annoying to make a separate entry.) + (kill-new (buffer-substring (point) (mark t)) t) + (mouse-set-region-1) + ;; Arrange for a repeated mouse-3 to kill this region. + (setq mouse-save-then-kill-posn + (list (car kill-ring) (point) click-posn)))) + (if (and (eq last-command 'mouse-save-then-kill) mouse-save-then-kill-posn (eq (car mouse-save-then-kill-posn) (car kill-ring)) - (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn))) + (equal (cdr mouse-save-then-kill-posn) + (list (point) click-posn))) ;; If this is the second time we've called ;; mouse-save-then-kill, delete the text from the buffer. (progn - (mouse-save-then-kill-delete-region (point) (mark)) + ;; Call `deactivate-mark' to save the primary selection. + (deactivate-mark) + (mouse-save-then-kill-delete-region (point) (mark t)) ;; After we kill, another click counts as "the first time". (setq mouse-save-then-kill-posn nil)) ;; This is not a repetition. @@ -1540,7 +1438,6 @@ If you do this twice in the same position, the selection is killed." (goto-char before-scroll)) (exchange-point-and-mark) ;Why??? --Stef (kill-new (buffer-substring (point) (mark t)))) - (mouse-show-mark) (mouse-set-region-1) (setq mouse-save-then-kill-posn (list (car kill-ring) (point) click-posn))))))) @@ -1693,7 +1590,7 @@ regardless of where you click." (or mouse-yank-at-point (mouse-set-point click)) (let ((secondary (x-get-selection 'SECONDARY))) (if secondary - (insert (x-get-selection 'SECONDARY)) + (insert secondary) (error "No secondary selection")))) (defun mouse-kill-secondary () @@ -2483,6 +2380,7 @@ choose a font." (declare-function font-face-attributes "font.c" (font &optional frame)) (defun mouse-appearance-menu (event) + "Show a menu for changing the default face in the current buffer." (interactive "@e") (require 'face-remap) (when (display-multi-font-p) @@ -2556,7 +2454,7 @@ choose a font." (global-set-key [left-fringe mouse-1] 'mouse-set-point) (global-set-key [right-fringe mouse-1] 'mouse-set-point) -(global-set-key [mouse-2] 'mouse-yank-at-click) +(global-set-key [mouse-2] 'mouse-yank-primary) ;; Allow yanking also when the corresponding cursor is "in the fringe". (global-set-key [right-fringe mouse-2] 'mouse-yank-at-click) (global-set-key [left-fringe mouse-2] 'mouse-yank-at-click) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 420381cf43e..fb9b57b724d 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -892,6 +892,7 @@ The order attempted is gnome-moz-remote, Mozilla, Firefox, Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3." (apply (cond + ((browse-url-can-use-xdg-open) 'browse-url-xdg-open) ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz) ((executable-find browse-url-mozilla-program) 'browse-url-mozilla) ((executable-find browse-url-firefox-program) 'browse-url-firefox) @@ -905,6 +906,41 @@ Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3." (lambda (&rest ignore) (error "No usable browser found")))) url args)) +(defun browse-url-can-use-xdg-open () + "Check if xdg-open can be used, i.e. we are on Gnome, KDE or xfce4." + (and (getenv "DISPLAY") + (executable-find "xdg-open") + ;; xdg-open may call gnome-open and that does not wait for its child + ;; to finish. This child may then be killed when the parent dies. + ;; Use nohup to work around. + (executable-find "nohup") + (or (getenv "GNOME_DESKTOP_SESSION_ID") + ;; GNOME_DESKTOP_SESSION_ID is deprecated, check on Dbus also. + (condition-case nil + (eq 0 (call-process + "dbus-send" nil nil nil + "--dest=org.gnome.SessionManager" + "--print-reply" + "/org/gnome/SessionManager" + "org.gnome.SessionManager.CanShutdown")) + (error nil)) + (equal (getenv "KDE_FULL_SESSION") "true") + (condition-case nil + (eq 0 (call-process + "/bin/sh" nil nil nil + "-c" + "xprop -root _DT_SAVE_MODE|grep xfce4")) + (error nil))))) + + +;;;###autoload +(defun browse-url-xdg-open (url &optional new-window) + (interactive (browse-url-interactive-arg "URL: ")) + (call-process "/bin/sh" nil nil nil + "-c" + (concat "nohup xdg-open " url + ">/dev/null 2>&1 </dev/null"))) + ;;;###autoload (defun browse-url-netscape (url &optional new-window) "Ask the Netscape WWW browser to load URL. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 46cbb723d76..870bd2e313d 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -39,6 +39,7 @@ (declare-function dbus-method-error-internal "dbusbind.c") (declare-function dbus-register-signal "dbusbind.c") (declare-function dbus-register-method "dbusbind.c") +(declare-function dbus-send-signal "dbusbind.c") (defvar dbus-debug) (defvar dbus-registered-objects-table) @@ -869,7 +870,7 @@ name of the property, and its value. If there are no properties, (add-to-list 'result (cons (car dict) (caadr dict)) 'append))))) (defun dbus-register-property - (bus service path interface property access value) + (bus service path interface property access value &optional emits-signal) "Register property PROPERTY on the D-Bus BUS. BUS is either the symbol `:system' or the symbol `:session'. @@ -892,7 +893,9 @@ can be changed by `dbus-set-property'. The interface \"org.freedesktop.DBus.Properties\" is added to PATH, including a default handler for the \"Get\", \"GetAll\" and -\"Set\" methods of this interface." +\"Set\" methods of this interface. When EMITS-SIGNAL is non-nil, +the signal \"PropertiesChanged\" is sent when the property is +changed by `dbus-set-property'." (unless (member access '(:read :readwrite)) (signal 'dbus-error (list "Access type invalid" access))) @@ -911,10 +914,23 @@ PATH, including a default handler for the \"Get\", \"GetAll\" and (dbus-register-method bus service path dbus-interface-properties "Set" 'dbus-property-handler) + ;; Send the PropertiesChanged signal. + (when emits-signal + (dbus-send-signal + bus service path dbus-interface-properties "PropertiesChanged" + (list (list :dict-entry property (list :variant value))) + '(:array))) + ;; Create a hash table entry. We use nil for the unique name, ;; because the property might be accessed from anybody. (let ((key (list bus interface property)) - (val (list (list nil service path (cons access value))))) + (val + (list + (list + nil service path + (cons + (if emits-signal (list access :emits-signal) (list access)) + value))))) (puthash key val dbus-registered-objects-table) ;; Return the object. @@ -924,6 +940,7 @@ PATH, including a default handler for the \"Get\", \"GetAll\" and "Default handler for the \"org.freedesktop.DBus.Properties\" interface. It will be registered for all objects created by `dbus-register-object'." (let ((bus (dbus-event-bus-name last-input-event)) + (service (dbus-event-service-name last-input-event)) (path (dbus-event-path-name last-input-event)) (method (dbus-event-member-name last-input-event)) (interface (car args)) @@ -931,25 +948,40 @@ It will be registered for all objects created by `dbus-register-object'." (cond ;; "Get" returns a variant. ((string-equal method "Get") - (let ((val (gethash (list bus interface property) - dbus-registered-objects-table))) - (when (string-equal path (nth 2 (car val))) - (list (list :variant (cdar (last (car val)))))))) + (let ((entry (gethash (list bus interface property) + dbus-registered-objects-table))) + (when (string-equal path (nth 2 (car entry))) + (list (list :variant (cdar (last (car entry)))))))) ;; "Set" expects a variant. ((string-equal method "Set") - (let ((val (gethash (list bus interface property) - dbus-registered-objects-table))) - (unless (consp (car (last (car val)))) + (let* ((value (caar (cddr args))) + (entry (gethash (list bus interface property) + dbus-registered-objects-table)) + ;; The value of the hash table is a list; in case of + ;; properties it contains just one element (UNAME SERVICE + ;; PATH OBJECT). OBJECT is a cons cell of a list, which + ;; contains a list of annotations (like :read, + ;; :read-write, :emits-signal), and the value of the + ;; property. + (object (car (last (car entry))))) + (unless (consp object) (signal 'dbus-error (list "Property not registered at path" property path))) - (unless (equal (caar (last (car val))) :readwrite) + (unless (member :readwrite (car object)) (signal 'dbus-error (list "Property not writable at path" property path))) (puthash (list bus interface property) - (list (append (butlast (car val)) - (list (cons :readwrite (caar (cddr args)))))) + (list (append (butlast (car entry)) + (list (cons (car object) value)))) dbus-registered-objects-table) + ;; Send the "PropertiesChanged" signal. + (when (member :emits-signal (car object)) + (dbus-send-signal + bus service path dbus-interface-properties "PropertiesChanged" + (list (list :dict-entry property (list :variant value))) + '(:array))) + ;; Return empty reply. :ignore)) ;; "GetAll" returns "a{sv}". diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 76fc1cd72dd..b4a7b3118d2 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1342,6 +1342,12 @@ Logfiles are kept in `rcirc-log-directory'." :type 'integer :group 'rcirc) +(defcustom rcirc-log-process-buffers nil + "Non-nil if rcirc process buffers should be logged to disk." + :group 'rcirc + :type 'boolean + :version "24.1") + (defun rcirc-last-quit-line (process nick target) "Return the line number where NICK left TARGET. Returns nil if the information is not recorded." @@ -1507,14 +1513,21 @@ record activity." (when (not (rcirc-channel-p rcirc-target)) 'nick))) - (when rcirc-log-flag + (when (and rcirc-log-flag + (or target + rcirc-log-process-buffers)) (rcirc-log process sender response target text)) (sit-for 0) ; displayed text before hook (run-hook-with-args 'rcirc-print-hooks process sender response target text))))) -(defcustom rcirc-log-filename-function 'rcirc-generate-new-buffer-name +(defun rcirc-generate-log-filename (process target) + (if target + (rcirc-generate-new-buffer-name process target) + (process-name process))) + +(defcustom rcirc-log-filename-function 'rcirc-generate-log-filename "A function to generate the filename used by rcirc's logging facility. It is called with two arguments, PROCESS and TARGET (see diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 86501561238..0e31360a416 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -225,7 +225,7 @@ Before reproducing the bug, you might apply This allows to investigate from a clean environment. Another useful thing to do is to put - (setq tramp-verbose 8) + (setq tramp-verbose 9) in the ~/.emacs file and to repeat the bug. Then, include the contents of the *tramp/foo* buffer and the *debug tramp/foo* diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index a984dd37fd8..202eaf59835 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -551,11 +551,14 @@ is no information where to trace the message.") (tramp-message v 4 "`copy-file' failed, trying `gvfs-copy'") (unless (zerop - (tramp-gvfs-send-command - v "gvfs-copy" - (if (or keep-date preserve-uid-gid) "--preserve" "") - (tramp-gvfs-url-file-name filename) - (tramp-gvfs-url-file-name newname))) + (let ((args + (append (if (or keep-date preserve-uid-gid) + (list "--preserve") + nil) + (list + (tramp-gvfs-url-file-name filename) + (tramp-gvfs-url-file-name newname))))) + (apply 'tramp-gvfs-send-command v "gvfs-copy" args))) ;; Propagate the error. (tramp-error v (car err) "%s" (cdr err))))))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8e9ca34f16b..052dc7d7575 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -200,6 +200,7 @@ Any level x includes messages for all levels 1 .. x-1. The levels are 6 sent and received strings 7 file caching 8 connection properties + 9 test commands 10 traces (huge)." :group 'tramp :type 'integer) @@ -332,8 +333,8 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-copy-recursive t) (tramp-password-end-of-line nil)) ("scp" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") @@ -348,8 +349,8 @@ detected as prompt when being sent on echoing hosts, therefore.") ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("scp1" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-1" "-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-1") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") @@ -364,8 +365,8 @@ detected as prompt when being sent on echoing hosts, therefore.") ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("scp2" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-2" "-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-2") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") @@ -400,8 +401,8 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-copy-recursive t) (tramp-password-end-of-line nil)) ("sftp" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "sftp") @@ -409,8 +410,8 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-copy-keep-date nil) (tramp-password-end-of-line nil)) ("rsync" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "rsync") @@ -421,10 +422,10 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-password-end-of-line nil)) ("rsyncc" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") + (tramp-login-args (("-l" "%u") ("-p" "%p") ("-o" "ControlPath=%t.%%r@%%h:%%p") ("-o" "ControlMaster=yes") - ("-e" "none"))) + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "rsync") @@ -453,8 +454,8 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-copy-keep-date nil) (tramp-password-end-of-line nil)) ("ssh" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) @@ -467,8 +468,8 @@ detected as prompt when being sent on echoing hosts, therefore.") ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("ssh1" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-1" "-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-1") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) @@ -481,8 +482,8 @@ detected as prompt when being sent on echoing hosts, therefore.") ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("ssh2" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-2" "-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-2") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) @@ -545,10 +546,10 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-copy-keep-date nil) (tramp-password-end-of-line nil)) ("scpc" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") + (tramp-login-args (("-l" "%u") ("-p" "%p") ("-o" "ControlPath=%t.%%r@%%h:%%p") ("-o" "ControlMaster=yes") - ("-e" "none"))) + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") @@ -563,8 +564,9 @@ detected as prompt when being sent on echoing hosts, therefore.") ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("scpx" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none" "-t" "-t" "/bin/sh"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("-t" "-t") + ("%h") ("/bin/sh"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") @@ -577,8 +579,9 @@ detected as prompt when being sent on echoing hosts, therefore.") ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("sshx" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none" "-t" "-t" "/bin/sh"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("-t" "-t") + ("%h") ("/bin/sh"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) @@ -599,8 +602,8 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-copy-keep-date nil) (tramp-password-end-of-line nil)) ("plink" (tramp-login-program "plink") - (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p") - ("-ssh"))) + (tramp-login-args (("-l" "%u") ("-P" "%p") + ("-ssh") ("%h"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) (tramp-copy-args nil) @@ -609,8 +612,8 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-default-port 22)) ("plink1" (tramp-login-program "plink") - (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p") - ("-1" "-ssh"))) + (tramp-login-args (("-l" "%u") ("-P" "%p") + ("-1" "-ssh") ("%h"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) (tramp-copy-args nil) @@ -633,8 +636,8 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-copy-keep-date nil) (tramp-password-end-of-line nil)) ("pscp" (tramp-login-program "plink") - (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p") - ("-ssh"))) + (tramp-login-args (("-l" "%u") ("-P" "%p") + ("-ssh") ("%h"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "pscp") (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k"))) @@ -642,8 +645,8 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-password-end-of-line "xy") ;see docstring for "xy" (tramp-default-port 22)) ("psftp" (tramp-login-program "plink") - (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p") - ("-ssh"))) + (tramp-login-args (("-l" "%u") ("-P" "%p") + ("-ssh") ("%h"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "pscp") (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k"))) @@ -1037,6 +1040,7 @@ The default value is to use the same value as `tramp-rsh-end-of-line'." ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin ;; GNU/Linux (Debian, Suse): /bin:/usr/bin ;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! +;; IRIX64: /usr/bin (defcustom tramp-remote-path '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin" "/local/bin" "/local/freeware/bin" "/local/gnu/bin" @@ -1443,10 +1447,14 @@ See also `tramp-file-name-regexp'.") ;;;###autoload (defconst tramp-file-name-regexp-unified - "\\`/\\([^[/:]+\\|[^/]+]\\):" + (if (memq system-type '(cygwin windows-nt)) + "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):" + "\\`/\\([^[/:]+\\|[^/]+]\\):") "Value for `tramp-file-name-regexp' for unified remoting. Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and -Tramp. See `tramp-file-name-structure' for more explanations.") +Tramp. See `tramp-file-name-structure' for more explanations. + +On W32 systems, the volume letter must be ignored.") ;;;###autoload (defconst tramp-file-name-regexp-separate @@ -1493,10 +1501,14 @@ volume letter, which will be removed by `tramp-drop-volume-letter'.") ;;;###autoload (defconst tramp-completion-file-name-regexp-unified - (concat tramp-root-regexp "[^/]*\\'") + (if (memq system-type '(cygwin windows-nt)) + (concat tramp-root-regexp "[^/]\\{2,\\}\\'") + (concat tramp-root-regexp "[^/]*\\'")) "Value for `tramp-completion-file-name-regexp' for unified remoting. GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP. -See `tramp-file-name-structure' for more explanations.") +See `tramp-file-name-structure' for more explanations. + +On W32 systems, the volume letter must be ignored.") ;;;###autoload (defconst tramp-completion-file-name-regexp-separate @@ -1786,7 +1798,7 @@ printf( $stat[2], $stat[1] >> 16 & 0xffff, $stat[1] & 0xffff -);' \"$1\" \"$2\" \"$3\" 2>/dev/null" +);' \"$1\" \"$2\" 2>/dev/null" "Perl script to produce output suitable for use with `file-attributes' on the remote file system. Escape sequence %s is replaced with name of Perl binary. @@ -1839,7 +1851,7 @@ for($i = 0; $i < $n; $i++) $stat[0] >> 16 & 0xffff, $stat[0] & 0xffff); } -printf(\")\\n\");' \"$1\" \"$2\" \"$3\" 2>/dev/null" +printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null" "Perl script implementing `directory-files-attributes' as Lisp `read'able output. Escape sequence %s is replaced with name of Perl binary. @@ -1971,13 +1983,13 @@ This string is passed to `format', so percent characters need to be doubled.") (defconst tramp-vc-registered-read-file-names "echo \"(\" -for file in \"$@\"; do - if %s $file; then +while read file; do + if %s \"$file\"; then echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\" else echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\" fi - if %s $file; then + if %s \"$file\"; then echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\" else echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\" @@ -1986,7 +1998,9 @@ done echo \")\"" "Script to check existence of VC related files. It must be send formatted with two strings; the tests for file -existence, and file readability.") +existence, and file readability. Input shall be read via +here-document, otherwise the command could exceed maximum length +of command line.") (defconst tramp-file-mode-type-map '((0 . "-") ; Normal file (SVID-v2 and XPG2) @@ -2538,7 +2552,7 @@ target of the symlink differ." (unless ln (tramp-error l 'file-error - "Making a symbolic link. ln(1) does not exist on the remote host.")) + "Making a symbolic link. ln(1) does not exist on the remote host.")) ;; Do the 'confirm if exists' thing. (when (file-exists-p linkname) @@ -2559,6 +2573,9 @@ target of the symlink differ." (tramp-file-name-localname (tramp-dissect-file-name (expand-file-name filename))))) + (tramp-flush-file-property l (file-name-directory l-localname)) + (tramp-flush-file-property l l-localname) + ;; Right, they are on the same host, regardless of user, method, etc. ;; We now make the link on the remote machine. This will occur as the user ;; that FILENAME belongs to. @@ -4222,7 +4239,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." ;; DIR-P is valid for XEmacs only. (with-parsed-tramp-file-name (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil - (tramp-flush-file-property v localname))) + (tramp-flush-directory-property v localname))) ;; Pacify byte-compiler. The function is needed on XEmacs only. I'm ;; not sure at all that this is the right way to do it, but let's hope @@ -4491,20 +4508,30 @@ beginning of local filename are not substituted." (with-parsed-tramp-file-name default-directory nil (tramp-find-executable v command (tramp-get-remote-path v) t))) +(defun tramp-process-sentinel (proc event) + "Flush file caches." + (unless (memq (process-status proc) '(run open)) + (let ((vec (tramp-get-connection-property proc "vector" nil))) + (when vec + (tramp-message vec 5 "Sentinel called: `%s' `%s'" proc event) + (tramp-flush-directory-property vec ""))))) + ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. (defun tramp-handle-start-file-process (name buffer program &rest args) "Like `start-file-process' for Tramp files." (with-parsed-tramp-file-name default-directory nil - (unless (stringp program) - (tramp-error - v 'file-error "pty association is not supported for `%s'" name)) (unwind-protect - (let ((command (format "cd %s; exec %s" - (tramp-shell-quote-argument localname) - (mapconcat 'tramp-shell-quote-argument - (cons program args) " "))) + ;; When PROGRAM is nil, we just provide a tty. + (let ((command + (when (stringp program) + (format "cd %s; exec %s" + (tramp-shell-quote-argument localname) + (mapconcat 'tramp-shell-quote-argument + (cons program args) " ")))) + (tramp-process-connection-type + (or (null program) tramp-process-connection-type)) (name1 name) (i 0)) (unless buffer @@ -4524,14 +4551,21 @@ beginning of local filename are not substituted." (with-current-buffer (tramp-get-connection-buffer v) (clear-visited-file-modtime) (narrow-to-region (point-max) (point-max))) - ;; Send the command. `tramp-send-command' opens a new - ;; connection. - (tramp-send-command v command nil t) ; nooutput - ;; Set query flag for this process. - (tramp-set-process-query-on-exit-flag - (tramp-get-connection-process v) t) - ;; Return process. - (tramp-get-connection-process v)) + (if command + ;; Send the command. + (tramp-send-command v command nil t) ; nooutput + ;; Check, whether a pty is associated. + (tramp-maybe-open-connection v) + (unless (process-get (tramp-get-connection-process v) 'remote-tty) + (tramp-error + v 'file-error "pty association is not supported for `%s'" name))) + (let ((p (tramp-get-connection-process v))) + ;; Set sentinel and query flag for this process. + (tramp-set-connection-property p "vector" v) + (set-process-sentinel p 'tramp-process-sentinel) + (tramp-set-process-query-on-exit-flag p t) + ;; Return process. + p)) ;; Save exit. (with-current-buffer (tramp-get-connection-buffer v) (if (string-match tramp-temp-buffer-name (buffer-name)) @@ -4607,7 +4641,9 @@ beginning of local filename are not substituted." (setq outbuf (current-buffer)))) (when stderr (setq command (format "%s 2>%s" command stderr))) - ;; Send the command. It might not return in time, so we protect it. + ;; Send the command. It might not return in time, so we protect + ;; it. Call it in a subshell, in order to preserve working + ;; directory. (condition-case nil (unwind-protect (setq ret @@ -4615,7 +4651,7 @@ beginning of local filename are not substituted." v (format "\\cd %s; %s" (tramp-shell-quote-argument localname) command) - nil t)) + t t)) ;; We should show the output anyway. (when outbuf (with-current-buffer outbuf @@ -4683,7 +4719,12 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) ;; We cannot use `shell-file-name' and `shell-command-switch', ;; they are variables of the local host. - (args (list "/bin/sh" "-c" (substring command 0 asynchronous))) + (args (list + (tramp-get-method-parameter + (tramp-file-name-method + (tramp-dissect-file-name default-directory)) + 'tramp-remote-sh) + "-c" (substring command 0 asynchronous))) current-buffer-p (output-buffer (cond @@ -5385,10 +5426,10 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (tramp-send-command-and-read v (format - "tramp_vc_registered_read_file_names %s" + "tramp_vc_registered_read_file_names <<'EOF'\n%s\nEOF\n" (mapconcat 'tramp-shell-quote-argument tramp-vc-registered-file-names - " ")))) + "\n")))) (tramp-set-file-property v (car elt) (cadr elt) (cadr (cdr elt)))))) @@ -5559,12 +5600,23 @@ Falls back to normal file name handler if no Tramp file name handler exists." (if foreign (condition-case err (apply foreign operation args) + + ;; Trace that somebody has interrupted the + ;; operation. + (quit + (let (tramp-message-show-message) + (tramp-message + v 1 "Interrupt received in operation %s" + (append (list operation) args))) + ;; Propagate the quit signal. + (signal (car err) (cdr err))) + + ;; When we are in completion mode, some failed + ;; operations shall return at least a default value + ;; in order to give the user a chance to correct the + ;; file name in the minibuffer. (error (cond - ;; When we are in completion mode, some failed - ;; operations shall return at least a default - ;; value in order to give the user a chance to - ;; correct the file name in the minibuffer. ((and completion (zerop (length localname)) (memq operation '(file-exists-p file-directory-p))) t) @@ -5574,6 +5626,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." filename) ;; Propagate the error. (t (signal (car err) (cdr err)))))) + ;; Nothing to do for us. (tramp-run-real-handler operation args))))) @@ -6572,7 +6625,29 @@ file exists and nonzero exit status otherwise." vec 'file-error "Couldn't find command to check if file exists")) result)) -;; CCC test ksh or bash found for tilde expansion? +(defun tramp-open-shell (vec shell) + "Opens shell SHELL." + (with-progress-reporter vec 5 (format "Opening remote shell `%s'" shell) + ;; Find arguments for this shell. + (let ((tramp-end-of-output tramp-initial-end-of-output) + (alist tramp-sh-extra-args) + item extra-args) + (while (and alist (null extra-args)) + (setq item (pop alist)) + (when (string-match (car item) shell) + (setq extra-args (cdr item)))) + (when extra-args (setq shell (concat shell " " extra-args))) + (tramp-send-command + vec (format "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s" + (shell-quote-argument tramp-end-of-output) shell) + t)) + ;; Setting prompts. + (tramp-send-command + vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t) + (tramp-send-command vec "PS2=''" t) + (tramp-send-command vec "PS3=''" t) + (tramp-send-command vec "PROMPT_COMMAND=''" t))) + (defun tramp-find-shell (vec) "Opens a shell on the remote host which groks tilde expansion." (unless (tramp-get-connection-property vec "remote-shell" nil) @@ -6593,38 +6668,16 @@ file exists and nonzero exit status otherwise." (tramp-error vec 'file-error "Couldn't find a shell which groks tilde expansion")) - ;; Find arguments for this shell. - (let ((alist tramp-sh-extra-args) - item extra-args) - (while (and alist (null extra-args)) - (setq item (pop alist)) - (when (string-match (car item) shell) - (setq extra-args (cdr item)))) - (when extra-args (setq shell (concat shell " " extra-args)))) (tramp-message vec 5 "Starting remote shell `%s' for tilde expansion" shell) - (let ((tramp-end-of-output tramp-initial-end-of-output)) - (tramp-send-command - vec - (format "PROMPT_COMMAND='' PS1=%s PS2='' PS3='' exec %s" - (shell-quote-argument tramp-end-of-output) shell) - t)) - ;; Setting prompts. - (with-progress-reporter vec 5 (format "Setting remote shell prompt") - (tramp-send-command - vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t) - (tramp-send-command vec "PS2=''" t) - (tramp-send-command vec "PS3=''" t) - (tramp-send-command vec "PROMPT_COMMAND=''" t))) + (tramp-open-shell vec shell)) (t (tramp-message vec 5 "Remote `%s' groks tilde expansion, good" - (tramp-get-method-parameter - (tramp-file-name-method vec) 'tramp-remote-sh)) - (tramp-set-connection-property - vec "remote-shell" - (tramp-get-method-parameter - (tramp-file-name-method vec) 'tramp-remote-sh)))))))) + (tramp-set-connection-property + vec "remote-shell" + (tramp-get-method-parameter + (tramp-file-name-method vec) 'tramp-remote-sh))))))))) ;; ------------------------------------------------------------ ;; -- Functions for establishing connection -- @@ -6650,8 +6703,10 @@ file exists and nonzero exit status otherwise." "Query the user for a password." (with-current-buffer (process-buffer proc) (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (tramp-message vec 3 "Sending %s" (match-string 1))) - (tramp-enter-password proc)) + (tramp-message vec 3 "Sending %s" (match-string 1)) + (tramp-enter-password proc) + ;; Hide password prompt. + (narrow-to-region (point-max) (point-max)))) (defun tramp-action-succeed (proc vec) "Signal success in finding shell prompt." @@ -6762,6 +6817,7 @@ The terminal type can be configured with `tramp-terminal-type'." (tramp-process-one-action proc vec actions)) (tramp-process-one-action proc vec actions))))) (with-current-buffer (tramp-get-connection-buffer vec) + (widen) (tramp-message vec 6 "\n%s" (buffer-string))) (unless (eq exit 'ok) (tramp-clear-passwd vec) @@ -6898,14 +6954,9 @@ process to set up. VEC specifies the connection." ;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND ;; is another way to set the prompt in /bin/bash, it must be ;; discarded as well. - (tramp-send-command + (tramp-open-shell vec - (format - "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s" - (shell-quote-argument tramp-end-of-output) - (tramp-get-method-parameter - (tramp-file-name-method vec) 'tramp-remote-sh)) - t) + (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-remote-sh)) ;; Disable echo. (tramp-message vec 5 "Setting up remote shell environment") @@ -6963,7 +7014,7 @@ process to set up. VEC specifies the connection." ;; stty, instead. (tramp-send-command vec "stty -onlcr" t)))) ;; Dump stty settings in the traces. - (when (>= tramp-verbose 10) + (when (>= tramp-verbose 9) (tramp-send-command vec "stty -a" t)) (tramp-send-command vec "set +o vi +o emacs" t) @@ -7021,7 +7072,7 @@ process to set up. VEC specifies the connection." ;; "echo $?" part if the "test" part has an error. In particular, ;; the OpenSolaris /bin/sh is a problem. There are also other ;; problems with /bin/sh of OpenSolaris, like redirection of stderr - ;; in in function declarations, or changing HISTFILE in place. + ;; in function declarations, or changing HISTFILE in place. ;; Therefore, OpenSolaris' /bin/sh is replaced by bash, when ;; detected. (tramp-find-shell vec) @@ -7029,6 +7080,17 @@ process to set up. VEC specifies the connection." ;; Disable unexpected output. (tramp-send-command vec "mesg n; biff n" t) + ;; IRIX64 bash expands "!" even when in single quotes. This + ;; destroys our shell functions, we must disable it. See + ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>. + (when (string-match "^IRIX64" (tramp-get-connection-property vec "uname" "")) + (tramp-send-command vec "set +H" t)) + + ;; Set `remote-tty' process property. + (ignore-errors + (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\""))) + (unless (zerop (length tty)) (process-put proc 'remote-tty tty)))) + ;; Set the environment. (tramp-message vec 5 "Setting default environment") @@ -7044,7 +7106,7 @@ process to set up. VEC specifies the connection." (setq env (cdr env))) (when unset (tramp-send-command - vec (format "unset %s" (mapconcat 'identity unset " "))))) t) + vec (format "unset %s" (mapconcat 'identity unset " ")) t)))) ;; CCC: We should either implement a Perl version of base64 encoding ;; and decoding. Then we just use that in the last item. The other @@ -7529,11 +7591,11 @@ connection if a previous connection has died for some reason." ;; Add arguments for asynchrononous processes. (when (and process-name async-args) - (setq login-args (append login-args async-args))) + (setq login-args (append async-args login-args))) ;; Add gateway arguments if necessary. (when (and gw gw-args) - (setq login-args (append login-args gw-args))) + (setq login-args (append gw-args login-args))) ;; Check for port number. Until now, there's no need ;; for handling like method, user, host. @@ -8316,10 +8378,14 @@ necessary only. This function will be used in file name completion." ;; Check parameters. On busybox, "ls" output coloring is ;; enabled by default sometimes. So we try to disable it ;; when possible. $LS_COLORING is not supported there. + ;; Some "ls" versions are sensible wrt the order of + ;; arguments, they fail when "-al" is after the + ;; "--color=never" argument (for example on FreeBSD). (when (zerop (tramp-send-command-and-check vec (format "%s -lnd /" result))) (when (zerop (tramp-send-command-and-check - vec (format "%s --color=never /" result))) + vec (format + "%s --color=never -al /dev/null" result))) (setq result (concat result " --color=never"))) (throw 'ls-found result)) (setq dl (cdr dl)))))) @@ -8329,8 +8395,12 @@ necessary only. This function will be used in file name completion." (save-match-data (with-connection-property vec "ls-dired" (tramp-message vec 5 "Checking, whether `ls --dired' works") + ;; Some "ls" versions are sensible wrt the order of arguments, + ;; they fail when "-al" is after the "--dired" argument (for + ;; example on FreeBSD). (zerop (tramp-send-command-and-check - vec (format "%s --dired /" (tramp-get-ls-command vec))))))) + vec (format "%s --dired -al /dev/null" + (tramp-get-ls-command vec))))))) (defun tramp-get-test-command (vec) (with-connection-property vec "test" @@ -8848,12 +8918,10 @@ Only works for Bourne-like shells." ;; by the files in that directory. Add this here. ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman) ;; * Make ffap.el grok Tramp filenames. (Eli Tziperman) -;; * Case-insensitive filename completion. (Norbert Goevert.) ;; * Don't use globbing for directories with many files, as this is ;; likely to produce long command lines, and some shells choke on ;; long command lines. ;; * How to deal with MULE in `insert-file-contents' and `write-region'? -;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'? ;; * abbreviate-file-name ;; * Better error checking. At least whenever we see something ;; strange when doing zerop, we should kill the process and start @@ -8917,20 +8985,15 @@ Only works for Bourne-like shells." ;; rsync). ;; * Keep a second connection open for out-of-band methods like scp or ;; rsync. -;; * Support ptys in `tramp-handle-start-file-process'. (Bug#4604, Bug#6360) ;; * IMHO, it's a drawback that currently Tramp doesn't support ;; Unicode in Dired file names by default. Is it possible to ;; improve Tramp to set LC_ALL to "C" only for commands where Tramp ;; expects English? Or just to set LC_MESSAGES to "C" if Tramp ;; expects only English messages? (Juri Linkov) ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) -;; * Do not handle files with drive letter as remote. (Bug#5447) ;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448, Bug#5705) ;; * Try telnet+curl as new method. It might be useful for busybox, ;; without built-in uuencode/uudecode. -;; * Let `shell-dynamic-complete-*' and `comint-dynamic-complete' work -;; on remote hosts. -;; * Use secrets.el for password handling. ;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'. ;; Functions for file-name-handler-alist: diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el index b0b98fc57f3..e49a45c8a48 100644 --- a/lisp/net/zeroconf.el +++ b/lisp/net/zeroconf.el @@ -336,6 +336,23 @@ The attributes of SERVICE can be retrieved via the functions (puthash type l-hook zeroconf-service-removed-hooks-hash))) (t (error "EVENT must be either `:new' or `:removed'")))) +(defun zeroconf-service-remove-hook (type event function) + "Remove FUNCTION from the hook of service type TYPE. + +EVENT must be either :new or :removed and has to match the event +type used when registering FUNCTION." + (let* ((table (cond + ((equal event :new) + zeroconf-service-added-hooks-hash) + ((equal event :removed) + zeroconf-service-removed-hooks-hash) + (t (error "EVENT must be either `:new' or `:removed'")))) + (l-hook (gethash type table nil))) + (remove-hook 'l-hook function) + (if l-hook + (puthash type l-hook table) + (remhash type table)))) + (defun zeroconf-get-host () "Returns the local host name as string." (dbus-call-method @@ -407,7 +424,7 @@ TYPE. The resulting list has the format (elt (nth 9 result))) ;; TXT. ;; The TXT field has the signature "aay". Transform to "as". (while elt - (setcar elt (apply 'string (car elt))) + (setcar elt (dbus-byte-array-to-string (car elt))) (setq elt (cdr elt))) (when nil ;; We discard it, no use so far. @@ -599,7 +616,7 @@ DOMAIN is nil, the local domain is used." ;; The "TXT" field has the signature "aay". Transform to "as". (let ((elt (nth 9 val))) (while elt - (setcar elt (apply 'string (car elt))) + (setcar elt (dbus-byte-array-to-string (car elt))) (setq elt (cdr elt)))) (when zeroconf-debug (message "zeroconf-service-resolver-handler: %s %S" @@ -641,11 +658,7 @@ For the description of arguments, see `zeroconf-resolved-services-hash'." ;; The TXT field has the signature "as". Transform to "aay". (dolist (elt txt) - (let (args) - (add-to-list - 'result - (dolist (elt1 (string-to-list elt) (append '(:array) args)) - (setq args (append args (list :byte elt1))))))) + (add-to-list 'result (dbus-string-to-byte-array elt))) ;; Add the service. (dbus-call-method diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 35007edfe15..9ebd951608e 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,1245 @@ +2010-08-17 Glenn Morris <rgm@gnu.org> + + * ob.el (tramp-compat-make-temp-file, org-edit-src-code) + (org-entry-get, org-table-import): Fix declarations. + (org-match-string-no-properties): Remove unnecessary declaration. + * ob-sh.el (org-babel-comint-in-buffer) + (org-babel-comint-wait-for-output, org-babel-comint-buffer-livep) + (org-babel-comint-with-output): Remove unnecessary declarations. + * ob-R.el (orgtbl-to-tsv): Fix declaration. + * org-list.el (org-entry-get): Fix declaration. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el: New file. + * ob-R.el: New file. + * ob-asymptote.el: New file. + * ob-clojure.el: New file. + * ob-comint.el: New file. + * ob-css.el: New file. + * ob-ditaa.el: New file. + * ob-dot.el: New file. + * ob-emacs-lisp.el: New file. + * ob-eval.el: New file. + * ob-exp.el: New file. + * ob-gnuplot.el: New file. + * ob-haskell.el: New file. + * ob-keys.el: New file. + * ob-latex.el: New file. + * ob-lob.el: New file. + * ob-matlab.el: New file. + * ob-mscgen.el: New file. + * ob-ocaml.el: New file. + * ob-octave.el: New file. + * ob-perl.el: New file. + * ob-python.el: New file. + * ob-ref.el: New file. + * ob-ruby.el: New file. + * ob-sass.el: New file. + * ob-screen.el: New file. + * ob-sh.el: New file. + * ob-sql.el: New file. + * ob-sqlite.el: New file. + * ob-table.el: New file. + * ob-tangle.el: New file. + * ob.el: New file. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mks.el: New file. + * org-capture.el: New file. + +2010-07-19 Christian Egli <christian.egli@sbszh.ch> + + * org-taskjuggler.el: New file. + +2010-07-19 Matt Lundin <mdl@imapmail.org> + + * org-agenda.el (org-search-view): Fix inclusion of agenda-archives + in org-agenda-text-search-extra-files. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-list.el (org-list-send-list): Locally bind variable `txt'. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-reload): Now also reloading babel files. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-plist): Make sure txt is a string + before calling `string-match'. + (org-capture-templates): Fix customization type. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Make a special case + for \nbsp. + (org-latex-entities): Remove the entry for \nbsp. + (org-latex-entities-exceptions): Variable removed. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-refile): Do not try to manipulate + bookmark list. + + * org.el (org-refile): Use the correct bookmark here. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-list-send-list): Parse list from its true beginning. + + * org.el (org-ctrl-c-ctrl-c): Maybe send the list when at a list item. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-link): Correctly determine if we should use + a relative path. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-radio-list-templates): Fix templates. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-send-list): Regexp defining the start of + a radio list is now on par with the one used for radio tables. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-entities.el (org-entities-help): Add a headline for + the user-defined entities. + +2010-07-19 Dirk-Jan C. Binnema <djcb.bulk@gmail.com> (tiny change) + + * org-agenda.el (org-agenda-action): Document capture key and add it + to the prompt. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-listings-langs): Add (sqlite "SQL"). + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-first-lines): Do not mark + meta lines for removal. Do not remove BABEL config lines during export. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-capture.el (org-capture): Check if + `org-capture-link-is-already-stored' is bound before evaluating. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el: Add autoload for org-babel-do-load-languages. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-src.el (org-src-lang-modes): Add sqlite to sql-mode. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el: Change indentation to match coding style + guideline. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-unescape, org-feed-parse-atom-feed): Load XML + library if necessary. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-amend-header): Standardize the + header cookie for the beamer extra stuff. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-amend-header): Put extra header + last in header. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-exp-blocks.el (org-export-blocks-format-ditaa) + (org-export-blocks-format-dot): Remove text properties of body before + calculating cache hash. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-tabular-environment): New option. + (org-export-latex-tables): Use `org-export-latex-tabular-environment'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-version-check): New function. + + * org-indent.el (org-indent-mode): Check for exact emacs version. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-templates): Allow the template + to come from a file or function call. + (org-capture-place-entry): Get the template from file or function. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-agenda-bulk-action): Don't create marker for + position if target is entire file. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-autoload): Autoload a few more org-table functions. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-babel-load-languages): Add ob-mscgen. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-tables): Format string now + matches options. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-babel-load-languages): This variable controls which + languages will be loaded by org-babel. It is customizable through + the customize interface. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-format-image): Update number of + arguments to allow for an optional short-name. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-indent.el (org-indent-mode): Refuse to turn on prior to Emacs 23.2. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-target-location): Store + exact positions for file+regexp and file+function targets. + (org-capture-place-entry, org-capture-place-item) + (org-capture-place-table-line, org-capture-place-plain-text): Respect + exact positions. + (org-capture-finalize): Make sure we are at the beginning of a line + when fixing the empty lines after the entry. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-entry-get-with-inheritance): New argument LITERAL-NIL. + (org-entry-get): Pass `literal-nil' into + `org-entry-get-with-inheritance'. + (org-todo): React to nil values of the LOGGING property. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-default-notes-file): Update docstring. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-link-frame-setup): Use `org-gnus-no-new-news' as default. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-attach-captions-and-attributes): Add + a shortname attribute to caption strings under the symbol name + org-caption-shortn. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-switchb): Rename from `org-iswitchb'. Improve + docstring. + (org-iswitchb): New alias. + (org-ido-switchb): Make alias point to `org-switchb'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-fill-template): Respect + time-of-day preference in template prompt. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-unescape): Remove superfluous lambda. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-disable-folder-check): New customization + variable. + (org-wl-open): Disable folder check depending on + `org-wl-disable-folder-check'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-target-location): Fix + file+function interpretation. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-parse-rss-entry): Unescape rss element + content. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (xml-entity-alist): Declare variable + `xml-entity-alist' for byte compiler. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-unescape): New function. Unescape + protected entities. + (org-feed-parse-atom-entry): Use function for atom:content + type text and html. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-parse-rss-feed): Ignore case of rss + element names. + +2010-07-19 Bernt Hansen <bernt@norang.ca> + + * org.el (org-time-string-to-absolute): Ignore cyclic repeater + when displaying items on todays agenda date. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-progress): Avoid reusing previous + value of EXTRA. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-initialize-cache): Make + timestamp directory, the entire path to it. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-handle-comments): Make sure to check + for protection in the comment line, and not in the line after it. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-html-preprocess): Call org-format-latex, + possibly with a protect-only argument. + + * org.el (org-format-latex): New argument PROTECT-ONLY. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-handle-table-metalines): This function + removes table specific meta-lines, now that we aren't wiping + everything that looks remotely like a comment at the end of the + export process we have to be sure to catch all of the specific lines + in org-exp.el. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-select-backend-specific-text): Properly + get rid of #+Backend and #+ATTR_Backend specifics to backends not + matching the one we're exporting to. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * Makefile (lisp/org-install.el): Replace babel files in + construction of org-install.el. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-table.el (orgtbl-to-generic): Add the :remove-newlines + option which will strip newline characters from the text of table + cells and replace then with "\n". + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-confirm-shell-link-function): + (org-confirm-elisp-link-function): Limit the values that can be set by + file variables. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-compute-latex-and-specials-regexp): Deal with + string elements by discarding them. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-iswitchb): Make sure to use at least iswitchb. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-position-for-last-stored) + (org-capture-bookmark-last-stored-position): New functions. + (org-capture-place-table-line): Better error catching. + (org-capture-place-item): + (org-capture-place-entry): + (org-capture-place-plain-text): Call + `org-capture-position-for-last-stored'. + (org-capture-finalize): Just call + `org-capture-bookmark-last-stored-position'. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-mark-blockquote-verse-center): Fix + small bug, now grabbing match data before overwritten by looking-at + this fixes a problem with remainders of #+end_quote lines appearing + in exported output. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-frame-setup): Add customization option for + Wanderlust. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-fixed-width): Now check + org-example rather than org-protected on verbatim export, because by + default all ": " prefixed lines are marked protected. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-fixed-width): Check for + protection before wrapping ": " lines as verbatim. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-handle-comments): Check for protection + before removing comments. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-entities.el (org-entities): Restructure the list. + (org-entities-help): Turn the help output into a buffer + in Org-mode, so that it becomes easier to find a symbol + in the structure. + (org-entities-create-table): Deal with new structure. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-write-agenda): Use backquotes to expand + `flet' at compile time. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-entry-properties): Make sure that standard property + names are used even if the user has customized time keywords. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-not-nil): Return the value if not interpreted + as nil. + + * org.el (org-entry-get): + (org-entry-get-with-inheritance): Interpret the value "nil" + as nil for properties. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-switch-to-buffer-other-window): Return the buffer. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-not-nil): New function. + + * org.el (org-block-todo-from-children-or-siblings-or-parent): + Use `org-not-nil' to interpret a property value of nil. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-truely-invisible-p): New function. + (org-beginning-of-line): Use `org-truely-invisible-p'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-timestamps): No errors + while getting TODO state. + (org-agenda-highlight-todo): No error when no keyword has + been matched. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-timestamp-change): New optional argument UPDOWN. + Use this to identify calls from org-timestamp-up/down, so that we can + skip by rounding minutes in this case. + (org-timestamp-up): + (org-timestamp-down): + (org-timestamp-up-day): + (org-timestamp-down-day): Call org-timestamp-change with the + updown argument. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-action): Make `c' key call org-capture. + + * org-capture.el: New file. + + * org-compat.el (org-get-x-clipboard): Function moved here from + remember.el. + + * org-mks.el: New file. + + * org.el (org-set-regexps-and-options): Allow statistic cookies as + part of complex headlines. + (org-find-olp): New argument THIS-BUFFER. When set, assume that the + OLP does not contain a file name. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-mode): Set `comment-start' instead of changing the + syntax of the `#' character. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Mark examples + by a property. + + * org-html.el (org-export-html-close-lists-maybe): Check if raw + HTML stuff was actually made from an example. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * Makefile (LISPF): Let's not compile files that won't often be used. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-latex.el: Items are no longer skipped when their first line + ends on a protected element. + + * org-list.el: Protected environments looking like lists are not + exported anymore. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-preprocess): + Cleanup trailing newline after block. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-exp.el: Comment regexp now matches documentation. No more + protection check when deleting comments before export. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-exp.el (org-export-preprocess-string): + Now using `org-export-handle-include-files-recurse' to resolve + included files. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-agenda.el (org-agenda-get-deadlines): + (org-agenda-get-scheduled): + * org.el (org-time-string-to-seconds): + For deadline and scheduled agenda display ignore the cyclic repeater + when calculating how many days late the task is. If you have a weekly + task and miss the date the agenda view will show more than a week late + now instead of resetting on the cyclic repeating date. This makes it + much more obvious when you missed a repeating task after the repeater. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-exp.el (org-export-mark-blockquote-verse-center): + Consider environments that end at eob. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org.el (org-raise-scripts): Do not fontify sub/superscripts of text + with face `org-special-keyword'. Make property keys as :LAST_REPEAT: + display correctly. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org.el (org-at-property-p): Use save-match-data macro instead of let. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org.el (test): Remove unused test function. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-preprocess): Fix typo. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-postblock-hook): Add + documentation to and turn into a defcustom. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-get-file-contents): By un-setting prefix1 to "" + instead of to nil we avoid errors when :prefix1 is defined, but + prefix is not. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Environments coming + from latex backend specific instructions (#+LaTeX) are already + protected and won't be treated as normal environments. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-set-timer): Fix typo in the docstring. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-set-timer): Use a prefix argument. + See the docstring of the function. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-set-timer): Fix bug about cancelling + timers. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-w3m.el (org-w3m-copy-for-org-mode) + (org-w3m-get-next-link-start, org-w3m-get-prev-link-start): + Get text property directly, not using macro `w3m-anchor'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-emph-re): Document the match groups. + +2010-07-19 Bernt Hansen <bernt@norang.ca> + + * org-clock.el (org-clock-in): Set `org-clock-clocking-in' to + t before calling `org-clock-out', so that that function can + know its call context. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-default-timer): New variable. + (org-timer-set-timer): Use the new variable. Also offer the + possibility to replace the current timer by a new one. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-kill-note-or-show-branches): Hide subtree before + exposing the headings. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-add-planning-info): Remove the empty line also + if there is no whitespace at all in there. + + * org-table.el (org-table-align): Fix alignment of strings + with invisible characters. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-refile-cache-get): Return empty list of targets + when cache was cleared. + (org-clone-subtree-with-time-shift): Maybe create ID property + in cloned subtrees. + (org-clone-delete-id): New customization variable. + (org-clone-subtree-with-time-shift): Use customization + variable `org-clone-delete-id'. + (org-clone-subtree-with-time-shift): Remove empty property + drawer in cloned subtrees. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-refile-use-cache): New option. + (org-refile-cache, org-refile-markers): New variable. + (org-refile-marker, org-refile-cache-clear) + (org-refile-cache-check-set, org-refile-cache-put) + (org-refile-cache-get): New function. + (org-get-refile-targets): Use the refile cache. + + * org-clock.el (org-clock-sum): Don't include running clock if + the time block is wrong. + +2010-07-19 John Wiegley <jwiegley@gmail.com> + + * org-clock.el (org-clock-clock-in, org-clock-in): Add + parameter `start-time'. + (org-clock-resolve-clock): Add parameter `clock-out-time'. + If set, and resolve-to is a past time, then the clock out + event occurs at `clock-out-time' rather than at `resolve-to'. + In this case, `resolve-to' becomes the clock in time. + (org-clock-jump-to-current-clock): Create new global command + to reveal the current clock. + (org-clock-resolve): Add new commands g/G and j/J, and a + help window describing all commands and their meaning. + (org-clock-resolve-expert): New customization variable. + (org-find-open-clocks): Fix a bug that caused discovered + clocks not to match up with the currently active clock. + (org-resolve-clocks): Change the argument + `also-non-dangling-p' to `only-dangling-p', since due to a bug + this was the default behavior all along. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-id.el (org-id-uuid): New function. Return string with + random (version 4) UUID. + (org-id-method): Make 'uuid the new default value. + (org-id-new): Use `org-id-uuid' if call to uuidgen program + does not return a UUID. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-format-image): Add support + for multicolumn figures in LaTeX. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-clone-subtree-with-time-shift): Remove ID + property of original subtree in cloned subtrees. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): + XEmacs compatibility. + + * org-latex.el (org-export-latex-tables): Accept comma in + align string. + + * org-docbook.el (org-export-docbook-xslt-stylesheet): New option. + (org-export-docbook-xslt-proc-command): Fix docstring. + (org-export-docbook-xsl-fo-proc-command): Fix docstring. + (org-export-as-docbook-pdf): Improve + formatting of the xslt command. + + * org-exp.el (org-infile-export-plist): Check for XSLT setting. + + * org.el (org-file-contents): Improve error message. + (org-set-regexps-and-options): Remove spaces at both ends. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-docbook.el (org-export-as-docbook-pdf): Improve + formatting of the xslt command. + +2010-07-19 Sebastian Rose <sebastian_rose@gmx.de> + + * org-publish.el (org-publish-cache): Use one big hashmap for + each project defined in `org-publish-project-alist'. + (initialize-files-alist): Function removed. + (org-publish-validate-link): Function removed. + (org-publish-get-base-files): Add variable `sitemap-requested' + to avoid sorting where possible. + (org-publish-get-files): Function removed. + (org-publish-get-project-from-filename): Make independent of + file list. + (org-publish-file): New argument NO-CACHE. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-beginning-of-defun, org-end-of-defun): New + functions. + (org-mode): Install the `org-beginning-of-defun' and + `org-end-of-defun' functions. + (org-pretty-entities): New option. + (org-toggle-pretty-entities): New command. + (org-fontify-entities): New function. + (org-startup-options): New keywords for pretty entities. + (org-set-font-lock-defaults): Call the pretty entities + function. + + * org-latex.el (org-export-latex-keywords-maybe): Protect the + TODO markup. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org-habit.el (org-habit-build-graph): Help-echo date when + mouse is over stars. + +2010-07-19 Jan Böker <jan.boecker@jboecker.de> + + * org.el (org-file-apps): Improve docstring to reflect + grouping matches. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-startup-visibility): Fix empty line display. + + * org-latex.el (org-export-latex-links): Use the formatting + function of the link type, if it is available. + + * org-table.el (org-table-get-remote-range): Return to + original buffer when retrieving remote reference. + + * org.el (org-display-inline-images): Do the entire buffer, + not just the narrowed region. Clear the cache. + (org-display-inline-images): Match mode file paths. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-store-link-folder): Don't throw error when + called on WL folder group. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-replace-escapes): Make sure the cdr is not nil. + (org-read-date): Make `M-v' and `C-v' scroll the popup calendar. + (org-mode): Revert comment syntax changes. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-sparse-tree): Make `C-c / t' search for all TODO + keywords, and `C-c / T' for a specific one. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-mode): Fix comment syntax settings. + + * org-src.el (org-edit-src-allow-write-back-p): Define + variable. + + * org.el (org-inline-image-overlays): New variable. + (org-toggle-inline-images, org-display-inline-images) + (org-remove-inline-images): New commands. + (org-mode-map): Define a key for `org-toggle-inline-images'. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-message-field): New function. Return + content of header field in message entity. + (org-wl-store-link): Call `org-wl-store-link-folder' or + `org-wl-store-link-message' depending on major-mode. + (org-wl-store-link-folder): New function. Store link to + Wanderlust folder. + (org-wl-store-link-message): New function. Store link to + Wanderlust message. + (org-wl-store-link-message): Store link to message while + visiting message. + (org-wl-open): Don't try to jump to message when opening a + folder link. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-replace-escapes): Avoid infinite loop when + replace string contains escape sequence it replaces. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-crypt.el (org-crypt-key-for-heading): Use symmetric + encryption when now key is set. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-recalculate-buffer-tables) + (org-table-iterate-buffer-tables): New commands. + + * org.el (org-check-for-hidden): When there is a region, skip + the check. + +2010-07-19 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): allow-write-back-p had + erroneously been omitted from let binding. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-sorting-choice): New sorting type alpha. + (org-cmp-alpha): New defsubst. + (org-em): New defsubst. + (org-entries-lessp): Only compute needed comparisons. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-format-org-table-html): Test all columns + for number content. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-treat-sub-super-char): Make + sure parenthesis matching is consistent. + + * org-table.el (org-table-colgroup-line-p) + (org-table-cookie-line-p): New functions. + + * org-exp.el (org-table-clean-before-export): Better tests for + colgroup and cookie lines. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-goto): Push a mark before changing + the position. + + * org-footnote.el (org-footnote): New group. + (org-footnote-section) + (org-footnote-tag-for-non-org-mode-files): Fix typos. + + * org-list.el (org-end-of-item-text-before-children): Also do + the right thing at the end of a file. + + * org.el (org-set-packages-alist, org-get-packages-alist): New + function. + (org-export-latex-default-packages-alist) + (org-export-latex-packages-alist): Add extra flag to + each package, indicating if it should be used for snippets. + (org-create-formula-image): Add the snippet argument. + (org-splice-latex-header): New argument SNIPPET-P, pass it + through to `org-latex-packages-to-string'. + (org-latex-packages-to-string): New argument SNIPPET-P. + + * org-latex.el (org-export-latex-make-header): Add the snippet + argument. + + * org-docbook.el (org-export-as-docbook): Implement ordered + lists starting at some offset. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-link-types, org-open-at-point): Add doi links. + + * org-ascii.el (org-export-ascii-preprocess): Remove list + startcounter cookies. + + * org-list.el (org-renumber-ordered-list): Respect counter + start values. + + * org-latex.el (org-export-latex-lists): Accept ordered list + item offset cookie. + + * org-html.el (org-export-as-html): Accept ordered list + item offset cookie. + + * org-indent.el (org-indent-mode): Turn off `indent-tabs-mode' + which messes up alignment of tags. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-cancel, org-clock-out): Make sure + the modeline display is removed. + + * org-exp.el (org-export-format-drawer-function): Fix + docstring. + + * org-agenda.el (org-agenda-refile): New optional argument + NO-UPDATE. + (org-agenda-refile): Call `org-agenda-redo' unless NO-UPDATE + is set. + (org-agenda-bulk-action): Call the refile command with updates + suppressed - but arrange for `org-agenda-redo' to be called at + the end. + + * org.el (org-mode): Make table mapping quiet. + (org-table-map-tables): New optional argument QUIETLY. + + * org-ascii.el (org-export-ascii-preprocess): Make table + mapping quiet. + + * org-html.el (org-export-as-html, org-html-level-start): Change + XHTML IDs to not use dots. + + * org-exp.el (org-export-define-heading-targets): Change + XHTML IDs to not use dots. + + * org-docbook.el (org-export-docbook-level-start): Change + XHTML IDs to not use dots. + + * org-latex.el (org-export-as-latex): Make sure that the + result buffer is in latex-mode. + + * org.el (org-shiftup-final-hook, org-shiftdown-final-hook) + (org-shiftleft-final-hook, org-shiftright-final-hook): New + hooks. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-justify-field-maybe): Make sure that + inserting a value does not turn a line into a hline. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-sum): New argument HEADLINE-FILTER. + (org-clock-sum): Add property to selected headlines. + (org-dblock-write:clocktable): Make tags matcher. + + * org.el (org-set-autofill-regexps): XEmacs compatibility. + + * org-latex.el (org-export-latex-set-initial-vars): Allow "-" + in latex class definitions. + + * org.el (org-shiftup-hook, org-shiftdown-hook) + (org-shiftleft-hook, org-shiftright-hook): New hooks. + + * org-entities.el (org-entities): Use \land and \lor for logical + operators. + + * org.el (org-shiftmetaleft, org-shiftmetaright): Call the subtree + indentation commands. + (org-hidden-tree-error): New defsubst. + (org-metaleft, org-metaright): Check for hidden stuff and throw an + error. + (org-check-for-hidden): New function. + + * org-list.el (org-item-re): New function. + (org-at-item-p): Use `org-item-re'. + (org-end-of-item-text-before-children): New function. + (org-outdent-item, org-indent-item): Arrange for leaving the + subtree alone. + (org-outdent-item-tree, org-indent-item-tree): New argument + NO-SUBTREE. + (org-indent-item-tree): Use `org-end-of-item-text-before-children' + to find the end for processing while ignoring the subtree. + + * org-publish.el (org-publish-sitemap-sort-alphabetically) + (org-publish-sitemap-sort-folders) + (org-publish-sitemap-sort-ignore-case): New options. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-compare-directory-files): Fix sorting. + + * org-compat.el (org-get-x-clipboard-compat): Use (featurep 'xemacs). + + * org-publish.el (org-publish-project-alist): Update docstring. + (org-publish-file-title-cache): New variable. + (org-publish-initialize-files-alist): Initialize + `org-publish-initialize-files-alist' to nil. + (org-publish-sort-directory-files): New function. + (org-publish-projects): Access the new properties. + (org-publish-find-title): Use the file title cache. + (org-publish-find-title): Build the file title cache. + (org-publish-get-base-files-1): Sort files. + (org-publish-aux-preprocess): Do not throw an error when before + the first headline. Allow an empty target, meaning to link just + to the file. + (org-publish-index-generate-theindex.inc): Check if there is + actually a target and only then add it to the link. + (org-publish-projects): Fix a remaining issue with the last commit. + + * org-html.el (org-export-as-html): Treat verse as open/close + paragraph. + (org-export-html-close-lists-maybe): Allow to splice raw HTML into + and out of lists. + +2010-07-19 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Allow the org-src edit buffer to + be used in a read-only mode. + (org-edit-src-code): Different message in read-only mode. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-src.el (org-edit-src-find-region-and-lang): Test for + table.el as late as possible. + + * org-colview-xemacs.el: Make sure this file is never loaded into + Emacs. Remove all tests for XEmacs. + + * org-colview.el: Make sure this file is never loaded into XEmacs. + + * org-agenda.el (org-highlight, org-unhighlight): Use direct + overlay calls. + + * org.el (org-key): Apply the translations defined in + `org-xemacs-key-equivalents'. + + * org-mouse.el (org-mode-hook): Use `org-defkey'. + + * org-compat.el (org-xemacs-key-equivalents): New constant. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-inlinetask.el (org-inlinetask-defaut-state): New option. + (org-inlinetask-insert-task): Use `org-inlinetask-defaut-state'. + Obey `org-odd-levels-only'. + + * org-compat.el (org-find-overlays): Use overlays-in/at. + + * org.el (org-remove-empty-overlays-at) + (org-outline-overlay-data, org-hide-block-toggle) + (org-format-latex, org-context): Use overlays-in/at. + + * org-src.el (org-edit-src-exit): Use overlays-in/at. + + * org-agenda.el (org-agenda-mark-clocking-task) + (org-agenda-fontify-priorities, org-agenda-dim-blocked-tasks) + (org-agenda-entry-text-hide) + (org-agenda-fix-tags-filter-overlays-at) + (org-agenda-bulk-remove-overlays): Use overlays-in/at. + + * org-compat.el (org-overlays-at): Function removed. + (org-overlays-in): Function removed. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-clock.el (org-clock-set-current): Just return the headline + itself, strip the TODO keyword, the priority cookie and the tags. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-xemacs-without-invisibility): New macro. + (org-xemacs-without-invisibility): New macro. + (org-indent-to-column, org-indent-line-to, org-move-to-column): + Redefine using the macro `org-xemacs-without-invisibility'. + + * org.el (org-mode, org-org-menu): Use `add-to-invisibility-spec'. + + * org-table.el (orgtbl-mode): Use `add-to-invisibility-spec'. + + * org-compat.el (org-make-overlay, org-delete-overlay) + (org-overlay-start, org-overlay-end, org-overlay-put) + (org-overlay-get, org-overlay-move, org-overlay-buffer): Functions + removed. + (org-add-to-invisibility-spec): Function removed. + + * org-html.el (org-export-as-html-and-open): Add argument to + kill-buffer. + + * org-habit.el (require): `calendar' is now required already by + org.el on top level. + + * org-clock.el (require): `calendar' is now required already by + org.el on top level. + + * org-agenda.el (require, org-timeline, org-agenda-list) + (org-todo-list, org-agenda-to-appt): `calendar' is now required + already by org.el on top level. + + * org.el (org-export-latex-fix-inputenc): Declare function. + + * org-agenda.el (org-agenda-goto-calendar): Do not bind obsolete + variables. + + * org.el (calendar): Require calendar now on top level in org.el + and define aliases to new variables when needed. + (org-read-date, org-goto-calendar): Do not bind obsolete + variables. + + * org-clock.el (org-clock-out, org-clock-cancel): Get rid of + compilation warning, add comment that this cannot be done with + `with-current-buffer'. + + * org-wl.el (org-wl-open): Use `with-current-buffer'. + + * org.el (overlay, org-remove-empty-overlays-at) + (org-outline-overlay-data, org-set-outline-overlay-data) + (org-show-block-all, org-hide-block-toggle) + (org-highlight-new-match, org-remove-occur-highlights) + (org-tags-overlay, org-fast-tag-selection, org-date-ovl) + (org-read-date, org-read-date-display, org-eval-in-calendar) + (org-format-latex, org-context) + (org-speedbar-restriction-lock-overlay) + (org-speedbar-set-agenda-restriction): Use the normal overlay API. + + * org-table.el (org-table-add-rectangle-overlay) + (org-table-remove-rectangle-highlight) + (org-table-overlay-coordinates) + (org-table-toggle-coordinate-overlays): Use the normal overlay + API. + + * org-src.el (org-edit-src-code, org-edit-fixed-width-region) + (org-edit-src-exit, org-src-mode-configure-edit-buffer): Use the + normal overlay API. + + * org-colview.el (org-columns-new-overlay) + (org-columns-display-here, org-columns-remove-overlays) + (org-columns-edit-value, org-columns-next-allowed-value) + (org-columns-update): Use the normal overlay API. + + * org-clock.el (org-clock-out, org-clock-cancel) + (org-clock-put-overlay, org-clock-remove-overlays): Use the normal + overlay API. + + * org-agenda.el (org-agenda-mark-filtered-text) + (org-agenda-mark-clocking-task, org-agenda-fontify-priorities) + (org-agenda-dim-blocked-tasks, org-agenda-entry-text-show-here) + (org-agenda-entry-text-hide) + (org-agenda-restriction-lock-overlay) + (org-agenda-set-restriction-lock) + (org-agenda-filter-by-tag-hide-line) + (org-agenda-fix-tags-filter-overlays-at) + (org-agenda-filter-by-tag-show-all, org-hl) + (org-agenda-goto-calendar, org-agenda-bulk-mark) + (org-agenda-bulk-remove-overlays): Use the normal overlay API. + + * org-freemind.el (org-freemind-from-org-mode-node) + (org-freemind-from-org-mode, ) + (org-freemind-from-org-sparse-tree, org-freemind-to-org-mode): Use + interactive-p instead of called-interactively, because this is + backward compatible with older Emacsen I still support.. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-define-heading-targets): Fix bug in + regexp finding ID and CUSTOM_ID properties. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-footnote.el (org-footnote-goto-previous-reference): Rename + from `org-footnote-goto-next-reference'. + + * org.el (org-auto-repeat-maybe): Only record LAST_REPEAT if + org-log-repeat is non-nil, or if there is clocking data in the + entry. + + * org-crypt.el (org-encrypt-entry): Improve mapping behavior. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-align-all-tags): New command. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-link-remove-filter): New customizable + variable. If non-nil, filter conditions are stripped when storing + link to message in filter folder. + (org-wl-shimbun-prefer-web-links): New customizable variable. If + non-nil, links to shimbun messages are created as web links to + message source. + (org-wl-nntp-prefer-web-links): New customizable variable. If + non-nil, links to nntp message are created as web links to gmane + or googlegroups. + (org-wl-namazu-default-index): New customizable variable. + Directory of namazu search index that should be used as default + when opening a link in a search folder. + (org-wl-folder-types): New constant. Wanderlust folder type + indicators. + (org-wl-folder-type): New function. Return type of Wanderlust + folder. + (org-wl-store-link): Create web links for shimbun or nntp messages + and strip filter conditions depending on customizable variables. + (org-wl-open): Open namazu search folder for message when called + with prefix. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-remove-if, org-remove-if-not): New functions. + (org-open-file): Use internal remove-if functions. + +2010-07-19 Jan Böcker <jan.boecker@jboecker.de> + + * org.el (org-file-apps-entry-match-against-dlink-p): New function. + (org-file-apps-ex): Remove variable. + (org-open-file): Integrate org-file-apps-ex functionality back + into org-file-apps, and decide whether to match a regexp against + the link or the filename using org-file-apps-entry-uses-grouping-p. + +2010-07-19 Jan Böcker <jan.boecker@jboecker.de> + + * org.el (org-file-apps-ex): New variable. + (org-open-file): Before considering org-file-apps, first match the + regexps from org-file-apps-ex against the whole link. See + docstring of org-file-apps-ex. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-export-latex-default-packages-alist): Remove + microtype package. + (org-todo-repeat-to-state): New variable. + (org-auto-repeat-maybe): Allow user-selected target states. + (org-default-properties): Add the new property REPEAT_TO_STATE. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-check-setup): Make sure that there is + a binary to compute checksums. + +2010-06-26 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-goto-calendar): Do not bind obsolete + variables. + + * org.el (calendar): Require calendar now on top level in org.el + and define aliases to new variables when needed. + (org-read-date, org-goto-calendar): Do not bind obsolete + variables. + +2010-06-22 Glenn Morris <rgm@gnu.org> + + * org-entities.el: Add explicit utf-8 coding cookie to file with + utf-8 characters. + 2010-05-26 Stefan Monnier <monnier@iro.umontreal.ca> * org.el (org-file-complete-link): Avoid (expand-file-name "."). @@ -34,7 +1276,7 @@ * org-entities.el (org-entities-user): Fix typo. - * org.el (org-prepare-agenda-buffers): Uniquify TODO keywords + * org.el (org-prepare-agenda-buffers): Uniquify TODO keywords. * org-entities.el (org-entities-user): Improve docstring. @@ -144,28 +1386,28 @@ * org.el (org-appearance): Change Customize group variable name from org-font-lock to org-appearance, and change tag from "Org - Font Lock" to "Org Appearance" - (org-odd-levels-only): Change Customize group variable name - (org-level-color-stars-only): Change Customize group variable name - (org-hide-leading-stars): Change Customize group variable name - (org-hidden-keywords): Change Customize group variable name - (org-fontify-done-headline): Change Customize group variable name - (org-fontify-emphasized-text): Change Customize group variable name - (org-fontify-whole-heading-line): Change Customize group variable name + Font Lock" to "Org Appearance". + (org-odd-levels-only): Change Customize group variable name. + (org-level-color-stars-only): Change Customize group variable name. + (org-hide-leading-stars): Change Customize group variable name. + (org-hidden-keywords): Change Customize group variable name. + (org-fontify-done-headline): Change Customize group variable name. + (org-fontify-emphasized-text): Change Customize group variable name. + (org-fontify-whole-heading-line): Change Customize group variable name. (org-highlight-latex-fragments-and-specials): Change Customize - group variable name - (org-hide-emphasis-markers): Change Customize group variable name - (org-emphasis-alist): Change Customize group variable name + group variable name. + (org-hide-emphasis-markers): Change Customize group variable name. + (org-emphasis-alist): Change Customize group variable name. (org-emphasis-regexp-components): Change Customize group variable - name - (org-modules): Remove mention of org-R + name. + (org-modules): Remove mention of org-R. - * org-faces.el (org-faces): Change Customize group variable name + * org-faces.el (org-faces): Change Customize group variable name. 2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> * org-agenda.el (org-diary-last-run-time): New variable. - (org-diary): prepare agenda buffers only if last call was some + (org-diary): Prepare agenda buffers only if last call was some time ago. * org-html.el (org-export-html-preprocess): Replace \ref macros @@ -183,15 +1425,16 @@ 2010-04-10 Dan Davison <davison@stats.ox.ac.uk> - * org.el (org-hidden-keywords): New customizable variable. This is + * org.el (org-hidden-keywords): New customizable variable. This is a list of symbols specifying which of the special keywords #+DATE, #+AUTHOR, #+EMAIL and #+TITLE should be hidden by font lock. (org-fontify-meta-lines-and-blocks): Changes to font-lock code implementing new faces and hiding behaviour. - * org-faces.el (org-document-title): New face for #+TITLE lines - (org-document-info): New face for #+DATE, #+AUTHOR, #+EMAIL lines - (org-document-info-keyword): New face for #+DATE, #+AUTHOR, #+EMAIL keywords + * org-faces.el (org-document-title): New face for #+TITLE lines. + (org-document-info): New face for #+DATE, #+AUTHOR, #+EMAIL lines. + (org-document-info-keyword): New face for #+DATE, #+AUTHOR, #+EMAIL + keywords. 2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> @@ -214,7 +1457,7 @@ * org-exp.el (org-export-author-info, org-export-email-info): Fix docstrings. - * org-beamer.el (org-beamer-select-environment): Renamed from + * org-beamer.el (org-beamer-select-environment): Rename from `org-beamer-set-environment-tag'. Improve docstring. * org-freemind.el (org-freemind-write-mm-buffer): Fix another @@ -291,7 +1534,7 @@ * org-src.el (org-edit-src-exit): When returning from code edit buffer, if code block is hidden, leave point at start of - #+begin_src line + #+begin_src line. 2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> @@ -365,18 +1608,18 @@ (org-set-autofill-regexps): Store a backup of `adaptive-fill-regexp'. (org-adaptive-fill-function): Fix filling of comments and ordered - lists. If there is no other match, till try adaptive fill. + lists. If there is no other match, till try adaptive fill. 2010-04-10 John Wiegley <jwiegley@gmail.com> - * org-agenda.el (org-agenda-include-deadlines): Added new + * org-agenda.el (org-agenda-include-deadlines): Add new customization variable to determine whether unscheduled tasks should appear in the agenda solely because of their deadline. Default to true, which was the previous behavior (it just wasn't configurable). (org-agenda-mode-map, org-agenda-view-mode-dispatch): Bind ! in the agenda to show/hide deadline tasks. - (org-agenda-menu): Added menu option for show/hide deadlines. + (org-agenda-menu): Add menu option for show/hide deadlines. (org-agenda-list): Make the agenda list sensitive to the value of `org-agenda-include-deadlines'. (org-agenda-toggle-deadlines): New function to toggle the value of @@ -544,9 +1787,9 @@ 2010-04-10 Bastien Guerry <bzg@altern.org> - * org-timer.el (org-timer-current-timer): Renamed from + * org-timer.el (org-timer-current-timer): Rename from `org-timer-last-timer'. - (org-timer-timer1, org-timer-timer2, org-timer-timer3): Removed. + (org-timer-timer1, org-timer-timer2, org-timer-timer3): Remove. (org-timer-cancel-timer, org-timer-show-remaining-time) (org-timer-set-timer): Update to use only one timer. @@ -666,7 +1909,7 @@ 2010-04-10 Dan Davison <davison@stats.ox.ac.uk> - * org-src.el (org-edit-src-exit): Widen before exiting edit buffers + * org-src.el (org-edit-src-exit): Widen before exiting edit buffers. 2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> @@ -725,7 +1968,7 @@ * org-mac-message.el (org-mac-message-insert-flagged): Call `org-insert-heading' with the INVISIBLE-OK argument. - * org.el (org-insert-heading): New argument INVISIBLE-OK. + * org.el (org-insert-heading): New argument INVISIBLE-OK. * org-agenda.el (org-agenda-view-mode-dispatch): Improve the prompt message. @@ -753,8 +1996,8 @@ 2010-04-10 Mikael Fornius <mfo@abc.se> * org.el (org-assign-fast-keys): Prefer keys used in keyword name - when assigning. Begin using numerical characters when all in name - is used up. This is to spare alphanumeric characters for better + when assigning. Begin using numerical characters when all in name + is used up. This is to spare alphanumeric characters for better match with other keywords. 2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> @@ -806,7 +2049,7 @@ * org-agenda.el (org-agenda-diary-entry-in-org-file): Make sure org-datetree.el is loaded. - * org-datetree.el: autoload `org-datetree-find-day-create' + * org-datetree.el: Autoload `org-datetree-find-day-create'. * org-latex.el (org-export-latex-hyperref-format): New option. (org-export-latex-links): Use `org-export-latex-hyperref-format'. @@ -1138,12 +2381,12 @@ * org-colview-xemacs.el (org-columns-edit-value): Use org-unrestricted property. - * org-colview.el (org-columns-edit-value): Use + * org-colview.el (org-columns-edit-value): Use org-unrestricted property. * org.el (org-compute-property-at-point): Set org-unrestricted text property if the list contains ":ETC". - (org-insert-property-drawer): Use + (org-insert-property-drawer): Use org-unrestricted property. * org-exp.el @@ -1652,16 +2895,15 @@ 2009-11-13 Dan Davison <davison@stats.ox.ac.uk> - * org-exp.el (org-export-format-source-code-or-example): restrict + * org-exp.el (org-export-format-source-code-or-example): Restrict scope of preserve-indentp to the let binding. - (org-src): require org-src, since org-src-preserve-indentation is used. + (org-src): Require org-src, since org-src-preserve-indentation is used. 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> * org-timer.el (org-timer-set-timer): Set variables org-timer-timer[123] correctly. - * org-mobile.el (org-mobile-files-alist): Make it work when `agenda-archives' is included in `org-agenda-text-search-extra-files'. @@ -1724,7 +2966,7 @@ 2009-11-13 James TD Smith <ahktenzero@mohorovi.cc> - * org-colview-xemacs.el: Add in changes from org-colview.el + * org-colview-xemacs.el: Add in changes from org-colview.el. 2009-11-13 Dan Davison <davison@stats.ox.ac.uk> @@ -1865,12 +3107,12 @@ point. (org-columns-compile-map): There is now an extra position in each entry specifying the function to use to calculate the displayed - value for the non-calculated properties in the column, + value for the non-calculated properties in the column. (org-columns-compute-all): Set `org-columns-time' to the current time so time difference calculations will work. (org-columns-compute): Handle column operators where the values used are calculated from the underlying property. - (org-columns-number-to-string): Handle the 'age' column format + (org-columns-number-to-string): Handle the 'age' column format. (org-columns-string-to-number): Correct the function name (was org-column...). Add support for the 'age' column format. (org-columns-compile-format): Support the additional parameter in @@ -1931,7 +3173,7 @@ called with either `org-scheduled-string' or `org-deadline-string'. - * org-clock.el (org-clock-auto-clock-resolution): Renamed + * org-clock.el (org-clock-auto-clock-resolution): Rename from `org-clock-disable-clock-resolution', since negatives don't sound good in customization variables. (org-clock-in): Don't use the auto-resolution logic if the user is @@ -1973,14 +3215,14 @@ more general. (org-habit-parse-todo): Parse the new ".+N/N" style repeater. - * org-agenda.el (org-agenda-get-deadlines): Removed all mention of + * org-agenda.el (org-agenda-get-deadlines): Remove all mention of habits, since they don't use DEADLINE anymore. * org.el (org-repeat-re, org-display-custom-time) - (org-timestamp-change): Extended to support the new ".+N/N" + (org-timestamp-change): Extend to support the new ".+N/N" syntax, used for habits. - * org-clock.el (org-clock-resolve-clock): Fixed an incorrect + * org-clock.el (org-clock-resolve-clock): Fix an incorrect variable reference. * org-agenda.el (org-agenda-set-mode-name): Show Habit in the @@ -2014,7 +3256,7 @@ * org.el (org-file-tags): Fix docstring. (org-get-buffer-tags): Add the #+FILETAGS tags. - ("ecb"): Maks ecb show context after jumping into an Org file. + ("ecb"): Make ecb show context after jumping into an Org file. 2009-11-13 John Wiegley <johnw@newartisans.com> @@ -2045,11 +3287,11 @@ (org-agenda-get-scheduled): Display consistency graphs when outputting habits into the agenda. The graphs are always relative to the current time. - (org-format-agenda-item): Added new parameter `habitp', which + (org-format-agenda-item): Add new parameter `habitp', which indicates whether we are formatting a habit or not. Do not display "extra" leading information if habitp is true. - * org.el (org-repeat-re): Improved regexp to include .+ and ++ + * org.el (org-repeat-re): Improve regexp to include .+ and ++ leaders for repeat strings. (org-get-repeat): Now takes a string parameter `tagline', so the caller can obtain the SCHEDULED repeat, or the DEADLINE repeat. @@ -2067,7 +3309,7 @@ * org.el (org-files-list): Don't attempt to return a file name for Org buffers which have no associated file. - * org-agenda.el (org-agenda-do-action): Fixed a typo. + * org-agenda.el (org-agenda-do-action): Fix a typo. 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> @@ -2089,7 +3331,7 @@ * org-clock.el (org-clock-resolve, org-resolve-clocks) (org-emacs-idle-seconds): Use `org-float-time' instead of - `time-to-seconds' + `time-to-seconds'. 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> @@ -2117,7 +3359,7 @@ currently active clock if the user has exceeded the time returned by `org-user-idle-seconds', based on the value of `org-clock-idle-time'. - (org-clock-in): If, after resolving clocks, + (org-clock-in): If, after resolving clocks, (???) (org-clock-out): Cancel the `org-clock-idle-timer' on clock out. * org-clock.el (org-clock-resolve-clock): New function that @@ -2258,7 +3500,7 @@ * org-exp.el (org-export-select-backend-specific-text): Remove the region markers. - * org-inlinetask.el (org-inlinetask-export-handler): fix bug for + * org-inlinetask.el (org-inlinetask-export-handler): Fix bug for tasks without content. * org-clock.el: Make sure the clock-in target position does not @@ -2547,7 +3789,7 @@ 2009-10-01 Bastien Guerry <bzg@altern.org> - * org.el (org-check-agenda-file): Use a more explicit message + * org.el (org-check-agenda-file): Use a more explicit message. 2009-10-01 Carsten Dominik <carsten.dominik@gmail.com> @@ -2926,7 +4168,7 @@ * org-exp.el (org-export-format-source-code-or-example): Translate language. - * org-src.el (org-src-lang-modes): New variable + * org-src.el (org-src-lang-modes): New variable. (org-edit-src-code): Translate language. * org-exp.el (org-export-format-source-code-or-example): Deal wit @@ -3054,7 +4296,7 @@ the markup is src or example. * org-agenda.el (org-agenda-skip-scheduled-if-deadline-is-shown): - New option + New option. (org-agenda-get-day-entries): Remember deadline results and pass them on into the function getting the scheduling information. (org-agenda-get-scheduled): Accept deadline results as parameters @@ -3065,7 +4307,7 @@ convert current line to headline. * org-clock.el (org-clock-save-markers-for-cut-and-paste): Also - cheeeeeck the hd marker + cheeeeeck the hd marker. (org-clock-in): Also set the hd marker. (org-clock-out): Also set the hd marker. (org-clock-cancel): Reset markers. @@ -3075,7 +4317,7 @@ * org-faces.el (org-agenda-clocking): New face. * org-agenda.el (org-agenda-mark-clocking-task): New function. - (org-finalize-agenda): call `org-agenda-mark-clocking-task'. + (org-finalize-agenda): Call `org-agenda-mark-clocking-task'. * org.el (org-modules): Add org-track.el. @@ -3287,9 +4529,9 @@ 2009-08-06 Bastien Guerry <bzg@altern.org> * org.el (org-make-link-regexps): Don't exclude parentheses from - `org-plain-link-re' + `org-plain-link-re'. (org-cycle-internal-local): When locally cycling, switch directly - from CHILDREN to FOLDED if there is no subtree + from CHILDREN to FOLDED if there is no subtree. (org-cycle): Update the docstring to document the new behavior of `org-cycle-internal-local'. @@ -3880,7 +5122,7 @@ (org-set-font-lock-defaults): Call the new fontification function. - * org-faces.el (org-meta-line): New face + * org-faces.el (org-meta-line): New face. (org-block): New face. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -4044,7 +5286,7 @@ 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> - * org-icalendar.el (org-icalendar-include-todo): New allowedvalue + * org-icalendar.el (org-icalendar-include-todo): New allowed value `unblocked'. (org-print-icalendar-entries): Respect the new value of `org-icalendar-include-todo'. @@ -4110,7 +5352,7 @@ 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> * org-exp.el (org-export, org-export-visible): Support ASCII - export to buffer + export to buffer. (org-export-normalize-links): Do not protect the description if it is explicitly given. @@ -4465,7 +5707,7 @@ * org-mouse.el: XEmacs compatibility fixes. - * org.el (org-modules): Add org-inlinetasks.el + * org.el (org-modules): Add org-inlinetasks.el. (org-cycle): Implement limiting level on cycling. (org-move-subtree-down): Fix bug with swapping subtrees at end of buffer. @@ -4475,7 +5717,7 @@ * org.el (org-emphasis-regexp-components): Allow braces in emphasis pre and post match. - * org-footnote.el (org-footnote-normalize): When only dorting, do + * org-footnote.el (org-footnote-normalize): When only sorting, do not insert inline notes at the end. * org.el (org-require-autoloaded-modules): Add org-docbook.el. @@ -4557,7 +5799,7 @@ (org-mouse-context-menu): Use `org-mouse-todo-menu'. * org-table.el (org-table-beginning-of-field) - (org-table-end-of-field): New commands + (org-table-end-of-field): New commands. (org-table-previous-field, org-table-beginning-of-field): Better error messages. (orgtbl-setup): Include `M-a' and `M-e'. @@ -4723,7 +5965,7 @@ (org-export-plist-vars): Add entries for :keywords and :description. (org-infile-export-plist): Parse for new keywords. - (org-get-current-options): Add new keywords + (org-get-current-options): Add new keywords. (org-export-as-html): Publish description and keywords. * org-agenda.el (org-agenda-add-entry-text-descriptive-links): New @@ -4909,9 +6151,9 @@ (org-export-latex-fontify): Catch error when org-emph-alist has entries that are not defined for LaTeX export. - * org-export-latex.el: renamed to org-latex.el. + * org-export-latex.el: Rename to org-latex.el. - * org-latex.el: renamed from org-export-latex.el. + * org-latex.el: Rename from org-export-latex.el. * org.el (orgstruct++-mode): New function. (turn-on-orgstruct++): Call `orgstruct++-mode'. @@ -5994,7 +7236,7 @@ * org-list.el (org-list-two-spaces-after-bullet-regexp): New option. - (org-fix-bullet-type): respect + (org-fix-bullet-type): Respect `org-list-two-spaces-after-bullet-regexp'. * org-clock.el (org-clock-load): Clean up the code. @@ -6371,7 +7613,7 @@ * org-agenda.el (org-agenda-remove-marked-text): New function. (org-agenda-mark-filtered-text) (org-agenda-unmark-filtered-text): New functions. - (org-write-agenda): Remove fltered text. + (org-write-agenda): Remove filtered text. * org.el (org-make-tags-matcher): Give access to TODO "property" without speed penalty. @@ -6468,7 +7710,7 @@ * org.el (org-insert-heading-respect-content): Force heading creation. - (org-insert-heading): keep the folding state of the heading before + (org-insert-heading): Keep the folding state of the heading before the inserted one. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> @@ -6539,7 +7781,7 @@ immediately after the scheduling keywords. * org-clock.el (org-clock-in-switch-to-state): Allow this to be a - function + function. (org-clock-in): If `org-clock-in-switch-to-state' is a function, call it with the current todo state to get the state to switch to when clocking in. @@ -6742,7 +7984,7 @@ line. * org.el (org-get-refile-targets): Replace links with their - descriptions + descriptions. (org-imenu-get-tree): Replace links with their descriptions. * org-remember.el (org-remember-apply-template): Add a new @@ -6751,7 +7993,7 @@ * org.el (org-add-log-setup): Skip over drawers (properties, clocks etc) when adding notes. - * org-agenda.el (org-agenda-get-closed): show durations of clocked + * org-agenda.el (org-agenda-get-closed): Show durations of clocked items as well as the start and end times. * org-compat.el (org-get-x-clipboard-compat): Add a compat @@ -6777,7 +8019,7 @@ 2008-10-12 Bastien Guerry <bzg@altern.org> - * org-export-latex.el (org-export-latex-tables): protect exported + * org-export-latex.el (org-export-latex-tables): Protect exported tables from further special chars conversion. (org-export-latex-preprocess): Preserve LaTeX environments. (org-list-parse-list): Parse descriptive lists. @@ -6786,7 +8028,7 @@ (org-quote-chars): Remove. (org-export-latex-keywords-maybe): Use `replace-regexp-in-string'. (org-export-latex-list-beginning-re): Rename to - `org-list-beginning-re' + `org-list-beginning-re'. (org-list-item-begin): Rename to `org-list-item-beginning'. 2008-10-12 Eric Schulte <schulte.eric@gmail.com> @@ -7121,7 +8363,7 @@ (org-map-entries): Make sure org-agenda-archives-mode is nil. (org-agenda-files): Functionality of second arg changed. - * org-agenda.el (org-agenda-archives-mode): New variable + * org-agenda.el (org-agenda-archives-mode): New variable. (org-write-agenda, org-prepare-agenda, org-agenda-list) (org-search-view, org-todo-list, org-tags-view) (org-agenda-list-stuck-projects): Call `org-agenda-files' with diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el new file mode 100644 index 00000000000..086079f9082 --- /dev/null +++ b/lisp/org/ob-C.el @@ -0,0 +1,198 @@ +;;; ob-C.el --- org-babel functions for C and similar languages + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating C code. +;; +;; very limited implementation: +;; - currently only support :results output +;; - not much in the way of error feedback + +;;; Code: +(require 'ob) +(require 'ob-eval) +(require 'org) +(require 'cc-mode) + +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) + +(add-to-list 'org-babel-tangle-lang-exts '("c++" . "cpp")) + +(defvar org-babel-default-header-args:C '()) + +(defvar org-babel-C-compiler "gcc" + "Command used to compile a C source code file into an + executable.") + +(defvar org-babel-c++-compiler "g++" + "Command used to compile a c++ source code file into an + executable.") + +(defvar org-babel-c-variant nil + "Internal variable used to hold which type of C (e.g. C or C++) +is currently being evaluated.") + +(defun org-babel-execute:cpp (body params) + "Execute BODY according to PARAMS. This function calls +`org-babel-execute:C'." + (org-babel-execute:C body params)) + +(defun org-babel-execute:c++ (body params) + "Execute a block of C++ code with org-babel. This function is +called by `org-babel-execute-src-block'." + (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) + +(defun org-babel-expand-body:c++ (body params &optional processed-params) + "Expand a block of C++ code with org-babel according to it's +header arguments (calls `org-babel-C-expand')." + (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params processed-params))) + +(defun org-babel-execute:C (body params) + "Execute a block of C code with org-babel. This function is +called by `org-babel-execute-src-block'." + (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params))) + +(defun org-babel-expand-body:c (body params &optional processed-params) + "Expand a block of C code with org-babel according to it's +header arguments (calls `org-babel-C-expand')." + (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params processed-params))) + +(defun org-babel-C-execute (body params) + "This function should only be called by `org-babel-execute:C' +or `org-babel-execute:c++'." + (let* ((processed-params (org-babel-process-params params)) + (tmp-src-file (make-temp-file "org-babel-C-src" nil + (cond + ((equal org-babel-c-variant 'c) ".c") + ((equal org-babel-c-variant 'cpp) ".cpp")))) + (tmp-bin-file (make-temp-file "org-babel-C-bin")) + (tmp-out-file (make-temp-file "org-babel-C-out")) + (cmdline (cdr (assoc :cmdline params))) + (flags (cdr (assoc :flags params))) + (full-body (org-babel-C-expand body params)) + (compile + (progn + (with-temp-file tmp-src-file (insert full-body)) + (org-babel-eval + (format "%s -o %s %s %s" + (cond + ((equal org-babel-c-variant 'c) org-babel-C-compiler) + ((equal org-babel-c-variant 'cpp) org-babel-c++-compiler)) + tmp-bin-file + (mapconcat 'identity + (if (listp flags) flags (list flags)) " ") + tmp-src-file) "")))) + ((lambda (results) + (org-babel-reassemble-table + (if (member "vector" (nth 2 processed-params)) + (let ((tmp-file (make-temp-file "ob-c"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file)) + (org-babel-read results)) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params))))) + (org-babel-trim + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) + +(defun org-babel-C-expand (body params &optional processed-params) + "Expand a block of C or C++ code with org-babel according to +it's header arguments." + (let ((vars (nth 1 (or processed-params + (org-babel-process-params params)))) + (main-p (not (string= (cdr (assoc :main params)) "no"))) + (includes (or (cdr (assoc :includes params)) + (org-babel-read (org-entry-get nil "includes" t)))) + (defines (org-babel-read + (or (cdr (assoc :defines params)) + (org-babel-read (org-entry-get nil "defines" t)))))) + (org-babel-trim + (mapconcat 'identity + (list + ;; includes + (mapconcat + (lambda (inc) (format "#include %s" inc)) + (if (listp includes) includes (list includes)) "\n") + ;; defines + (mapconcat + (lambda (inc) (format "#define %s" inc)) + (if (listp defines) defines (list defines)) "\n") + ;; variables + (mapconcat 'org-babel-C-var-to-C vars "\n") + ;; body + (if main-p + (org-babel-C-ensure-main-wrap body) + body) "\n") "\n")))) + +(defun org-babel-C-ensure-main-wrap (body) + "Wrap body in a \"main\" function call if none exists." + (if (string-match "^[ \t]*[intvod]+[ \t]*main[ \t]*(.*)" body) + body + (format "int main() {\n%s\n}\n" body))) + +(defun org-babel-prep-session:C (session params) + "This function does nothing as C is a compiled language with no +support for sessions" + (error "C is a compiled languages -- no support for sessions")) + +(defun org-babel-load-session:C (session body params) + "This function does nothing as C is a compiled language with no +support for sessions" + (error "C is a compiled languages -- no support for sessions")) + +;; helper functions + +(defun org-babel-C-var-to-C (pair) + "Convert an elisp val into a string of C code specifying a var +of the same value." + ;; TODO list support + (let ((var (car pair)) + (val (cdr pair))) + (when (symbolp val) + (setq val (symbol-name val)) + (when (= (length val) 1) + (setq val (string-to-char val)))) + (cond + ((integerp val) + (format "int %S = %S;" var val)) + ((floatp val) + (format "double %S = %S;" var val)) + ((or (characterp val)) + (format "char %S = '%S';" var val)) + ((stringp val) + (format "char %S[%d] = \"%s\";" + var (+ 1 (length val)) val)) + (t + (format "u32 %S = %S;" var val))))) + + +(provide 'ob-C) + +;; arch-tag: 8f49e462-54e3-417b-9a8d-423864893b37 + +;;; ob-C.el ends here diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el new file mode 100644 index 00000000000..d990d69b357 --- /dev/null +++ b/lisp/org/ob-R.el @@ -0,0 +1,279 @@ +;;; ob-R.el --- org-babel functions for R code evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research, R, statistics +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating R code + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function orgtbl-to-tsv "org-table" (table params)) +(declare-function R "ext:essd-r" (&optional start-args)) +(declare-function inferior-ess-send-input "ext:ess-inf" ()) + +(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) + "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.") + +(defun org-babel-expand-body:R (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let* ((processed-params (or processed-params + (org-babel-process-params params))) + (vars (mapcar + (lambda (i) + (cons (car (nth i (nth 1 processed-params))) + (org-babel-reassemble-table + (cdr (nth i (nth 1 processed-params))) + (cdr (nth i (nth 4 processed-params))) + (cdr (nth i (nth 5 processed-params)))))) + (number-sequence 0 (1- (length (nth 1 processed-params)))))) + (out-file (cdr (assoc :file params)))) + (mapconcat ;; define any variables + #'org-babel-trim + ((lambda (inside) + (if out-file + (append + (list (org-babel-R-construct-graphics-device-call out-file params)) + inside + (list "dev.off()")) + inside)) + (append + (mapcar + (lambda (pair) + (org-babel-R-assign-elisp + (car pair) (cdr pair) + (equal "yes" (cdr (assoc :colnames params))) + (equal "yes" (cdr (assoc :rownames params))))) + vars) + (list body))) "\n"))) + +(defun org-babel-execute:R (body params) + "Execute a block of R code. +This function is called by `org-babel-execute-src-block'." + (save-excursion + (let* ((processed-params (org-babel-process-params params)) + (result-type (nth 3 processed-params)) + (session (org-babel-R-initiate-session + (first processed-params) params)) + (colnames-p (cdr (assoc :colnames params))) + (rownames-p (cdr (assoc :rownames params))) + (out-file (cdr (assoc :file params))) + (full-body (org-babel-expand-body:R body params processed-params)) + (result + (org-babel-R-evaluate + session full-body result-type + (or (equal "yes" colnames-p) + (org-babel-pick-name (nth 4 processed-params) colnames-p)) + (or (equal "yes" rownames-p) + (org-babel-pick-name (nth 5 processed-params) rownames-p))))) + (message "result is %S" result) + (or out-file result)))) + +(defun org-babel-prep-session:R (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-R-initiate-session session params)) + (vars (org-babel-ref-variables params)) + (var-lines + (mapcar + (lambda (pair) (org-babel-R-assign-elisp + (car pair) (cdr pair) + (equal (cdr (assoc :colnames params)) "yes") + (equal (cdr (assoc :rownames params)) "yes"))) + vars))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:R (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:R session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-R-quote-tsv-field (s) + "Quote field S for export to R." + (if (stringp s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") + (format "%S" s))) + +(defun org-babel-R-assign-elisp (name value colnames-p rownames-p) + "Construct R code assigning the elisp VALUE to a variable named NAME." + (if (listp value) + (let ((transition-file (make-temp-file "org-babel-R-import"))) + ;; ensure VALUE has an orgtbl structure (depth of at least 2) + (unless (listp (car value)) (setq value (list value))) + (with-temp-file (org-babel-maybe-remote-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 transition-file + (if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE") + (if rownames-p "1" "NULL"))) + (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) + +(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 (not (cdr (assoc :dir params))))) + (if (org-babel-comint-buffer-livep session) + session + (save-window-excursion + (require 'ess) (R) + (rename-buffer + (if (bufferp session) + (buffer-name session) + (if (stringp session) + session + (buffer-name)))) + (current-buffer)))))) + +(defun org-babel-R-construct-graphics-device-call (out-file params) + "Construct the call to the graphics device." + (let ((devices + '((:bmp . "bmp") + (:jpg . "jpeg") + (:jpeg . "jpeg") + (:tiff . "tiff") + (:png . "png") + (:svg . "svg") + (:pdf . "pdf") + (:ps . "postscript") + (:postscript . "postscript"))) + (allowed-args '(:width :height :bg :units :pointsize + :antialias :quality :compression :res + :type :family :title :fonts :version + :paper :encoding :pagecentre :colormodel + :useDingbats :horizontal)) + (device (and (string-match ".+\\.\\([^.]+\\)" out-file) + (match-string 1 out-file))) + (extra-args (cdr (assq :R-dev-args params))) filearg args) + (setq device (or (and device (cdr (assq (intern (concat ":" device)) + devices))) "png")) + (setq filearg + (if (member device '("pdf" "postscript" "svg")) "file" "filename")) + (setq args (mapconcat + (lambda (pair) + (if (member (car pair) allowed-args) + (format ",%s=%s" + (substring (symbol-name (car pair)) 1) + (cdr pair)) "")) + params "")) + (format "%s(%s=\"%s\"%s%s%s)" + device filearg out-file args + (if extra-args "," "") (or extra-args "")))) + +(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") +(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") +(defvar org-babel-R-wrapper-method "main <- function ()\n{\n%s\n} +write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)") +(defvar org-babel-R-wrapper-lastvar "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)") + +(defun org-babel-R-evaluate + (session body result-type column-names-p row-names-p) + "Pass BODY to the R process in SESSION. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (if (not session) + ;; external process evaluation + (case result-type + (output (org-babel-eval org-babel-R-command body)) + (value + (let ((tmp-file (make-temp-file "org-babel-R-results-"))) + (org-babel-eval org-babel-R-command + (format org-babel-R-wrapper-method + body tmp-file + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE"))) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file)) column-names-p)))) + ;; comint session evaluation + (case result-type + (value + (let ((tmp-file (make-temp-file "org-babel-R")) + broke) + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat + #'org-babel-chomp + (list + body + (format org-babel-R-wrapper-lastvar + tmp-file + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE")) + org-babel-R-eoe-indicator) "\n")) + (inferior-ess-send-input)) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file)) column-names-p))) + (output + (mapconcat + #'org-babel-chomp + (butlast + (delq nil + (mapcar + #'identity + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat #'org-babel-chomp + (list body org-babel-R-eoe-indicator) + "\n")) + (inferior-ess-send-input)))) 2) "\n"))))) + +(defun org-babel-R-process-value-result (result column-names-p) + "R-specific processing of return value. +Insert hline if column names in output have been requested." + (if column-names-p + (cons (car result) (cons 'hline (cdr result))) + result)) + +(provide 'ob-R) + +;; arch-tag: cd4c7298-503b-450f-a3c2-f3e74b630237 + +;;; ob-R.el ends here diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el new file mode 100644 index 00000000000..043bc4c5ff7 --- /dev/null +++ b/lisp/org/ob-asymptote.el @@ -0,0 +1,161 @@ +;;; ob-asymptote.el --- org-babel functions for asymptote evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating asymptote source code. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in asymptote +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments, if file +;; is omitted then the -V option is passed to the asy command for +;; interactive viewing + +;;; Requirements: + +;; - The asymptote program :: http://asymptote.sourceforge.net/ +;; +;; - asy-mode :: Major mode for editing asymptote files + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function org-combine-plists "org" (&rest plists)) + +(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy")) + +(defvar org-babel-default-header-args:asymptote + '((:results . "file") (:exports . "results")) + "Default arguments when evaluating an Asymptote source block.") + +(defun org-babel-expand-body:asymptote (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params + (org-babel-process-params params))))) + (concat (mapconcat 'org-babel-asymptote-var-to-asymptote vars "\n") + "\n" body "\n"))) + +(defun org-babel-execute:asymptote (body params) + "Execute a block of Asymptote code. +This function is called by `org-babel-execute-src-block'." + (let* ((processed-params (org-babel-process-params params)) + (result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (format (or (and out-file + (string-match ".+\\.\\(.+\\)" out-file) + (match-string 1 out-file)) + "pdf")) + (cmdline (cdr (assoc :cmdline params))) + (in-file (make-temp-file "org-babel-asymptote")) + (cmd (concat "asy " + (if out-file + (concat "-globalwrite -f " format " -o " out-file) + "-V") + " " cmdline " " in-file))) + (with-temp-file in-file + (insert (org-babel-expand-body:asymptote body params processed-params))) + (message cmd) (shell-command cmd) + out-file)) + +(defun org-babel-prep-session:asymptote (session params) + "Return an error if the :session header argument is set. +Asymptote does not support sessions" + (error "Asymptote does not support sessions")) + +(defun org-babel-asymptote-var-to-asymptote (pair) + "Convert an elisp value into an Asymptote variable. +The elisp value PAIR is converted into Asymptote code specifying +a variable of the same value." + (let ((var (car pair)) + (val (if (symbolp (cdr pair)) + (symbol-name (cdr pair)) + (cdr pair)))) + (cond + ((integerp val) + (format "int %S=%S;" var val)) + ((floatp val) + (format "real %S=%S;" var val)) + ((stringp val) + (format "string %S=\"%s\";" var val)) + ((listp val) + (let* ((dimension-2-p (not (null (cdr val)))) + (dim (if dimension-2-p "[][]" "[]")) + (type (org-babel-asymptote-define-type val)) + (array (org-babel-asymptote-table-to-array + val + (if dimension-2-p '(:lstart "{" :lend "}," :llend "}"))))) + (format "%S%s %S=%s;" type dim var array)))))) + +(defun org-babel-asymptote-table-to-array (table params) + "Convert values of an elisp table into a string of an asymptote array. +Empty cells are ignored." + (labels ((atom-to-string (table) + (cond + ((null table) '()) + ((not (listp (car table))) + (cons (if (and (stringp (car table)) + (not (string= (car table) ""))) + (format "\"%s\"" (car table)) + (format "%s" (car table))) + (atom-to-string (cdr table)))) + (t + (cons (atom-to-string (car table)) + (atom-to-string (cdr table)))))) + ;; Remove any empty row + (fix-empty-lines (table) + (delq nil (mapcar (lambda (l) (delq "" l)) table)))) + (orgtbl-to-generic + (fix-empty-lines (atom-to-string table)) + (org-combine-plists '(:hline nil :sep "," :tstart "{" :tend "}") params)))) + +(defun org-babel-asymptote-define-type (data) + "Determine type of DATA. +DATA is a list. Type symbol is returned as 'symbol. The type is +usually the type of the first atom encountered, except for arrays +of int, where every cell must be of int type." + (labels ((anything-but-int (el) + (cond + ((null el) nil) + ((not (listp (car el))) + (cond + ((floatp (car el)) 'real) + ((stringp (car el)) 'string) + (t + (anything-but-int (cdr el))))) + (t + (or (anything-but-int (car el)) + (anything-but-int (cdr el))))))) + (or (anything-but-int data) 'int))) + +(provide 'ob-asymptote) + +;; arch-tag: f2f5bd0d-78e8-412b-8e6c-6dadc94cc06b + +;;; ob-asymptote.el ends here diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el new file mode 100644 index 00000000000..c42d9b4db38 --- /dev/null +++ b/lisp/org/ob-clojure.el @@ -0,0 +1,316 @@ +;;; ob-clojure.el --- org-babel functions for clojure evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Joel Boehland +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;;; ob support for evaluating clojure code + +;;; Requirements: + +;;; A working clojure install. This also implies a working java executable +;;; clojure-mode +;;; slime +;;; swank-clojure + +;;; By far, the best way to install these components is by following +;;; the directions as set out by Phil Hagelberg (Technomancy) on the +;;; web page: http://technomancy.us/126 + +;;; Code: +(require 'ob) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function slime-eval-async "ext:slime" (sexp &optional cont package)) +(declare-function slime-eval "ext:slime" (sexp &optional package)) +(declare-function swank-clojure-concat-paths "ext:slime" (paths)) +(declare-function org-babel-ref-variables "ext:slime" (params)) +(declare-function slime "ext:slime" (&optional command coding-system)) +(declare-function slime-output-buffer "ext:slime" (&optional noprompt)) +(declare-function slime-filter-buffers "ext:slime" (predicate)) + +(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) + +(defvar org-babel-default-header-args:clojure '()) + +(defvar org-babel-clojure-wrapper-method + " +(defn spit + [f content] + (with-open [#^java.io.PrintWriter w + (java.io.PrintWriter. + (java.io.BufferedWriter. + (java.io.OutputStreamWriter. + (java.io.FileOutputStream. + (java.io.File. f)))))] + (.print w content))) + +(defn main + [] + %s) + +(spit \"%s\" (str (main)))") +;;";; <-- syntax highlighting is messed without this double quote + +;;taken mostly from clojure-test-mode.el +(defun org-babel-clojure-clojure-slime-eval (string &optional handler) + "Evaluate a STRING of clojure code using `slime-eval-async'." + (slime-eval-async `(swank:eval-and-grab-output ,string) + (or handler #'identity))) + +(defun org-babel-clojure-slime-eval-sync (string) + "Evaluate a STRING of clojure code using `slime-eval'." + (slime-eval `(swank:eval-and-grab-output ,string))) + +;;taken from swank-clojure.el +(defvar swank-clojure-binary) +(defvar swank-clojure-classpath) +(defvar swank-clojure-java-path) +(defvar swank-clojure-extra-vm-args) +(defvar swank-clojure-library-paths) +(defvar swank-clojure-extra-classpaths) +(defun org-babel-clojure-babel-clojure-cmd () + "Create the command to start clojure according to current settings." + (if (and (not swank-clojure-binary) (not swank-clojure-classpath)) + (error "%s" (concat "You must specifiy either a `swank-clojure-binary' " + "or a `swank-clojure-jar-path'")) + (if swank-clojure-binary + (if (listp swank-clojure-binary) + swank-clojure-binary + (list swank-clojure-binary)) + (delq + nil + (append + (list swank-clojure-java-path) + swank-clojure-extra-vm-args + (list + (when swank-clojure-library-paths + (concat "-Djava.library.path=" + (swank-clojure-concat-paths swank-clojure-library-paths))) + "-classpath" + (swank-clojure-concat-paths + (append + swank-clojure-classpath + swank-clojure-extra-classpaths)) + "clojure.main")))))) + +(defun org-babel-clojure-table-or-string (results) + "Convert RESULTS to an elisp value. +If RESULTS looks like a table, then convert to an Emacs-lisp +table, otherwise return the results as a string." + (org-babel-read + (if (string-match "^\\[.+\\]$" results) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-clojure-var-to-clojure (var) + "Convert an elisp value into a clojure variable. +The elisp value VAR is converted into a string of clojure source +code specifying a variable of the same value." + (if (listp var) + (format "'%s" var) + (format "%S" var))) + +(defun org-babel-clojure-build-full-form (body vars) + "Construct a clojure let form with VARS as the let variables." + (let ((vars-forms + (mapconcat ;; define any variables + (lambda (pair) + (format "%s %s" + (car pair) (org-babel-clojure-var-to-clojure (cdr pair)))) + vars "\n ")) + (body (org-babel-trim body))) + (if (> (length vars-forms) 0) + (format "(let [%s]\n %s)" vars-forms body) + body))) + +(defun org-babel-prep-session:clojure (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (require 'slime) (require 'swank-clojure) + (let* ((session-buf (org-babel-clojure-initiate-session session)) + (vars (org-babel-ref-variables params)) + (var-lines (mapcar ;; define any top level session variables + (lambda (pair) + (format "(def %s %s)\n" (car pair) + (org-babel-clojure-var-to-clojure (cdr pair)))) + vars))) + session-buf)) + +(defun org-babel-load-session:clojure (session body params) + "Load BODY into SESSION." + (require 'slime) (require 'swank-clojure) + (save-window-excursion + (let ((buffer (org-babel-prep-session:clojure session params))) + (with-current-buffer buffer + (goto-char (point-max)) + (insert (org-babel-chomp body))) + buffer))) + +(defvar org-babel-clojure-buffers '()) +(defvar org-babel-clojure-pending-sessions '()) + +(defun org-babel-clojure-session-buffer (session) + "Return the buffer associated with SESSION." + (cdr (assoc session org-babel-clojure-buffers))) + +(defun org-babel-clojure-initiate-session-by-key (&optional session) + "Initiate a clojure session in an inferior-process-buffer. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session." + (save-window-excursion + (let* ((session (if session + (if (stringp session) (intern session) + session) + :default)) + (clojure-buffer (org-babel-clojure-session-buffer session))) + (unless (and clojure-buffer (buffer-live-p clojure-buffer)) + (setq org-babel-clojure-buffers + (assq-delete-all session org-babel-clojure-buffers)) + (push session org-babel-clojure-pending-sessions) + (slime) + ;; we are waiting to finish setting up which will be done in + ;; org-babel-clojure-session-connected-hook below. + (let ((timeout 9)) + (while (and (not (org-babel-clojure-session-buffer session)) + (< 0 timeout)) + (message "Waiting for clojure repl for session: %s ... %i" + session timeout) + (sit-for 1) + (decf timeout))) + (setq org-babel-clojure-pending-sessions + (remove session org-babel-clojure-pending-sessions)) + (unless (org-babel-clojure-session-buffer session) + (error "Couldn't create slime clojure process")) + (setq clojure-buffer (org-babel-clojure-session-buffer session))) + session))) + +(defun org-babel-clojure-initiate-session (&optional session params) + "Return the slime-clojure repl buffer bound to SESSION. +Returns nil if \"none\" is specified." + (require 'slime) (require 'swank-clojure) + (unless (and (stringp session) (string= session "none")) + (org-babel-clojure-session-buffer + (org-babel-clojure-initiate-session-by-key session)))) + +(defun org-babel-clojure-session-connected-hook () + "Finish binding an org-babel session to a slime-clojure repl." + (let ((pending-session (pop org-babel-clojure-pending-sessions))) + (when pending-session + (save-excursion + (switch-to-buffer (slime-output-buffer)) + (rename-buffer + (if (stringp pending-session) + pending-session (symbol-name pending-session))) + (org-babel-clojure-bind-session-to-repl-buffer + pending-session (slime-output-buffer)))))) + +(add-hook 'slime-connected-hook 'org-babel-clojure-session-connected-hook) + +(defun org-babel-clojure-bind-session-to-repl-buffer (session repl-buffer) + "Associate SESSION with REPL-BUFFER." + (when (stringp session) (setq session (intern session))) + (setq org-babel-clojure-buffers + (cons (cons session repl-buffer) + (assq-delete-all session org-babel-clojure-buffers)))) + +(defun org-babel-clojure-repl-buffer-pred () + "Test whether the current buffer is an active slime-clojure +repl buffer." + (and (buffer-live-p (current-buffer)) (eq major-mode 'slime-repl-mode))) + +(defun org-babel-clojure-bind-session-to-repl (session) + "Bind SESSION to a clojure repl." + (interactive "sEnter session name: ") + (let ((repl-bufs (slime-filter-buffers 'org-babel-clojure-repl-buffer-pred))) + (unless repl-bufs (error "No existing slime-clojure repl buffers exist")) + (let ((repl-buf (read-buffer "Choose slime-clojure repl: " repl-bufs t))) + (org-babel-clojure-bind-session-to-repl-buffer session repl-buf)))) + +(defun org-babel-clojure-evaluate-external-process + (buffer body &optional result-type) + "Evaluate the body in an external process." + (let ((cmd (format "%s -" (mapconcat #'identity + (org-babel-clojure-babel-clojure-cmd) + " ")))) + (case result-type + (output (org-babel-eval cmd body)) + (value (let* ((tmp-file (make-temp-file "org-babel-clojure-results-"))) + (org-babel-eval cmd (format org-babel-clojure-wrapper-method + body tmp-file tmp-file)) + (org-babel-clojure-table-or-string + (org-babel-eval-read-file tmp-file))))))) + +(defun org-babel-clojure-evaluate-session (buffer body &optional result-type) + "Evaluate the body in the context of a clojure session." + (require 'slime) (require 'swank-clojure) + (let ((raw nil) + (results nil)) + (with-current-buffer buffer + (setq raw (org-babel-clojure-slime-eval-sync body)) + (setq results (reverse (mapcar #'org-babel-trim raw))) + (cond + ((equal result-type 'output) + (mapconcat #'identity (reverse (cdr results)) "\n")) + ((equal result-type 'value) + (org-babel-clojure-table-or-string (car results))))))) + +(defun org-babel-clojure-evaluate (buffer body &optional result-type) + "Pass BODY to the Clojure process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY as elisp." + (if buffer + (org-babel-clojure-evaluate-session buffer body result-type) + (org-babel-clojure-evaluate-external-process buffer body result-type))) + +(defun org-babel-expand-body:clojure (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (org-babel-clojure-build-full-form + body (nth 1 (or processed-params (org-babel-process-params params))))) + +(defun org-babel-execute:clojure (body params) + "Execute a block of Clojure code." + (require 'slime) (require 'swank-clojure) + (let* ((processed-params (org-babel-process-params params)) + (body (org-babel-expand-body:clojure body params processed-params)) + (session (org-babel-clojure-initiate-session + (first processed-params)))) + (org-babel-reassemble-table + (org-babel-clojure-evaluate session body (nth 3 processed-params)) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +(provide 'ob-clojure) + +;; arch-tag: a43b33f2-653e-46b1-ac56-2805cf05b7d1 + +;;; ob-clojure.el ends here diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el new file mode 100644 index 00000000000..732f2766b28 --- /dev/null +++ b/lisp/org/ob-comint.el @@ -0,0 +1,143 @@ +;;; ob-comint.el --- org-babel functions for interaction with comint buffers + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, comint +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; These functions build on comint to ease the sending and receiving +;; of commands and results from comint buffers. + +;; Note that the buffers in this file are analogous to sessions in +;; org-babel at large. + +;;; Code: +(require 'ob) +(require 'comint) +(eval-when-compile (require 'cl)) + +(defun org-babel-comint-buffer-livep (buffer) + "Check if BUFFER is a comint buffer with a live process." + (let ((buffer (if buffer (get-buffer buffer)))) + (and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer))) + +(defmacro org-babel-comint-in-buffer (buffer &rest body) + "Check BUFFER and execute BODY. +BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is +executed inside the protection of `save-window-excursion' and +`save-match-data'." + (declare (indent 1)) + `(save-excursion + (save-match-data + (unless (org-babel-comint-buffer-livep ,buffer) + (error "buffer %s doesn't exist or has no process" ,buffer)) + (set-buffer ,buffer) + ,@body))) + +(defmacro org-babel-comint-with-output (meta &rest body) + "Evaluate BODY in BUFFER and return process output. +Will wait until EOE-INDICATOR appears in the output, then return +all process output. If REMOVE-ECHO and FULL-BODY are present and +non-nil, then strip echo'd body from the returned output. META +should be a list containing the following where the last two +elements are optional. + + (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY) + +This macro ensures that the filter is removed in case of an error +or user `keyboard-quit' during execution of body." + (declare (indent 1)) + (let ((buffer (car meta)) + (eoe-indicator (cadr meta)) + (remove-echo (cadr (cdr meta))) + (full-body (cadr (cdr (cdr meta))))) + `(org-babel-comint-in-buffer ,buffer + (let ((string-buffer "") dangling-text raw) + (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 + comint-prompt-regexp nil t) + (re-search-forward + (regexp-quote ,eoe-indicator) 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))) + ;; remove echo'd FULL-BODY from input + (if (and ,remove-echo ,full-body + (string-match + (replace-regexp-in-string + "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) + string-buffer)) + (setq raw (substring string-buffer (match-end 0)))) + (split-string string-buffer comint-prompt-regexp))))) + +(defun org-babel-comint-input-command (buffer cmd) + "Pass CMD to BUFFER. +The input will not be echoed." + (org-babel-comint-in-buffer buffer + (goto-char (process-mark (get-buffer-process buffer))) + (insert cmd) + (comint-send-input) + (org-babel-comint-wait-for-output buffer))) + +(defun org-babel-comint-wait-for-output (buffer) + "Wait until output arrives from BUFFER. +Note: this is only safe when waiting for the result of a single +statement (not large blocks of code)." + (org-babel-comint-in-buffer buffer + (while (progn + (goto-char comint-last-input-end) + (not (and (re-search-forward comint-prompt-regexp nil t) + (goto-char (match-beginning 0)) + (string= (face-name (face-at-point)) + "comint-highlight-prompt")))) + (accept-process-output (get-buffer-process buffer))))) + +(provide 'ob-comint) + +;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889 + +;;; ob-comint.el ends here diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el new file mode 100644 index 00000000000..0a279b24573 --- /dev/null +++ b/lisp/org/ob-css.el @@ -0,0 +1,52 @@ +;;; ob-css.el --- org-babel functions for css evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; Since CSS can't be executed, this file exists solely for tangling +;; CSS from org-mode files. + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:css '()) + +(defun org-babel-expand-body:css (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:css (body params) + "Execute a block of CSS code. +This function is called by `org-babel-execute-src-block'." + body) + +(defun org-babel-prep-session:css (session params) + "Return an error if the :session header argument is set. +CSS does not support sessions." + (error "CSS sessions are nonsensical")) + +(provide 'ob-css) + +;; arch-tag: f4447e8c-50ab-41f9-b322-b7b9574d9fbe + +;;; ob-css.el ends here diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el new file mode 100644 index 00000000000..336eaa93f12 --- /dev/null +++ b/lisp/org/ob-ditaa.el @@ -0,0 +1,72 @@ +;;; ob-ditaa.el --- org-babel functions for ditaa evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating ditaa source code. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in ditaa +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments +;; +;; 4) there are no variables (at least for now) + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:ditaa + '((:results . "file") (:exports . "results")) + "Default arguments for evaluating a ditaa source block.") + +(defun org-babel-expand-body:ditaa (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defvar org-ditaa-jar-path) +(defun org-babel-execute:ditaa (body params) + "Execute a block of Ditaa code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (make-temp-file "org-babel-ditaa"))) + (unless (file-exists-p org-ditaa-jar-path) + (error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) + (with-temp-file in-file (insert body)) + (message (concat "java -jar " org-ditaa-jar-path " " cmdline " " in-file " " out-file)) + (shell-command (concat "java -jar " (shell-quote-argument org-ditaa-jar-path) " " cmdline " " in-file " " out-file)) + out-file)) + +(defun org-babel-prep-session:ditaa (session params) + "Return an error because ditaa does not support sessions." + (error "Ditaa does not support sessions")) + +(provide 'ob-ditaa) + +;; arch-tag: 492cd006-07d9-4fac-bef6-5bb60b48842e + +;;; ob-ditaa.el ends here diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el new file mode 100644 index 00000000000..4657fb80ba0 --- /dev/null +++ b/lisp/org/ob-dot.el @@ -0,0 +1,87 @@ +;;; ob-dot.el --- org-babel functions for dot evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating dot source code. +;; +;; For information on dot see http://www.graphviz.org/ +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in dot +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments +;; +;; 4) there are no variables (at least for now) + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:dot + '((:results . "file") (:exports . "results")) + "Default arguments to use when evaluating a dot source block.") + +(defun org-babel-expand-body:dot (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params + (org-babel-process-params params))))) + (mapc + (lambda (pair) + (let ((name (symbol-name (car pair))) + (value (cdr pair))) + (setq body + (replace-regexp-in-string + (concat "\$" (regexp-quote name)) + (if (stringp value) value (format "%S" value)) + body)))) + vars) + body)) + +(defun org-babel-execute:dot (body params) + "Execute a block of Dot code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let ((processed-params (org-babel-process-params params)) + (result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (cmdline (cdr (assoc :cmdline params))) + (cmd (or (cdr (assoc :cmd params)) "dot")) + (in-file (make-temp-file "org-babel-dot"))) + (with-temp-file in-file + (insert (org-babel-expand-body:dot body params processed-params))) + (org-babel-eval (concat cmd " " in-file " " cmdline " -o " out-file) "") + out-file)) + +(defun org-babel-prep-session:dot (session params) + "Return an error because Dot does not support sessions." + (error "Dot does not support sessions")) + +(provide 'ob-dot) + +;; arch-tag: 817d0516-7b47-4f77-a8b2-2aadd8e4d0e2 + +;;; ob-dot.el ends here diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el new file mode 100644 index 00000000000..92c3f36e2ed --- /dev/null +++ b/lisp/org/ob-emacs-lisp.el @@ -0,0 +1,74 @@ +;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating emacs-lisp code + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:emacs-lisp + '((:hlines . "yes") (:colnames . "no")) + "Default arguments for evaluating an emacs-lisp source block.") + +(declare-function org-babel-comint-with-output "ob-comint" (&rest body)) +(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) +(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) +(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defun org-babel-expand-body:emacs-lisp (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let* ((processed-params (or processed-params (org-babel-process-params params))) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-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 ")") + body))) + (if (or (member "code" result-params) + (member "pp" result-params)) + (concat "(pp " body ")") body))) + +(defun org-babel-execute:emacs-lisp (body params) + "Execute a block of emacs-lisp code with Babel." + (save-window-excursion + (let ((processed-params (org-babel-process-params params))) + (org-babel-reassemble-table + (eval (read (format "(progn %s)" + (org-babel-expand-body:emacs-lisp + body params processed-params)))) + (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))) + +(provide 'ob-emacs-lisp) + +;; arch-tag: e9a3acca-dc84-472a-9f5a-23c35befbcd6 + +;;; ob-emacs-lisp.el ends here diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el new file mode 100644 index 00000000000..dea39f12089 --- /dev/null +++ b/lisp/org/ob-eval.el @@ -0,0 +1,255 @@ +;;; ob-run.el --- org-babel functions for external code evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, comint +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; These functions build existing Emacs support for executing external +;; shell commands. + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(defun org-babel-eval-error-notify (exit-code stderr) + "Open a buffer to display STDERR and a message with the value of EXIT-CODE." + (let ((buf (get-buffer-create "*Org-Babel Error Output*"))) + (with-current-buffer buf + (goto-char (point-max)) + (save-excursion (insert stderr))) + (display-buffer buf)) + (message "Babel evaluation exited with code %S" exit-code)) + +(defun org-babel-eval (cmd body) + "Run CMD on BODY. +If CMD succeeds then return it's results, otherwise display +STDERR with `org-babel-eval-error-notify'." + (let ((err-buff (get-buffer-create "*Org-Babel Error*")) exit-code) + (with-current-buffer err-buff (erase-buffer)) + (with-temp-buffer + (insert body) + (setq exit-code + (org-babel-shell-command-on-region + (point-min) (point-max) cmd t 'replace err-buff)) + (if (or (not (numberp exit-code)) (> exit-code 0)) + (progn + (with-current-buffer err-buff + (org-babel-eval-error-notify exit-code (buffer-string))) + nil) + (buffer-string))))) + +(defun org-babel-eval-read-file (file) + "Return the contents of FILE as a string." + (with-temp-buffer (insert-file-contents + (org-babel-maybe-remote-file file)) + (buffer-string))) + +(defun org-babel-shell-command-on-region (start end command + &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' + +Normally display output (if any) in temp buffer `*Shell Command Output*'; +Prefix arg means replace the region with it. Return the exit code of +COMMAND. + +To specify a coding system for converting non-ASCII characters in +the input and output to the shell command, use +\\[universal-coding-system-argument] before this command. By +default, the input (from the current buffer) is encoded in the +same coding system that will be used to save the file, +`buffer-file-coding-system'. If the output is going to replace +the region, then it is decoded from that same coding system. + +The noninteractive arguments are START, END, COMMAND, +OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER. +Noninteractive callers can specify coding systems by binding +`coding-system-for-read' and `coding-system-for-write'. + +If the command generates output, the output may be displayed +in the echo area or in a buffer. +If the output is short enough to display in the echo area +\(determined by the variable `max-mini-window-height' if +`resize-mini-windows' is non-nil), it is shown there. Otherwise +it is displayed in the buffer `*Shell Command Output*'. The output +is available in that buffer in both cases. + +If there is output and an error, a message about the error +appears at the end of the output. + +If there is no output, or if output is inserted in the current buffer, +then `*Shell Command Output*' is deleted. + +If the optional fourth argument OUTPUT-BUFFER is non-nil, +that says to put the output in some other buffer. +If OUTPUT-BUFFER is a buffer or buffer name, put the output there. +If OUTPUT-BUFFER is not a buffer and not nil, +insert output in the current buffer. +In either case, the output is inserted after point (leaving mark after it). + +If REPLACE, the optional fifth argument, is non-nil, that means insert +the output in place of text from START to END, putting point and mark +around it. + +If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer +or buffer name to which to direct the command's standard error output. +If it is nil, error output is mingled with regular output. +If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there +were any errors. (This is always t, interactively.) +In an interactive call, the variable `shell-command-default-error-buffer' +specifies the value of ERROR-BUFFER." + (interactive (let (string) + (unless (mark) + (error "The mark is not set now, so there is no region")) + ;; Do this before calling region-beginning + ;; and region-end, in case subprocess output + ;; relocates them while we are in the minibuffer. + (setq string (read-shell-command "Shell command on region: ")) + ;; call-interactively recognizes region-beginning and + ;; region-end specially, leaving them in the history. + (list (region-beginning) (region-end) + string + current-prefix-arg + current-prefix-arg + shell-command-default-error-buffer + t))) + (let ((error-file + (if error-buffer + (make-temp-file + (expand-file-name "scor" + (or (unless (featurep 'xemacs) + small-temporary-file-directory) + temporary-file-directory))) + nil)) + exit-status) + (if (or replace + (and output-buffer + (not (or (bufferp output-buffer) (stringp output-buffer))))) + ;; Replace specified region with output from command. + (let ((swap (and replace (< start end)))) + ;; Don't muck with mark unless REPLACE says we should. + (goto-char start) + (and replace (push-mark (point) 'nomsg)) + (setq exit-status + (call-process-region start end shell-file-name t + (if error-file + (list output-buffer error-file) + t) + nil shell-command-switch command)) + ;; It is rude to delete a buffer which the command is not using. + ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) + ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) + ;; (kill-buffer shell-buffer))) + ;; Don't muck with mark unless REPLACE says we should. + (and replace swap (exchange-point-and-mark))) + ;; No prefix argument: put the output in a temp buffer, + ;; replacing its entire contents. + (let ((buffer (get-buffer-create + (or output-buffer "*Shell Command Output*")))) + (unwind-protect + (if (eq buffer (current-buffer)) + ;; If the input is the same buffer as the output, + ;; delete everything but the specified region, + ;; then replace that region with the output. + (progn (setq buffer-read-only nil) + (delete-region (max start end) (point-max)) + (delete-region (point-min) (min start end)) + (setq exit-status + (call-process-region (point-min) (point-max) + shell-file-name t + (if error-file + (list t error-file) + t) + nil shell-command-switch + command))) + ;; Clear the output buffer, then run the command with + ;; output there. + (let ((directory default-directory)) + (with-current-buffer buffer + (setq buffer-read-only nil) + (if (not output-buffer) + (setq default-directory directory)) + (erase-buffer))) + (setq exit-status + (call-process-region start end shell-file-name nil + (if error-file + (list buffer error-file) + buffer) + nil shell-command-switch command))) + ;; Report the output. + (with-current-buffer buffer + (setq mode-line-process + (cond ((null exit-status) + " - Error") + ((stringp exit-status) + (format " - Signal [%s]" exit-status)) + ((not (equal 0 exit-status)) + (format " - Exit [%d]" exit-status))))) + (if (with-current-buffer buffer (> (point-max) (point-min))) + ;; There's some output, display it + (display-message-or-buffer buffer) + ;; No output; error? + (let ((output + (if (and error-file + (< 0 (nth 7 (file-attributes error-file)))) + "some error output" + "no output"))) + (cond ((null exit-status) + (message "(Shell command failed with error)")) + ((equal 0 exit-status) + (message "(Shell command succeeded with %s)" + output)) + ((stringp exit-status) + (message "(Shell command killed by signal %s)" + exit-status)) + (t + (message "(Shell command failed with code %d and %s)" + exit-status output)))) + ;; Don't kill: there might be useful info in the undo-log. + ;; (kill-buffer buffer) + )))) + + (when (and error-file (file-exists-p error-file)) + (if (< 0 (nth 7 (file-attributes error-file))) + (with-current-buffer (get-buffer-create error-buffer) + (let ((pos-from-end (- (point-max) (point)))) + (or (bobp) + (insert "\f\n")) + ;; Do no formatting while reading error file, + ;; because that can run a shell command, and we + ;; don't want that to cause an infinite recursion. + (format-insert-file error-file nil) + ;; Put point after the inserted errors. + (goto-char (- (point-max) pos-from-end))) + (and display-error-buffer + (display-buffer (current-buffer))))) + (delete-file error-file)) + exit-status)) + +(provide 'ob-eval) + +;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d + +;;; ob-comint.el ends here diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el new file mode 100644 index 00000000000..4c074887ef1 --- /dev/null +++ b/lisp/org/ob-exp.el @@ -0,0 +1,313 @@ +;;; ob-exp.el --- Exportation of org-babel source blocks + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; See the online documentation for more information +;; +;; http://orgmode.org/worg/org-contrib/babel/ + +;;; Code: +(require 'ob) +(require 'org-exp-blocks) +(eval-when-compile + (require 'cl)) + +(defvar obe-marker nil) +(defvar org-current-export-file) +(defvar org-babel-lob-one-liner-regexp) +(defvar org-babel-ref-split-regexp) +(declare-function org-babel-lob-get-info "ob-lob" ()) +(declare-function org-babel-ref-literal "ob-ref" (ref)) + +(add-to-list 'org-export-interblocks '(src org-babel-exp-inline-src-blocks)) +(add-to-list 'org-export-interblocks '(lob org-babel-exp-lob-one-liners)) +(add-hook 'org-export-blocks-postblock-hook 'org-exp-res/src-name-cleanup) + +(org-export-blocks-add-block '(src org-babel-exp-src-blocks nil)) + +(defcustom org-export-babel-evaluate t + "Switch controlling code evaluation during export. +When set to nil no code will be exported as part of the export +process." + :group 'org-babel + :type 'boolean) +(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) + +(defvar org-babel-function-def-export-keyword "function" + "The keyword to substitute for the source name line on export. +When exporting a source block function, this keyword will +appear in the exported version in the place of source name +line. A source block is considered to be a source block function +if the source name is present and is followed by a parenthesized +argument list. The parentheses may be empty or contain +whitespace. An example is the following which generates n random +\(uniform) numbers. + +#+source: rand(n) +#+begin_src R + runif(n) +#+end_src") + +(defvar org-babel-function-def-export-indent 4 + "Number of characters to indent a source block on export. +When exporting a source block function, the block contents will +be indented by this many characters. See +`org-babel-function-def-export-name' for the definition of a +source block function.") + +(defun org-babel-exp-src-blocks (body &rest headers) + "Process source block for export. +Depending on the 'export' headers argument in replace the source +code block with... + +both ---- display the code and the results + +code ---- the default, display the code inside the block but do + not process + +results - just like none only the block is run on export ensuring + that it's results are present in the org-mode buffer + +none ----- do not display either code or results upon export" + (interactive) + (message "org-babel-exp processing...") + (save-excursion + (goto-char (match-beginning 0)) + (let* ((info (org-babel-get-src-block-info)) + (params (nth 2 info))) + ;; bail if we couldn't get any info from the block + (when info + ;; expand noweb references in the original file + (setf (nth 1 info) + (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)) + (nth 1 info)))) + (org-babel-exp-do-export info 'block)))) + +(defun org-babel-exp-inline-src-blocks (start end) + "Process inline source blocks between START and END for export. +See `org-babel-exp-src-blocks' for export options, currently the +options and are taken from `org-babel-default-inline-header-args'." + (interactive) + (save-excursion + (goto-char start) + (while (and (< (point) end) + (re-search-forward org-babel-inline-src-block-regexp end t)) + (let* ((info (save-match-data (org-babel-parse-inline-src-block-match))) + (params (nth 2 info)) + (replacement + (save-match-data + (if (org-babel-in-example-or-verbatim) + (buffer-substring (match-beginning 0) (match-end 0)) + ;; expand noweb references in the original file + (setf (nth 1 info) + (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)) + (nth 1 info))) + (org-babel-exp-do-export info 'inline))))) + (setq end (+ end (- (length replacement) (length (match-string 1))))) + (replace-match replacement t t nil 1))))) + +(defun org-exp-res/src-name-cleanup () + "Clean up #+results and #+srcname lines for export. +This function should only be called after all block processing +has taken place." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (org-re-search-forward-unprotected + (concat + "\\("org-babel-src-name-regexp"\\|"org-babel-result-regexp"\\)") + nil t) + (delete-region + (progn (beginning-of-line) (point)) + (progn (end-of-line) (+ 1 (point))))))) + +(defun org-babel-in-example-or-verbatim () + "Return true if point is in example or verbatim code. +Example and verbatim code include escaped portions of +an org-mode buffer code that should be treated as normal +org-mode text." + (or (org-in-indented-comment-line) + (save-excursion + (save-match-data + (goto-char (point-at-bol)) + (looking-at "[ \t]*:[ \t]"))) + (org-in-regexps-block-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src"))) + +(defun org-babel-exp-lob-one-liners (start end) + "Process Library of Babel calls between START and END for export. +See `org-babel-exp-src-blocks' for export options. Currently the +options are taken from `org-babel-default-header-args'." + (interactive) + (let (replacement) + (save-excursion + (goto-char start) + (while (and (< (point) end) + (re-search-forward org-babel-lob-one-liner-regexp nil t)) + (setq replacement + (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-parse-header-arguments + (org-babel-clean-text-properties + (concat ":var results=" + (mapconcat #'identity + (butlast lob-info) " "))))) + (car (last lob-info))) + 'lob)))) + (setq end (+ end (- (length replacement) (length (match-string 0))))) + (replace-match replacement t t))))) + +(defun org-babel-exp-do-export (info type) + "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 (and session + (not (equal "none" session)) + (not (assoc :noeval (nth 2 info)))) + (org-babel-exp-results info type 'silent)))) + (clean () (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 type)) + ('results (org-babel-exp-results info type)) + ('both (concat (org-babel-exp-code info type) + "\n\n" + (org-babel-exp-results info type)))))) + +(defvar backend) +(defun org-babel-exp-code (info type) + "Prepare and return code in the current code block for export. +Code is prepared in a manner suitable for exportat by +org-mode. This function is called by `org-babel-exp-do-export'. +The code block is not evaluated." + (let ((lang (nth 0 info)) + (body (nth 1 info)) + (switches (nth 3 info)) + (name (nth 4 info)) + (args (mapcar + #'cdr + (org-remove-if-not (lambda (el) (eq :var (car el))) (nth 2 info))))) + (case type + ('inline (format "=%s=" body)) + ('block + (let ((str + (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body + (if (and body (string-match "\n$" body)) + "" "\n")))) + (when name + (add-text-properties + 0 (length str) + (list 'org-caption + (format "%s(%s)" + name + (mapconcat #'identity args ", "))) + str)) + str)) + ('lob + (let ((call-line (and (string-match "results=" (car args)) + (substring (car args) (match-end 0))))) + (cond + ((eq backend 'html) + (format "\n#+HTML: <label class=\"org-src-name\">%s</label>\n" + call-line)) + ((format ": %s\n" call-line)))))))) + +(defun org-babel-exp-results (info type &optional silent) + "Evaluate and return the results of the current code block for export. +Results are prepared in a manner suitable for export by org-mode. +This function is called by `org-babel-exp-do-export'. The code +block will be evaluated. Optional argument SILENT can be used to +inhibit insertion of results into the buffer." + (if org-export-babel-evaluate + (let ((lang (nth 0 info)) + (body (nth 1 info)) + (params + ;; lets ensure that we lookup references in the original file + (mapcar + (lambda (pair) + (if (and org-current-export-file + (eq (car pair) :var) + (string-match org-babel-ref-split-regexp (cdr pair)) + (equal :ob-must-be-reference + (org-babel-ref-literal + (match-string 2 (cdr pair))))) + `(:var . ,(concat (match-string 1 (cdr pair)) + "=" org-current-export-file + ":" (match-string 2 (cdr pair)))) + pair)) + (nth 2 info)))) + ;; skip code blocks which we can't evaluate + (if (fboundp (intern (concat "org-babel-execute:" lang))) + (case type + ('inline + (let ((raw (org-babel-execute-src-block + nil info '((:results . "silent")))) + (result-params (split-string + (cdr (assoc :results params))))) + (unless silent + (cond ;; respect the value of the :results header argument + ((member "file" result-params) + (org-babel-result-to-file raw)) + ((or (member "raw" result-params) + (member "org" result-params)) + (format "%s" raw)) + ((member "code" result-params) + (format "src_%s{%s}" lang raw)) + (t + (if (stringp raw) + (if (= 0 (length raw)) "=(no results)=" + (format "%s" raw)) + (format "%S" raw))))))) + ('block + (org-babel-execute-src-block + nil info (org-babel-merge-params + params + `((:results . ,(if silent "silent" "replace"))))) + "") + ('lob + (save-excursion + (re-search-backward org-babel-lob-one-liner-regexp nil t) + (org-babel-execute-src-block + nil info (org-babel-merge-params + params + `((:results . ,(if silent "silent" "replace"))))) + ""))) + "")) + "")) + +(provide 'ob-exp) + +;; arch-tag: 523abf4c-76d1-44ed-9f27-e3bddf34bf0f + +;;; ob-exp.el ends here diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el new file mode 100644 index 00000000000..40543d720b0 --- /dev/null +++ b/lisp/org/ob-gnuplot.el @@ -0,0 +1,229 @@ +;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating gnuplot source code. +;; +;; This differs from most standard languages in that +;; +;; 1) we are generally only going to return results of type "file" +;; +;; 2) we are adding the "file" and "cmdline" header arguments + +;;; Requirements: + +;; - gnuplot :: http://www.gnuplot.info/ +;; +;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(eval-when-compile (require 'cl)) + +(declare-function org-time-string-to-time "org" (s)) +(declare-function org-combine-plists "org" (&rest plists)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function gnuplot-mode "ext:gnuplot-mode" ()) +(declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt)) +(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ()) + +(defvar org-babel-default-header-args:gnuplot + '((:results . "file") (:exports . "results") (:session . nil)) + "Default arguments to use when evaluating a gnuplot source block.") + +(defvar org-babel-gnuplot-timestamp-fmt nil) + +(defun org-babel-gnuplot-process-vars (params) + "Extract variables from PARAMS and process the variables. +Dumps all vectors into files and returns an association list +of variable names and the related value to be used in the gnuplot +code." + (mapcar + (lambda (pair) + (cons + (car pair) ;; variable name + (if (listp (cdr pair)) ;; variable value + (org-babel-gnuplot-table-to-data + (cdr pair) (make-temp-file "org-babel-gnuplot") params) + (cdr pair)))) + (org-babel-ref-variables params))) + +(defun org-babel-expand-body:gnuplot (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (save-window-excursion + (let* ((vars (org-babel-gnuplot-process-vars params)) + (out-file (cdr (assoc :file params))) + (term (or (cdr (assoc :term params)) + (when out-file (file-name-extension out-file)))) + (cmdline (cdr (assoc :cmdline params))) + (title (plist-get params :title)) + (lines (plist-get params :line)) + (sets (plist-get params :set)) + (x-labels (plist-get params :xlabels)) + (y-labels (plist-get params :ylabels)) + (timefmt (plist-get params :timefmt)) + (time-ind (or (plist-get params :timeind) + (when timefmt 1))) + 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 + (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) + vars "\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. +This function is called by `org-babel-execute-src-block'." + (require 'gnuplot) + (let ((session (cdr (assoc :session params))) + (result-type (cdr (assoc :results params))) + (out-file (cdr (assoc :file params))) + (body (org-babel-expand-body:gnuplot body params)) + output) + (save-window-excursion + ;; evaluate the code body with gnuplot + (if (string= session "none") + (let ((script-file (make-temp-file "org-babel-gnuplot-script"))) + (with-temp-file script-file + (insert (concat body "\n"))) + (message "gnuplot \"%s\"" script-file) + (setq output + (shell-command-to-string (format "gnuplot \"%s\"" script-file))) + (message output)) + (with-temp-buffer + (insert (concat body "\n")) + (gnuplot-mode) + (gnuplot-send-buffer-to-gnuplot))) + (if (member "output" (split-string result-type)) + output + out-file)))) + +(defun org-babel-prep-session:gnuplot (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (let* ((session (org-babel-gnuplot-initiate-session session)) + (vars (org-babel-ref-variables params)) + (var-lines (mapcar + (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) + vars))) + (message "%S" session) + (org-babel-comint-in-buffer session + (mapc (lambda (var-line) + (insert var-line) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines)) + session)) + +(defun org-babel-load-session:gnuplot (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:gnuplot session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +(defvar gnuplot-buffer) +(defun org-babel-gnuplot-initiate-session (&optional session params) + "Initiate a gnuplot session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session. The current +`gnuplot-mode' doesn't provide support for multiple sessions." + (require 'gnuplot) + (unless (string= session "none") + (save-window-excursion + (gnuplot-send-string-to-gnuplot "" "line") + gnuplot-buffer))) + +(defun org-babel-gnuplot-quote-timestamp-field (s) + "Convert S from timestamp to Unix time and export to gnuplot." + (format-time-string org-babel-gnuplot-timestamp-fmt (org-time-string-to-time s))) + +(defvar org-table-number-regexp) +(defvar org-ts-regexp3) +(defun org-babel-gnuplot-quote-tsv-field (s) + "Quote S for export to gnuplot." + (unless (stringp s) + (setq s (format "%s" s))) + (if (string-match org-table-number-regexp s) s + (if (string-match org-ts-regexp3 s) + (org-babel-gnuplot-quote-timestamp-field s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")))) + +(defun org-babel-gnuplot-table-to-data (table data-file params) + "Export TABLE to DATA-FILE in a format readable by gnuplot. +Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." + (with-temp-file data-file + (make-local-variable 'org-babel-gnuplot-timestamp-fmt) + (setq org-babel-gnuplot-timestamp-fmt (or + (plist-get params :timefmt) + "%Y-%m-%d-%H:%M:%S")) + (insert (orgtbl-to-generic + table + (org-combine-plists + '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field) + params)))) + data-file) + +(provide 'ob-gnuplot) + +;; arch-tag: 50490ace-a9e1-4b29-a6e5-0db9f16c610b + +;;; ob-gnuplot.el ends here diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el new file mode 100644 index 00000000000..e0803347a64 --- /dev/null +++ b/lisp/org/ob-haskell.el @@ -0,0 +1,230 @@ +;;; ob-haskell.el --- org-babel functions for haskell evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating haskell source code. This one will +;; be sort of tricky because haskell programs must be compiled before +;; they can be run, but haskell code can also be run through an +;; interactive interpreter. +;; +;; For now lets only allow evaluation using the haskell interpreter. + +;;; Requirements: + +;; - haskell-mode :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode +;; +;; - inf-haskell :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode +;; +;; - (optionally) lhs2tex :: http://people.cs.uu.nl/andres/lhs2tex/ + +;;; Code: +(require 'ob) +(require 'ob-comint) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function haskell-mode "ext:haskell-mode" ()) +(declare-function run-haskell "ext:inf-haskell" (&optional arg)) +(declare-function inferior-haskell-load-file + "ext:inf-haskell" (&optional reload)) + +(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) + +(defvar org-babel-default-header-args:haskell '()) + +(defvar org-babel-haskell-lhs2tex-command "lhs2tex") + +(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"") + +(defun org-babel-expand-body:haskell (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat + (lambda (pair) (format "let %s = %s" + (car pair) + (org-babel-haskell-var-to-haskell (cdr pair)))) + vars "\n") "\n" body "\n"))) + +(defun org-babel-execute:haskell (body params) + "Execute a block of Haskell code." + (let* ((processed-params (org-babel-process-params params)) + (session (nth 0 processed-params)) + (vars (nth 1 processed-params)) + (result-type (nth 3 processed-params)) + (full-body (org-babel-expand-body:haskell body params processed-params)) + (session (org-babel-haskell-initiate-session session params)) + (raw (org-babel-comint-with-output + (session org-babel-haskell-eoe t full-body) + (insert (org-babel-trim full-body)) + (comint-send-input nil t) + (insert org-babel-haskell-eoe) + (comint-send-input nil t))) + (results (mapcar + #'org-babel-haskell-read-string + (cdr (member org-babel-haskell-eoe + (reverse (mapcar #'org-babel-trim raw))))))) + (org-babel-reassemble-table + (cond + ((equal result-type 'output) + (mapconcat #'identity (reverse (cdr results)) "\n")) + ((equal result-type 'value) + (org-babel-haskell-table-or-string (car results)))) + (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +(defun org-babel-haskell-read-string (string) + "Strip \\\"s from around a haskell string." + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(defun org-babel-haskell-initiate-session (&optional session params) + "Initiate a haskell session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session." + (require 'inf-haskell) + (or (get-buffer "*haskell*") + (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer)))) + +(defun org-babel-load-session:haskell + (session body params &optional processed-params) + "Load BODY into SESSION." + (save-window-excursion + (let* ((buffer (org-babel-prep-session:haskell + session params processed-params)) + (load-file (concat (make-temp-file "org-babel-haskell-load") ".hs"))) + (with-temp-buffer + (insert body) (write-file load-file) + (haskell-mode) (inferior-haskell-load-file)) + buffer))) + +(defun org-babel-prep-session:haskell + (session params &optional processed-params) + "Prepare SESSION according to the header arguments in PARAMS." + (save-window-excursion + (let ((pp (or processed-params (org-babel-process-params params))) + (buffer (org-babel-haskell-initiate-session session))) + (org-babel-comint-in-buffer buffer + (mapc + (lambda (pair) + (insert (format "let %s = %s" + (car pair) + (org-babel-haskell-var-to-haskell (cdr pair)))) + (comint-send-input nil t)) + (nth 1 pp))) + (current-buffer)))) + +(defun org-babel-haskell-table-or-string (results) + "Convert RESULTS to an Emacs-lisp table or string. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + "," " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-haskell-var-to-haskell (var) + "Convert an elisp value VAR into a haskell variable. +The elisp VAR is converted to a string of haskell source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]") + (format "%S" var))) + +(defvar org-src-preserve-indentation) +(defun org-babel-haskell-export-to-lhs (&optional arg) + "Export to a .lhs file with all haskell code blocks escaped. +When called with a prefix argument the resulting +.lhs file will be exported to a .tex file. This function will +create two new files, base-name.lhs and base-name.tex where +base-name is the name of the current org-mode file. + +Note that all standard Babel literate programming +constructs (header arguments, no-web syntax etc...) are ignored." + (interactive "P") + (let* ((contents (buffer-string)) + (haskell-regexp + (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)?[\r\n]" + "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*")) + (base-name (file-name-sans-extension (buffer-file-name))) + (tmp-file (make-temp-file "ob-haskell")) + (tmp-org-file (concat tmp-file ".org")) + (tmp-tex-file (concat tmp-file ".tex")) + (lhs-file (concat base-name ".lhs")) + (tex-file (concat base-name ".tex")) + (command (concat org-babel-haskell-lhs2tex-command " " lhs-file " > " tex-file)) + (preserve-indentp org-src-preserve-indentation) + indentation) + ;; escape haskell source-code blocks + (with-temp-file tmp-org-file + (insert contents) + (goto-char (point-min)) + (while (re-search-forward haskell-regexp nil t) + (save-match-data (setq indentation (length (match-string 1)))) + (replace-match (save-match-data + (concat + "#+begin_latex\n\\begin{code}\n" + (if (or preserve-indentp + (string-match "-i" (match-string 2))) + (match-string 3) + (org-remove-indentation (match-string 3))) + "\n\\end{code}\n#+end_latex\n")) + t t) + (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) + (save-excursion + ;; export to latex w/org and save as .lhs + (find-file tmp-org-file) (funcall 'org-export-as-latex nil) + (kill-buffer) + (delete-file tmp-org-file) + (find-file tmp-tex-file) + (goto-char (point-min)) (forward-line 2) + (insert "%include polycode.fmt\n") + ;; ensure all \begin/end{code} statements start at the first column + (while (re-search-forward "^[ \t]+\\\\begin{code}[^\000]+\\\\end{code}" nil t) + (replace-match (save-match-data (org-remove-indentation (match-string 0))) + t t)) + (setq contents (buffer-string)) + (save-buffer) (kill-buffer)) + (delete-file tmp-tex-file) + ;; save org exported latex to a .lhs file + (with-temp-file lhs-file (insert contents)) + (if (not arg) + (find-file lhs-file) + ;; process .lhs file with lhs2tex + (message "running %s" command) (shell-command command) (find-file tex-file)))) + +(provide 'ob-haskell) + +;; arch-tag: b53f75f3-ba1a-4b05-82d9-a2a0d4e70804 + +;;; ob-haskell.el ends here diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el new file mode 100644 index 00000000000..3f8e83b4f91 --- /dev/null +++ b/lisp/org/ob-keys.el @@ -0,0 +1,89 @@ +;;; ob-keys.el --- key bindings for org-babel + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; Add org-babel keybindings to the org-mode keymap for exposing +;; org-babel functions. These will all share a common prefix. See +;; the value of `org-babel-key-bindings' for a list of interactive +;; functions and their associated keys. + +;;; Code: +(require 'ob) + +(defvar org-babel-key-prefix "\C-c\C-v" + "The key prefix for Babel interactive key-bindings. +See `org-babel-key-bindings' for the list of interactive babel +functions which are assigned key bindings, and see +`org-babel-map' for the actual babel keymap.") + +(defvar org-babel-map (make-sparse-keymap) + "The keymap for interactive Babel functions.") + +;;;###autoload +(defun org-babel-describe-bindings () + "Describe all keybindings behind `org-babel-key-prefix'." + (interactive) + (describe-bindings org-babel-key-prefix)) + +(defvar org-babel-key-bindings + '(("p" . org-babel-previous-src-block) + ("\C-p" . org-babel-previous-src-block) + ("n" . org-babel-next-src-block) + ("\C-n" . org-babel-next-src-block) + ("e" . org-babel-execute-src-block) + ("\C-e" . org-babel-execute-src-block) + ("o" . org-babel-open-src-block-result) + ("\C-o" . org-babel-open-src-block-result) + ("\C-v" . org-babel-expand-src-block) + ("v" . org-babel-expand-src-block) + ("g" . org-babel-goto-named-src-block) + ("r" . org-babel-goto-named-result) + ("\C-r" . org-babel-goto-named-result) + ("\C-b" . org-babel-execute-buffer) + ("b" . org-babel-execute-buffer) + ("\C-s" . org-babel-execute-subtree) + ("s" . org-babel-execute-subtree) + ("\C-t" . org-babel-tangle) + ("t" . org-babel-tangle) + ("\C-f" . org-babel-tangle-file) + ("f" . org-babel-tangle-file) + ("\C-l" . org-babel-lob-ingest) + ("l" . org-babel-lob-ingest) + ("\C-z" . org-babel-switch-to-session) + ("z" . org-babel-switch-to-session) + ("\C-a" . org-babel-sha1-hash) + ("a" . org-babel-sha1-hash) + ("h" . org-babel-describe-bindings)) + "Alist of key bindings and interactive Babel functions. +This list associates interactive Babel functions +with keys. Each element of this list will add an entry to the +`org-babel-map' using the letter key which is the `car' of the +a-list placed behind the generic `org-babel-key-prefix'.") + +(provide 'ob-keys) + +;; arch-tag: 01e348ee-4906-46fa-839a-6b7b6f989048 + +;;; ob-keys.el ends here diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el new file mode 100644 index 00000000000..e5b01463a51 --- /dev/null +++ b/lisp/org/ob-latex.el @@ -0,0 +1,158 @@ +;;; ob-latex.el --- org-babel functions for latex "evaluation" + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating LaTeX source code. +;; +;; Currently on evaluation this returns raw LaTeX code, unless a :file +;; header argument is given in which case small png or pdf files will +;; be created directly form the latex source code. + +;;; Code: +(require 'ob) + +(declare-function org-create-formula-image "org" (string tofile options buffer)) +(declare-function org-splice-latex-header "org" + (tpl def-pkg pkg snippets-p &optional extra)) +(declare-function org-export-latex-fix-inputenc "org-latex" ()) + +(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) + +(defvar org-babel-default-header-args:latex + '((:results . "latex") (:exports . "results")) + "Default arguments to use when evaluating a LaTeX source block.") + +(defun org-babel-expand-body:latex (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (mapc (lambda (pair) ;; replace variables + (setq body + (replace-regexp-in-string + (regexp-quote (format "%S" (car pair))) + (if (stringp (cdr pair)) + (cdr pair) (format "%S" (cdr pair))) + body))) (nth 1 (org-babel-process-params params))) + body) + +(defvar org-format-latex-options) +(defvar org-export-latex-packages-alist) +(defun org-babel-execute:latex (body params) + "Execute a block of Latex code with Babel. +This function is called by `org-babel-execute-src-block'." + (setq body (org-babel-expand-body:latex body params)) + (if (cdr (assoc :file params)) + (let ((out-file (cdr (assoc :file params))) + (tex-file (make-temp-file "org-babel-latex" nil ".tex")) + (pdfheight (cdr (assoc :pdfheight params))) + (pdfwidth (cdr (assoc :pdfwidth params))) + (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) + (org-export-latex-packages-alist + (append (cdr (assoc :packages params)) + org-export-latex-packages-alist))) + (cond + ((string-match "\\.png$" out-file) + (org-create-formula-image + body out-file org-format-latex-options in-buffer)) + ((string-match "\\.pdf$" out-file) + (org-babel-latex-body-to-tex-file tex-file body pdfheight pdfwidth) + (when (file-exists-p out-file) (delete-file out-file)) + (rename-file (org-babel-latex-tex-to-pdf tex-file) out-file)) + ((string-match "\\.\\([^\\.]+\\)$" out-file) + (error "can not create %s files, please specify a .png or .pdf file" + (match-string 1 out-file)))) + out-file) + body)) + +(defvar org-format-latex-header) +(defvar org-format-latex-header-extra) +(defvar org-export-latex-packages-alist) +(defvar org-export-latex-default-packages-alist) +(defun org-babel-latex-body-to-tex-file (tex-file body &optional height width) + "Place the contents of BODY into TEX-FILE. +Extracted from `org-create-formula-image' in org.el." + (with-temp-file tex-file + (insert (org-splice-latex-header + org-format-latex-header + (delq + nil + (mapcar + (lambda (el) (unless (and (listp el) (string= "hyperref" (cadr el))) + el)) + org-export-latex-default-packages-alist)) + org-export-latex-packages-alist + org-format-latex-header-extra) + (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") + (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "") + (if org-format-latex-header-extra + (concat "\n" org-format-latex-header-extra) + "") + "\n\\begin{document}\n" body "\n\\end{document}\n") + (org-export-latex-fix-inputenc))) + +(defvar org-export-pdf-logfiles) +(defvar org-latex-to-pdf-process) +(defvar org-export-pdf-remove-logfiles) +(defun org-babel-latex-tex-to-pdf (tex-file) + "Generate a pdf file according to the contents TEX-FILE. +Extracted from `org-export-as-pdf' in org-latex.el." + (let* ((wconfig (current-window-configuration)) + (default-directory (file-name-directory tex-file)) + (base (file-name-sans-extension tex-file)) + (pdffile (concat base ".pdf")) + (cmds org-latex-to-pdf-process) + (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) + cmd) + (if (and cmds (symbolp cmds)) + (funcall cmds tex-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 "%s" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument tex-file)) + t t cmd))) + (shell-command cmd outbuf outbuf))) + (if (not (file-exists-p pdffile)) + (error "PDF file was not produced from %s" tex-file) + (set-window-configuration wconfig) + (when org-export-pdf-remove-logfiles + (dolist (ext org-export-pdf-logfiles) + (setq tex-file (concat base "." ext)) + (and (file-exists-p tex-file) (delete-file tex-file)))) + pdffile))) + +(defun org-babel-prep-session:latex (session params) + "Return an error because LaTeX doesn't support sesstions." + (error "LaTeX does not support sessions")) + +(provide 'ob-latex) + +;; arch-tag: 1f13f7e2-26de-4c24-9274-9f331d4c6ff3 + +;;; ob-latex.el ends here diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el new file mode 100644 index 00000000000..f806668e2e8 --- /dev/null +++ b/lisp/org/ob-lob.el @@ -0,0 +1,116 @@ +;;; ob-lob.el --- functions supporting the Library of Babel + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; See the online documentation for more information +;; +;; http://orgmode.org/worg/org-contrib/babel/ + +;;; Code: +(require 'ob) +(require 'ob-table) + +(defvar org-babel-library-of-babel nil + "Library of source-code blocks. +This is an association list. Populate the library by adding +files to `org-babel-lob-files'.") + +(defcustom org-babel-lob-files '() + "Files used to populate the `org-babel-library-of-babel'. +To add files to this list use the `org-babel-lob-ingest' command." + :group 'org-babel + :type 'list) + +;;;###autoload +(defun org-babel-lob-ingest (&optional file) + "Add all source-blocks defined in FILE to `org-babel-library-of-babel'." + (interactive "f") + (org-babel-map-src-blocks file + (let* ((info (org-babel-get-src-block-info)) + (source-name (intern (nth 4 info)))) + (when source-name + (setq org-babel-library-of-babel + (cons (cons source-name info) + (assq-delete-all source-name org-babel-library-of-babel))))))) + +(defconst org-babel-lob-call-aliases '("lob" "call") + "Aliases to call a source block function. +If you change the value of this variable then your files may + become unusable by other org-babel users, and vice versa.") + +(defconst org-babel-lob-one-liner-regexp + (concat "^\\([ \t]*\\)#\\+\\(?:" + (mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|") + "\\):[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)[ \t]*\\([^\n]*\\)") + "Regexp to match calls to predefined source block functions.") + +;; functions for executing lob one-liners +;;;###autoload +(defun org-babel-lob-execute-maybe () + "Execute a Library of Babel source block, if appropriate. +Detect if this is context for a Library Of Babel source block and +if so then run the appropriate source block from the Library." + (interactive) + (let ((info (org-babel-lob-get-info))) + (if (nth 0 info) (progn (org-babel-lob-execute info) t) nil))) + +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-lob-execute-maybe) + +;;;###autoload +(defun org-babel-lob-get-info () + "Return a Library of Babel function call as a string. + +This function is analogous to org-babel-get-src-block-name. For +both functions, after they are called, (match-string 1) matches +the function name, and (match-string 2) matches the function +arguments inside the parentheses. I think perhaps these functions +should be renamed to bring out this similarity, perhaps involving +the word 'call'." + (let ((case-fold-search t)) + (save-excursion + (beginning-of-line 1) + (if (looking-at org-babel-lob-one-liner-regexp) + (append (mapcar #'org-babel-clean-text-properties + (list (format "%s(%s)" (match-string 2) (match-string 3)) + (match-string 4))) + (list (length (match-string 1)))))))) + +(defun org-babel-lob-execute (info) + "Execute the lob call specified by INFO." + (let ((params (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (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))))) + +(provide 'ob-lob) + +;; arch-tag: ce0712c9-2147-4019-ba3f-42341b8b474b + +;;; ob-lob.el ends here diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el new file mode 100644 index 00000000000..0728edf49dc --- /dev/null +++ b/lisp/org/ob-matlab.el @@ -0,0 +1,48 @@ +;;; ob-matlab.el --- org-babel support for matlab evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; Functions that are common to org-babel support for matlab and +;; octave are in org-babel-octave.el + +;;; Requirements: + +;; Matlab + +;; matlab.el required for interactive emacs sessions and matlab-mode +;; major mode for source code editing buffer +;; http://matlab-emacs.sourceforge.net/ + +;;; Code: +(require 'ob) +(require 'ob-octave) + +;; see ob-octave for matlab implementation + +(provide 'ob-matlab) + +;; arch-tag: 6b234299-c1f7-4eb1-ace8-7b93344065ac + +;;; ob-matlab.el ends here diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el new file mode 100644 index 00000000000..a78e0b6bd68 --- /dev/null +++ b/lisp/org/ob-mscgen.el @@ -0,0 +1,89 @@ +;;; ob-msc.el --- org-babel functions for mscgen evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Juan Pechiar +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This software provides EMACS org-babel export support for message +;; sequence charts. The mscgen utility is used for processing the +;; sequence definition, and must therefore be installed in the system. +;; +;; Mscgen is available and documented at +;; http://www.mcternan.me.uk/mscgen/index.html +;; +;; This code is directly inspired by Eric Schulte's ob-dot.el +;; +;; Example: +;; +;; #+begin_src mscgen :file example.png +;; msc { +;; A,B; +;; A -> B [ label = "send message" ]; +;; A <- B [ label = "get answer" ]; +;; } +;; #+end_src +;; +;; Header for alternative file type: +;; +;; #+begin_src mscgen :file ex2.svg :filetype svg + +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in mscgen +;; 2) we are generally only going to return results of type "file" +;; 3) we are adding the "file" and "filetype" header arguments +;; 4) there are no variables + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:mscgen + '((:results . "file") (:exports . "results")) + "Default arguments to use when evaluating a mscgen source block.") + +(defun org-babel-expand-body:mscgen (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:mscgen (body params) + "Execute a block of Mscgen code with Babel. +This function is called by `org-babel-execute-src-block'. +Default filetype is png. Modify by setting :filetype parameter to +mscgen supported formats." + (let* ((out-file (or (cdr (assoc :file params)) "output.png" )) + (filetype (or (cdr (assoc :filetype params)) "png" ))) + (unless (cdr (assoc :file params)) + (error " +ERROR: no output file specified. Add \":file name.png\" to the src header")) + (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) + out-file)) + +(defun org-babel-prep-session:mscgen (session params) + "Raise an error because Mscgen doesn't support sessions." + (error "Mscgen does not support sessions")) + +(provide 'ob-mscgen) + +;; arch-tag: 74695b1e-715f-4b5a-a3a9-d78ee39ba5c8 + +;;; ob-msc.el ends here diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el new file mode 100644 index 00000000000..f5add5c5754 --- /dev/null +++ b/lisp/org/ob-ocaml.el @@ -0,0 +1,158 @@ +;;; ob-ocaml.el --- org-babel functions for ocaml evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating ocaml source code. This one will +;; be sort of tricky because ocaml programs must be compiled before +;; they can be run, but ocaml code can also be run through an +;; interactive interpreter. +;; +;; For now lets only allow evaluation using the ocaml interpreter. + +;;; Requirements: + +;; - tuareg-mode :: http://www-rocq.inria.fr/~acohen/tuareg/ + +;;; Code: +(require 'ob) +(require 'ob-comint) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function tuareg-run-caml "ext:tuareg" ()) +(declare-function tuareg-interactive-send-input "ext:tuareg" ()) + +(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml")) + +(defvar org-babel-default-header-args:ocaml '()) + +(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;") +(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe") + +(defun org-babel-expand-body:ocaml (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat + (lambda (pair) (format "let %s = %s;;" (car pair) + (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) + vars "\n") "\n" body "\n"))) + +(defun org-babel-execute:ocaml (body params) + "Execute a block of Ocaml code with Babel." + (let* ((processed-params (org-babel-process-params params)) + (vars (nth 1 processed-params)) + (full-body (org-babel-expand-body:ocaml body params processed-params)) + (session (org-babel-prep-session:ocaml + (cdr (assoc :session params)) params)) + (raw (org-babel-comint-with-output + (session org-babel-ocaml-eoe-output t full-body) + (insert + (concat + (org-babel-chomp full-body)"\n"org-babel-ocaml-eoe-indicator)) + (tuareg-interactive-send-input))) + (clean + (car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out) + (delq nil (mapcar (lambda (line) + (if out + (progn (setq out nil) line) + (when (string-match re line) + (progn (setq out t) nil)))) + (mapcar #'org-babel-trim (reverse raw)))))))) + (org-babel-reassemble-table + (org-babel-ocaml-parse-output (org-babel-trim clean)) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +(defvar tuareg-interactive-buffer-name) +(defun org-babel-prep-session:ocaml (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (require 'tuareg) + (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none")) + (not (string= session "default")) + (stringp session)) + session + tuareg-interactive-buffer-name))) + (save-window-excursion (tuareg-run-caml) + (get-buffer tuareg-interactive-buffer-name)))) + +(defun org-babel-ocaml-elisp-to-ocaml (val) + "Return a string of ocaml code which evaluates to VAL." + (if (listp val) + (concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]") + (format "%S" val))) + +(defun org-babel-ocaml-parse-output (output) + "Parse OUTPUT. +OUTPUT is string output from an ocaml process." + (let ((regexp "%s = \\(.+\\)$")) + (cond + ((string-match (format regexp "string") output) + (org-babel-read (match-string 1 output))) + ((or (string-match (format regexp "int") output) + (string-match (format regexp "float") output)) + (string-to-number (match-string 1 output))) + ((string-match (format regexp "list") output) + (org-babel-ocaml-read-list (match-string 1 output))) + ((string-match (format regexp "array") output) + (org-babel-ocaml-read-array (match-string 1 output))) + (t (message "don't recognize type of %s" output) output)))) + +(defun org-babel-ocaml-read-list (results) + "Convert RESULTS into an elisp table or string. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + "; " " " (replace-regexp-in-string + "'" "\"" results))))) + results))) + +(defun org-babel-ocaml-read-array (results) + "Convert RESULTS into an elisp table or string. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat + "'" (replace-regexp-in-string + "\\[|" "(" (replace-regexp-in-string + "|\\]" ")" (replace-regexp-in-string + "; " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(provide 'ob-ocaml) + +;; arch-tag: 2e815f4d-365e-4d69-b1df-dd17fdd7b7b7 + +;;; ob-ocaml.el ends here diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el new file mode 100644 index 00000000000..2cdbaa0468c --- /dev/null +++ b/lisp/org/ob-octave.el @@ -0,0 +1,266 @@ +;;; ob-octave.el --- org-babel functions for octave and matlab evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;;; Requirements: + +;; octave +;; octave-mode.el and octave-inf.el come with GNU emacs + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function matlab-shell "ext:matlab-mode") +(declare-function matlab-shell-run-region "ext:matlab-mode") + +(defvar org-babel-default-header-args:matlab '()) +(defvar org-babel-default-header-args:octave '()) + +(defvar org-babel-matlab-shell-command "matlab -nosplash" + "Shell command to run matlab as an external process.") +(defvar org-babel-octave-shell-command "octave -q" + "Shell command to run octave as an external process.") + +(defun org-babel-expand-body:matlab (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (org-babel-expand-body:octave body params processed-params)) +(defun org-babel-expand-body:octave (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-octave-var-to-octave (cdr pair)))) + vars "\n") "\n" body "\n"))) + +(defvar org-babel-matlab-with-emacs-link nil + "If non-nil use matlab-shell-run-region for session evaluation. + This will use EmacsLink if (matlab-with-emacs-link) evaluates + to a non-nil value.") + +(defvar org-babel-matlab-emacs-link-wrapper-method + "%s +if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); +else, save -ascii %s ans +end +delete('%s') +") +(defvar org-babel-octave-wrapper-method + "%s +if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); +else, save -ascii %s ans +end") + +(defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'") + +(defvar org-babel-octave-eoe-output "ans = org_babel_eoe") + +(defun org-babel-execute:matlab (body params) + "Execute a block of matlab code with Babel." + (require 'matlab) + (org-babel-execute:octave body params 'matlab)) +(defun org-babel-execute:octave (body params &optional matlabp) + "Execute a block of octave code with Babel." + (let* ((processed-params (org-babel-process-params params)) + (session + (funcall (intern (format "org-babel-%s-initiate-session" + (if matlabp "matlab" "octave"))) + (nth 0 processed-params) params)) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (result-type (nth 3 processed-params)) + (out-file (cdr (assoc :file params))) + (augmented-body + (org-babel-expand-body:octave body params processed-params)) + (result (org-babel-octave-evaluate + session augmented-body result-type matlabp))) + (or out-file + (org-babel-reassemble-table + result + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params))))))) + +(defun org-babel-prep-session:matlab (session params) + "Prepare SESSION according to PARAMS." + (require 'matlab) + (org-babel-prep-session:octave session params 'matlab)) +(defun org-babel-octave-var-to-octave (var) + "Convert an emacs-lisp value into an octave variable. +Converts an emacs-lisp variable into a string of octave code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-octave-var-to-octave var ", ") "]") + (format "%S" var))) + +(defun org-babel-prep-session:octave (session params &optional matlabp) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-octave-initiate-session session params matlabp)) + (vars (org-babel-ref-variables params)) + (var-lines (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-octave-var-to-octave (cdr pair)))) + vars))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-matlab-initiate-session (&optional session params) + "Create a matlab inferior process buffer. +If there is not a current inferior-process-buffer in SESSION then +create. Return the initialized session." + (require 'matlab) + (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." + (require 'octave-inf) + (unless (string= session "none") + (let ((session (or session + (if matlabp "*Inferior Matlab*" "*Inferior Octave*")))) + (if (org-babel-comint-buffer-livep session) session + (save-window-excursion + (if matlabp (unless org-babel-matlab-with-emacs-link (matlab-shell)) + (run-octave)) + (rename-buffer (if (bufferp session) (buffer-name session) + (if (stringp session) session (buffer-name)))) + (current-buffer)))))) + +(defun org-babel-octave-evaluate + (session body result-type lang &optional matlabp) + "Pass BODY to the octave process in SESSION. +If RESULT-TYPE equals 'output then return the outputs of the +statements in BODY, if RESULT-TYPE equals 'value then return the +value of the last statement in BODY, as elisp." + (if session + (org-babel-octave-evaluate-session session body result-type matlabp) + (org-babel-octave-evaluate-external-process body result-type matlabp))) + +(defun org-babel-octave-evaluate-external-process (body result-type matlabp) + "Evaluate BODY in an external octave process." + (let ((cmd (if matlabp + org-babel-matlab-shell-command + org-babel-octave-shell-command))) + (case result-type + (output (org-babel-eval cmd body)) + (value (let ((tmp-file (make-temp-file "org-babel-results-"))) + (org-babel-eval + cmd + (format org-babel-octave-wrapper-method body tmp-file tmp-file)) + (org-babel-eval-read-file tmp-file)))))) + +(defun org-babel-octave-evaluate-session + (session body result-type &optional matlabp) + "Evaluate BODY in SESSION." + (let* ((tmp-file (make-temp-file "org-babel-results-")) + (wait-file (make-temp-file "org-babel-matlab-emacs-link-wait-signal-")) + (full-body + (case result-type + (output + (mapconcat + #'org-babel-chomp + (list body org-babel-octave-eoe-indicator) "\n")) + (value + (if (and matlabp org-babel-matlab-with-emacs-link) + (concat + (format org-babel-matlab-emacs-link-wrapper-method + body tmp-file tmp-file wait-file) "\n") + (mapconcat + #'org-babel-chomp + (list (format org-babel-octave-wrapper-method + body tmp-file tmp-file) + org-babel-octave-eoe-indicator) "\n"))))) + (raw (if (and matlabp org-babel-matlab-with-emacs-link) + (save-window-excursion + (with-temp-buffer + (insert full-body) + (write-region "" 'ignored wait-file nil nil nil 'excl) + (matlab-shell-run-region (point-min) (point-max)) + (message "Waiting for Matlab Emacs Link") + (while (file-exists-p wait-file) (sit-for 0.01)) + "")) ;; matlab-shell-run-region doesn't seem to + ;; make *matlab* buffer contents easily + ;; available, so :results output currently + ;; won't work + (org-babel-comint-with-output + (session + (if matlabp + org-babel-octave-eoe-indicator + org-babel-octave-eoe-output) + t full-body) + (insert full-body) (comint-send-input nil t)))) results) + (case result-type + (value + (org-babel-octave-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file))) + (output + (progn + (setq results + (if matlabp + (cdr (reverse (delq "" (mapcar + #'org-babel-octave-read-string + (mapcar #'org-babel-trim raw))))) + (cdr (member org-babel-octave-eoe-output + (reverse (mapcar + #'org-babel-octave-read-string + (mapcar #'org-babel-trim raw))))))) + (mapconcat #'identity (reverse results) "\n")))))) + +(defun org-babel-octave-import-elisp-from-file (file-name) + "Import data from FILE-NAME. +This removes initial blank and comment lines and then calls +`org-babel-import-elisp-from-file'." + (let ((temp-file (make-temp-file "org-babel-results-")) beg end) + (with-temp-file temp-file + (insert-file-contents file-name) + (re-search-forward "^[ \t]*[^# \t]" nil t) + (if (< (setq beg (point-min)) + (setq end (point-at-bol))) + (delete-region beg end))) + (org-babel-import-elisp-from-file temp-file))) + +(defun org-babel-octave-read-string (string) + "Strip \\\"s from around octave string" + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(provide 'ob-octave) + +;; arch-tag: d8e5f68b-ba13-440a-a495-b653e989e704 + +;;; ob-octave.el ends here diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el new file mode 100644 index 00000000000..bfba158d4a8 --- /dev/null +++ b/lisp/org/ob-perl.el @@ -0,0 +1,120 @@ +;;; ob-perl.el --- org-babel functions for perl evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Dan Davison, Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating perl source code. + +;;; Code: +(require 'ob) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl")) + +(defvar org-babel-default-header-args:perl '()) + +(defvar org-babel-perl-command "perl" + "Name of command to use for executing perl code.") + +(defun org-babel-expand-body:perl (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat ;; define any variables + (lambda (pair) + (format "$%s=%s;" + (car pair) + (org-babel-perl-var-to-perl (cdr pair)))) + vars "\n") "\n" (org-babel-trim body) "\n"))) + +(defun org-babel-execute:perl (body params) + "Execute a block of Perl code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((processed-params (org-babel-process-params params)) + (session (nth 0 processed-params)) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (result-type (nth 3 processed-params)) + (full-body (org-babel-expand-body:perl + body params processed-params)) + (session (org-babel-perl-initiate-session session))) + (org-babel-reassemble-table + (org-babel-perl-evaluate session full-body result-type) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:perl (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (error "Sessions are not supported for Perl.")) + +;; helper functions + +(defun org-babel-perl-var-to-perl (var) + "Convert an elisp value to a perl variable. +The elisp value, VAR, is converted to a string of perl source code +specifying a var of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-perl-var-to-perl var ", ") "]") + (format "%S" var))) + +(defvar org-babel-perl-buffers '(:default . nil)) + +(defun org-babel-perl-initiate-session (&optional session params) + "Return nil because sessions are not supported by perl" +nil) + +(defvar org-babel-perl-wrapper-method + " +sub main { +%s +} +@r = main; +open(o, \">%s\"); +print o join(\"\\n\", @r), \"\\n\"") + +(defvar org-babel-perl-pp-wrapper-method + nil) + +(defun org-babel-perl-evaluate (session body &optional result-type) + "Pass BODY to the Perl process in SESSION. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (when session (error "Sessions are not supported for Perl.")) + (case result-type + (output (org-babel-eval org-babel-perl-command body)) + (value (let ((tmp-file (make-temp-file "org-babel-perl-results-"))) + (org-babel-eval + org-babel-perl-command + (format org-babel-perl-wrapper-method body tmp-file)) + (org-babel-eval-read-file tmp-file))))) + +(provide 'ob-perl) + +;; arch-tag: 88ef9396-d857-4dc3-8946-5a72bdfa2337 + +;;; ob-perl.el ends here diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el new file mode 100644 index 00000000000..c082188bea7 --- /dev/null +++ b/lisp/org/ob-python.el @@ -0,0 +1,276 @@ +;;; ob-python.el --- org-babel functions for python evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating python source code. + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function org-remove-indentation "org" ) +(declare-function py-shell "ext:python-mode" (&optional argprompt)) +(declare-function run-python "ext:python" (&optional cmd noshow new)) + +(add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) + +(defvar org-babel-default-header-args:python '()) + +(defvar org-babel-python-command "python" + "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.") + +(defun org-babel-expand-body:python (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (concat + (mapconcat ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-python-var-to-python (cdr pair)))) + (nth 1 (or processed-params (org-babel-process-params params))) "\n") + "\n" (org-babel-trim body) "\n")) + +(defun org-babel-execute:python (body params) + "Execute a block of Python code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-python-initiate-session (first processed-params))) + (result-params (nth 2 processed-params)) + (result-type (nth 3 processed-params)) + (full-body (org-babel-expand-body:python + body params processed-params)) + (result (org-babel-python-evaluate + session full-body result-type result-params))) + (or (cdr (assoc :file params)) + (org-babel-reassemble-table + result + (org-babel-pick-name (nth 4 processed-params) + (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) + (cdr (assoc :rownames params))))))) + +(defun org-babel-prep-session:python (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (let* ((session (org-babel-python-initiate-session session)) + (vars (org-babel-ref-variables params)) + (var-lines (mapcar ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-python-var-to-python (cdr pair)))) + vars))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:python (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:python session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-python-var-to-python (var) + "Convert an elisp value to a python variable. +Convert an elisp value, VAR, into a string of python source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]") + (if (equal var 'hline) + "None" + (format + (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S") + var)))) + +(defun org-babel-python-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If the results look like a list or tuple, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + ((lambda (res) + (if (listp res) + (mapcar (lambda (el) (if (equal el 'None) 'hline el)) res) + res)) + (org-babel-read + (if (or (string-match "^\\[.+\\]$" results) + (string-match "^(.+)$" results)) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results t)))))) + results)))) + +(defvar org-babel-python-buffers '((:default . nil))) + +(defun org-babel-python-session-buffer (session) + "Return the buffer associated with SESSION." + (cdr (assoc session org-babel-python-buffers))) + +(defun org-babel-python-initiate-session-by-key (&optional session) + "Initiate a python session. +If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (require org-babel-python-mode) + (save-window-excursion + (let* ((session (if session (intern session) :default)) + (python-buffer (org-babel-python-session-buffer session))) + (cond + ((and (equal 'python org-babel-python-mode) + (fboundp 'run-python)) ; python.el + (run-python)) + ((and (equal 'python-mode org-babel-python-mode) + (fboundp 'py-shell)) ; python-mode.el + ;; `py-shell' creates a buffer whose name is the value of + ;; `py-which-bufname' with '*'s at the beginning and end + (let* ((bufname (if python-buffer + (replace-regexp-in-string ;; zap surrounding * + "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) + (concat "Python-" (symbol-name session)))) + (py-which-bufname bufname)) + (py-shell) + (setq python-buffer (concat "*" bufname "*")))) + (t + (error "No function available for running an inferior python."))) + (setq org-babel-python-buffers + (cons (cons session python-buffer) + (assq-delete-all session org-babel-python-buffers))) + session))) + +(defun org-babel-python-initiate-session (&optional session params) + "Create a session named SESSION according to PARAMS." + (unless (string= session "none") + (org-babel-python-session-buffer + (org-babel-python-initiate-session-by-key session)))) + +(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'" + "A string to indicate that evaluation has completed.") +(defvar org-babel-python-wrapper-method + " +def main(): +%s + +open('%s', 'w').write( str(main()) )") +(defvar org-babel-python-pp-wrapper-method + " +import pprint +def main(): +%s + +open('%s', 'w').write( pprint.pformat(main()) )") + +(defun org-babel-python-evaluate + (buffer body &optional result-type result-params) + "Pass BODY to the Python process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (if (not buffer) + ;; external process evaluation + (case result-type + (output (org-babel-eval org-babel-python-command body)) + (value (let ((tmp-file (make-temp-file "org-babel-python-results-"))) + (org-babel-eval org-babel-python-command + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-babel-trim body)) + "[\r\n]") "\n") + tmp-file)) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-python-table-or-string raw))) + (org-babel-eval-read-file tmp-file))))) + ;; comint session evaluation + (flet ((dump-last-value (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (comint-send-input)) + (if pp + (list + "import pp" + (format "open('%s', 'w').write(pprint.pformat(_))" tmp-file)) + (list (format "open('%s', 'w').write(str(_))" tmp-file))))) + (input-body (body) + (mapc (lambda (statement) (insert statement) (comint-send-input)) + (split-string (org-babel-trim body) "[\r\n]+")) + (comint-send-input) (comint-send-input))) + (case result-type + (output + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (buffer org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) 2) "\n")) + (value + ((lambda (results) + (if (or (member "code" result-params) (member "pp" result-params)) + results + (org-babel-python-table-or-string results))) + (let ((tmp-file (make-temp-file "org-babel-python-results-"))) + (org-babel-comint-with-output + (buffer org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (dump-last-value tmp-file (member "pp" result-params)) + (comint-send-input) (comint-send-input) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) + (org-babel-eval-read-file tmp-file)))))))) + +(defun org-babel-python-read-string (string) + "Strip 's from around python string" + (if (string-match "^'\\([^\000]+\\)'$" string) + (match-string 1 string) + string)) + +(provide 'ob-python) + +;; arch-tag: f19b6c3d-dfcb-4a1a-9ce0-45ade1ebc212 + +;;; ob-python.el ends here diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el new file mode 100644 index 00000000000..4c344e6761e --- /dev/null +++ b/lisp/org/ob-ref.el @@ -0,0 +1,242 @@ +;;; ob-ref.el --- org-babel functions for referencing external data + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; Functions for referencing data from the header arguments of a +;; org-babel block. The syntax of such a reference should be + +;; #+VAR: variable-name=file:resource-id + +;; - variable-name :: the name of the variable to which the value +;; will be assigned + +;; - file :: path to the file containing the resource, or omitted if +;; resource is in the current file + +;; - resource-id :: the id or name of the resource + +;; So an example of a simple src block referencing table data in the +;; same file would be + +;; #+TBLNAME: sandbox +;; | 1 | 2 | 3 | +;; | 4 | org-babel | 6 | +;; +;; #+begin_src emacs-lisp :var table=sandbox +;; (message table) +;; #+end_src + +;;; Code: +(require 'ob) +(eval-when-compile + (require 'cl)) + +(declare-function org-remove-if-not "org" (predicate seq)) +(declare-function org-at-table-p "org" (&optional table-type)) +(declare-function org-count "org" (CL-ITEM CL-SEQ)) + +(defun org-babel-ref-variables (params) + "Convert PARAMS to variable names and values. +Takes a parameter alist, and return an alist of variable names, +and the emacs-lisp representation of the related value." + (let ((assignments + (delq nil (mapcar (lambda (pair) (if (eq (car pair) :var) (cdr pair))) params))) + (others + (delq nil (mapcar (lambda (pair) (unless (eq :var (car pair)) pair)) params)))) + (mapcar (lambda (assignment) (org-babel-ref-parse assignment)) assignments))) + +(defvar org-babel-ref-split-regexp + "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*") + +(defun org-babel-ref-parse (assignment &optional params) + "Parse a variable ASSIGNMENT in a header argument. +If the right hand side of the assignment has a literal value +return that value, otherwise interpret as a reference to an +external resource and find it's value using +`org-babel-ref-resolve-reference'. Return a list with two +elements. The first element of the list will be the name of the +variable, and the second will be an emacs-lisp representation of +the value of the variable." + (if (string-match org-babel-ref-split-regexp assignment) + (let ((var (match-string 1 assignment)) + (ref (match-string 2 assignment))) + (cons (intern var) + ((lambda (val) + (if (equal :ob-must-be-reference val) + (org-babel-ref-resolve-reference ref params) + val)) (org-babel-ref-literal ref)))))) + +(defun org-babel-ref-literal (ref) + "Return the value of REF if it is a literal value. +Determine if the right side of a header argument variable +assignment is a literal value or is a reference to some external +resource. REF should be a string of the right hand side of the +assignment. If REF is literal then return it's value, otherwise +return nil." + (let ((out (org-babel-read ref))) + (if (equal out ref) + (if (string-match "^\".+\"$" ref) + (read ref) + :ob-must-be-reference) + out))) + +(defvar org-babel-library-of-babel) +(defun org-babel-ref-resolve-reference (ref &optional params) + "Resolve the reference REF and return its value." + (save-excursion + (let ((case-fold-search t) + type args new-refere new-referent result lob-info split-file split-ref + index index-row index-col) + ;; 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-referent (match-string 2 ref)) + ;; (message "new-refere=%S, new-referent=%S" new-refere new-referent) ;; debugging + (when (> (length new-refere) 0) + (if (> (length new-referent) 0) + (setq args (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args new-referent)))) + ;; (message "args=%S" args) ;; debugging + (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 ((result_regexp (concat "^[ \t]*#\\+\\(TBLNAME\\|RESNAME\\|RESULTS\\):[ \t]*" + (regexp-quote ref) "[ \t]*$")) + (regexp (concat org-babel-src-name-regexp + (regexp-quote ref) "\\(\(.*\)\\)?" "[ \t]*$"))) + ;; goto ref in the current buffer + (or (and (not args) + (or (re-search-forward result_regexp nil t) + (re-search-backward result_regexp nil t))) + (re-search-forward regexp nil t) + (re-search-backward regexp nil t) + ;; check the Library of Babel + (setq lob-info (cdr (assoc (intern ref) org-babel-library-of-babel))))) + (unless lob-info (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)) + (if lob-info + (setq type 'lob) + (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")))) + (setq params (org-babel-merge-params params args '((:results . "silent")))) + (setq result + (case type + ('results-line (org-babel-read-result)) + ('table (org-babel-read-table)) + ('file (org-babel-read-link)) + ('source-block (org-babel-execute-src-block nil nil params)) + ('lob (org-babel-execute-src-block nil lob-info params)))) + (if (symbolp result) + (format "%S" result) + (if (and index (listp result)) + (org-babel-ref-index-list index result) + result)))))) + +(defun org-babel-ref-index-list (index lis) + "Return the subset of LIS indexed by INDEX. + +Indices are 0 based and negative indices count from the end of +LIS, so 0 references the first element of LIS and -1 references +the last. If INDEX is separated by \",\"s then each \"portion\" +is assumed to index into the next deepest nesting or dimension. + +A valid \"portion\" can consist of either an integer index, two +integers separated by a \":\" in which case the entire range is +returned, or an empty string or \"*\" both of which are +interpreted to mean the entire range and as such are equivalent +to \"0:-1\"." + (if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index)) + (let ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)") + (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) (org-babel-ref-index-list remainder sub-lis)) + (if (or (= 0 (length portion)) (string-match ind-re portion)) + (mapcar + (lambda (n) (nth n lis)) + (apply '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))))))) + lis)) + +(defun org-babel-ref-split-args (arg-string) + "Split ARG-STRING into top-level arguments of balanced parenthesis." + (let ((index 0) (depth 0) (buffer "") holder return) + ;; crawl along string, splitting at any ","s which are on the top level + (while (< index (length arg-string)) + (setq holder (substring arg-string index (+ 1 index))) + (setq buffer (concat buffer holder)) + (setq index (+ 1 index)) + (cond + ((string= holder ",") + (when (= depth 0) + (setq return (reverse (cons (substring buffer 0 -1) return))) + (setq buffer ""))) + ((or (string= holder "(") (string= holder "[")) (setq depth (+ depth 1))) + ((or (string= holder ")") (string= holder "]")) (setq depth (- depth 1))))) + (mapcar #'org-babel-trim (reverse (cons buffer return))))) + +(defvar org-bracket-link-regexp) +(defun org-babel-ref-at-ref-p () + "Return the type of reference located at point. +Return nil if none of the supported reference types are found. +Supported reference types are tables and source blocks." + (cond ((org-at-table-p) 'table) + ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block) + ((looking-at org-bracket-link-regexp) 'file) + ((looking-at org-babel-result-regexp) 'results-line))) + +(provide 'ob-ref) + +;; arch-tag: ace4a4f4-ea38-4dac-8fe6-6f52fcc43b6d + +;;; ob-ref.el ends here diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el new file mode 100644 index 00000000000..e557c80ef1a --- /dev/null +++ b/lisp/org/ob-ruby.el @@ -0,0 +1,254 @@ +;;; ob-ruby.el --- org-babel functions for ruby evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating ruby source code. + +;;; Requirements: + +;; - ruby and irb executables :: http://www.ruby-lang.org/ +;; +;; - ruby-mode :: Can be installed through ELPA, or from +;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el +;; +;; - inf-ruby mode :: Can be installed through ELPA, or from +;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function run-ruby "ext:inf-ruby" (&optional command name)) + +(add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb")) + +(defvar org-babel-default-header-args:ruby '()) + +(defvar org-babel-ruby-command "ruby" + "Name of command to use for executing ruby code.") + +(defun org-babel-expand-body:ruby (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (require 'inf-ruby) + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-ruby-var-to-ruby (cdr pair)))) + vars "\n") "\n" body "\n"))) + +(defun org-babel-execute:ruby (body params) + "Execute a block of Ruby code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-ruby-initiate-session (first processed-params))) + (result-params (nth 2 processed-params)) + (result-type (nth 3 processed-params)) + (full-body (org-babel-expand-body:ruby + body params processed-params)) + (result (org-babel-ruby-evaluate + session full-body result-type result-params))) + (or (cdr (assoc :file params)) + (org-babel-reassemble-table + result + (org-babel-pick-name (nth 4 processed-params) + (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) + (cdr (assoc :rownames params))))))) + +(defun org-babel-prep-session:ruby (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + ;; (message "params=%S" params) ;; debugging + (let* ((session (org-babel-ruby-initiate-session session)) + (vars (org-babel-ref-variables params)) + (var-lines (mapcar ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-ruby-var-to-ruby (cdr pair)))) + vars))) + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines)) + session)) + +(defun org-babel-load-session:ruby (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:ruby session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-ruby-var-to-ruby (var) + "Convert VAR into a ruby variable. +Convert an elisp value into a string of ruby source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]") + (format "%S" var))) + +(defun org-babel-ruby-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-ruby-initiate-session (&optional session params) + "Initiate a ruby session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session." + (require 'inf-ruby) + (unless (string= session "none") + (let ((session-buffer (save-window-excursion + (run-ruby nil session) (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-ruby-initiate-session session))))) + +(defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe" + "String to indicate that evaluation has completed.") +(defvar org-babel-ruby-f-write + "File.open('%s','w'){|f| f.write((_.class == String) ? _ : _.inspect)}") +(defvar org-babel-ruby-pp-f-write + "File.open('%s','w'){|f| $stdout = f; pp(results); $stdout = orig_out}") +(defvar org-babel-ruby-wrapper-method + " +def main() +%s +end +results = main() +File.open('%s', 'w'){ |f| f.write((results.class == String) ? results : results.inspect) } +") +(defvar org-babel-ruby-pp-wrapper-method + " +require 'pp' +def main() +%s +end +results = main() +File.open('%s', 'w') do |f| + $stdout = f + pp results +end +") + +(defun org-babel-ruby-evaluate + (buffer body &optional result-type result-params) + "Pass BODY to the Ruby process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (if (not buffer) + ;; external process evaluation + (case result-type + (output (org-babel-eval org-babel-ruby-command body)) + (value (let ((tmp-file (make-temp-file "org-babel-ruby-results-"))) + (org-babel-eval org-babel-ruby-command + (format (if (member "pp" result-params) + org-babel-ruby-pp-wrapper-method + org-babel-ruby-wrapper-method) + body tmp-file)) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-ruby-table-or-string raw))) + (org-babel-eval-read-file tmp-file))))) + ;; comint session evaluation + (case result-type + (output + (mapconcat + #'identity + (butlast + (split-string + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body org-babel-ruby-eoe-indicator)) + (comint-send-input nil t)) 2) + "\n") "[\r\n]")) "\n")) + (value + ((lambda (results) + (if (or (member "code" result-params) (member "pp" result-params)) + results + (org-babel-ruby-table-or-string results))) + (let* ((tmp-file (make-temp-file "org-babel-ruby-results-")) + (ppp (or (member "code" result-params) + (member "pp" result-params)))) + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (when ppp (insert "require 'pp';") (comint-send-input nil t)) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (append + (list body) + (if (not ppp) + (list (format org-babel-ruby-f-write tmp-file)) + (list + "results=_" "require 'pp'" "orig_out = $stdout" + (format org-babel-ruby-pp-f-write tmp-file))) + (list org-babel-ruby-eoe-indicator))) + (comint-send-input nil t)) + (org-babel-eval-read-file tmp-file))))))) + +(defun org-babel-ruby-read-string (string) + "Strip \\\"s from around a ruby string." + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(provide 'ob-ruby) + +;; arch-tag: 3e9726db-4520-49e2-b263-e8f571ac88f5 + +;;; ob-ruby.el ends here diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el new file mode 100644 index 00000000000..87f9ff46ecc --- /dev/null +++ b/lisp/org/ob-sass.el @@ -0,0 +1,70 @@ +;;; ob-sass.el --- org-babel functions for the sass css generation language + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; For more information on sass see http://sass-lang.com/ +;; +;; This accepts a 'file' header argument which is the target of the +;; compiled sass. The default output type for sass evaluation is +;; either file (if a 'file' header argument was given) or scalar if no +;; such header argument was supplied. +;; +;; A 'cmdline' header argument can be supplied to pass arguments to +;; the sass command line. + +;;; Requirements: + +;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:sass '()) + +(defun org-babel-expand-body:sass (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:sass (body params) + "Execute a block of Sass code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (file (cdr (assoc :file params))) + (out-file (or file (make-temp-file "org-babel-sass-out"))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (make-temp-file "org-babel-sass-in")) + (cmd (concat "sass " (or cmdline "") in-file " " out-file))) + (with-temp-file in-file + (insert (org-babel-expand-body:sass body params))) (shell-command cmd) + (or file (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) + +(defun org-babel-prep-session:sass (session params) + "Raise an error because sass does not support sessions." + (error "Sass does not support sessions")) + +(provide 'ob-sass) + +;; arch-tag: 2954b169-eef4-45ce-a8e5-3e619f0f07ac + +;;; ob-sass.el ends here diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el new file mode 100644 index 00000000000..7e575aa02ec --- /dev/null +++ b/lisp/org/ob-screen.el @@ -0,0 +1,154 @@ +;;; ob-screen.el --- org-babel support for interactive terminal + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Benjamin Andresen +;; Keywords: literate programming, interactive shell +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for interactive terminals. Mostly shell scripts. +;; Heavily inspired by 'eev' from Eduardo Ochs +;; +;; Adding :cmd and :terminal as header arguments +;; :terminal must support the -T (title) and -e (command) parameter +;; +;; You can test the default setup. (xterm + sh) with +;; M-x org-babel-screen-test RET + +;;; Code: +(require 'ob) +(require 'ob-ref) + +(defvar org-babel-screen-location "screen" + "The command location for screen. +In case you want to use a different screen than one selected by your $PATH") + +(defvar org-babel-default-header-args:screen + '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm")) + "Default arguments to use when running screen source blocks.") + +(defun org-babel-expand-body:screen (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:screen (body params) + "Send a block of code via screen to a terminal using Babel. +\"default\" session is be used when none is specified." + (message "Sending source code block to interactive terminal session...") + (save-window-excursion + (let* ((processed-params (org-babel-process-params params)) + (session (nth 0 processed-params)) + (socket (org-babel-screen-session-socketname session))) + (unless socket (org-babel-prep-session:screen session params)) + (org-babel-screen-session-execute-string + session (org-babel-expand-body:screen body params))))) + +(defun org-babel-prep-session:screen (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((processed-params (org-babel-process-params params)) + (session (nth 0 processed-params)) + (vars (nth 1 processed-params)) + (socket (org-babel-screen-session-socketname session)) + (vars (org-babel-ref-variables params)) + (cmd (cdr (assoc :cmd params))) + (terminal (cdr (assoc :terminal params))) + (process-name (concat "org-babel: terminal (" session ")"))) + (apply 'start-process process-name "*Messages*" + terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location + "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) + ,cmd)) + ;; XXX: Is there a better way than the following? + (while (not (org-babel-screen-session-socketname session)) + ;; wait until screen session is available before returning + ))) + +;; helper functions + +(defun org-babel-screen-session-execute-string (session body) + "If SESSION exists, send BODY to it." + (let ((socket (org-babel-screen-session-socketname session))) + (when socket + (let ((tmpfile (org-babel-screen-session-write-temp-file session body))) + (apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*" + org-babel-screen-location + `("-S" ,socket "-X" "eval" "msgwait 0" + ,(concat "readreg z " tmpfile) + "paste z")))))) + +(defun org-babel-screen-session-socketname (session) + "Check if SESSION exists by parsing output of \"screen -ls\"." + (let* ((screen-ls (shell-command-to-string "screen -ls")) + (sockets (delq + nil + (mapcar + (lambda (x) + (when (string-match (rx (or "(Attached)" "(Detached)")) x) + x)) + (split-string screen-ls "\n")))) + (match-socket (car + (delq + nil + (mapcar + (lambda (x) + (when (string-match + (concat "org-babel-session-" session) x) + x)) + sockets))))) + (when match-socket (car (split-string match-socket))))) + +(defun org-babel-screen-session-write-temp-file (session body) + "Save BODY in a temp file that is named after SESSION." + (let ((tmpfile (concat "/tmp/screen.org-babel-session-" session))) + (with-temp-file tmpfile + (insert body) + + ;; org-babel has superflous spaces + (goto-char (point-min)) + (delete-matching-lines "^ +$")) + tmpfile)) + +(defun org-babel-screen-test () + "Test if the default setup works. +The terminal should shortly flicker." + (interactive) + (let* ((session "org-babel-testing") + (random-string (format "%s" (random 99999))) + (tmpfile "/tmp/org-babel-screen.test") + (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) + process tmp-string) + (org-babel-execute:screen body org-babel-default-header-args:screen) + ;; XXX: need to find a better way to do the following + (while (not (file-readable-p tmpfile)) + ;; do something, otherwise this will be optimized away + (format "org-babel-screen: File not readable yet.")) + (setq tmp-string (with-temp-buffer + (insert-file-contents-literally tmpfile) + (buffer-substring (point-min) (point-max)))) + (delete-file tmpfile) + (message (concat "org-babel-screen: Setup " + (if (string-match random-string tmp-string) + "WORKS." + "DOESN'T work."))))) + +(provide 'ob-screen) + +;; arch-tag: 908e5afe-89a0-4f27-b982-23f1f2e3bac9 + +;;; ob-screen.el ends here diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el new file mode 100644 index 00000000000..072bc91af1c --- /dev/null +++ b/lisp/org/ob-sh.el @@ -0,0 +1,185 @@ +;;; ob-sh.el --- org-babel functions for shell evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating shell source code. + +;;; Code: +(require 'ob) +(require 'ob-comint) +(require 'ob-eval) +(require 'shell) +(eval-when-compile (require 'cl)) + +(declare-function org-babel-ref-variables "ob-ref" (params)) +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defvar org-babel-default-header-args:sh '()) + +(defvar org-babel-sh-command "sh" + "Command used to invoke a shell. +This will be passed to `shell-command-on-region'") + +(defun org-babel-expand-body:sh (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params)))) + (sep (cdr (assoc :separator params)))) + (concat + (mapconcat ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-sh-var-to-sh (cdr pair) sep))) + vars "\n") "\n" body "\n\n"))) + +(defun org-babel-execute:sh (body params) + "Execute a block of Shell commands with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-sh-initiate-session (nth 0 processed-params))) + (result-params (nth 2 processed-params)) + (full-body (org-babel-expand-body:sh + body params processed-params))) + (org-babel-reassemble-table + (org-babel-sh-evaluate session full-body result-params) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:sh (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-sh-initiate-session session)) + (vars (org-babel-ref-variables params)) + (sep (cdr (assoc :separator params))) + (var-lines (mapcar ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-sh-var-to-sh (cdr pair) sep))) + vars))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:sh (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:sh session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-sh-var-to-sh (var &optional sep) + "Convert an elisp value to a shell variable. +Convert an elisp var into a string of shell commands specifying a +var of the same value." + (if (listp var) + (flet ((deep-string (el) + (if (listp el) + (mapcar #'deep-string el) + (org-babel-sh-var-to-sh el sep)))) + (format "$(cat <<BABEL_TABLE\n%s\nBABEL_TABLE\n)" + (orgtbl-to-generic + (deep-string var) (list :sep (or sep "\t"))))) + (if (stringp var) + (if (string-match "[\n\r]" var) + (format "$(cat <<BABEL_STRING\n%s\nBABEL_STRING\n)" var) + (format "%s" var)) + (format "%S" var)))) + +(defun org-babel-sh-table-or-results (results) + "Convert RESULTS to an appropriate elisp value. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (string-match "^\\[.+\\]$" results) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-sh-initiate-session (&optional session params) + "Initiate a session named SESSION according to PARAMS." + (when (and session (not (string= session "none"))) + (save-window-excursion + (or (org-babel-comint-buffer-livep session) + (progn (shell session) (get-buffer (current-buffer))))))) + +(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'" + "String to indicate that evaluation has completed.") +(defvar org-babel-sh-eoe-output "org_babel_sh_eoe" + "String to indicate that evaluation has completed.") + +(defun org-babel-sh-evaluate (session body &optional result-params) + "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) + (if (or (member "scalar" result-params) + (member "output" result-params)) + results + (let ((tmp-file (make-temp-file "org-babel-sh"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file)))) + (if (not session) + (org-babel-eval org-babel-sh-command (org-babel-trim body)) + (let ((tmp-file (make-temp-file "org-babel-sh"))) + (mapconcat + #'org-babel-sh-strip-weird-long-prompt + (mapcar + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-sh-eoe-output t body) + (mapc + (lambda (line) + (insert line) (comint-send-input nil t) (sleep-for 0.25)) + (append + (split-string (org-babel-trim body) "\n") + (list org-babel-sh-eoe-indicator)))) + 2)) "\n"))))) + +(defun org-babel-sh-strip-weird-long-prompt (string) + "Remove prompt cruft from a string of shell output." + (while (string-match "^% +[\r\n$]+ *" string) + (setq string (substring string (match-end 0)))) + string) + +(provide 'ob-sh) + +;; arch-tag: 416dd531-c230-4b0a-a5bf-8d948f990f2d + +;;; ob-sh.el ends here diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el new file mode 100644 index 00000000000..184c755f7b8 --- /dev/null +++ b/lisp/org/ob-sql.el @@ -0,0 +1,90 @@ +;;; ob-sql.el --- org-babel functions for sql evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating sql source code. +;; +;; SQL is somewhat unique in that there are many different engines for +;; the evaluation of sql (Mysql, PostgreSQL, etc...), so much of this +;; file will have to be implemented engine by engine. +;; +;; Also SQL evaluation generally takes place inside of a database. +;; +;; For now lets just allow a generic ':cmdline' header argument. +;; +;; TODO: +;; +;; - support for sessions +;; - add more useful header arguments (user, passwd, database, etc...) +;; - support for more engines (currently only supports mysql) +;; - what's a reasonable way to drop table data into SQL? +;; + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function org-table-import "org-table" (file arg)) + +(defvar org-babel-default-header-args:sql '()) + +(defun org-babel-expand-body:sql (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:sql (body params) + "Execute a block of Sql code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (processed-params (org-babel-process-params params)) + (cmdline (cdr (assoc :cmdline params))) + (engine (cdr (assoc :engine params))) + (in-file (make-temp-file "org-babel-sql-in")) + (out-file (or (cdr (assoc :out-file params)) + (make-temp-file "org-babel-sql-out"))) + (command (case (intern engine) + ('mysql (format "mysql %s -e \"source %s\" > %s" + (or cmdline "") in-file out-file)) + (t (error "no support for the %s sql engine" engine))))) + (with-temp-file in-file + (insert (org-babel-expand-body:sql body params))) + (message command) + (shell-command command) + (with-temp-buffer + (org-table-import out-file nil) + (org-babel-reassemble-table + (org-table-to-lisp) + (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))) + + +(defun org-babel-prep-session:sql (session params) + "Raise an error because Sql sessions aren't implemented." + (error "sql sessions not yet implemented")) + +(provide 'ob-sql) + +;; arch-tag: a43ff944-6de1-4566-a83c-626814e3dad2 + +;;; ob-sql.el ends here diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el new file mode 100644 index 00000000000..7d6930abd4b --- /dev/null +++ b/lisp/org/ob-sqlite.el @@ -0,0 +1,152 @@ +;;; ob-sqlite.el --- org-babel functions for sqlite database interaction + +;; Copyright (C) 2010 Free Software Foundation + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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-Babel support for evaluating sqlite source code. + +;;; Code: +(require 'ob) +(require 'ob-ref) + +(declare-function org-fill-template "org" (template alist)) +(declare-function org-table-convert-region "org-table" + (beg0 end0 &optional separator)) +(declare-function orgtbl-to-csv "org-table" (TABLE PARAMS)) + +(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) + "Sqlite specific header args.") + +(defun org-babel-expand-body:sqlite (body params &optional processed-params) + (org-babel-sqlite-expand-vars + body (or (nth 1 processed-params) (org-babel-ref-variables params)))) + +(defvar org-babel-sqlite3-command "sqlite3") + +(defun org-babel-execute:sqlite (body params) + "Execute a block of Sqlite code with Babel. +This function is called by `org-babel-execute-src-block'." + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (vars (org-babel-ref-variables params)) + (db (cdr (assoc :db params))) + (separator (cdr (assoc :separator params))) + (nullvalue (cdr (assoc :nullvalue params))) + (headers-p (equal "yes" (cdr (assoc :colnames params)))) + (others (delq nil (mapcar + (lambda (arg) (car (assoc arg params))) + (list :header :echo :bail :column + :csv :html :line :list)))) + exit-code) + (unless db (error "ob-sqlite: can't evaluate without a database.")) + (with-temp-buffer + (insert + (shell-command-to-string + (org-fill-template + "%cmd -init %body %header %separator %nullvalue %others %csv %db " + (list + (cons "body" ((lambda (sql-file) + (with-temp-file sql-file + (insert (org-babel-expand-body:sqlite + body nil (list nil vars)))) + sql-file) + (make-temp-file "ob-sqlite-sql"))) + (cons "cmd" org-babel-sqlite3-command) + (cons "header" (if headers-p "-header" "-noheader")) + (cons "separator" + (if separator (format "-separator %s" separator) "")) + (cons "nullvalue" + (if nullvalue (format "-nullvalue %s" nullvalue) "")) + (cons "others" + (mapconcat + (lambda (arg) (format "-%s" (substring (symbol-name arg) 1))) + others " ")) + ;; for easy table parsing, default header type should be -csv + (cons "csv" (if (or (member :csv others) (member :column others) + (member :line others) (member :list others) + (member :html others) separator) + "" + "-csv")) + (cons "db " db))))) + (if (or (member "scalar" result-params) + (member "html" result-params) + (member "code" result-params) + (equal (point-min) (point-max))) + (buffer-string) + (org-table-convert-region (point-min) (point-max)) + (org-babel-sqlite-table-or-scalar + (org-babel-sqlite-offset-colnames + (org-table-to-lisp) headers-p)))))) + +(defun org-babel-sqlite-expand-vars (body vars) + "Expand the variables held in VARS in BODY." + (mapc + (lambda (pair) + (setq body + (replace-regexp-in-string + (format "\$%s" (car pair)) + ((lambda (val) + (if (listp val) + ((lambda (data-file) + (with-temp-file data-file + (insert (orgtbl-to-csv + val '(:fmt (lambda (el) (if (stringp el) + el + (format "%S" el))))))) + data-file) + (make-temp-file "ob-sqlite-data")) + (format "%S" val))) + (cdr pair)) + body))) + vars) + body) + +(defun org-babel-sqlite-table-or-scalar (result) + "If RESULT looks like a trivial table, then unwrap it." + (if (and (equal 1 (length result)) + (equal 1 (length (car result)))) + (org-babel-read (caar result)) + (mapcar (lambda (row) + (if (equal 'hline row) + 'hline + (mapcar #'org-babel-read row))) result))) + +(defun org-babel-sqlite-offset-colnames (table headers-p) + "If HEADERS-P is non-nil then offset the first row as column names." + (if headers-p + (cons (car table) (cons 'hline (cdr table))) + table)) + +(defun org-babel-prep-session:sqlite (session params) + "Raise an error because support for sqlite sessions isn't implemented. +Prepare SESSION according to the header arguments specified in PARAMS." + (error "sqlite sessions not yet implemented")) + +(provide 'ob-sqlite) + +;; arch-tag: 5c03d7f2-0f72-48b8-bbd1-35aafea248ac + +;;; ob-sqlite.el ends here diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el new file mode 100644 index 00000000000..f1506550829 --- /dev/null +++ b/lisp/org/ob-table.el @@ -0,0 +1,109 @@ +;;; ob-table.el --- support for calling org-babel functions from tables + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; Should allow calling functions from org-mode tables using the +;; function `sbe' as so... + +;; #+begin_src emacs-lisp :results silent +;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2))))) +;; #+end_src + +;; #+srcname: fibbd +;; #+begin_src emacs-lisp :var n=2 :results silent +;; (fibbd n) +;; #+end_src + +;; | original | fibbd | +;; |----------+--------| +;; | 0 | | +;; | 1 | | +;; | 2 | | +;; | 3 | | +;; | 4 | | +;; | 5 | | +;; | 6 | | +;; | 7 | | +;; | 8 | | +;; | 9 | | +;; #+TBLFM: $2='(sbe 'fibbd (n $1)) + +;;; Code: +(require 'ob) + +(defun org-babel-table-truncate-at-newline (string) + "Replace newline character with ellipses. +If STRING ends in a newline character, then remove the newline +character and replace it with ellipses." + (if (and (stringp string) (string-match "[\n\r]" string)) + (concat (substring string 0 (match-beginning 0)) "...") + string)) + +(defmacro sbe (source-block &rest variables) + "Return the results of calling SOURCE-BLOCK with VARIABLES. +Each element of VARIABLES should be a two +element list, whose first element is the name of the variable and +second element is a string of its value. The following call to +`sbe' would be equivalent to the following source code block. + + (sbe 'source-block (n $2) (m 3)) + +#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent +results +#+end_src + +NOTE: by default string variable names are interpreted as +references to source-code blocks, to force interpretation of a +cell's value as a string, prefix the identifier with two \"$\"s +rather than a single \"$\" (i.e. \"$$2\" instead of \"$2\" in the +example above." + (let ((variables (mapcar + (lambda (var) + (if (and (= 3 (length var)) (eq (nth 1 var) '$)) + (list (car var) (format "\"%s\"" (last var))) + var)) + variables))) + (unless (stringp source-block) (setq source-block (symbol-name source-block))) + (org-babel-table-truncate-at-newline ;; org-table cells can't be multi-line + (if (and source-block (> (length source-block) 0)) + (let ((params + (eval `(org-babel-parse-header-arguments + (concat ":var results=" + ,source-block + "(" + (mapconcat (lambda (var-spec) + (format "%S=%s" (nth 0 var-spec) (nth 1 var-spec))) + ',variables ", ") + ")"))))) + (org-babel-execute-src-block + nil (list "emacs-lisp" "results" + (org-babel-merge-params '((:results . "silent")) params)))) + "")))) + +(provide 'ob-table) + +;; arch-tag: 4234cc7c-4fc8-4e92-abb0-2892de1a493b + +;;; ob-table.el ends here diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el new file mode 100644 index 00000000000..85f69ede357 --- /dev/null +++ b/lisp/org/ob-tangle.el @@ -0,0 +1,300 @@ +;;; ob-tangle.el --- extract source code from org-mode files + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; Extract the code from source blocks out into raw source-code files. + +;;; Code: +(require 'ob) +(require 'org-src) +(eval-when-compile + (require 'cl)) + +(declare-function org-link-escape "org" (text &optional table)) +(declare-function org-heading-components "org" ()) + +(defcustom org-babel-tangle-lang-exts + '(("emacs-lisp" . "el")) + "Alist mapping languages to their file extensions. +The key is the language name, the value is the string that should +be inserted as the extension commonly used to identify files +written in this language. If no entry is found in this list, +then the name of the language is used." + :group 'org-babel-tangle + :type '(repeat + (cons + (string "Language name") + (string "File Extension")))) + +(defcustom org-babel-post-tangle-hook nil + "Hook run in code files tangled by `org-babel-tangle'." + :group 'org-babel + :type 'hook) + +(defmacro org-babel-with-temp-filebuffer (file &rest body) + "Open FILE into a temporary buffer execute BODY there like +`progn', then kill the FILE buffer returning the result of +evaluating BODY." + (declare (indent 1)) + (let ((temp-result (make-symbol "temp-result")) + (temp-file (make-symbol "temp-file"))) + `(let (,temp-result ,temp-file) + (find-file ,file) + (setf ,temp-file (current-buffer)) + (setf ,temp-result (progn ,@body)) + (kill-buffer ,temp-file) + ,temp-result))) + +;;;###autoload +(defun org-babel-load-file (file) + "Load Emacs Lisp source code blocks in the Org-mode FILE. +This function exports the source code using +`org-babel-tangle' and then loads the resulting file using +`load-file'." + (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)))) + +;;;###autoload +(defun org-babel-tangle-file (file &optional target-file lang) + "Extract the bodies of source code blocks in FILE. +Source code blocks are extracted with `org-babel-tangle'. +Optional argument TARGET-FILE can be used to specify a default +export file for all source blocks. Optional argument LANG can be +used to limit the exported source code blocks by language." + (interactive "fFile to tangle: \nP") + (let ((visited-p (get-file-buffer (expand-file-name file))) + to-be-removed) + (save-window-excursion + (find-file file) + (setq to-be-removed (current-buffer)) + (org-babel-tangle target-file lang)) + (unless visited-p + (kill-buffer to-be-removed)))) + +(defun org-babel-tangle-publish (_ filename pub-dir) + "Tangle FILENAME and place the results in PUB-DIR." + (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) + +;;;###autoload +(defun org-babel-tangle (&optional target-file lang) + "Write code blocks to source-specific files. +Extract the bodies of all source code blocks from the current +file into their own source-specific files. Optional argument +TARGET-FILE can be used to specify a default export file for all +source blocks. Optional argument LANG can be used to limit the +exported source code blocks by language." + (interactive) + (save-buffer) + (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 2 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 + ;; 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) (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 ?\755)) + ;; 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" block-counter + (if (= block-counter 1) "" "s")) + ;; 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'. +Call this function inside of a source-code file generated by +`org-babel-tangle' to remove all comments inserted automatically +by `org-babel-tangle'. Warning, this comment removes any lines +containing constructs which resemble org-mode file links or noweb +references." + (interactive) + (goto-char (point-min)) + (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t) + (re-search-forward "<<[^[:space:]]*>>" 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) +(defun org-babel-tangle-collect-blocks (&optional lang) + "Collect source blocks in the current Org-mode file. +Return an association list of source-code block specifications of +the form used by `org-babel-spec-to-string' grouped by language. +Optional argument LANG can be used to limit the collected source +code blocks by language." + (let ((block-counter 1) (current-heading "") blocks) + (org-babel-map-src-blocks (buffer-file-name) + ((lambda (new-heading) + (if (not (string= new-heading current-heading)) + (progn + (setq block-counter 1) + (setq current-heading new-heading)) + (setq block-counter (+ 1 block-counter)))) + (replace-regexp-in-string "[ \t]" "-" + (nth 4 (org-heading-components)))) + (let* ((link (progn (call-interactively 'org-store-link) + (org-babel-clean-text-properties + (car (pop org-stored-links))))) + (info (org-babel-get-src-block-info)) + (source-name (intern (or (nth 4 info) + (format "%s:%d" + current-heading block-counter)))) + (src-lang (nth 0 info)) + (expand-cmd (intern (concat "org-babel-expand-body:" src-lang))) + (params (nth 2 info)) + by-lang) + (unless (string= (cdr (assoc :tangle params)) "no") ;; skip + (unless (and lang (not (string= lang src-lang))) ;; limit by language + ;; add the spec for this block to blocks under it's language + (setq by-lang (cdr (assoc src-lang blocks))) + (setq blocks (delq (assoc src-lang blocks) blocks)) + (setq blocks + (cons + (cons src-lang + (cons (list link source-name params + ((lambda (body) + (if (assoc :no-expand params) + body + (funcall + (if (fboundp expand-cmd) + expand-cmd + 'org-babel-expand-body:generic) + body + params))) + (if (and (cdr (assoc :noweb params)) + (string= + "yes" + (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references + info) + (nth 1 info)))) + by-lang)) blocks)))))) + ;; ensure blocks in the correct order + (setq blocks + (mapcar + (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) + 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 + + (link source-name params body)" + (let ((link (nth 0 spec)) + (source-name (nth 1 spec)) + (body (nth 3 spec)) + (commentable (string= (cdr (assoc :comments (nth 2 spec))) "yes"))) + (flet ((insert-comment (text) + (when commentable + (insert "\n") + (comment-region (point) + (progn (insert text) (point))) + (end-of-line nil) + (insert "\n")))) + (insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name)) + (insert (format "\n%s\n" (replace-regexp-in-string + "^," "" (org-babel-chomp body)))) + (insert-comment (format "%s ends here" source-name))))) + +(provide 'ob-tangle) + +;; arch-tag: 413ced93-48f5-4216-86e4-3fc5df8c8f24 + +;;; ob-tangle.el ends here diff --git a/lisp/org/ob.el b/lisp/org/ob.el new file mode 100644 index 00000000000..4aee07f26ab --- /dev/null +++ b/lisp/org/ob.el @@ -0,0 +1,1592 @@ +;;; ob.el --- working with code blocks in org-mode + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; 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: + +;; See the online documentation for more information +;; +;; http://orgmode.org/worg/org-contrib/babel/ + +;;; Code: +(eval-when-compile (require 'cl)) +(require 'org-macs) + +(defvar org-babel-call-process-region-original) +(declare-function show-all "outline" ()) +(declare-function tramp-compat-make-temp-file "tramp-compat" + (filename &optional dir-flag)) +(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) +(declare-function tramp-file-name-user "tramp" (vec)) +(declare-function tramp-file-name-host "tramp" (vec)) +(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-edit-src-code "org-src" + (&optional context code edit-buffer-name)) +(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-narrow-to-subtree "org" ()) +(declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-make-options-regexp "org" (kwds &optional extra)) +(declare-function org-do-remove-indentation "org" (&optional n)) +(declare-function org-show-context "org" (&optional key)) +(declare-function org-at-table-p "org" (&optional table-type)) +(declare-function org-cycle "org" (&optional arg)) +(declare-function org-uniquify "org" (list)) +(declare-function org-table-import "org-table" (file arg)) +(declare-function org-add-hook "org-compat" (hook function &optional append local)) +(declare-function org-table-align "org-table" ()) +(declare-function org-table-end "org-table" (&optional table-type)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-orgtbl "org-table" (table params)) +(declare-function org-babel-lob-get-info "ob-lob" nil) +(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) +(declare-function org-babel-ref-variables "ob-ref" (params)) +(declare-function org-babel-ref-resolve-reference "ob-ref" (ref &optional params)) + +(defgroup org-babel nil + "Code block evaluation and management in `org-mode' documents." + :tag "Babel" + :group 'org) + +(defcustom org-confirm-babel-evaluate t + "Confirm before evaluation. +Require confirmation before interactively evaluating code +blocks in Org-mode buffers. The default value of this variable +is t, meaning confirmation is required for any code block +evaluation. This variable can be set to nil to inhibit any +future confirmation requests. This variable can also be set to a +function which takes two arguments the language of the code block +and the body of the code block. Such a function should then +return a non-nil value if the user should be prompted for +execution or nil if no prompt is required. + +Warning: Disabling confirmation may result in accidental +evaluation of potentially harmful code. It may be advisable +remove code block execution from C-c C-c as further protection +against accidental code block evaluation. The +`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to +remove code block execution from the C-c C-c keybinding." + :group 'org-babel + :type '(choice boolean function)) +;; don't allow this variable to be changed through file settings +(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) + +(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil + "Remove code block evaluation from the C-c C-c key binding." + :group 'org-babel + :type 'boolean) + +(defvar org-babel-src-name-regexp + "^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*" + "Regular expression used to match a source name line.") + +(defvar org-babel-src-name-w-name-regexp + (concat org-babel-src-name-regexp + "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)") + "Regular expression matching source name lines with a name.") + +(defvar org-babel-src-block-regexp + (concat + ;; (1) indentation (2) lang + "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*" + ;; (3) switches + "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)" + ;; (4) header arguments + "\\([^\n]*\\)\n" + ;; (5) body + "\\([^\000]+?\n\\)[ \t]*#\\+end_src") + "Regexp used to identify code blocks.") + +(defvar org-babel-inline-src-block-regexp + (concat + ;; (1) replacement target (2) lang + "[ \f\t\n\r\v]\\(src_\\([^ \f\t\n\r\v]+\\)" + ;; (3,4) (unused, headers) + "\\(\\|\\[\\(.*?\\)\\]\\)" + ;; (5) body + "{\\([^\f\n\r\v]+?\\)}\\)") + "Regexp used to identify inline src-blocks.") + +(defun org-babel-get-src-block-info (&optional header-vars-only) + "Get information on the current source block. + +Returns a list + (language body header-arguments-alist switches name function-args indent). +Unless HEADER-VARS-ONLY is non-nil, any variable +references provided in 'function call style' (i.e. in a +parenthesised argument list following the src block name) are +added to the header-arguments-alist." + (let ((case-fold-search t) head info args indent) + (if (setq head (org-babel-where-is-src-block-head)) + (save-excursion + (goto-char head) + (setq info (org-babel-parse-src-block-match)) + (setq indent (car (last info))) + (setq info (butlast info)) + (forward-line -1) + (if (and (looking-at org-babel-src-name-w-name-regexp) + (match-string 2)) + (progn + (setq info (append info (list (org-babel-clean-text-properties + (match-string 2))))) + ;; Note that e.g. "name()" and "name( )" result in + ;; ((:var . "")). We maintain that behaviour, and the + ;; resulting non-nil sixth element is relied upon in + ;; org-babel-exp-code to detect a functional-style + ;; block in those cases. However, "name" without any + ;; parentheses would result in the same thing, so we + ;; explicitly avoid that. + (if (setq args (match-string 4)) + (setq info + (append info (list + (mapcar + (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args args)))))) + (unless header-vars-only + (setf (nth 2 info) + (org-babel-merge-params (nth 5 info) (nth 2 info))))) + (setq info (append info (list nil nil)))) + (append info (list indent))) + (if (save-excursion ;; inline source block + (re-search-backward "[ \f\t\n\r\v]" nil t) + (looking-at org-babel-inline-src-block-regexp)) + (org-babel-parse-inline-src-block-match) + nil)))) + +(defun org-babel-confirm-evaluate (info) + "Confirm evaluation of the code block INFO. +This behavior can be suppressed by setting the value of +`org-confirm-babel-evaluate' to nil, in which case all future +interactive code block evaluations will proceed without any +confirmation from the user. + +Note disabling confirmation may result in accidental evaluation +of potentially harmful code." + (let* ((eval (cdr (assoc :eval (nth 2 info)))) + (query (or (equal eval "query") + (and (functionp org-confirm-babel-evaluate) + (funcall org-confirm-babel-evaluate + (nth 0 info) (nth 1 info))) + org-confirm-babel-evaluate))) + (when (or (equal eval "never") + (and query + (not (yes-or-no-p + (format "Evaluate this%scode on your system? " + (if info (format " %s " (nth 0 info)) " ")))))) + (error "evaluation aborted")))) + +;;;###autoload +(defun org-babel-execute-src-block-maybe () + "Conditionally execute a source block. +Detect if this is context for a Babel src-block and if so +then run `org-babel-execute-src-block'." + (interactive) + (if (not org-babel-no-eval-on-ctrl-c-ctrl-c) + (let ((info (org-babel-get-src-block-info))) + (if info + (progn (org-babel-execute-src-block current-prefix-arg info) t) nil)) + nil)) +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe) + +;;;###autoload +(defun org-babel-expand-src-block-maybe () + "Conditionally expand a source block. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-expand-src-block'." + (interactive) + (let ((info (org-babel-get-src-block-info))) + (if info + (progn (org-babel-expand-src-block current-prefix-arg info) t) + nil))) + +;;;###autoload +(defun org-babel-load-in-session-maybe () + "Conditionally load a source block in a session. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-load-in-session'." + (interactive) + (let ((info (org-babel-get-src-block-info))) + (if info + (progn (org-babel-load-in-session current-prefix-arg info) t) + nil))) + +(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe) + +;;;###autoload +(defun org-babel-pop-to-session-maybe () + "Conditionally pop to a session. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-pop-to-session'." + (interactive) + (let ((info (org-babel-get-src-block-info))) + (if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil))) + +(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe) + +(defconst org-babel-header-arg-names + '(cache cmdline colnames dir exports file noweb results + session tangle var noeval comments) + "Common header arguments used by org-babel. +Note that individual languages may define their own language +specific header arguments as well.") + +(defvar org-babel-default-header-args + '((:session . "none") (:results . "replace") (:exports . "code") + (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")) + "Default arguments to use when evaluating a source block.") + +(defvar org-babel-default-inline-header-args + '((:session . "none") (:results . "silent") (:exports . "results")) + "Default arguments to use when evaluating an inline source block.") + +(defvar org-babel-current-buffer-properties) +(make-variable-buffer-local 'org-babel-current-buffer-properties) + +(defvar org-babel-result-regexp + "^[ \t]*#\\+res\\(ults\\|name\\)\\(\\[\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*" + "Regular expression used to match result lines. +If the results are associated with a hash key then the hash will +be saved in the second match data.") + +(defvar org-babel-result-w-name-regexp + (concat org-babel-result-regexp + "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")) + +(defvar org-babel-min-lines-for-block-output 10 + "The minimum number of lines for block output. +If number of lines of output is equal to or exceeds this +value, the output is placed in a #+begin_example...#+end_example +block. Otherwise the output is marked as literal by inserting +colons at the starts of the lines. This variable only takes +effect if the :results output option is in effect.") + +(defvar org-babel-noweb-error-langs nil + "Languages for which Babel will raise literate programming errors. +List of languages for which errors should be raised when the +source code block satisfying a noweb reference in this language +can not be resolved.") + +(defvar org-babel-hash-show 4 + "Number of initial characters to show of a hidden results hash.") + +(defvar org-babel-after-execute-hook nil + "Hook for functions to be called after `org-babel-execute-src-block'") +(defun org-babel-named-src-block-regexp-for-name (name) + "This generates a regexp used to match a src block named NAME." + (concat org-babel-src-name-regexp (regexp-quote name) "[ \t\n]*" + (substring org-babel-src-block-regexp 1))) + +;;; functions +(defvar call-process-region) +;;;###autoload +(defun org-babel-execute-src-block (&optional arg info params) + "Execute the current source code block. +Insert the results of execution into the buffer. Source code +execution and the collection and formatting of results can be +controlled through a variety of header arguments. + +Optionally supply a value for INFO in the form returned by +`org-babel-get-src-block-info'. + +Optionally supply a value for PARAMS which will be merged with +the header arguments specified at the front of the source code +block." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + ;; note the `evaluation-confirmed' variable is currently not + ;; used, but could be used later to avoid the need for + ;; chaining confirmations + (evaluation-confirmed (org-babel-confirm-evaluate info)) + (lang (nth 0 info)) + (params (setf (nth 2 info) + (sort (org-babel-merge-params (nth 2 info) params) + (lambda (el1 el2) (string< (symbol-name (car el1)) + (symbol-name (car el2))))))) + (new-hash + (if (and (cdr (assoc :cache params)) + (string= "yes" (cdr (assoc :cache params)))) + (org-babel-sha1-hash info))) + (old-hash (org-babel-result-hash info)) + (body (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (result-params (split-string (or (cdr (assoc :results params)) ""))) + (result-type (cond ((member "output" result-params) 'output) + ((member "value" result-params) 'value) + (t 'value))) + (cmd (intern (concat "org-babel-execute:" lang))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (org-babel-call-process-region-original + (if (boundp 'org-babel-call-process-region-original) org-babel-call-process-region-original + (symbol-function 'call-process-region))) + (indent (car (last info))) + result) + (unwind-protect + (flet ((call-process-region (&rest args) + (apply 'org-babel-tramp-handle-call-process-region args))) + (unless (fboundp cmd) + (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 + (goto-char (org-babel-where-is-src-block-result nil info)) + (end-of-line 1) (forward-char 1) + (setq result (org-babel-read-result)) + (message (replace-regexp-in-string "%" "%%" + (format "%S" result))) result) + (message "executing %s code block%s..." + (capitalize lang) + (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) + (setq result (funcall cmd body params)) + (if (eq result-type 'value) + (setq result (if (and (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result)) + result))) + (org-babel-insert-result + result result-params info new-hash indent lang) + (run-hooks 'org-babel-after-execute-hook) + result)) + (setq call-process-region 'org-babel-call-process-region-original)))) + +(defun org-babel-expand-body:generic (body params &optional processed-params) + "Expand BODY with PARAMS. +Expand a block of code with org-babel according to it's header +arguments. This generic implementation of body expansion is +called for languages which have not defined their own specific +org-babel-expand-body:lang function." body) + +;;;###autoload +(defun org-babel-expand-src-block (&optional arg info params) + "Expand the current source code block. +Expand according to the source code block's header +arguments and pop open the results in a preview buffer." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (params (setf (nth 2 info) + (sort (org-babel-merge-params (nth 2 info) params) + (lambda (el1 el2) (string< (symbol-name (car el1)) + (symbol-name (car el2))))))) + (body (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) (nth 1 info)))) + (cmd (intern (concat "org-babel-expand-body:" lang))) + (expanded (funcall (if (fboundp cmd) cmd 'org-babel-expand-body:generic) + body params))) + (org-edit-src-code + nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")))) + +;;;###autoload +(defun org-babel-load-in-session (&optional arg info) + "Load the body of the current source-code block. +Evaluate the header arguments for the source block before +entering the session. After loading the body this pops open the +session." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (body (nth 1 info)) + (params (nth 2 info)) + (session (cdr (assoc :session params))) + (cmd (intern (concat "org-babel-load-session:" lang)))) + (unless (fboundp cmd) + (error "No org-babel-load-session function for %s!" lang)) + (pop-to-buffer (funcall cmd session body params)) + (end-of-line 1))) + +;;;###autoload +(defun org-babel-switch-to-session (&optional arg info) + "Switch to the session of the current source-code block. +If called with a prefix argument then evaluate the header arguments +for the source block before entering the session. Copy the body +of the source block to the kill ring." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (body (nth 1 info)) + (params (nth 2 info)) + (session (cdr (assoc :session params))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (cmd (intern (format "org-babel-%s-initiate-session" lang))) + (cmd2 (intern (concat "org-babel-prep-session:" lang)))) + (unless (fboundp cmd) + (error "No org-babel-initiate-session function for %s!" lang)) + ;; copy body to the kill ring + (with-temp-buffer (insert (org-babel-trim body)) + (copy-region-as-kill (point-min) (point-max))) + ;; if called with a prefix argument, then process header arguments + (unless (fboundp cmd2) + (error "No org-babel-prep-session function for %s!" lang)) + (when arg (funcall cmd2 session params)) + ;; just to the session using pop-to-buffer + (pop-to-buffer (funcall cmd session params)) + (end-of-line 1))) + +(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) + +(defvar org-bracket-link-regexp) +;;;###autoload +(defun org-babel-open-src-block-result (&optional re-run) + "If `point' is on a src block then open the results of the +source code block, otherwise return nil. With optional prefix +argument RE-RUN the source-code block is evaluated even if +results already exist." + (interactive "P") + (when (org-babel-get-src-block-info) + (save-excursion + ;; go to the results, if there aren't any then run the block + (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result)) + (progn (org-babel-execute-src-block) + (org-babel-where-is-src-block-result)))) + (end-of-line 1) + (while (looking-at "[\n\r\t\f ]") (forward-char 1)) + ;; open the results + (if (looking-at org-bracket-link-regexp) + ;; file results + (org-open-at-point) + (let ((results (org-babel-read-result))) + (flet ((echo-res (result) + (if (stringp result) result (format "%S" result)))) + (pop-to-buffer (get-buffer-create "org-babel-results")) + (delete-region (point-min) (point-max)) + (if (listp results) + ;; table result + (insert (orgtbl-to-generic results '(:sep "\t" :fmt echo-res))) + ;; scalar result + (insert (echo-res results)))))) + t))) + +;;;###autoload +(defun org-babel-execute-buffer (&optional arg) + "Execute source code blocks in a buffer. +Call `org-babel-execute-src-block' on every source block in +the current buffer." + (interactive "P") + (save-excursion + (org-save-outline-visibility t + (goto-char (point-min)) + (show-all) + (while (re-search-forward org-babel-src-block-regexp nil t) + (let ((pos-end (match-end 0))) + (goto-char (match-beginning 0)) + (org-babel-execute-src-block arg) + (goto-char pos-end)))))) + +;;;###autoload +(defun org-babel-execute-subtree (&optional arg) + "Execute source code blocks in a subtree. +Call `org-babel-execute-src-block' on every source block in +the current subtree." + (interactive "P") + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (org-babel-execute-buffer) + (widen)))) + +;;;###autoload +(defun org-babel-sha1-hash (&optional info) + "Generate an sha1 hash based on the value of info." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (hash (sha1 (format "%s-%s" (mapconcat (lambda (arg) (format "%S" arg)) + (nth 2 info) ":") + (nth 1 info))))) + (when (interactive-p) (message hash)) + hash)) + +(defun org-babel-result-hash (&optional info) + "Return the in-buffer hash associated with INFO." + (org-babel-where-is-src-block-result nil info) + (org-babel-clean-text-properties (match-string 3))) + +(defun org-babel-hide-hash () + "Hide the hash in the current results line. +Only the initial `org-babel-hash-show' characters of the hash +will remain visible." + (add-to-invisibility-spec '(org-babel-hide-hash . t)) + (save-excursion + (when (and (re-search-forward org-babel-result-regexp nil t) + (match-string 3)) + (let* ((start (match-beginning 3)) + (hide-start (+ org-babel-hash-show start)) + (end (match-end 3)) + (hash (match-string 3)) + ov1 ov2) + (setq ov1 (make-overlay start hide-start)) + (setq ov2 (make-overlay hide-start end)) + (overlay-put ov2 'invisible 'org-babel-hide-hash) + (overlay-put ov1 'babel-hash hash))))) + +(defun org-babel-hide-all-hashes () + "Hide the hash in the current buffer. +Only the initial `org-babel-hash-show' characters of each hash +will remain visible. This function should be called as part of +the `org-mode-hook'." + (save-excursion + (while (re-search-forward org-babel-result-regexp nil t) + (goto-char (match-beginning 0)) + (org-babel-hide-hash) + (goto-char (match-end 0))))) +(add-hook 'org-mode-hook 'org-babel-hide-all-hashes) + +(defun org-babel-hash-at-point (&optional point) + "Return the value of the hash at POINT. +The hash is also added as the last element of the kill ring. +This can be called with C-c C-c." + (interactive) + (let ((hash (car (delq nil (mapcar + (lambda (ol) (overlay-get ol 'babel-hash)) + (overlays-at (or point (point)))))))) + (when hash (kill-new hash) (message hash)))) +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point) + +(defun org-babel-result-hide-spec () + "Hide portions of results lines. +Add `org-babel-hide-result' as an invisibility spec for hiding +portions of results lines." + (add-to-invisibility-spec '(org-babel-hide-result . t))) +(add-hook 'org-mode-hook 'org-babel-result-hide-spec) + +(defvar org-babel-hide-result-overlays nil + "Overlays hiding results.") + +(defun org-babel-result-hide-all () + "Fold all results in the current buffer." + (interactive) + (org-babel-show-result-all) + (save-excursion + (while (re-search-forward org-babel-result-regexp nil t) + (save-excursion (goto-char (match-beginning 0)) + (org-babel-hide-result-toggle-maybe))))) + +(defun org-babel-show-result-all () + "Unfold all results in the current buffer." + (mapc 'delete-overlay org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays nil)) + +;;;###autoload +(defun org-babel-hide-result-toggle-maybe () + "Toggle visibility of result at point." + (interactive) + (let ((case-fold-search t)) + (if (save-excursion + (beginning-of-line 1) + (looking-at org-babel-result-regexp)) + (progn (org-babel-hide-result-toggle) + t) ;; to signal that we took action + nil))) ;; to signal that we did not + +(defun org-babel-hide-result-toggle (&optional force) + "Toggle the visibility of the current result." + (interactive) + (save-excursion + (beginning-of-line) + (if (re-search-forward org-babel-result-regexp nil t) + (let ((start (progn (beginning-of-line 2) (- (point) 1))) + (end (progn (goto-char (- (org-babel-result-end) 1)) (point))) + ov) + (if (memq t (mapcar (lambda (overlay) + (eq (overlay-get overlay 'invisible) + 'org-babel-hide-result)) + (overlays-at start))) + (if (or (not force) (eq force 'off)) + (mapc (lambda (ov) + (when (member ov org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays + (delq ov org-babel-hide-result-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-babel-hide-result) + (delete-overlay ov))) + (overlays-at start))) + (setq ov (make-overlay start end)) + (overlay-put ov 'invisible 'org-babel-hide-result) + ;; make the block accessible to isearch + (overlay-put + ov 'isearch-open-invisible + (lambda (ov) + (when (member ov org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays + (delq ov org-babel-hide-result-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-babel-hide-result) + (delete-overlay ov)))) + (push ov org-babel-hide-result-overlays))) + (error "Not looking at a result line")))) + +;; org-tab-after-check-for-cycling-hook +(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) +;; Remove overlays when changing major mode +(add-hook 'org-mode-hook + (lambda () (org-add-hook 'change-major-mode-hook + 'org-babel-show-result-all 'append 'local))) + +(defmacro org-babel-map-src-blocks (file &rest body) + "Evaluate BODY forms on each source-block in FILE." + (declare (indent 1)) + `(let ((visited-p (get-file-buffer (expand-file-name ,file))) + to-be-removed) + (save-window-excursion + (find-file ,file) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward org-babel-src-block-regexp nil t) + (goto-char (match-beginning 0)) + (save-match-data ,@body) + (goto-char (match-end 0)))) + (unless visited-p + (kill-buffer to-be-removed)))) + +(defvar org-file-properties) +(defun org-babel-params-from-properties (&optional lang) + "Retrieve parameters specified as properties. +Return an association list of any source block params which +may be specified in the properties of the current outline entry." + (save-match-data + (let (val sym) + (delq nil + (mapcar + (lambda (header-arg) + (and (setq val + (or (condition-case nil + (org-entry-get (point) header-arg t) + (error nil)) + (cdr (assoc header-arg org-file-properties)))) + (cons (intern (concat ":" header-arg)) 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)))))))))) + +(defun org-babel-params-from-buffer () + "Retrieve per-buffer parameters. + Return an association list of any source block params which +may be specified at the top of the current buffer." + (or org-babel-current-buffer-properties + (setq org-babel-current-buffer-properties + (save-match-data + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (when (re-search-forward + (org-make-options-regexp (list "BABEL")) nil t) + (org-babel-parse-header-arguments + (org-match-string-no-properties 2))))))))) + +(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-headers (intern (concat "org-babel-default-header-args:" lang))) + (switches (match-string 3)) + (body (org-babel-clean-text-properties (match-string 5))) + (preserve-indentation (or org-src-preserve-indentation + (string-match "-i\\>" switches)))) + (list lang + ;; get block body less properties, protective commas, and indentation + (with-temp-buffer + (save-match-data + (insert (org-babel-strip-protective-commas body)) + (unless preserve-indentation (org-do-remove-indentation)) + (buffer-string))) + (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (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) "")))) + 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))) + (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))) + (org-babel-merge-params + org-babel-default-inline-header-args + (org-babel-params-from-buffer) + (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) ""))))))) + +(defun org-babel-parse-header-arguments (arg-string) + "Parse a string of header arguments returning an alist." + (if (> (length arg-string) 0) + (delq nil + (mapcar + (lambda (arg) + (if (string-match + "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" + arg) + (cons (intern (concat ":" (match-string 1 arg))) + (let ((raw (org-babel-chomp (match-string 2 arg)))) + (if (org-babel-number-p raw) + raw (org-babel-read raw)))) + (cons (intern (concat ":" arg)) nil))) + (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t))))) + +(defun org-babel-process-params (params) + "Parse params and resolve references. + +Return a list (session vars result-params result-type colnames rownames)." + (let* ((session (cdr (assoc :session params))) + (vars-and-names (org-babel-disassemble-tables + (org-babel-ref-variables params) + (cdr (assoc :hlines params)) + (cdr (assoc :colnames params)) + (cdr (assoc :rownames params)))) + (vars (car vars-and-names)) + (colnames (cadr vars-and-names)) + (rownames (caddr vars-and-names)) + (result-params (split-string (or (cdr (assoc :results params)) ""))) + (result-type (cond ((member "output" result-params) 'output) + ((member "value" result-params) 'value) + (t 'value)))) + (list session vars result-params result-type colnames rownames))) + +;; row and column names +(defun org-babel-del-hlines (table) + "Remove all 'hlines from TABLE." + (remove 'hline table)) + +(defun org-babel-get-colnames (table) + "Return the column names of TABLE. +Return a cons cell, the `car' of which contains the TABLE less +colnames, and the `cdr' of which contains a list of the column +names." + (if (equal 'hline (nth 1 table)) + (cons (cddr table) (car table)) + (cons (cdr table) (car table)))) + +(defun org-babel-get-rownames (table) + "Return the row names of TABLE. +Return a cons cell, the `car' of which contains the TABLE less +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)))))) + +(defun org-babel-put-colnames (table colnames) + "Add COLNAMES to TABLE if they exist." + (if colnames (apply 'list colnames 'hline table) table)) + +(defun org-babel-put-rownames (table rownames) + "Add ROWNAMES to TABLE if they exist." + (if rownames + (mapcar (lambda (row) + (if (listp row) + (cons (or (pop rownames) "") row) + row)) table) + table)) + +(defun org-babel-pick-name (names selector) + "Select one out of an alist of row or column names." + (when names + (if (and selector (symbolp selector) (not (equal t selector))) + (cdr (assoc selector names)) + (if (integerp selector) + (nth (- selector 1) names) + (cdr (car (last names))))))) + +(defun org-babel-disassemble-tables (vars hlines colnames rownames) + "Parse tables for further processing. +Process the variables in VARS according to the HLINES, +ROWNAMES and COLNAMES header arguments. Return a list consisting +of the vars, cnames and rnames." + (let (cnames rnames) + (list + (mapcar + (lambda (var) + (when (listp (cdr var)) + (when (and (not (equal colnames "no")) + (or colnames (and (equal (nth 1 (cdr var)) 'hline) + (not (member 'hline (cddr (cdr var))))))) + (let ((both (org-babel-get-colnames (cdr var)))) + (setq cnames (cons (cons (car var) (cdr both)) + cnames)) + (setq var (cons (car var) (car both))))) + (when (and rownames (not (equal rownames "no"))) + (let ((both (org-babel-get-rownames (cdr var)))) + (setq rnames (cons (cons (car var) (cdr both)) + rnames)) + (setq var (cons (car var) (car both))))) + (when (and hlines (not (equal hlines "yes"))) + (setq var (cons (car var) (org-babel-del-hlines (cdr var)))))) + var) + vars) + cnames rnames))) + +(defun org-babel-reassemble-table (table colnames rownames) + "Add column and row names to a table. +Given a TABLE and set of COLNAMES and ROWNAMES add the names +to the table for reinsertion to org-mode." + (if (listp table) + ((lambda (table) + (if (and colnames (listp (car table)) (= (length (car table)) + (length colnames))) + (org-babel-put-colnames table colnames) table)) + (if (and rownames (= (length table) (length rownames))) + (org-babel-put-rownames table rownames) table)) + table)) + +(defun org-babel-where-is-src-block-head () + "Find where the current source block begins. +Return the point at the beginning of the current source +block. Specifically at the beginning of the #+BEGIN_SRC line. +If the point is not on a source block then return nil." + (let ((initial (point)) top bottom) + (or + (save-excursion ;; on a source name line + (beginning-of-line 1) + (and (looking-at org-babel-src-name-regexp) (forward-line 1) + (looking-at org-babel-src-block-regexp) + (point))) + (save-excursion ;; on a #+begin_src line + (beginning-of-line 1) + (and (looking-at org-babel-src-block-regexp) + (point))) + (save-excursion ;; inside a src block + (and + (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point)) + (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point)) + (< top initial) (< initial bottom) + (progn (goto-char top) (beginning-of-line 1) + (looking-at org-babel-src-block-regexp)) + (point)))))) + +;;;###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 ((point (org-babel-find-named-block name))) + (if point + ;; taken from `org-open-at-point' + (progn (goto-char point) (org-show-context)) + (message "source-code block '%s' not found in this buffer" name)))) + +(defun org-babel-find-named-block (name) + "Find a named source-code block. +Return the location of the source block identified by source +NAME, or nil if no such block exists. Set match data according to +org-babel-named-src-block-regexp." + (save-excursion + (let ((case-fold-search t) + (regexp (org-babel-named-src-block-regexp-for-name name)) msg) + (goto-char (point-min)) + (when (or (re-search-forward regexp nil t) + (re-search-backward regexp nil t)) + (match-beginning 0))))) + +(defun org-babel-src-block-names (&optional file) + "Returns the names of source blocks in FILE or the current buffer." + (save-excursion + (when file (find-file file)) (goto-char (point-min)) + (let (names) + (while (re-search-forward org-babel-src-name-w-name-regexp nil t) + (setq names (cons (org-babel-clean-text-properties (match-string 2)) + names))) + names))) + +;;;###autoload +(defun org-babel-goto-named-result (name) + "Go to a named result." + (interactive + (let ((completion-ignore-case t)) + (list (org-icompleting-read "source-block name: " + (org-babel-result-names) nil t)))) + (let ((point (org-babel-find-named-result name))) + (if point + ;; taken from `org-open-at-point' + (progn (goto-char point) (org-show-context)) + (message "result '%s' not found in this buffer" name)))) + +(defun org-babel-find-named-result (name) + "Find a named result. +Return the location of the result named NAME in the current +buffer or nil if no such result exists." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward + (concat org-babel-result-regexp + "[ \t]" (regexp-quote name) "[ \t\n\f\v\r]") nil t) + (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) + (while (re-search-forward org-babel-result-w-name-regexp nil t) + (setq names (cons (org-babel-clean-text-properties (match-string 4)) + names))) + names))) + +;;;###autoload +(defun org-babel-next-src-block (&optional arg) + "Jump to the next source block. +With optional prefix argument ARG, jump forward ARG many source blocks." + (interactive "P") + (when (looking-at org-babel-src-block-regexp) (forward-char 1)) + (re-search-forward org-babel-src-block-regexp nil nil (or arg 1)) + (goto-char (match-beginning 0)) (org-show-context)) + +;;;###autoload +(defun org-babel-previous-src-block (&optional arg) + "Jump to the previous source block. +With optional prefix argument ARG, jump backward ARG many source blocks." + (interactive "P") + (re-search-backward org-babel-src-block-regexp nil nil (or arg 1)) + (goto-char (match-beginning 0)) (org-show-context)) + +(defvar org-babel-lob-one-liner-regexp) +(defun org-babel-where-is-src-block-result (&optional insert info hash indent) + "Find where the current source block results begin. +Return the point at the beginning of the result of the current +source block. Specifically at the beginning of the results line. +If no result exists for this block then create a results line +following the source block." + (save-excursion + (let* ((on-lob-line (progn (beginning-of-line 1) + (looking-at org-babel-lob-one-liner-regexp))) + (name (if on-lob-line + (nth 0 (org-babel-lob-get-info)) + (nth 4 (or info (org-babel-get-src-block-info))))) + (head (unless on-lob-line (org-babel-where-is-src-block-head))) + found beg end) + (when head (goto-char head)) + (setq + found ;; was there a result (before we potentially insert one) + (or + (and + ;; named results: + ;; - return t if it is found, else return nil + ;; - if it does not need to be rebuilt, then don't set end + ;; - if it does need to be rebuilt then do set end + name (setq beg (org-babel-find-named-result name)) + (prog1 beg + (when (and hash (not (string= hash (match-string 3)))) + (goto-char beg) (setq end beg) ;; beginning of result + (forward-line 1) + (delete-region end (org-babel-result-end)) nil))) + (and + ;; unnamed results: + ;; - return t if it is found, else return nil + ;; - if it is found, and the hash doesn't match, delete and set end + (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t)) + (progn (end-of-line 1) + (if (eobp) (insert "\n") (forward-char 1)) + (setq end (point)) + (or (and (not name) + (progn ;; unnamed results line already exists + (re-search-forward "[^ \f\t\n\r\v]" nil t) + (beginning-of-line 1) + (looking-at + (concat org-babel-result-regexp "\n"))) + (prog1 (point) + ;; must remove and rebuild if hash!=old-hash + (if (and hash (not (string= hash (match-string 3)))) + (prog1 nil + (forward-line 1) + (delete-region + end (org-babel-result-end))) + (setq end nil))))))))) + (if (and insert end) + (progn + (goto-char end) + (unless beg + (if (looking-at "[\n\r]") (forward-char 1) (insert "\n"))) + (insert (concat + (if indent + (mapconcat + (lambda (el) " ") + (number-sequence 1 indent) "") + "") + "#+results" + (when hash (concat "["hash"]")) + ":" + (when name (concat " " name)) "\n")) + (unless beg (insert "\n") (backward-char)) + (beginning-of-line 0) + (if hash (org-babel-hide-hash)) + (point)) + found)))) + +(defvar org-block-regexp) +(defun org-babel-read-result () + "Read the result at `point' into emacs-lisp." + (let ((case-fold-search t) result-string) + (cond + ((org-at-table-p) (org-babel-read-table)) + ((looking-at org-bracket-link-regexp) (org-babel-read-link)) + ((looking-at org-block-regexp) (org-babel-trim (match-string 4))) + ((looking-at "^[ \t]*: ") + (setq result-string + (org-babel-trim + (mapconcat (lambda (line) + (if (and (> (length line) 1) + (string-match "^[ \t]*: \\(.+\\)" line)) + (match-string 1 line) + line)) + (split-string + (buffer-substring + (point) (org-babel-result-end)) "[\r\n]+") + "\n"))) + (or (org-babel-number-p result-string) result-string)) + ((looking-at org-babel-result-regexp) + (save-excursion (forward-line 1) (org-babel-read-result)))))) + +(defun org-babel-read-table () + "Read the table at `point' into emacs-lisp." + (mapcar (lambda (row) + (if (and (symbolp row) (equal row 'hline)) row + (mapcar #'org-babel-read row))) + (org-table-to-lisp))) + +(defvar org-link-types-re) +(defun org-babel-read-link () + "Read the link at `point' into emacs-lisp. +If the path of the link is a file path it is expanded using +`expand-file-name'." + (let* ((case-fold-search t) + (raw (and (looking-at org-bracket-link-regexp) + (org-babel-clean-text-properties (match-string 1)))) + (type (and (string-match org-link-types-re raw) + (match-string 1 raw)))) + (cond + ((not type) (expand-file-name raw)) + ((string= type "file") + (and (string-match "file\\(.*\\):\\(.+\\)" raw) + (expand-file-name (match-string 2 raw)))) + (t raw)))) + +(defun org-babel-insert-result + (result &optional result-params info hash indent lang) + "Insert RESULT into the current buffer. +By default RESULT is inserted after the end of the +current source block. With optional argument RESULT-PARAMS +controls insertion of results in the org-mode file. +RESULT-PARAMS can take the following values... + +replace - (default option) insert results after the source block + replacing any previously inserted results + +silent -- no results are inserted + +file ---- the results are interpreted as a file path, and are + inserted into the buffer using the Org-mode file syntax + +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. + +org ----- this is the same as the 'raw' option + +html ---- results are added inside of a #+BEGIN_HTML block. This + is a good option if you code block will output html + formatted text. + +latex --- results are added inside of a #+BEGIN_LATEX block. + This is a good option if you code block will output + latex formatted text. + +code ---- the results are extracted in the syntax of the source + code of the language being evaluated and are added + inside of a #+BEGIN_SRC block with the source-code + language set appropriately. Note this relies on the + optional LANG argument." + (if (stringp result) + (progn + (setq result (org-babel-clean-text-properties result)) + (when (member "file" result-params) + (setq result (org-babel-result-to-file result)))) + (unless (listp result) (setq result (format "%S" result)))) + (if (= (length result) 0) + (if (member "value" result-params) + (message "No result returned by source block") + (message "Source block produced no output")) + (if (and result-params (member "silent" result-params)) + (progn + (message (replace-regexp-in-string "%" "%%" (format "%S" result))) + result) + (when (and (stringp result) ;; ensure results end in a newline + (not (or (string-equal (substring result -1) "\n") + (string-equal (substring result -1) "\r")))) + (setq result (concat result "\n"))) + (save-excursion + (let ((existing-result (org-babel-where-is-src-block-result + t info hash indent)) + (results-switches + (cdr (assoc :results_switches (nth 2 info)))) + beg end) + (when existing-result + (goto-char existing-result) + (save-excursion + (re-search-forward "#" nil t) + (setq indent (- (current-column) 1))) + (forward-line 1) + (setq beg (point)) + (cond + ((member "replace" result-params) + (delete-region (point) (org-babel-result-end))) + ((member "append" result-params) + (goto-char (org-babel-result-end)) (setq beg (point))) + ((member "prepend" result-params) ;; already there + ))) + (setq results-switches + (if results-switches (concat " " results-switches) "")) + (cond + ;; assume the result is a table if it's not a string + ((not (stringp result)) + (insert (concat (orgtbl-to-orgtbl + (if (or (eq 'hline (car result)) + (and (listp (car result)) + (listp (cdr (car result))))) + result (list result)) + '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) + (goto-char beg) (when (org-at-table-p) (org-table-align))) + ((member "file" result-params) + (insert result)) + ((member "html" result-params) + (insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n" + results-switches result))) + ((member "latex" result-params) + (insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n" + results-switches result))) + ((member "code" result-params) + (insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n" + (or lang "none") results-switches result))) + ((or (member "raw" result-params) (member "org" result-params)) + (save-excursion (insert result)) (if (org-at-table-p) (org-cycle))) + (t + (org-babel-examplize-region + (point) (progn (insert result) (point)) results-switches))) + ;; possibly indent the results to match the #+results line + (setq end (if (listp result) (org-table-end) (point))) + (when (and indent (> indent 0) + ;; in this case `table-align' does the work for us + (not (and (listp result) + (member "append" result-params)))) + (indent-rigidly beg end indent)))) + (message "finished")))) + +(defun org-babel-remove-result (&optional info) + "Remove the result of the current source block." + (interactive) + (let ((location (org-babel-where-is-src-block-result nil info)) start) + (when location + (save-excursion + (goto-char location) (setq start (point)) (forward-line 1) + (delete-region start (org-babel-result-end)))))) + +(defun org-babel-result-end () + "Return the point at the end of the current set of results" + (save-excursion + (if (org-at-table-p) + (progn (goto-char (org-table-end)) (point)) + (let ((case-fold-search t)) + (cond + ((looking-at "[ \t]*#\\+begin_latex") + (re-search-forward "[ \t]*#\\+end_latex" nil t) + (forward-line 1)) + ((looking-at "[ \t]*#\\+begin_html") + (re-search-forward "[ \t]*#\\+end_html" nil t) + (forward-line 1)) + ((looking-at "[ \t]*#\\+begin_example") + (re-search-forward "[ \t]*#\\+end_example" nil t) + (forward-line 1)) + ((looking-at "[ \t]*#\\+begin_src") + (re-search-forward "[ \t]*#\\+end_src" nil t) + (forward-line 1)) + (t (progn (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") + (forward-line 1)))))) + (point)))) + +(defun org-babel-result-to-file (result) + "Convert RESULT into an `org-mode' link. +If the `default-directory' is different from the containing +file's directory then expand relative links." + (format + "[[file:%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))) + +(defun org-babel-examplize-region (beg end &optional results-switches) + "Comment out region using the ': ' org example quote." + (interactive "*r") + (let ((size (count-lines beg end))) + (save-excursion + (cond ((= size 0) + (error (concat "This should be impossible:" + "a newline was appended to result if missing"))) + ((< size org-babel-min-lines-for-block-output) + (goto-char beg) + (dotimes (n size) + (beginning-of-line 1) (insert ": ") (forward-line 1))) + (t + (goto-char beg) + (insert (if results-switches + (format "#+begin_example%s\n" results-switches) + "#+begin_example\n")) + (forward-char (- end beg)) + (insert "#+end_example\n")))))) + +(defun org-babel-merge-params (&rest plists) + "Combine all parameter association lists in PLISTS. +Later elements of PLISTS override the values of previous element. +This takes into account some special considerations for certain +parameters when merging lists." + (let ((results-exclusive-groups + '(("file" "vector" "table" "scalar" "raw" "org" + "html" "latex" "code" "pp") + ("replace" "silent" "append" "prepend") + ("output" "value"))) + (exports-exclusive-groups + '(("code" "results" "both" "none"))) + params results exports tangle noweb cache vars var ref shebang comments) + (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 + ;; we want only one specification per variable + (when (string-match + (concat "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" + "[ \t]*\\([^\f\n\r\v]+\\)$") (cdr pair)) + ;; TODO: When is this not true? + (setq var (intern (match-string 1 (cdr pair))) + ref (match-string 2 (cdr pair)) + vars (cons (cons var ref) + (assq-delete-all var vars))))) + (:results + (setq results + (e-merge results-exclusive-groups + results (split-string (cdr pair))))) + (: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")) noweb + (split-string (or (cdr pair) ""))))) + (:cache + (setq cache + (e-merge '(("yes" "no")) cache + (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)) + (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars)) + (while vars (setq params (cons (cons :var (pop vars)) params))) + (cons (cons :comments (mapconcat 'identity comments " ")) + (cons (cons :shebang (mapconcat 'identity shebang " ")) + (cons (cons :cache (mapconcat 'identity cache " ")) + (cons (cons :noweb (mapconcat 'identity noweb " ")) + (cons (cons :tangle (mapconcat 'identity tangle " ")) + (cons (cons :exports + (mapconcat 'identity exports " ")) + (cons + (cons :results + (mapconcat 'identity results " ")) + params))))))))) + +(defun org-babel-expand-noweb-references (&optional info parent-buffer) + "Expand Noweb references in the body of the current source code block. + +For example the following reference would be replaced with the +body of the source-code block named 'example-block'. + +<<example-block>> + +Note that any text preceding the <<foo>> construct on a line will +be interposed between the lines of the replacement text. So for +example if <<foo>> is placed behind a comment, then the entire +replacement text will also be commented. + +This function must be called from inside of the buffer containing +the source-code block which holds BODY. + +In addition the following syntax can be used to insert the +results of evaluating the source-code block named 'example-block'. + +<<example-block()>> + +Any optional arguments can be passed to example-block by placing +the arguments inside the parenthesis following the convention +defined by `org-babel-lob'. For example + +<<example-block(a=9)>> + +would set the value of argument \"a\" equal to \"9\". Note that +these arguments are not evaluated in the current source-code +block but are passed literally to the \"example-block\"." + (let* ((parent-buffer (or parent-buffer (current-buffer))) + (info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (body (nth 1 info)) + (new-body "") index source-name evaluate prefix) + (flet ((nb-add (text) + (setq new-body (concat new-body text)))) + (with-temp-buffer + (insert body) (goto-char (point-min)) + (setq index (point)) + (while (and (re-search-forward "<<\\(.+?\\)>>" 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 + (mapconcat ;; interpose PREFIX between every line + #'identity + (split-string + (if evaluate + (let ((raw (org-babel-ref-resolve-reference + source-name nil))) + (if (stringp raw) raw (format "%S" raw))) + (save-restriction + (widen) + (let ((point (org-babel-find-named-block + source-name))) + (if point + (save-excursion + (goto-char point) + (org-babel-trim + (org-babel-expand-noweb-references + (org-babel-get-src-block-info)))) + ;; optionally raise an error if named + ;; source-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))))) + 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) + "Strip protective commas from bodies of source blocks." + (replace-regexp-in-string "^,#" "#" body)) + +(defun org-babel-read (cell) + "Convert the string value of CELL to a number if appropriate. +Otherwise if cell looks like lisp (meaning it starts with a +\"(\" or a \"'\") then read it as lisp, otherwise return it +unmodified as a string. + +This is taken almost directly from `org-read-prop'." + (if (and (stringp cell) (not (equal cell ""))) + (or (org-babel-number-p cell) + (if (or (equal "(" (substring cell 0 1)) + (equal "'" (substring cell 0 1)) + (equal "`" (substring cell 0 1))) + (eval (read cell)) + (progn (set-text-properties 0 (length cell) nil cell) cell))) + cell)) + +(defun org-babel-number-p (string) + "Return t if STRING represents a number." + (if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string) + (= (length (substring string (match-beginning 0) + (match-end 0))) + (length string))) + (string-to-number string))) + +(defun org-babel-import-elisp-from-file (file-name) + "Read the results located at FILE-NAME into an elisp table. +If the table is trivial, then return it as a scalar." + (let (result) + (save-window-excursion + (with-temp-buffer + (condition-case nil + (progn + (org-table-import file-name nil) + (delete-file file-name) + (setq result (mapcar (lambda (row) + (mapcar #'org-babel-string-read row)) + (org-table-to-lisp)))) + (error nil))) + (if (null (cdr result)) ;; if result is trivial vector, then scalarize it + (if (consp (car result)) + (if (null (cdr (car result))) + (caar result) + result) + (car result)) + result)))) + +(defun org-babel-string-read (cell) + "Strip nested \"s from around strings." + (org-babel-read (or (and (stringp cell) + (string-match "\\\"\\(.+\\)\\\"" cell) + (match-string 1 cell)) + cell))) + +(defun org-babel-reverse-string (string) + "Return the reverse of STRING." + (apply 'string (reverse (string-to-list string)))) + +(defun org-babel-chomp (string &optional regexp) + "Strip trailing spaces and carriage returns from STRING. +Default regexp used is \"[ \f\t\n\r\v]\" but can be +overwritten by specifying a regexp as a second argument." + (let ((regexp (or regexp "[ \f\t\n\r\v]"))) + (while (and (> (length string) 0) + (string-match regexp (substring string -1))) + (setq string (substring string 0 -1))) + string)) + +(defun org-babel-trim (string &optional regexp) + "Strip leading and trailing spaces and carriage returns from STRING. +Like `org-babel-chomp' only it runs on both the front and back +of the string." + (org-babel-chomp (org-babel-reverse-string + (org-babel-chomp (org-babel-reverse-string string) regexp)) + regexp)) + +(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. +Fixes a bug in `tramp-handle-call-process-region'." + (if (and (featurep 'tramp) (file-remote-p default-directory)) + (let ((tmpfile (tramp-compat-make-temp-file ""))) + (write-region start end tmpfile) + (when delete (delete-region start end)) + (unwind-protect + ;; (apply 'call-process program tmpfile buffer display args) + ;; bug in tramp + (apply 'process-file program tmpfile buffer display args) + (delete-file tmpfile))) + ;; org-babel-call-process-region-original is the original emacs definition. It + ;; is in scope from the let binding in org-babel-execute-src-block + (apply org-babel-call-process-region-original + start end program delete buffer display args))) + +(defun org-babel-maybe-remote-file (file) + "Conditionally parse information on a remote connnection. +If FILE specifies a remove file, then parse the information on +the remote connection." + (if (file-remote-p default-directory) + (let* ((vec (tramp-dissect-file-name default-directory)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-host vec))) + (concat "/" user (when user "@") host ":" file)) + file)) + +(provide 'ob) + +;; arch-tag: 01a7ebee-06c5-4ee4-a709-e660d28c0af1 + +;;; ob.el ends here diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 50e78528256..a3d288065d3 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -32,8 +32,7 @@ (require 'org) (eval-when-compile - (require 'cl) - (require 'calendar)) + (require 'cl)) (declare-function diary-add-to-list "diary-lib" (date string specifier &optional marker globcolor literal)) @@ -143,8 +142,8 @@ specifies the maximum number of lines that will be added for each entry that is listed in the agenda view. Note that this variable is not used during display, only when exporting -the agenda. For agenda display, see org-agenda-entry-text-mode and the -variable `org-agenda-entry-text-maxlines'." +the agenda. For agenda display, see the variables `org-agenda-entry-text-mode' +and `org-agenda-entry-text-maxlines'." :group 'org-agenda :type 'integer) @@ -198,6 +197,11 @@ you can \"misuse\" it to also add other text to the header. However, :group 'org-export-html :type 'string) +(defcustom org-agenda-persistent-filter nil + "When set, keep filters from one agenda view to the next." + :group 'org-agenda + :type 'boolean) + (defgroup org-agenda-custom-commands nil "Options concerning agenda views in Org-mode." :tag "Org Agenda Custom Commands" @@ -212,6 +216,7 @@ you can \"misuse\" it to also add other text to the header. However, (const todo-state-up) (const todo-state-down) (const effort-up) (const effort-down) (const habit-up) (const habit-down) + (const alpha-up) (const alpha-down) (const user-defined-up) (const user-defined-down)) "Sorting choices.") @@ -590,7 +595,7 @@ to make his option also apply to the tags-todo list." There are different motivations for using different values, please think carefully when configuring this variable. -This applie when creating the global todo list. +This applies when creating the global todo list. Valid values are: near Don't show near deadline entries. A deadline is near when it is @@ -757,7 +762,7 @@ Needs to be set before org.el is loaded." :type 'boolean) (defcustom org-agenda-start-with-follow-mode nil - "The initial value of follow-mode in a newly created agenda window." + "The initial value of follow mode in a newly created agenda window." :group 'org-agenda-startup :type 'boolean) @@ -1003,7 +1008,7 @@ When this is non-nil, the string will be split on whitespace, and each snippet will be searched individually, and all must match in order to select an entry. A snippet is then a single string of non-white characters, or a string in double quotes, or a regexp in {} braces. -If a snippet is preceeded by \"-\", the snippet must *not* match. +If a snippet is preceded by \"-\", the snippet must *not* match. \"+\" is syntactic sugar for positive selection. Each snippet may be found as a full word or a partial word, but see the variable `org-agenda-search-view-force-full-words'. @@ -1013,7 +1018,7 @@ with each space character matching any amount of whitespace, including line breaks. Even when this is nil, you can still switch to Boolean search dynamically -by preceeding the first snippet with \"+\" or \"-\". If the first snippet +by preceding the first snippet with \"+\" or \"-\". If the first snippet is a regexp marked with braces like \"{abc}\", this will also switch to boolean search." :group 'org-agenda-search-view @@ -1024,8 +1029,7 @@ boolean search." 'org-agenda-search-view-always-boolean)) (defcustom org-agenda-search-view-force-full-words nil - "Non-nil me -ans, search words must be matches as complete words. + "Non-nil means, search words must be matches as complete words. When nil, they may also match part of a word." :group 'org-agenda-search-view :type 'boolean) @@ -1121,6 +1125,8 @@ user-defined-up Sort according to `org-agenda-cmp-user-defined', high last. user-defined-down Sort according to `org-agenda-cmp-user-defined', high first. habit-up Put entries that are habits first habit-down Put entries that are habits last +alpha-up Sort headlines alphabetically +alpha-down Sort headlines alphabetically, reversed The different possibilities will be tried in sequence, and testing stops if one comparison returns a \"not-equal\". For example, the default @@ -1279,7 +1285,7 @@ range, respectively." (function)))) (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") - "Text preceeding scheduled items in the agenda view. + "Text preceding scheduled items in the agenda view. This is a list with two strings. The first applies when the item is scheduled on the current day. The second applies when it has been scheduled previously, it may contain a %d indicating that this is the nth time that @@ -1292,7 +1298,7 @@ that passed since this item was scheduled first." (string :tag "Scheduled previously"))) (defcustom org-agenda-inactive-leader "[" - "Text preceeding item pulled into the agenda by inactive time stamps. + "Text preceding item pulled into the agenda by inactive time stamps. These entries are added to the agenda when pressing \"[\"." :group 'org-agenda-line-format :type '(list @@ -1300,7 +1306,7 @@ These entries are added to the agenda when pressing \"[\"." (string :tag "Scheduled previously"))) (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") - "Text preceeding deadline items in the agenda view. + "Text preceding deadline items in the agenda view. This is a list with two strings. The first applies when the item has its deadline on the current day. The second applies when it is in the past or in the future, it may contain %d to capture how many days away the deadline @@ -1321,7 +1327,7 @@ placed into the prefix. If this option is non-nil, the original specification 11:30-4pm) will be removed for agenda display. This makes the agenda less cluttered. The option can be t or nil. It may also be the symbol `beg', indicating -that the time should only be removed what it is located at the beginning of +that the time should only be removed when it is located at the beginning of the headline/diary entry." :group 'org-agenda-line-format :type '(choice @@ -1329,6 +1335,11 @@ the headline/diary entry." (const :tag "Never" nil) (const :tag "When at beginning of entry" beg))) +(defcustom org-agenda-remove-timeranges-from-blocks nil + "Non-nil means remove time ranges specifications in agenda +items that span on several days." + :group 'org-agenda-line-format + :type 'boolean) (defcustom org-agenda-default-appointment-duration nil "Default duration for appointments that only have a starting time. @@ -1347,7 +1358,7 @@ When non-nil, this must be the number of minutes, e.g. 60 for one hour." (defcustom org-agenda-hide-tags-regexp nil "Regular expression used to filter away specific tags in agenda views. This means that these tags will be present, but not be shown in the agenda -line. Secondayt filltering will still work on the hidden tags. +line. Secondary filtering will still work on the hidden tags. Nil means don't hide any tags." :group 'org-agenda-line-format :type '(choice @@ -1382,7 +1393,7 @@ it means that the tags should be flushright to that column. For example, (defcustom org-agenda-fontify-priorities 'cookies "Non-nil means highlight low and high priorities in agenda. When t, the highest priority entries are bold, lowest priority italic. -However, settings in org-priority-faces will overrule these faces. +However, settings in `org-priority-faces' will overrule these faces. When this variable is the symbol `cookies', only fontify the cookies, not the entire task. This may also be an association list of priority faces, whose @@ -1485,7 +1496,7 @@ 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 for `org-agenda-mode', run after the mode is turned on.") (defvar org-agenda-type nil) (defvar org-agenda-force-single-file nil) (defvar org-agenda-bulk-marked-entries) ;; Defined further down in this file @@ -1663,10 +1674,8 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) -(org-defkey org-agenda-mode-map - (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) -(org-defkey org-agenda-mode-map - (if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) +(org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse) +(org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse) (when org-agenda-mouse-1-follows-link (org-defkey org-agenda-mode-map [follow-link] 'mouse-face)) (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" @@ -1967,7 +1976,6 @@ Pressing `<' twice means to restrict to the current subtree or region (move-marker org-agenda-restrict-end (progn (org-end-of-subtree t))))))) - (require 'calendar) ; FIXME: can we avoid this for some commands? ;; For example the todo list should not need it (but does...) (cond ((setq entry (assoc keys org-agenda-custom-commands)) @@ -2256,7 +2264,7 @@ s Search for keywords C Configure custom agenda commands If CMD-KEY is a string of length 1, it is used as a key in `org-agenda-custom-commands' and triggers this command. If it is a longer string it is used as a tags/todo match string. -Paramters are alternating variable names and values that will be bound +Parameters are alternating variable names and values that will be bound before running the agenda command." (let (pars) (while parameters @@ -2284,7 +2292,7 @@ before running the agenda command." If CMD-KEY is a string of length 1, it is used as a key in `org-agenda-custom-commands' and triggers this command. If it is a longer string it is used as a tags/todo match string. -Paramters are alternating variable names and values that will be bound +Parameters are alternating variable names and values that will be bound before running the agenda command. The output gives a line for each selected agenda item. Each @@ -2339,8 +2347,8 @@ agenda-day The day in the agenda where this is listed" (princ "\n")))))) (defun org-fix-agenda-info (props) - "Make sure all properties on an agenda item have a canonical form, -so the export commands can easily use it." + "Make sure all properties on an agenda item have a canonical form. +This ensures the export commands can easily use it." (let (tmp re) (when (setq tmp (plist-get props 'tags)) (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) @@ -2446,7 +2454,7 @@ higher priority settings." ((string-match "\\.html?\\'" file) (require 'htmlize)) ((string-match "\\.ps\\'" file) (require 'ps-print))) (org-let (if nosettings nil org-agenda-exporter-settings) - '(save-excursion + `(save-excursion (save-window-excursion (org-agenda-mark-filtered-text) (let ((bs (copy-sequence (buffer-string))) beg) @@ -2478,14 +2486,14 @@ higher priority settings." (message "HTML written to %s" file)) ((string-match "\\.ps\\'" file) (require 'ps-print) - (flet ((ps-get-buffer-name () "Agenda View")) - (ps-print-buffer-with-faces file)) + ,(flet ((ps-get-buffer-name () "Agenda View")) + (ps-print-buffer-with-faces file)) (message "Postscript written to %s" file)) ((string-match "\\.pdf\\'" file) (require 'ps-print) - (flet ((ps-get-buffer-name () "Agenda View")) - (ps-print-buffer-with-faces - (concat (file-name-sans-extension file) ".ps"))) + ,(flet ((ps-get-buffer-name () "Agenda View")) + (ps-print-buffer-with-faces + (concat (file-name-sans-extension file) ".ps"))) (call-process "ps2pdf" nil nil nil (expand-file-name (concat (file-name-sans-extension file) ".ps")) @@ -2518,9 +2526,9 @@ higher priority settings." (let ((inhibit-read-only t)) (mapc (lambda (o) - (when (equal (org-overlay-buffer o) (current-buffer)) + (when (equal (overlay-buffer o) (current-buffer)) (put-text-property - (org-overlay-start o) (org-overlay-end o) + (overlay-start o) (overlay-end o) 'org-filtered t))) org-agenda-filter-overlays))) @@ -2706,7 +2714,7 @@ removed from the entry content. Currently only `planning' is allowed here." (defvar org-agenda-filter nil) (defvar org-agenda-filter-preset nil "A preset of the tags filter used for secondary agenda filtering. -This must be a list of strings, each string must be a single tag preceeded +This must be a list of strings, each string must be a single tag preceded by \"+\" or \"-\". This variable should not be set directly, but agenda custom commands can bind it in the options section.") @@ -2715,7 +2723,8 @@ bind it in the options section.") (setq org-todo-keywords-for-agenda nil) (setq org-done-keywords-for-agenda nil) (setq org-drawers-for-agenda nil) - (setq org-agenda-filter nil) + (unless org-agenda-persistent-filter + (setq org-agenda-filter nil)) (put 'org-agenda-filter :preset-filter org-agenda-filter-preset) (if org-agenda-multi (progn @@ -2790,16 +2799,16 @@ bind it in the options section.") (org-habit-insert-consistency-graphs)) (run-hooks 'org-finalize-agenda-hook) (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) - (when (get 'org-agenda-filter :preset-filter) + (when (or org-agenda-filter (get 'org-agenda-filter :preset-filter)) (org-agenda-filter-apply org-agenda-filter)) ))) (defun org-agenda-mark-clocking-task () "Mark the current clock entry in the agenda if it is present." (mapc (lambda (o) - (if (eq (org-overlay-get o 'type) 'org-agenda-clocking) - (org-delete-overlay o))) - (org-overlays-in (point-min) (point-max))) + (if (eq (overlay-get o 'type) 'org-agenda-clocking) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) (when (marker-buffer org-clock-hd-marker) (save-excursion (goto-char (point-min)) @@ -2808,18 +2817,18 @@ bind it in the options section.") (goto-char s) (when (equal (org-get-at-bol 'org-hd-marker) org-clock-hd-marker) - (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-eol)))) - (org-overlay-put ov 'type 'org-agenda-clocking) - (org-overlay-put ov 'face 'org-agenda-clocking) - (org-overlay-put ov 'help-echo + (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol)))) + (overlay-put ov 'type 'org-agenda-clocking) + (overlay-put ov 'face 'org-agenda-clocking) + (overlay-put ov 'help-echo "The clock is running in this item"))))))) (defun org-agenda-fontify-priorities () "Make highest priority lines bold, and lowest italic." (interactive) - (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) - (org-delete-overlay o))) - (org-overlays-in (point-min) (point-max))) + (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) (save-excursion (let ((inhibit-read-only t) b e p ov h l) @@ -2834,8 +2843,8 @@ bind it in the options section.") e (if (eq org-agenda-fontify-priorities 'cookies) (match-end 0) (point-at-eol)) - ov (org-make-overlay b e)) - (org-overlay-put + ov (make-overlay b e)) + (overlay-put ov 'face (cond ((org-face-from-face-or-color 'priority nil @@ -2846,13 +2855,13 @@ bind it in the options section.") (cdr (assoc p org-agenda-fontify-priorities))))) ((equal p l) 'italic) ((equal p h) 'bold))) - (org-overlay-put ov 'org-type 'org-priority))))) + (overlay-put ov 'org-type 'org-priority))))) (defun org-agenda-dim-blocked-tasks () "Dim currently blocked TODO's in the agenda display." - (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-blocked-todo) - (org-delete-overlay o))) - (org-overlays-in (point-min) (point-max))) + (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) (save-excursion (let ((inhibit-read-only t) (org-depend-tag-blocked nil) @@ -2881,11 +2890,11 @@ bind it in the options section.") (max (point-min) (1- (point-at-bol))) (point-at-bol)) e (point-at-eol) - ov (org-make-overlay b e)) + ov (make-overlay b e)) (if invis1 - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'face 'org-agenda-dimmed-todo-face)) - (org-overlay-put ov 'org-type 'org-blocked-todo))))))) + (overlay-put ov 'invisible t) + (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) + (overlay-put ov 'org-type 'org-blocked-todo))))))) (defvar org-agenda-skip-function nil "Function to be called at each match during agenda construction. @@ -2896,7 +2905,7 @@ This may also be a Lisp form, it will be evaluated. Never set this variable using `setq' or so, because then it will apply to all future agenda commands. Instead, bind it with `let' to scope it dynamically into the agenda-constructing command. A good way to set -it is through options in org-agenda-custom-commands.") +it is through options in `org-agenda-custom-commands'.") (defun org-agenda-skip () "Throw to `:skip' in places that should be skipped. @@ -2958,10 +2967,10 @@ no longer in use." (org-agenda-get-some-entry-text m org-agenda-entry-text-maxlines " > ")))) (when (string-match "\\S-" txt) - (setq o (org-make-overlay (point-at-bol) (point-at-eol))) - (org-overlay-put o 'evaporate t) - (org-overlay-put o 'org-overlay-type 'agenda-entry-content) - (org-overlay-put o 'after-string txt)))) + (setq o (make-overlay (point-at-bol) (point-at-eol))) + (overlay-put o 'evaporate t) + (overlay-put o 'org-overlay-type 'agenda-entry-content) + (overlay-put o 'after-string txt)))) (defun org-agenda-entry-text-show () "Add entry context for all agenda lines." @@ -2978,10 +2987,10 @@ no longer in use." "Remove any shown entry context." (delq nil (mapcar (lambda (o) - (if (eq (org-overlay-get o 'org-overlay-type) + (if (eq (overlay-get o 'org-overlay-type) 'agenda-entry-content) - (progn (org-delete-overlay o) t))) - (org-overlays-in (point-min) (point-max))))) + (progn (delete-overlay o) t))) + (overlays-in (point-min) (point-max))))) ;;; Agenda timeline @@ -2995,7 +3004,6 @@ under the current date. If the buffer contains an active region, only check the region for dates." (interactive "P") - (require 'calendar) (org-compile-prefix-format 'timeline) (org-set-sorting-strategy 'timeline) (let* ((dopast t) @@ -3127,7 +3135,7 @@ When EMPTY is non-nil, also include days without any entries." (defvar org-agenda-start-day nil ; dynamically scoped parameter "Custom commands can set this variable in the options section.") (defvar org-agenda-last-arguments nil - "The arguments of the previous call to org-agenda") + "The arguments of the previous call to `org-agenda'.") (defvar org-starting-day nil) ; local variable in the agenda buffer (defvar org-agenda-span nil) ; local variable in the agenda buffer (defvar org-include-all-loc nil) ; local variable @@ -3197,7 +3205,6 @@ given in `org-agenda-start-on-weekday'." (setq org-agenda-last-arguments (list include-all start-day ndays)) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) - (require 'calendar) (let* ((org-agenda-start-on-weekday (if (or (equal ndays 7) (and (null ndays) (equal 7 org-agenda-ndays))) org-agenda-start-on-weekday nil)) @@ -3400,7 +3407,7 @@ is, or it can be broken into a number of snippets, each of which must match in a Boolean way to select an entry. The default depends on the variable `org-agenda-search-view-always-boolean'. Even if this is turned off (the default) you can always switch to -Boolean search dynamically by preceeding the first word with \"+\" or \"-\". +Boolean search dynamically by preceding the first word with \"+\" or \"-\". The default is a direct search of the whole phrase, where each space in the search string can expand to an arbitrary amount of whitespace, @@ -3415,9 +3422,9 @@ match whole words, not parts of a word) if `org-agenda-search-view-force-full-words' is set (default is nil). Boolean search snippets enclosed by curly braces are interpreted as -regular expressions that must or (when preceeded with \"-\") must not +regular expressions that must or (when preceded with \"-\") must not match in the entry. Snippets enclosed into double quotes will be taken -as a whole, to incude whitespace. +as a whole, to include whitespace. - If the search string starts with an asterisk, search only in headlines. - If (possibly after the leading star) the search string starts with an @@ -3441,6 +3448,7 @@ in `org-agenda-text-search-extra-files'." 'mouse-face 'highlight 'help-echo (format "mouse-2 or RET jump to location"))) (full-words org-agenda-search-view-force-full-words) + (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) regexp rtn rtnall files file pos marker category tags c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) @@ -3618,13 +3626,12 @@ in `org-agenda-text-search-extra-files'." ;;;###autoload (defun org-todo-list (arg) - "Show all TODO entries from all agenda file in a single list. + "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") - (require 'calendar) (org-compile-prefix-format 'todo) (org-set-sorting-strategy 'todo) (org-prepare-agenda "TODO") @@ -3771,7 +3778,7 @@ This variable should not be set directly, but custom commands can bind it in the options section.") (defun org-agenda-skip-entry-when-regexp-matches () - "Checks if the current entry contains match for `org-agenda-skip-regexp'. + "Check if the current entry contains match for `org-agenda-skip-regexp'. If yes, it returns the end position of this entry, causing agenda commands to skip the entry but continuing the search in the subtree. This is a function that can be put into `org-agenda-skip-function' for the duration @@ -3783,7 +3790,7 @@ of a command." (and skip end))) (defun org-agenda-skip-subtree-when-regexp-matches () - "Checks if the current subtree contains match for `org-agenda-skip-regexp'. + "Check if the current subtree contains match for `org-agenda-skip-regexp'. If yes, it returns the end position of this tree, causing agenda commands to skip this subtree. This is a function that can be put into `org-agenda-skip-function' for the duration of a command." @@ -3794,7 +3801,7 @@ to skip this subtree. This is a function that can be put into (and skip end))) (defun org-agenda-skip-entry-when-regexp-matches-in-subtree () - "Checks if the current subtree contains match for `org-agenda-skip-regexp'. + "Check if the current subtree contains match for `org-agenda-skip-regexp'. If yes, it returns the end position of the current entry (NOT the tree), causing agenda commands to skip the entry but continuing the search in the subtree. This is a function that can be put into @@ -3981,7 +3988,6 @@ MATCH is being ignored." "Get the (Emacs Calendar) diary entries for DATE." (require 'diary-lib) (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") - (fancy-diary-buffer diary-fancy-buffer) (diary-display-hook '(fancy-diary-display)) (diary-display-function 'fancy-diary-display) (pop-up-frames nil) @@ -4343,7 +4349,7 @@ the documentation of `org-diary'." clockp (and org-agenda-include-inactive-timestamps (or (string-match org-clock-string tmp) (string-match "]-+\\'" tmp))) - todo-state (org-get-todo-state) + todo-state (ignore-errors (org-get-todo-state)) donep (member todo-state org-done-keywords)) (if (or scheduledp deadlinep closedp clockp (and donep org-agenda-skip-timestamp-if-done)) @@ -4424,7 +4430,7 @@ the documentation of `org-diary'." "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. The order of the first 2 times 3 arguments depends on the variable `calendar-date-style' or, if that is not defined, on `european-calendar-style'. -So for american calendars, give this as MONTH DAY YEAR, for european as +So for American calendars, give this as MONTH DAY YEAR, for European as DAY MONTH YEAR, and for ISO as YEAR MONTH DAY. DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS is any number of ISO weeks in the block period for which the item should @@ -4501,15 +4507,15 @@ be skipped." (setq clocked (match-string 2 rest))) (setq clocked "-"))) (save-excursion + (setq extra nil) (cond - ((not org-agenda-log-mode-add-notes) (setq extra nil)) + ((not org-agenda-log-mode-add-notes)) (statep (and (looking-at ".*\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") (setq extra (match-string 1)))) (clockp (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") - (setq extra (match-string 1)))) - (t (setq extra nil))) + (setq extra (match-string 1))))) (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) @@ -4789,13 +4795,20 @@ FRACTION is what fraction of the head-warning time has passed." (setq tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (match-string 1)) - (setq txt (org-format-agenda-item - (format - (nth (if (= d1 d2) 0 1) - org-agenda-timerange-leaders) - (1+ (- d0 d1)) (1+ (- d2 d1))) - head category tags - timestr))) + (let ((remove-re + (if org-agenda-remove-timeranges-from-blocks + (concat + "<" (regexp-quote s1) ".*?>" + "--" + "<" (regexp-quote s2) ".*?>") + nil))) + (setq txt (org-format-agenda-item + (format + (nth (if (= d1 d2) 0 1) + org-agenda-timerange-leaders) + (1+ (- d0 d1)) (1+ (- d2 d1))) + head category tags + timestr nil remove-re)))) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date @@ -4818,9 +4831,9 @@ The flag is set if the currently compiled format contains a `%T'.") "A flag, set by `org-compile-prefix-format'. The flag is set if the currently compiled format contains a `%e'.") (defvar org-prefix-category-length nil - "Used by `org-compile-prefix-format' to remember the category field widh.") + "Used by `org-compile-prefix-format' to remember the category field width.") (defvar org-prefix-category-max-length nil - "Used by `org-compile-prefix-format' to remember the category field widh.") + "Used by `org-compile-prefix-format' to remember the category field width.") (defun org-format-agenda-item (extra txt &optional category tags dotime noprefix remove-re habitp) @@ -5161,11 +5174,12 @@ HH:MM." (or (match-end 1) (match-end 0)) (match-end 0) (list 'face (org-get-todo-face (match-string 2 x))) x) - (setq x (concat (substring x 0 (match-end 1)) - (format org-agenda-todo-keyword-format - (match-string 2 x)) - (org-add-props " " (text-properties-at 0 x)) - (substring x (match-end 3))))) + (when (match-end 1) + (setq x (concat (substring x 0 (match-end 1)) + (format org-agenda-todo-keyword-format + (match-string 2 x)) + (org-add-props " " (text-properties-at 0 x)) + (substring x (match-end 3)))))) x))) (defsubst org-cmp-priority (a b) @@ -5216,6 +5230,28 @@ HH:MM." ((< lb la) +1) (t nil)))) +(defsubst org-cmp-alpha (a b) + "Compare the headlines, alphabetically." + (let* ((pla (get-text-property 0 'prefix-length a)) + (plb (get-text-property 0 'prefix-length b)) + (ta (and pla (substring a pla))) + (tb (and plb (substring b plb)))) + (when pla + (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta) + (setq ta (substring ta (match-end 0)))) + (setq ta (downcase ta))) + (when plb + (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "") + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb) + (setq tb (substring tb (match-end 0)))) + (setq tb (downcase tb))) + (cond ((not ta) +1) + ((not tb) -1) + ((string-lessp ta tb) -1) + ((string-lessp tb ta) +1) + (t nil)))) + (defsubst org-cmp-tag (a b) "Compare the string values of the first tags of A and B." (let ((ta (car (last (get-text-property 1 'tags a)))) @@ -5243,25 +5279,39 @@ HH:MM." ((and (not ha) hb) +1) (t nil)))) +(defsubst org-em (x y list) (or (memq x list) (memq y list))) + (defun org-entries-lessp (a b) "Predicate for sorting agenda entries." ;; The following variables will be used when the form is evaluated. ;; So even though the compiler complains, keep them. - (let* ((time-up (org-cmp-time a b)) - (time-down (if time-up (- time-up) nil)) - (priority-up (org-cmp-priority a b)) - (priority-down (if priority-up (- priority-up) nil)) - (effort-up (org-cmp-effort a b)) - (effort-down (if effort-up (- effort-up) nil)) - (category-up (org-cmp-category a b)) - (category-down (if category-up (- category-up) nil)) - (category-keep (if category-up +1 nil)) - (tag-up (org-cmp-tag a b)) - (tag-down (if tag-up (- tag-up) nil)) - (todo-state-up (org-cmp-todo-state a b)) + (let* ((ss org-agenda-sorting-strategy-selected) + (time-up (and (org-em 'time-up 'time-down ss) + (org-cmp-time a b))) + (time-down (if time-up (- time-up) nil)) + (priority-up (and (org-em 'priority-up 'priority-down ss) + (org-cmp-priority a b))) + (priority-down (if priority-up (- priority-up) nil)) + (effort-up (and (org-em 'effort-up 'effort-down ss) + (org-cmp-effort a b))) + (effort-down (if effort-up (- effort-up) nil)) + (category-up (and (or (org-em 'category-up 'category-down ss) + (memq 'category-keep ss)) + (org-cmp-category a b))) + (category-down (if category-up (- category-up) nil)) + (category-keep (if category-up +1 nil)) + (tag-up (and (org-em 'tag-up 'tag-down ss) + (org-cmp-tag a b))) + (tag-down (if tag-up (- tag-up) nil)) + (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) + (org-cmp-todo-state a b))) (todo-state-down (if todo-state-up (- todo-state-up) nil)) - (habit-up (org-cmp-habit-p a b)) - (habit-down (if habit-up (- habit-up) nil)) + (habit-up (and (org-em 'habit-up 'habit-down ss) + (org-cmp-habit-p a b))) + (habit-down (if habit-up (- habit-up) nil)) + (alpha-up (and (org-em 'alpha-up 'alpha-down ss) + (org-cmp-alpha a b))) + (alpha-down (if alpha-up (- alpha-up) nil)) user-defined-up user-defined-down) (if (and org-agenda-cmp-user-defined (functionp org-agenda-cmp-user-defined)) @@ -5274,12 +5324,12 @@ HH:MM." ;;; Agenda restriction lock -(defvar org-agenda-restriction-lock-overlay (org-make-overlay 1 1) +(defvar org-agenda-restriction-lock-overlay (make-overlay 1 1) "Overlay to mark the headline to which agenda commands are restricted.") -(org-overlay-put org-agenda-restriction-lock-overlay - 'face 'org-agenda-restriction-lock) -(org-overlay-put org-agenda-restriction-lock-overlay - 'help-echo "Agendas are currently limited to this subtree.") +(overlay-put org-agenda-restriction-lock-overlay + 'face 'org-agenda-restriction-lock) +(overlay-put org-agenda-restriction-lock-overlay + 'help-echo "Agendas are currently limited to this subtree.") (org-detach-overlay org-agenda-restriction-lock-overlay) (defun org-agenda-set-restriction-lock (&optional type) @@ -5302,7 +5352,7 @@ in the file. Otherwise, restriction will be to the current subtree." (put 'org-agenda-files 'org-restrict (list (buffer-file-name (buffer-base-buffer)))) (org-back-to-heading t) - (org-move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) + (move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) (move-marker org-agenda-restrict-begin (point)) (move-marker org-agenda-restrict-end (save-excursion (org-end-of-subtree t))) @@ -5391,8 +5441,9 @@ Org-mode buffers visited directly by the user will not be touched." (org-agenda-quit)) (defun org-agenda-execute (arg) - "Execute another agenda command, keeping same window.\\<global-map> -So this is just a shortcut for `\\[org-agenda]', available in the agenda." + "Execute another agenda command, keeping same window. +So this is just a shortcut for \\<global-map>`\\[org-agenda]', available +in the agenda." (interactive "P") (let ((org-agenda-window-setup 'current-window)) (org-agenda arg))) @@ -5549,7 +5600,7 @@ to switch to narrowing." (defun org-agenda-filter-effort-form (e) "Return the form to compare the effort of the current line with what E says. -E looks line \"+<2:25\"." +E looks like \"+<2:25\"." (let (op) (setq e (substring e 1)) (setq op (string-to-char e) e (substring e 1)) @@ -5588,25 +5639,25 @@ If the line does not have an effort defined, return nil." (defun org-agenda-filter-by-tag-hide-line () (let (ov) - (setq ov (org-make-overlay (max (point-min) (1- (point-at-bol))) + (setq ov (make-overlay (max (point-min) (1- (point-at-bol))) (point-at-eol))) - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'type 'tags-filter) + (overlay-put ov 'invisible t) + (overlay-put ov 'type 'tags-filter) (push ov org-agenda-filter-overlays))) (defun org-agenda-fix-tags-filter-overlays-at (&optional pos) (setq pos (or pos (point))) (save-excursion - (dolist (ov (org-overlays-at pos)) - (when (and (org-overlay-get ov 'invisible) - (eq (org-overlay-get ov 'type) 'tags-filter)) + (dolist (ov (overlays-at pos)) + (when (and (overlay-get ov 'invisible) + (eq (overlay-get ov 'type) 'tags-filter)) (goto-char pos) - (if (< (org-overlay-start ov) (point-at-eol)) - (org-move-overlay ov (point-at-eol) - (org-overlay-end ov))))))) + (if (< (overlay-start ov) (point-at-eol)) + (move-overlay ov (point-at-eol) + (overlay-end ov))))))) (defun org-agenda-filter-by-tag-show-all () - (mapc 'org-delete-overlay org-agenda-filter-overlays) + (mapc 'delete-overlay org-agenda-filter-overlays) (setq org-agenda-filter-overlays nil) (setq org-agenda-filter nil) (setq org-agenda-filter-form nil) @@ -5881,17 +5932,16 @@ so that the date SD will be in that range." (error "No previous date before this line in this buffer"))) ;; Initialize the highlight -(defvar org-hl (org-make-overlay 1 1)) -(org-overlay-put org-hl 'face 'highlight) +(defvar org-hl (make-overlay 1 1)) +(overlay-put org-hl 'face 'highlight) (defun org-highlight (begin end &optional buffer) "Highlight a region with overlay." - (funcall (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay) - org-hl begin end (or buffer (current-buffer)))) + (move-overlay org-hl begin end (or buffer (current-buffer)))) (defun org-unhighlight () "Detach overlay INDEX." - (funcall (if (featurep 'xemacs) 'detach-extent 'delete-overlay) org-hl)) + (org-detach-overlay org-hl)) ;; FIXME this is currently not used. (defun org-highlight-until-next-command (beg end &optional buffer) @@ -6043,7 +6093,7 @@ When called with a prefix argument, include all archive files as well." 'org-agenda-type)))) (defun org-agenda-next-line () - "Move cursor to the next line, and show if follow-mode is active." + "Move cursor to the next line, and show if follow mode is active." (interactive) (call-interactively 'next-line) (org-agenda-do-context-action)) @@ -6056,7 +6106,7 @@ When called with a prefix argument, include all archive files as well." (org-agenda-do-context-action)) (defun org-agenda-do-context-action () - "Show outline path and, maybe, follow-mode window." + "Show outline path and, maybe, follow mode window." (let ((m (org-get-at-bol 'org-marker))) (if (and org-agenda-follow-mode m) (org-agenda-show)) @@ -6090,6 +6140,7 @@ and by additional input from the age of a schedules or deadline entry." (pos (marker-position marker))) (switch-to-buffer-other-window buffer) (widen) + (push-mark) (goto-char pos) (when (org-mode-p) (org-show-context 'agenda) @@ -6206,7 +6257,7 @@ If this information is not given, the function uses the tree at point." (delete-region (point-at-bol) (1+ (point-at-eol))))) (beginning-of-line 0)))))) -(defun org-agenda-refile (&optional goto rfloc) +(defun org-agenda-refile (&optional goto rfloc no-update) "Refile the item at point." (interactive "P") (if (equal goto '(16)) @@ -6225,7 +6276,8 @@ If this information is not given, the function uses the tree at point." (widen) (goto-char marker) (org-remove-subtree-entries-from-agenda) - (org-refile goto buffer rfloc))))))) + (org-refile goto buffer rfloc))))) + (unless no-update (org-agenda-redo)))) (defun org-agenda-open-link (&optional arg) "Follow the link in the current line, if any. @@ -6435,8 +6487,8 @@ docstring of `org-agenda-show-1'." 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. -With a C-u prefix, make a separate frame for this tree (i.e. don't use the -dedicated frame)." +With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't +use the dedicated frame)." (interactive) (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) @@ -6926,13 +6978,14 @@ 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 [ ]show") + (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [c]apture [ ]show") (setq ans (read-char-exclusive)) (cond ((equal ans ?m) @@ -6953,6 +7006,8 @@ The cursor may be at a date in the calendar, or in the Org agenda." (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 @@ -7312,9 +7367,7 @@ argument, latitude and longitude will be prompted for." (date (calendar-gregorian-from-absolute day)) (calendar-move-hook nil) (calendar-view-holidays-initially-flag nil) - (calendar-view-diary-initially-flag nil) - (view-calendar-holidays-initially nil) - (view-diary-entries-initially nil)) + (calendar-view-diary-initially-flag nil)) (calendar) (calendar-goto-date date))) @@ -7373,11 +7426,11 @@ This is a command that has to be installed in `calendar-mode-map'." (unless (org-agenda-bulk-marked-p) (unless m (error "Nothing to mark at point")) (push m org-agenda-bulk-marked-entries) - (setq ov (org-make-overlay (point-at-bol) (+ 2 (point-at-bol)))) + (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) (org-overlay-display ov "> " (org-get-todo-face "TODO") 'evaporate) - (org-overlay-put ov 'type 'org-marked-entry-overlay)) + (overlay-put ov 'type 'org-marked-entry-overlay)) (beginning-of-line 2) (while (and (get-char-property (point) 'invisible) (not (eobp))) (beginning-of-line 2)) @@ -7414,9 +7467,9 @@ This only removes the overlays, it does not remove the markers from the list in `org-agenda-bulk-marked-entries'." (interactive) (mapc (lambda (ov) - (and (eq (org-overlay-get ov 'type) 'org-marked-entry-overlay) - (org-delete-overlay ov))) - (org-overlays-in (or beg (point-min)) (or end (point-max))))) + (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay) + (delete-overlay ov))) + (overlays-in (or beg (point-min)) (or end (point-max))))) (defun org-agenda-bulk-remove-all-marks () "Remove all marks in the agenda buffer. @@ -7436,6 +7489,7 @@ The prefix arg is passed through to the command if possible." (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 ?$) @@ -7449,13 +7503,15 @@ The prefix arg is passed through to the command if possible." "Refile to: " (marker-buffer (car org-agenda-bulk-marked-entries)) org-refile-allow-creating-parent-nodes)) - (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")))) + (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)))) + (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t) + redo-at-end t)) ((equal action ?t) (setq state (org-icompleting-read @@ -7516,6 +7572,7 @@ The prefix arg is passed through to the command if possible." (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) @@ -7595,7 +7652,6 @@ either 'headline or 'category. For example: will only add headlines containing IMPORTANT or headlines belonging to the \"Work\" category." (interactive "P") - (require 'calendar) (if refresh (setq appt-time-msg-list nil)) (if (eq filter t) (setq filter (read-from-minibuffer "Regexp filter: "))) diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index b9bd8a447d2..31ae488d4d8 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el index 3d86e7a5230..730f8bdfa41 100644 --- a/lisp/org/org-ascii.el +++ b/lisp/org/org-ascii.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,7 +26,10 @@ ;; ;;; Commentary: +;;; Code: + (require 'org-exp) + (eval-when-compile (require 'cl)) @@ -541,7 +544,7 @@ publishing directory." (current-buffer)))) (defun org-export-ascii-preprocess (parameters) - "Do extra work for ASCII export" + "Do extra work for ASCII export." ;; ;; Realign tables to get rid of narrowing (when org-export-ascii-table-widen-columns @@ -550,9 +553,8 @@ publishing directory." (org-ascii-replace-entities) (goto-char (point-min)) (org-table-map-tables - (lambda () - (org-if-unprotected - (org-table-align)))))) + (lambda () (org-if-unprotected (org-table-align))) + 'quietly))) ;; Put quotes around verbatim text (goto-char (point-min)) (while (re-search-forward org-verbatim-re nil t) @@ -566,7 +568,12 @@ publishing directory." (goto-char (point-min)) (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t) (org-if-unprotected-at (match-beginning 1) - (replace-match "\\1\\2")))) + (replace-match "\\1\\2"))) + ;; Remove list start counters + (goto-char (point-min)) + (while (re-search-forward "\\[@start:[0-9]+\\] ?" nil t) + (org-if-unprotected + (replace-match "")))) (defun org-html-expand-for-ascii (line) "Handle quoted HTML for ASCII export." diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 42a3894388e..573244beed4 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -4,7 +4,7 @@ ;; Author: John Wiegley <johnw@newartisans.com> ;; Keywords: org data task -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index 8915faa565a..0d7b5fa086a 100644 --- a/lisp/org/org-bbdb.el +++ b/lisp/org/org-bbdb.el @@ -7,7 +7,7 @@ ;; Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -207,7 +207,7 @@ date year)." (defun org-bbdb-export (path desc format) "Create the export version of a BBDB link specified by PATH or DESC. If exporting to either HTML or LaTeX FORMAT the link will be -italicised, in all other cases it is left unchanged." +italicized, in all other cases it is left unchanged." (cond ((eq format 'html) (format "<i>%s</i>" (or desc path))) ((eq format 'latex) (format "\\textit{%s}" (or desc path))) diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el index c4bf197c22c..06853b8bd63 100644 --- a/lisp/org/org-beamer.el +++ b/lisp/org/org-beamer.el @@ -2,7 +2,7 @@ ;; ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; -;; Version: 6.35i +;; Version: 7.01 ;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -27,8 +27,11 @@ ;; This library implement the special treatment needed by using the ;; beamer class during LaTeX export. +;;; Code: + (require 'org) (require 'org-exp) + (defvar org-export-latex-header) (defvar org-export-latex-options-plist) (defvar org-export-opt-plist) @@ -47,7 +50,7 @@ "The level that should be interpreted as a frame. The levels above this one will be translated into a sectioning structure. Setting this to 2 will allow sections, 3 will allow subsections as well. -You can se this to 4 as well, if you at the same time set +You can set this to 4 as well, if you at the same time set `org-beamer-use-parts' to make the top levels `\part'." :group 'org-beamer :type '(choice @@ -64,7 +67,9 @@ And example for this is \"[allowframebreaks]\"." "%45ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Env Args) %4BEAMER_col(Col) %8BEAMER_extra(Extra)" "Default column view format that should be used to fill the template." :group 'org-beamer - :type '(string :tag "Beamer column view format")) + :type '(choice + (const :tag "Do not insert Beamer column view format" nil) + (string :tag "Beamer column view format"))) (defcustom org-beamer-themes "\\usetheme{default}\\usecolortheme{default}" @@ -72,7 +77,9 @@ And example for this is \"[allowframebreaks]\"." When a beamer template is filled, this will be the default for BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}." :group 'org-beamer - :type '(string :tag "Beamer column view format")) + :type '(choice + (const :tag "Do not insert Beamer themes" nil) + (string :tag "Beamer themes"))) (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" @@ -105,7 +112,7 @@ These are just a completion help.") "Environments triggered by properties in Beamer export. These are the defaults - for user definitions, see `org-beamer-environments-extra'. -\"normal\" is a special fake environment, which emite the heading as +\"normal\" is a special fake environment, which emit the heading as 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. @@ -125,7 +132,7 @@ Each entry has 4 elements: name Name of the environment key Selection key for `org-beamer-select-environment' -open The opening template for the environment, with the following excapes +open The opening template for the environment, with the following escapes %a the action/overlay specification %A the default action/overlay specification %o the options argument of the template @@ -178,7 +185,7 @@ close The closing string of the environment." (defun org-beamer-select-environment () "Select the environment to be used by beamer for this entry. -While this uses (for convenince) a tag selection interface, the result +While this uses (for convenience) a tag selection interface, the result of this command will be that the BEAMER_env *property* of the entry is set. In addition to this, the command will also set a tag as a visual aid, but @@ -383,11 +390,12 @@ the value will be inserted right after the documentclass statement." org-beamer-header-extra) (goto-char (point-min)) (cond - ((re-search-forward "^[ \t]*BEAMER-HEADER-EXTRA-HERE[ \t]*$" nil t) + ((re-search-forward + "^[ \t]*\\[?BEAMER-HEADER-EXTRA\\(-HERE\\)?\\]?[ \t]*$" nil t) (replace-match org-beamer-header-extra t t) (or (bolp) (insert "\n"))) - ((re-search-forward "^[ \t]*\\\\documentclass\\>" nil t) - (beginning-of-line 2) + ((re-search-forward "^[ \t]*\\\\begin{document}" nil t) + (beginning-of-line 1) (insert org-beamer-header-extra) (or (bolp) (insert "\n")))))) @@ -412,7 +420,7 @@ the value will be inserted right after the documentclass statement." (setq org-beamer-export-is-beamer-p nil)) (defun org-beamer-after-initial-vars () - "Find special setings for beamer and store them. + "Find special settings for beamer and store them. The effect is that these values will be accessible during export." ;; First verify that we are exporting using the beamer class (setq org-beamer-export-is-beamer-p @@ -479,7 +487,7 @@ The effect is that these values will be accessible during export." (defun org-beamer-auto-fragile-frames () "Mark any frames containing verbatim environments as fragile. -This funcion will run in the final LaTeX document." +This function will run in the final LaTeX document." (when org-beamer-export-is-beamer-p (let (opts) (goto-char (point-min)) @@ -507,9 +515,9 @@ This funcion will run in the final LaTeX document." ) (defcustom org-beamer-outline-frame-options nil - "Outline frame options appended after \\begin{frame}. You might -want to put e.g. [allowframebreaks=0.9] here. Remember to include -square brackets." + "Outline frame options appended after \\begin{frame}. +You might want to put e.g. [allowframebreaks=0.9] here. Remember to +include square brackets." :group 'org-beamer :type '(string :tag "Outline frame options") ) @@ -571,7 +579,7 @@ square brackets." (add-hook 'org-export-preprocess-before-selecting-backend-code-hook 'org-beamer-select-beamer-code) -(defun org-beamer-settings-template (kind) +(defun org-insert-beamer-options-template (kind) "Insert a settings template, to make sure users do this right." (interactive (progn (message "Current [s]ubtree or [g]lobal?") @@ -587,14 +595,18 @@ square brackets." (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf") (org-entry-put nil "BEAMER_FRAME_LEVEL" (number-to-string org-beamer-frame-level)) - (org-entry-put nil "BEAMER_HEADER_EXTRA" org-beamer-themes) - (org-entry-put nil "COLUMNS" org-beamer-column-view-format) + (when org-beamer-themes + (org-entry-put nil "BEAMER_HEADER_EXTRA" org-beamer-themes)) + (when org-beamer-column-view-format + (org-entry-put nil "COLUMNS" org-beamer-column-view-format)) (org-entry-put nil "BEAMER_col_ALL" "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC")) (insert "#+LaTeX_CLASS: beamer\n") (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n") (insert (format "#+BEAMER_FRAME_LEVEL: %d\n" org-beamer-frame-level) "\n") - (insert "#+BEAMER_HEADER_EXTRA: " org-beamer-themes "\n") - (insert "#+COLUMNS: " org-beamer-column-view-format "\n") + (when org-beamer-themes + (insert "#+BEAMER_HEADER_EXTRA: " org-beamer-themes "\n")) + (when org-beamer-column-view-format + (insert "#+COLUMNS: " org-beamer-column-view-format "\n")) (insert "#+PROPERTY: BEAMER_col_ALL 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC\n"))) diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index fc5a605c186..f7f6595f5a1 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -5,7 +5,7 @@ ;; Author: Bastien Guerry <bzg at altern dot org> ;; Carsten Dominik <carsten dot dominik at gmail dot com> ;; Keywords: org, wp, remember -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el new file mode 100644 index 00000000000..c6197d69fb3 --- /dev/null +++ b/lisp/org/org-capture.el @@ -0,0 +1,1321 @@ +;;; org-capture.el --- Fast note taking in Org-mode + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 7.01 +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains an alternative implementation of the same functionality +;; that is also provided by org-remember.el. The implementation is more +;; streamlined, can produce more target types (e.g. plain list items or +;; table lines). Also, it does not use a temporary buffer for editing +;; the captured entry - instead it uses an indirect buffer that visits +;; the new entry already in the target buffer (this was an idea by Samuel +;; Wales). John Wiegley's excellent `remember.el' is not needed for this +;; implementation, even though we borrow heavily from its ideas. + +;; This implementation heavily draws on ideas by James TD Smith and +;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration. + +;;; TODO + +;; - find a clever way to not always insert an annotation maybe a +;; predicate function that can check for conditions for %a to be +;; used. This could be one of the properties. + +;; - Should there be plist members that arrange for properties to be +;; asked for, like James proposed in his RFC? + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'org) +(require 'org-mks) + +(declare-function org-datetree-find-date-create "org-datetree" + (DATE &optional KEEP-RESTRICTION)) +(declare-function org-table-get-specials "org-table" ()) +(declare-function org-table-goto-line "org-table" (N)) +(defvar org-remember-default-headline) +(defvar org-remember-templates) +(defvar org-table-hlines) + +(defvar org-capture-clock-was-started nil + "Internal flag, noting if the clock was started.") + +(defvar org-capture-last-stored-marker (make-marker) + "Marker pointing to the entry most recently stored with `org-capture'.") + +;; The following variable is scoped dynamically by org-protocol +;; to indicate that the link properties have already been stored +(defvar org-capture-link-is-already-stored nil) + +(defgroup org-capture nil + "Options concerning capturing new entries." + :tag "Org Capture" + :group 'org) + +(defcustom org-capture-templates nil + "Templates for the creation of new entries. + +Each entry is a list with the following items: + +keys The keys that will select the template, as a string, characters + only, for example \"a\" for a template to be selected with a + single key, or \"bt\" for selection with two keys. When using + several keys, keys using the same prefix key must be together + in the list and preceded by a 2-element entry explaining the + prefix key, for example + + (\"b\" \"Templates for marking stuff to buy\") + + The \"C\" key is used by default for quick access to the + customization of the template variable. But if you want to use + that key for a template, you can. + +description A short string describing the template, will be shown during + selection. + +type The type of entry. Valid types are: + entry an Org-mode node, with a headline. Will be + filed as the child of the target entry or as + a top-level entry. + item a plain list item, will be placed in the + first plain list at the target + location. + checkitem a checkbox item. This differs from the + plain list item only is so far as it uses a + different default template. + table-line a new line in the first table at target location. + plain text to be inserted as it is. + +target Specification of where the captured item should be placed. + In Org-mode files, targets usually define a node. Entries will + become children of this node, other types will be added to the + table or list in the body of this node. + + Valid values are: + + (file \"path/to/file\") + Text will be placed at the beginning or end of that file + + (id \"id of existing org entry\") + File as child of this entry, or in the body of the entry + + (file+headline \"path/to/file\" \"node headline\") + Fast configuration if the target heading is unique in the file + + (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...) + For non-unique headings, the full path is safer + + (file+regexp \"path/to/file\" \"regexp to find location\") + File to the entry matching regexp + + (file+datetree \"path/to/file\") + Will create a heading in a date tree + + (file+function \"path/to/file\" function-finding-location) + A function to find the right location in the file + + (clock) + File to the entry that is currently being clocked + + (function function-finding-location) + Most general way, write your own function to find both + file and location + +template The template for creating the capture item. If you leave this + empty, an appropriate default template will be used. See below + for more details. Instead of a string, this may also be one of + + (file \"/path/to/template-file\") + (function function-returning-the-template) + + in order to get a template from a file, or dynamically + from a function. + +The rest of the entry is a property list of additional options. Recognized +properties are: + + :prepend Normally newly captured information will be appended at + the target location (last child, last table line, + last list item...). Setting this property will + change that. + + :immediate-finish When set, do not offer to edit the information, just + file it away immediately. This makes sense if the + template only needs information that can be added + automatically. + + :empty-lines Set this to the number of lines the should be inserted + before and after the new item. Default 0, only common + other value is 1. + + :clock-in Start the clock in this item. + + :clock-resume Start the interrupted clock when finishing the capture. + + :unnarrowed Do not narrow the target buffer, simply show the + full buffer. Default is to narrow it so that you + only see the new stuff. + + :table-line-pos Specification of the location in the table where the + new line should be inserted. It looks like \"II-3\" + which means that the new line should become the third + line before the second horizontal separator line. + +The template defines the text to be inserted. Often this is an org-mode +entry (so the first line should start with a star) that will be filed as a +child of the target headline. It can also be freely formatted text. +Furthermore, the following %-escapes will be replaced with content: + + %^{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|...} + %t time stamp, date only + %T time stamp with date and time + %u, %U like the above, but inactive time stamps + %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. + You may define a prompt like %^{Please specify birthday + %n user name (taken from `user-full-name') + %a annotation, normally the link created with `org-store-link' + %i initial content, copied from the active region. If %i is + indented, the entire inserted text will be indented as well. + %c current kill ring head + %x content of the X clipboard + %^C interactive selection of which kill or clip to use + %^L like %^C, but insert as link + %k title of currently clocked task + %K link to currently clocked task + %^g prompt for tags, with completion on tags in target file + %^G prompt for tags, with completion on all tags in all agenda files + %^{prop}p prompt the user for a value for property `prop' + %:keyword specific information for certain link types, see below + %[pathname] insert the contents of the file given by `pathname' + %(sexp) evaluate elisp `(sexp)' and replace with the result + + %? After completing the template, position cursor here. + +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 +can access with \"%:author\" 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, rmail | %:type %:subject %:message-id + | %:from %:fromname %:fromaddress + | %:to %:toname %:toaddress + | %:fromto (either \"to NAME\" or \"from NAME\") +gnus | %:group, for messages also all email fields +w3, w3m | %:type %:url +info | %:type %:file %:node +calendar | %:type %:date" + :group 'org-capture + :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 & 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) + (file :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-resume) (const t)) + ((const :format "%v " :unnarrowed) (const t)))))))) + +(defcustom org-capture-before-finalize-hook nil + "Hook that is run right before a remember process is finalized. +The remember buffer is still current when this hook runs." + :group 'org-capture + :type 'hook) + +;;; The property list for keeping information about the capture process + +(defvar org-capture-plist nil + "Plist for the current capture process, global, to avoid having to pass it.") +(defvar org-capture-current-plist nil + "Local variable holding the plist in a capture buffer. +This is used to store the plist for use when finishing a capture process. +Another such process might have changed the global variable by then.") + +(defun org-capture-put (&rest stuff) + (while stuff + (setq org-capture-plist (plist-put org-capture-plist + (pop stuff) (pop stuff))))) +(defun org-capture-get (prop &optional local) + (plist-get (if local org-capture-current-plist org-capture-plist) prop)) + +(defun org-capture-member (prop) + (plist-get org-capture-plist prop)) + +;;; The minor mode + +(defvar org-capture-mode-map (make-sparse-keymap) + "Keymap for `org-capture-mode', a minor mode. +Use this map to set additional keybindings for when Org-mode is used +for a Remember buffer.") + +(defvar org-capture-mode-hook nil + "Hook for the minor `org-capture-mode'.") + +(define-minor-mode org-capture-mode + "Minor mode for special key bindings in a remember buffer." + 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)) +(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) +(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) +(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) + +;;; The main commands + +;;;###autoload +(defun org-capture (&optional goto keys) + "Capture something. +\\<org-capture-mode-map> +This will let you select a template from `org-capture-templates', and then +file the newly captured information. The text is immediately inserted +at the target location, and an indirect buffer is shown where you can +edit it. Pressing \\[org-capture-finalize] brings you back to the previous state +of Emacs, so that you can continue your work. + +When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture +anything, just go to the file/headline where the selected template +stores its notes. With a double prefix argument \ +\\[universal-argument] \\[universal-argument], go to the last note +stored. + +When called with a `C-0' (zero) prefix, insert a template at point. + +Lisp programs can set KEYS to a string associated with a template in +`org-capture-templates'. In this case, interactive selection will be +bypassed." + (interactive "P") + (cond + ((equal goto '(4)) (org-capture-goto-target)) + ((equal goto '(16)) (org-capture-goto-last-stored)) + (t + ;; FIXME: Are these needed? + (let* ((orig-buf (current-buffer)) + (annotation (if (and (boundp 'org-capture-link-is-already-stored) + org-capture-link-is-already-stored) + (plist-get org-store-link-plist :annotation) + (org-store-link nil))) + (initial (and (org-region-active-p) + (buffer-substring (point) (mark)))) + (entry (org-capture-select-template keys))) + (cond + ((equal entry "C") + (customize-variable 'org-capture-templates)) + ((equal entry "q") + (error "Abort")) + (t + (org-capture-set-plist entry) + (org-capture-get-template) + (org-capture-put :original-buffer orig-buf :annotation annotation + :initial initial) + (org-capture-put :default-time + (or org-overriding-default-time + (org-current-time))) + (org-capture-set-target-location) + (condition-case error + (org-capture-put :template (org-capture-fill-template)) + ((error quit) + (if (get-buffer "*Capture*") (kill-buffer "*Capture*")) + (error "Capture abort: %s" error))) + + (if (equal goto 0) + ;;insert at point + (org-capture-insert-template-here) + (condition-case error + (org-capture-place-template) + ((error quit) + (if (and (buffer-base-buffer (current-buffer)) + (string-match "\\`CAPTURE-" (buffer-name))) + (kill-buffer (current-buffer))) + (set-window-configuration (org-capture-get :return-to-wconf)) + (error "Capture template `%s': %s" + (org-capture-get :key) + (nth 1 error)))) + (if (org-capture-get :immediate-finish) + (org-capture-finalize) + (if (and (org-mode-p) + (org-capture-get :clock-in)) + (condition-case nil + (progn + (if (org-clock-is-active) + (org-capture-put :interrupted-clock + (copy-marker org-clock-marker))) + (org-clock-in) + (org-set-local 'org-capture-clock-was-started t)) + (error + "Could not start the clock in this capture buffer"))))))))))) + + +(defun org-capture-get-template () + "Get the template from a file or a function if necessary." + (let ((txt (org-capture-get :template)) file) + (cond + ((and (listp txt) (eq (car txt) 'file)) + (if (file-exists-p + (setq file (expand-file-name (nth 1 txt) org-directory))) + (setq txt (org-file-contents file)) + (setq txt (format "* Template file %s not found" (nth 1 txt))))) + ((and (listp txt) (eq (car txt) 'function)) + (if (fboundp (nth 1 txt)) + (setq txt (funcall (nth 1 txt))) + (setq txt (format "* Template function %s not found" (nth 1 txt))))) + ((not txt) (setq txt "")) + ((stringp txt)) + (t (setq txt "* Invalid capture template"))) + (org-capture-put :template txt))) + +(defun org-capture-finalize () + "Finalize the capture process." + (interactive) + (unless (and org-capture-mode + (buffer-base-buffer (current-buffer))) + (error "This does not seem to be a capture buffer for Org-mode")) + + ;; Did we start the clock in this capture buffer? + (when (and org-capture-clock-was-started + org-clock-marker (marker-buffer org-clock-marker) + (equal (marker-buffer org-clock-marker) (buffer-base-buffer)) + (> org-clock-marker (point-min)) + (< org-clock-marker (point-max))) + ;; Looks like the clock we started is still running. Clock out. + (let (org-log-note-clock-out) (org-clock-out)) + (when (and (org-capture-get :clock-resume 'local) + (markerp (org-capture-get :interrupted-clock 'local)) + (buffer-live-p (marker-buffer + (org-capture-get :interrupted-clock 'local)))) + (org-with-point-at (org-capture-get :interrupted-clock 'local) + (org-clock-in)) + (message "Interrupted clock has been resumed"))) + + (let ((beg (point-min)) + (end (point-max)) + (abort-note nil)) + (widen) + + (if org-note-abort + (let ((m1 (org-capture-get :begin-marker 'local)) + (m2 (org-capture-get :end-marker 'local))) + (if (and m1 m2 (= m1 beg) (= m2 end)) + (progn + (setq abort-note 'clean) + (kill-region m1 m2)) + (setq abort-note 'dirty))) + + ;; Make sure that the empty lines after are correct + (when (and (> (point-max) end) ; indeed, the buffer was still narrowed + (member (org-capture-get :type 'local) + '(entry item checkitem plain))) + (save-excursion + (goto-char end) + (or (bolp) (newline)) + (org-capture-empty-lines-after + (or (org-capture-get :empty-lines 'local) 0)))) + ;; Postprocessing: Update Statistics cookies, do the sorting + (when (org-mode-p) + (save-excursion + (when (ignore-errors (org-back-to-heading)) + (org-update-parent-todo-statistics) + (org-update-checkbox-count))) + ;; FIXME Here we should do the sorting + ;; If we have added a table line, maybe recompute? + (when (and (eq (org-capture-get :type 'local) 'table-line) + (org-at-table-p)) + (if (org-table-get-stored-formulas) + (org-table-recalculate 'all) ;; FIXME: Should we iterate??? + (org-table-align))) + ) + ;; Store this place as the last one where we stored something + ;; Do the marking in the base buffer, so that it makes sense after + ;; the indirect buffer has been killed. + (org-capture-bookmark-last-stored-position) + + ;; Run the hook + (run-hooks 'org-capture-before-finalize-hook) + ) + + ;; Kill the indirect buffer + (save-buffer) + (let ((return-wconf (org-capture-get :return-to-wconf 'local))) + (kill-buffer (current-buffer)) + ;; Restore the window configuration before capture + (set-window-configuration return-wconf)) + (when abort-note + (cond + ((equal abort-note 'clean) + (message "Capture process aborted and target file cleaned up")) + ((equal abort-note 'dirty) + (error "Capture process aborted, but target buffer could not be cleaned up correctly")))))) + +(defun org-capture-refile () + "Finalize the current capture and then refile the entry. +Refiling is done from the base buffer, because the indirect buffer is then +already gone." + (interactive) + (unless (eq (org-capture-get :type 'local) 'entry) + (error + "Refiling from a capture buffer makes only sense for `entry'-type templates")) + (let ((pos (point)) + (base (buffer-base-buffer (current-buffer))) + (org-refile-for-capture t)) + (org-capture-finalize) + (save-window-excursion + (with-current-buffer (or base (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (call-interactively 'org-refile))))))) + +(defun org-capture-kill () + "Abort the current capture process." + (interactive) + ;; FIXME: This does not do the right thing, we need to remove the new stuff + ;; By hand it is easy: undo, then kill the buffer + (let ((org-note-abort t) (org-capture-before-finalize-hook nil)) + (org-capture-finalize))) + +(defun org-capture-goto-last-stored () + "Go to the location where the last remember note was stored." + (interactive) + (org-goto-marker-or-bmk org-capture-last-stored-marker + "org-capture-last-stored") + (message "This is the last note stored by a capture process")) + +;;; Supporting functions for handling the process + +(defun org-capture-set-target-location (&optional target) + "Find target buffer and position and store then in the property list." + (let ((target-entry-p t)) + (setq target (or target (org-capture-get :target))) + (save-excursion + (cond + ((eq (car target) 'file) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (setq target-entry-p nil)) + + ((eq (car target) 'id) + (let ((loc (org-id-find (nth 1 target)))) + (if (not loc) + (error "Cannot find target ID \"%s\"" (nth 1 target)) + (set-buffer (org-capture-target-buffer (car loc))) + (goto-char (cdr loc))))) + + ((eq (car target) 'file+headline) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (let ((hd (nth 2 target))) + (goto-char (point-min)) + (if (re-search-forward + (format org-complex-heading-regexp-format (regexp-quote hd)) + nil t) + (goto-char (point-at-bol)) + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (insert "* " hd "\n") + (beginning-of-line 0)))) + + ((eq (car target) 'file+olp) + (let ((m (org-find-olp (cdr target)))) + (set-buffer (marker-buffer m)) + (goto-char m))) + + ((eq (car target) 'file+regexp) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (goto-char (point-min)) + (if (re-search-forward (nth 2 target) nil t) + (progn + (goto-char (if (org-capture-get :prepend) + (match-beginning 0) (match-end 0))) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) + (error "No match for target regexp in file %s" (nth 1 target)))) + + ((eq (car target) 'file+datetree) + (require 'org-datetree) + (set-buffer (org-capture-target-buffer (nth 1 target))) + ;; Make a date tree entry, with the current date (or yesterday, + ;; if we are extending dates for a couple of hours) + (org-datetree-find-date-create + (calendar-gregorian-from-absolute + (if org-overriding-default-time + (time-to-days org-overriding-default-time) + (time-to-days + (time-subtract (current-time) + (list 0 (* 3600 org-extend-today-until) 0))))))) + + ((eq (car target) 'file+function) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (funcall (nth 2 target)) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) + + ((eq (car target) 'function) + (funcall (nth 1 target)) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) + + ((eq (car target) 'clock) + (if (and (markerp org-clock-hd-marker) + (marker-buffer org-clock-hd-marker)) + (progn (set-buffer (marker-buffer org-clock-hd-marker)) + (goto-char org-clock-hd-marker)) + (error "No running clock that could be used as capture target"))) + + (t (error "Invalid capture target specification"))) + + (org-capture-put :buffer (current-buffer) :pos (point) + :target-entry-p target-entry-p)))) + +(defun org-capture-target-buffer (file) + "Get a buffer for FILE." + (or (org-find-base-buffer-visiting file) + (find-file-noselect (expand-file-name file org-directory)))) + +(defun org-capture-steal-local-variables (buffer) + "Install Org-mode local variables." + (mapc (lambda (v) + (ignore-errors (org-set-local (car v) (cdr v)))) + (buffer-local-variables buffer))) + +(defun org-capture-place-template () + "Insert the template at the target location, and display the buffer." + (org-capture-put :return-to-wconf (current-window-configuration)) + (delete-other-windows) + (org-switch-to-buffer-other-window + (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) + (show-all) + (goto-char (org-capture-get :pos)) + (org-set-local 'org-capture-target-marker + (move-marker (make-marker) (point))) + (let* ((template (org-capture-get :template)) + (type (org-capture-get :type))) + (case type + ((nil entry) (org-capture-place-entry)) + (table-line (org-capture-place-table-line)) + (plain (org-capture-place-plain-text)) + (item (org-capture-place-item)))) + (org-capture-mode 1) + (org-set-local 'org-capture-current-plist org-capture-plist)) + +(defun org-capture-place-entry () + "Place the template as a new Org entry." + (let* ((txt (org-capture-get :template)) + (reversed (org-capture-get :prepend)) + (target-entry-p (org-capture-get :target-entry-p)) + level beg end file) + + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Insert as top-level entry, either at beginning or at end of file + (setq level 1) + (if reversed + (progn (goto-char (point-min)) + (outline-next-heading)) + (goto-char (point-max)) + (or (bolp) (insert "\n")))) + (t + ;; Insert as a child of the current entry + (and (looking-at "\\*+") + (setq level (- (match-end 0) (match-beginning 0)))) + (setq level (org-get-valid-level (or level 1) 1)) + (if reversed + (progn + (outline-next-heading) + (or (bolp) (insert "\n"))) + (org-end-of-subtree t t) + (or (bolp) (insert "\n"))))) + (org-capture-empty-lines-before) + (setq beg (point)) + (org-paste-subtree level txt 'for-yank) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (outline-next-heading) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (re-search-forward "%\\?" end t) (replace-match "")))) + +(defun org-capture-place-item () + "Place the template as a new plain list item." + (let* ((txt (org-capture-get :template)) + (target-entry-p (org-capture-get :target-entry-p)) + (ind 0) + beg end) + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Insert as top-level entry, either at beginning or at end of file + (setq beg (point-min) end (point-max))) + (t + (setq beg (1+ (point-at-eol)) + end (save-excursion (outline-next-heading) (point))))) + (if (org-capture-get :prepend) + (progn + (goto-char beg) + (if (re-search-forward (concat "^" (org-item-re)) nil t) + (progn + (goto-char (match-beginning 0)) + (setq ind (org-get-indentation))) + (goto-char end) + (setq ind 0))) + (goto-char end) + (if (re-search-backward (concat "^" (org-item-re)) nil t) + (progn + (setq ind (org-get-indentation)) + (org-end-of-item)) + (setq ind 0))) + ;; Remove common indentation + (setq txt (org-remove-indentation txt)) + ;; Make sure this is indeed an item + (unless (string-match (concat "\\`" (org-item-re)) txt) + (setq txt (concat "- " + (mapconcat 'identity (split-string txt "\n") + "\n ")))) + ;; Set the correct indentation, depending on context + (setq ind (make-string ind ?\ )) + (setq txt (concat ind + (mapconcat 'identity (split-string txt "\n") + (concat "\n" ind)) + "\n")) + ;; Insert, with surrounding empty lines + (org-capture-empty-lines-before) + (setq beg (point)) + (insert txt) + (or (bolp) (insert "\n")) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (forward-char 1) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (re-search-forward "%\\?" end t) (replace-match "")))) + +(defun org-capture-place-table-line () + "Place the template as a table line." + (require 'org-table) + (let* ((txt (org-capture-get :template)) + (target-entry-p (org-capture-get :target-entry-p)) + (table-line-pos (org-capture-get :table-line-pos)) + ind beg end) + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Table is not necessarily under a heading + (setq beg (point-min) end (point-max))) + (t + ;; WE are at a heading, limit search to the body + (setq beg (1+ (point-at-eol)) + end (save-excursion (outline-next-heading) (point))))) + (if (re-search-forward org-table-dataline-regexp end t) + (let ((b (org-table-begin)) (e (org-table-end))) + (goto-char e) + (if (looking-at "[ \t]*#\\+TBLFM:") + (forward-line 1)) + (narrow-to-region b (point))) + (goto-char end) + (insert "\n| |\n|----|\n| |\n") + (narrow-to-region (1+ end) (point))) + ;; We are narrowed to the table, or to an empty line if there was no table + + ;; Check if the template is good + (if (not (string-match org-table-dataline-regexp txt)) + (setq txt "| %?Bad template |\n")) + (cond + ((and table-line-pos + (string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos)) + ;; we have a complex line specification + (goto-char (point-min)) + (let ((nh (- (match-end 1) (match-beginning 1))) + (delta (string-to-number (match-string 2 table-line-pos))) + ll) + ;; The user wants a special position in the table + (org-table-get-specials) + (setq ll (ignore-errors (aref org-table-hlines nh))) + (unless ll (error "Invalid table line specification \"%s\"" + table-line-pos)) + (setq ll (+ ll delta (if (< delta 0) 0 -1))) + (org-goto-line ll) + (org-table-insert-row 'below) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (setq beg (point)) + (insert txt) + (setq end (point)))) + ((org-capture-get :prepend) + (goto-char (point-min)) + (re-search-forward org-table-hline-regexp nil t) + (beginning-of-line 1) + (re-search-forward org-table-dataline-regexp nil t) + (beginning-of-line 1) + (setq beg (point)) + (org-table-insert-row) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (insert txt) + (setq end (point))) + (t + (goto-char (point-max)) + (re-search-backward org-table-dataline-regexp nil t) + (beginning-of-line 1) + (org-table-insert-row 'below) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (setq beg (point)) + (insert txt) + (setq end (point)))) + (goto-char beg) + (org-capture-position-for-last-stored 'table-line) + (if (re-search-forward "%\\?" end t) (replace-match "")) + (org-table-align))) + +(defun org-capture-place-plain-text () + "Place the template plainly." + (let* ((txt (org-capture-get :template)) + beg end) + (goto-char (cond + ((org-capture-get :exact-position)) + ((org-capture-get :prepend) (point-min)) + (t (point-max)))) + (or (bolp) (newline)) + (org-capture-empty-lines-before) + (setq beg (point)) + (insert txt) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (re-search-forward "%\\?" end t) (replace-match "")))) + +(defun org-capture-mark-kill-region (beg end) + "Mark the region that will have to be killed when aborting capture." + (let ((m1 (move-marker (make-marker) beg)) + (m2 (move-marker (make-marker) end))) + (org-capture-put :begin-marker m1) + (org-capture-put :end-marker m2))) + +(defun org-capture-position-for-last-stored (where) + "Memorize the position that should later become the position of last capture." + (cond + ((integerp where) + (org-capture-put :position-for-last-stored + (move-marker (make-marker) where + (or (buffer-base-buffer (current-buffer)) + (current-buffer))))) + ((eq where 'table-line) + (org-capture-put :position-for-last-stored + (list 'table-line + (org-table-current-dline)))) + (t (error "This should not happen")))) + +(defun org-capture-bookmark-last-stored-position () + "Bookmark the last-captured position." + (let* ((where (org-capture-get :position-for-last-stored 'local)) + (pos (cond + ((markerp where) + (prog1 (marker-position where) + (move-marker where nil))) + ((and (listp where) (eq (car where) 'table-line)) + (if (org-at-table-p) + (save-excursion + (org-table-goto-line (nth 1 where)) + (point-at-bol)) + (point)))))) + (with-current-buffer (buffer-base-buffer (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (bookmark-set "org-capture-last-stored") + (move-marker org-capture-last-stored-marker (point))))))) + +(defun org-capture-narrow (beg end) + "Narrow, unless configuration says not to narrow." + (unless (org-capture-get :unnarrowed) + (narrow-to-region beg end) + (goto-char beg))) + +(defun org-capture-empty-lines-before (&optional n) + "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)) + (let ((pos (point))) + (org-back-over-empty-lines) + (delete-region (point) pos) + (newline n))) + +(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)) + (org-back-over-empty-lines) + (while (looking-at "[ \t]*\n") (replace-match "")) + (let ((pos (point))) + (newline n) + (goto-char pos))) + +(defvar org-clock-marker) ; Defined in org.el +;;;###autoload +(defun org-capture-insert-template-here () + (let* ((template (org-capture-get :template)) + (type (org-capture-get :type)) + beg end pp) + (or (bolp) (newline)) + (setq beg (point)) + (cond + ((and (eq type 'entry) (org-mode-p)) + (org-paste-subtree nil template t)) + ((and (memq type '(item checkitem)) + (org-mode-p) + (save-excursion (skip-chars-backward " \t\n") + (setq pp (point)) + (org-in-item-p))) + (goto-char pp) + (org-insert-item) + (skip-chars-backward " ") + (skip-chars-backward "-+*0123456789).") + (delete-region (point) (point-at-eol)) + (setq beg (point)) + (org-remove-indentation template) + (insert template) + (org-capture-empty-lines-after) + (goto-char beg) + (org-maybe-renumber-ordered-list) + (org-end-of-item) + (setq end (point))) + (t (insert template))) + (setq end (point)) + (goto-char beg) + (if (re-search-forward "%\\?" end t) + (replace-match "")))) + +(defun org-capture-set-plist (entry) + "Initialize the property list from the template definition." + (setq org-capture-plist (copy-sequence (nthcdr 5 entry))) + (org-capture-put :key (car entry) :description (nth 1 entry) + :target (nth 3 entry)) + (let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry))) + (when (or (not txt) (and (stringp txt) (not (string-match "\\S-" txt)))) + ;; The template may be empty or omitted for special types. + ;; Here we insert the default templates for such cases. + (cond + ((eq type 'item) (setq txt "- %?")) + ((eq type 'checkitem) (setq txt "- [ ] %?")) + ((eq type 'table-line) (setq txt "| %? |")) + ((member type '(nil entry)) (setq txt "* %?\n %a")))) + (org-capture-put :template txt :type type))) + +(defun org-capture-goto-target (&optional template-key) + "Go to the target location of a capture template. +The user is queried for the template." + (interactive) + (let* (org-select-template-temp-major-mode + (entry (org-capture-select-template template-key))) + (unless entry + (error "No capture template selected")) + (org-capture-set-plist entry) + (org-capture-set-target-location) + (switch-to-buffer (org-capture-get :buffer)) + (goto-char (org-capture-get :pos)))) + +(defun org-capture-get-indirect-buffer (&optional buffer prefix) + "Make an indirect buffer for a capture process. +Use PREFIX as a prefix for the name of the indirect buffer." + (setq buffer (or buffer (current-buffer))) + (let ((n 1) (base (buffer-name buffer)) bname) + (setq bname (concat prefix "-" base)) + (while (buffer-live-p (get-buffer bname)) + (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base))) + (condition-case nil + (make-indirect-buffer buffer bname 'clone) + (error (make-indirect-buffer buffer bname))))) + + +;;; The template code + +(defun org-capture-select-template (&optional keys) + "Select a capture template. +Lisp programs can force the template by setting KEYS to a string." + (when org-capture-templates + (if keys + (or (assoc keys org-capture-templates) + (error "No capture template referred to by \"%s\" keys" keys)) + (if (= 1 (length org-capture-templates)) + (car org-capture-templates) + (org-mks org-capture-templates + "Select a capture template\n=========================" + "Template key: " + '(("C" "Customize org-capture-templates") + ("q" "Abort"))))))) + +(defun org-capture-fill-template (&optional template initial annotation) + "Fill a template and return the filled template as a string. +The template may still contain \"%?\" for cursor positioning." + (setq template (or template (org-capture-get :template))) + (when (stringp initial) + (setq initial (org-no-properties initial)) + (remove-text-properties 0 (length initial) '(read-only t) initial)) + (let* ((buffer (org-capture-get :buffer)) + (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) + (ct (org-capture-get :default-time)) + (dct (decode-time ct)) + (ct1 + (if (< (nth 2 dct) org-extend-today-until) + (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) + ct)) + (plist-p (if org-store-link-plist t nil)) + (v-c (and (> (length kill-ring) 0) (current-kill 0))) + (v-x (or (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY))) + (v-t (format-time-string (car org-time-stamp-formats) ct)) + (v-T (format-time-string (cdr org-time-stamp-formats) ct)) + (v-u (concat "[" (substring v-t 1 -1) "]")) + (v-U (concat "[" (substring v-T 1 -1) "]")) + ;; `initial' and `annotation' might habe been passed. + ;; But if the property list has them, we prefer those values + (v-i (or (plist-get org-store-link-plist :initial) + initial + (org-capture-get :initial) + "")) + (v-a (or (plist-get org-store-link-plist :annotation) + annotation + (org-capture-get :annotation) + "")) + ;; Is the link empty? Then we do not want it... + (v-a (if (equal v-a "[[]]") "" v-a)) + (clipboards (remove nil (list v-i + (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY) + v-c))) + (v-A (if (and v-a + (string-match + "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a)) + (replace-match "[\\1[%^{Link description}]]" 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))) + (v-K (if (marker-buffer org-clock-marker) + (org-make-link-string + (buffer-file-name (marker-buffer org-clock-marker)) + org-clock-heading))) + v-I + (org-startup-folded nil) + (org-inhibit-startup t) + org-time-was-given org-end-time-was-given x + prompt completions char time pos default histvar) + + (setq org-store-link-plist + (plist-put org-store-link-plist :annotation v-a) + org-store-link-plist + (plist-put org-store-link-plist :initial v-i)) + + (unless template (setq template "") (message "No template") (ding) + (sit-for 1)) + (save-window-excursion + (delete-other-windows) + (switch-to-buffer (get-buffer-create "*Capture*")) + (erase-buffer) + (insert template) + (goto-char (point-min)) + (org-capture-steal-local-variables buffer) + (setq buffer-file-name nil) + + ;; %[] Insert contents of a file. + (goto-char (point-min)) + (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) + (unless (org-capture-escaped-%) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (filename (expand-file-name (match-string 1)))) + (goto-char start) + (delete-region start end) + (condition-case error + (insert-file-contents filename) + (error (insert (format "%%![Couldn't insert %s: %s]" + filename error))))))) + ;; %() embedded elisp + (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 + (condition-case error + (eval (read (current-buffer))) + (error (format "%%![Error: %s]" error))))) + (delete-region template-start (point)) + (insert result))))) + + ;; Simple %-escapes + (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) + (unless (org-capture-escaped-%) + (when (and initial (equal (match-string 0) "%i")) + (save-match-data + (let* ((lead (buffer-substring + (point-at-bol) (match-beginning 0)))) + (setq v-i (mapconcat 'identity + (org-split-string initial "\n") + (concat "\n" lead)))))) + (replace-match + (or (eval (intern (concat "v-" (match-string 1)))) "") + t t))) + + ;; From the property list + (when plist-p + (goto-char (point-min)) + (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) + (unless (org-capture-escaped-%) + (and (setq x (or (plist-get org-store-link-plist + (intern (match-string 1))) "")) + (replace-match x t t))))) + + ;; Turn on org-mode in temp buffer, set local variables + ;; This is to support completion in interactive prompts + (let ((org-inhibit-startup t)) (org-mode)) + ;; Interactive template entries + (goto-char (point-min)) + (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" + nil t) + (unless (org-capture-escaped-%) + (setq char (if (match-end 3) (match-string 3)) + prompt (if (match-end 2) (match-string 2))) + (goto-char (match-beginning 0)) + (replace-match "") + (setq completions nil default nil) + (when prompt + (setq completions (org-split-string prompt "|") + prompt (pop completions) + default (car completions) + histvar (intern (concat + "org-capture-template-prompt-history::" + (or prompt ""))) + completions (mapcar 'list completions))) + (cond + ((member char '("G" "g")) + (let* ((org-last-tags-completion-table + (org-global-tags-completion-table + (if (equal char "G") + (org-agenda-files) + (and file (list file))))) + (org-add-colon-after-tag-completion t) + (ins (org-icompleting-read + (if prompt (concat prompt ": ") "Tags: ") + 'org-tags-completion-function nil nil nil + 'org-tags-history))) + (setq ins (mapconcat 'identity + (org-split-string + ins (org-re "[^[:alnum:]_@]+")) + ":")) + (when (string-match "\\S-" ins) + (or (equal (char-before) ?:) (insert ":")) + (insert ins) + (or (equal (char-after) ?:) (insert ":"))))) + ((equal char "C") + (cond ((= (length clipboards) 1) (insert (car clipboards))) + ((> (length clipboards) 1) + (insert (read-string "Clipboard/kill value: " + (car clipboards) '(clipboards . 1) + (car clipboards)))))) + ((equal char "L") + (cond ((= (length clipboards) 1) + (org-insert-link 0 (car clipboards))) + ((> (length clipboards) 1) + (org-insert-link 0 (read-string "Clipboard/kill value: " + (car clipboards) + '(clipboards . 1) + (car clipboards)))))) + ((equal char "p") + (let* + ((prop (org-substring-no-properties prompt)) + (pall (concat prop "_ALL")) + (allowed + (with-current-buffer + (get-buffer (file-name-nondirectory file)) + (or (cdr (assoc pall org-file-properties)) + (cdr (assoc pall org-global-properties)) + (cdr (assoc pall org-global-properties-fixed))))) + (existing (with-current-buffer + (get-buffer (file-name-nondirectory file)) + (mapcar 'list (org-property-values prop)))) + (propprompt (concat "Value for " prop ": ")) + (val (if allowed + (org-completing-read + propprompt + (mapcar 'list (org-split-string allowed + "[ \t]+")) + nil 'req-match) + (org-completing-read-no-i propprompt + existing nil nil + "" nil "")))) + (org-set-property prop val))) + (char + ;; These are the date/time related ones + (setq org-time-was-given (equal (upcase char) char)) + (setq time (org-read-date (equal (upcase char) char) t nil + prompt)) + (if (equal (upcase char) char) (setq org-time-was-given t)) + (org-insert-time-stamp time org-time-was-given + (member char '("u" "U")) + nil nil (list org-end-time-was-given))) + (t + (let (org-completion-use-ido) + (insert (org-completing-read-no-i + (concat (if prompt prompt "Enter string") + (if default (concat " [" default "]")) + ": ") + completions nil nil nil histvar default))))))) + ;; Make sure there are no empty lines before the text, and that + ;; it ends with a newline character + (goto-char (point-min)) + (while (looking-at "[ \t]*\n") (replace-match "")) + (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n")) + ;; Return the expanded tempate and kill the temporary buffer + (untabify (point-min) (point-max)) + (set-buffer-modified-p nil) + (prog1 (buffer-string) (kill-buffer (current-buffer)))))) + +(defun org-capture-escaped-% () + "Check if % was escaped - if yes, unescape it now." + (if (equal (char-before (match-beginning 0)) ?\\) + (progn + (delete-region (1- (match-beginning 0)) (match-beginning 0)) + t) + nil)) + +;;;###autoload +(defun org-capture-import-remember-templates () + "Set org-capture-templates to be similar to `org-remember-templates'." + (interactive) + (when (and (yes-or-no-p + "Import old remember templates into org-capture-templates? ") + (yes-or-no-p + "Note that this will remove any templates currently defined in `org-capture-templates'. Do you still want to go ahead? ")) + (require 'org-remember) + (setq org-capture-templates + (mapcar + (lambda (entry) + (let ((desc (car entry)) + (key (char-to-string (nth 1 entry))) + (template (nth 2 entry)) + (file (or (nth 3 entry) org-default-notes-file)) + (position (or (nth 4 entry) org-remember-default-headline)) + (type 'entry) + (prepend org-reverse-note-order) + immediate target) + (cond + ((member position '(top bottom)) + (setq target (list 'file file) + prepend (eq position 'top))) + ((eq position 'date-tree) + (setq target (list 'file+datetree file) + prepend nil)) + (t (setq target (list 'file+headline file position)))) + + (when (string-match "%!" template) + (setq template (replace-match "" t t template) + immediate t)) + + (append (list key desc type target template) + (if prepend '(:prepend t)) + (if immediate '(:immediate-finish t))))) + + org-remember-templates)))) + +(provide 'org-capture) + +;; arch-tag: 986bf41b-8ada-4e28-bf20-e8388a7205a0 + +;;; org-capture.el ends here + + diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 02ad4bf8b50..f451cf80792 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -29,9 +29,10 @@ ;; This file contains the time clocking code for Org-mode (require 'org) +;;; Code: + (eval-when-compile - (require 'cl) - (require 'calendar)) + (require 'cl)) (declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) (defvar org-time-stamp-formats) @@ -83,7 +84,7 @@ clocking out." (defcustom org-clock-in-switch-to-state nil "Set task to a special todo state while clocking it. The value should be the state to which the entry should be -switched. If the value is a function, it must take one +switched. If the value is a function, it must take one parameter (the current TODO state of the item) and return the state to switch it to." :group 'org-clock @@ -96,7 +97,7 @@ state to switch it to." (defcustom org-clock-out-switch-to-state nil "Set task to a special todo state after clocking out. The value should be the state to which the entry should be -switched. If the value is a function, it must take one +switched. If the value is a function, it must take one parameter (the current TODO state of the item) and return the state to switch it to." :group 'org-clock @@ -124,7 +125,7 @@ The function is called with point at the beginning of the headline." :type 'function) (defcustom org-clock-string-limit 0 - "Maximum length of clock strings in the modeline. 0 means no limit." + "Maximum length of clock strings in the modeline. 0 means no limit." :group 'org-clock :type 'integer) @@ -136,8 +137,8 @@ the clock can be resumed from that point." :type 'boolean) (defcustom org-clock-persist nil - "When non-nil, save the running clock when emacs is closed. -The clock is resumed when emacs restarts. + "When non-nil, save the running clock when Emacs is closed. +The clock is resumed when Emacs restarts. When this is t, both the running clock, and the entire clock history are saved. When this is the symbol `clock', only the running clock is saved. @@ -245,6 +246,11 @@ string as argument." :group 'org-clock :type 'boolean) +(defcustom org-clock-resolve-expert nil + "Non-nil means do not show the splash buffer with the clock resolver." + :group 'org-clock + :type 'boolean) + (defvar org-clock-in-prepare-hook nil "Hook run when preparing the clock. This hook is run before anything happens to the task that @@ -277,7 +283,7 @@ to add an effort property.") "If non-nil, user cancelled a clock; this is when leftover time started.") (defvar org-clock-effort "" - "Effort estimate of the currently clocking task") + "Effort estimate of the currently clocking task.") (defvar org-clock-total-time nil "Holds total time, spent previously on currently clocked item. @@ -310,7 +316,10 @@ of a different task.") (defun org-clock-history-push (&optional pos buffer) "Push a marker to the clock history." (setq org-clock-history-length (max 1 (min 35 org-clock-history-length))) - (let ((m (move-marker (make-marker) (or pos (point)) buffer)) n l) + (let ((m (move-marker (make-marker) + (or pos (point)) (org-base-buffer + (or buffer (current-buffer))))) + n l) (while (setq n (member m org-clock-history)) (move-marker (car n) nil)) (setq org-clock-history @@ -334,11 +343,11 @@ of a different task.") org-clock-history)) (defun org-clocking-buffer () - "Returns clocking buffer if we are currently clocking a task or nil" + "Return the clocking buffer if we are currently clocking a task or nil." (marker-buffer org-clock-marker)) (defun org-clocking-p () - "Returns t when clocking a task" + "Return t when clocking a task." (not (equal (org-clocking-buffer) nil))) (defun org-clock-select-task (&optional prompt) @@ -501,7 +510,8 @@ the mode line." ;; A string. See if it is a delta (setq sign (string-to-char value)) (if (member sign '(?- ?+)) - (setq current (org-hh:mm-string-to-minutes (substring current 1))) + (setq current (org-hh:mm-string-to-minutes current) + value (substring value 1)) (setq current 0)) (setq value (org-hh:mm-string-to-minutes value)) (if (equal ?- sign) @@ -587,7 +597,7 @@ Use alsa's aplay tool if available." (save-excursion (goto-char (point-min)) (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t) - (push (cons (copy-marker (1- (match-end 1)) t) + (push (cons (copy-marker (match-end 1) t) (org-time-string-to-time (match-string 1))) clocks)))) clocks)) @@ -624,12 +634,12 @@ This macro also protects the current active clock from being altered." (put 'org-with-clock 'lisp-indent-function 1) -(defsubst org-clock-clock-in (clock &optional resume) +(defsubst org-clock-clock-in (clock &optional resume start-time) "Clock in to the clock located by CLOCK. If necessary, clock-out of the currently active clock." (org-with-clock-position clock (let ((org-clock-in-resume (or resume org-clock-in-resume))) - (org-clock-in)))) + (org-clock-in nil start-time)))) (defsubst org-clock-clock-out (clock &optional fail-quietly at-time) "Clock out of the clock located by CLOCK." @@ -655,39 +665,10 @@ If necessary, clock-out of the currently active clock." (defvar org-clock-resolving-clocks nil) (defvar org-clock-resolving-clocks-due-to-idleness nil) -(defun org-clock-resolve-clock (clock resolve-to &optional close-p - restart-p fail-quietly) +(defun org-clock-resolve-clock (clock resolve-to clock-out-time + &optional close-p restart-p fail-quietly) "Resolve `CLOCK' given the time `RESOLVE-TO', and the present. -`CLOCK' is a cons cell of the form (MARKER START-TIME). -This routine can do one of many things: - - if `RESOLVE-TO' is nil - if `CLOSE-P' is non-nil, give an error - if this clock is the active clock, cancel it - else delete the clock line (as if it never happened) - if `RESTART-P' is non-nil, start a new clock - - else if `RESOLVE-TO' is the symbol `now' - if `RESTART-P' is non-nil, give an error - if `CLOSE-P' is non-nil, clock out the entry and - if this clock is the active clock, stop it - else if this clock is the active clock, do nothing - else if there is no active clock, resume this clock - else ask to cancel the active clock, and if so, - resume this clock after cancelling it - - else if `RESOLVE-TO' is some date in the future - give an error about `RESOLVE-TO' being invalid - - else if `RESOLVE-TO' is some date in the past - if `RESTART-P' is non-nil, give an error - if `CLOSE-P' is non-nil, enter a closing time and - if this clock is the active clock, stop it - else if this clock is the active clock, enter a - closing time, stop the current clock, then - start a new clock for the same item - else just enter a closing time for this clock - and then start a new clock for the same item" +`CLOCK' is a cons cell of the form (MARKER START-TIME)." (let ((org-clock-resolving-clocks t)) (cond ((null resolve-to) @@ -709,11 +690,41 @@ This routine can do one of many things: (t (if restart-p (error "RESTART-P is not valid here")) - (org-clock-clock-out clock fail-quietly resolve-to) + (org-clock-clock-out clock fail-quietly (or clock-out-time + resolve-to)) (unless org-clock-clocking-in (if close-p - (setq org-clock-leftover-time resolve-to) - (org-clock-clock-in clock))))))) + (setq org-clock-leftover-time (and (null clock-out-time) + resolve-to)) + (org-clock-clock-in clock nil (and clock-out-time + resolve-to)))))))) + +(defun org-clock-jump-to-current-clock (&optional effective-clock) + (interactive) + (let ((clock (or effective-clock (cons org-clock-marker + org-clock-start-time)))) + (unless (marker-buffer (car clock)) + (error "No clock is currently running")) + (org-with-clock clock (org-clock-goto)) + (with-current-buffer (marker-buffer (car clock)) + (goto-char (car clock)) + (if org-clock-into-drawer + (let ((logbook + (if (stringp org-clock-into-drawer) + (concat ":" org-clock-into-drawer ":") + ":LOGBOOK:"))) + (ignore-errors + (outline-flag-region + (save-excursion + (outline-back-to-heading t) + (search-forward logbook) + (goto-char (match-beginning 0))) + (save-excursion + (outline-back-to-heading t) + (search-forward logbook) + (search-forward ":END:") + (goto-char (match-end 0))) + nil))))))) (defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) "Resolve an open org-mode clock. @@ -739,51 +750,66 @@ was started." (save-window-excursion (save-excursion (unless org-clock-resolving-clocks-due-to-idleness - (org-with-clock clock (org-clock-goto)) - (with-current-buffer (marker-buffer (car clock)) - (goto-char (car clock)) - (if org-clock-into-drawer - (let ((logbook - (if (stringp org-clock-into-drawer) - (concat ":" org-clock-into-drawer ":") - ":LOGBOOK:"))) - (ignore-errors - (outline-flag-region - (save-excursion - (outline-back-to-heading t) - (search-forward logbook) - (goto-char (match-beginning 0))) - (save-excursion - (outline-back-to-heading t) - (search-forward logbook) - (search-forward ":END:") - (goto-char (match-end 0))) - nil)))))) + (org-clock-jump-to-current-clock clock)) + (unless org-clock-resolve-expert + (with-output-to-temp-buffer "*Org Clock*" + (princ "Select a Clock Resolution Command: + +i/q/C-g Ignore this question; the same as keeping all the idle time. + +k/K Keep X minutes of the idle time (default is all). If this + amount is less than the default, you will be clocked out + that many minutes after the time that idling began, and then + clocked back in at the present time. +g/G Indicate that you \"got back\" X minutes ago. This is quite + different from 'k': it clocks you out from the beginning of + the idle period and clock you back in X minutes ago. +s/S Subtract the idle time from the current clock. This is the + same as keeping 0 minutes. +C Cancel the open timer altogether. It will be as though you + never clocked in. +j/J Jump to the current clock, to make manual adjustments. + +For all these options, using uppercase makes your final state +to be CLOCKED OUT."))) + (org-fit-window-to-buffer (get-buffer-window "*Org Clock*")) (let (char-pressed) - (if (featurep 'xemacs) - (progn - (message (concat (funcall prompt-fn clock) - " [(kK)eep (sS)ubtract (C)ancel]? ")) - (setq char-pressed (read-char-exclusive))) + (when (featurep 'xemacs) + (message (concat (funcall prompt-fn clock) + " [jkKgGsScCiq]? ")) + (setq char-pressed (read-char-exclusive))) (while (or (null char-pressed) - (and (not (memq char-pressed '(?k ?K ?s ?S ?C ?i))) + (and (not (memq char-pressed + '(?k ?K ?g ?G ?s ?S ?C + ?j ?J ?i ?q))) (or (ding) t))) (setq char-pressed (read-char (concat (funcall prompt-fn clock) - " [(kK)p (sS)ub (C)ncl (i)gn]? ") + " [jkKgGSscCiq]? ") nil 45))) - (and (not (eq char-pressed ?i)) char-pressed)))))) - (default (floor (/ (org-float-time - (time-subtract (current-time) last-valid)) 60))) - (keep (and (memq ch '(?k ?K)) - (read-number "Keep how many minutes? " default))) + (and (not (memq char-pressed '(?i ?q))) char-pressed))))) + (default + (floor (/ (org-float-time + (time-subtract (current-time) last-valid)) 60))) + (keep + (and (memq ch '(?k ?K)) + (read-number "Keep how many minutes? " default))) + (gotback + (and (memq ch '(?g ?G)) + (read-number "Got back how many minutes ago? " default))) (subtractp (memq ch '(?s ?S))) (barely-started-p (< (- (org-float-time last-valid) (org-float-time (cdr clock))) 45)) (start-over (and subtractp barely-started-p))) - (if (or (null ch) - (not (memq ch '(?k ?K ?s ?S ?C)))) - (message "") + (cond + ((memq ch '(?j ?J)) + (if (eq ch ?J) + (org-clock-resolve-clock clock 'now nil t nil fail-quietly)) + (org-clock-jump-to-current-clock clock)) + ((or (null ch) + (not (memq ch '(?k ?K ?g ?G ?s ?S ?C)))) + (message "")) + (t (org-clock-resolve-clock clock (cond ((or (eq ch ?C) @@ -792,21 +818,29 @@ was started." ;; time... start-over) nil) - (subtractp + ((or subtractp + (and gotback (= gotback 0))) last-valid) - ((= keep default) + ((or (and keep (= keep default)) + (and gotback (= gotback default))) 'now) + (keep + (time-add last-valid (seconds-to-time (* 60 keep)))) + (gotback + (time-subtract (current-time) + (seconds-to-time (* 60 gotback)))) (t - (time-add last-valid (seconds-to-time (* 60 keep))))) - (memq ch '(?K ?S)) + (error "Unexpected, please report this as a bug"))) + (and gotback last-valid) + (memq ch '(?K ?G ?S)) (and start-over - (not (memq ch '(?K ?S ?C)))) - fail-quietly)))) + (not (memq ch '(?K ?G ?S ?C)))) + fail-quietly))))) -(defun org-resolve-clocks (&optional also-non-dangling-p prompt-fn last-valid) +(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid) "Resolve all currently open org-mode clocks. -If `also-non-dangling-p' is non-nil, also ask to resolve -non-dangling (i.e., currently open and valid) clocks." +If `only-dangling-p' is non-nil, only ask to resolve dangling +\(i.e., not currently open and valid) clocks." (interactive "P") (unless org-clock-resolving-clocks (let ((org-clock-resolving-clocks t)) @@ -815,7 +849,7 @@ non-dangling (i.e., currently open and valid) clocks." (dolist (clock clocks) (let ((dangling (or (not (org-clock-is-active)) (/= (car clock) org-clock-marker)))) - (unless (and (not dangling) (not also-non-dangling-p)) + (if (or (not only-dangling-p) dangling) (org-clock-resolve clock (or prompt-fn @@ -837,11 +871,11 @@ non-dangling (i.e., currently open and valid) clocks." 0))) (defun org-mac-idle-seconds () - "Return the current Mac idle time in seconds" + "Return the current Mac idle time in seconds." (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'"))) (defun org-x11-idle-seconds () - "Return the current X11 idle time in seconds" + "Return the current X11 idle time in seconds." (/ (string-to-number (shell-command-to-string "x11idle")) 1000)) (defun org-user-idle-seconds () @@ -882,11 +916,13 @@ so long." 60.0)))) org-clock-user-idle-start))))) -(defun org-clock-in (&optional select) +(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 prefix arg SELECT, offer a list of recently clocked tasks to -clock into. When SELECT is `C-u C-u', clock into the current task and mark +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'." (interactive "P") @@ -930,7 +966,8 @@ the clocking selection, associated with the letter `d'." (move-marker org-clock-interrupted-task (marker-position org-clock-marker) (org-clocking-buffer)) - (org-clock-out t)))) + (let ((org-clock-clocking-in t)) + (org-clock-out t))))) (when (equal select '(16)) ;; Mark as default clocking task @@ -1027,6 +1064,7 @@ the clocking selection, associated with the letter `d'." (/ (- (org-float-time (current-time)) (org-float-time leftover)) 60))) leftover) + start-time (current-time))) (setq ts (org-insert-time-stamp org-clock-start-time 'with-hm 'inactive)))) @@ -1059,7 +1097,7 @@ the clocking selection, associated with the letter `d'." "Task currently clocked in.") (defun org-clock-set-current () "Set `org-clock-current-task' to the task currently clocked in." - (setq org-clock-current-task (org-get-heading))) + (setq org-clock-current-task (nth 4 (org-heading-components)))) (defun org-clock-delete-current () "Reset `org-clock-current-task' to nil." (setq org-clock-current-task nil)) @@ -1196,11 +1234,14 @@ line and position cursor in that line." If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (interactive) (catch 'exit - (if (not (org-clocking-p)) - (if fail-quietly (throw 'exit t) (error "No active clock"))) + (when (not (org-clocking-p)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (force-mode-line-update) + (if fail-quietly (throw 'exit t) (error "No active clock"))) (let (ts te s h m remove) - (save-excursion - (set-buffer (org-clocking-buffer)) + (save-excursion ; Do not replace this with `with-current-buffer'. + (with-no-warnings (set-buffer (org-clocking-buffer))) (save-restriction (widen) (goto-char org-clock-marker) @@ -1263,12 +1304,15 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (org-clock-delete-current)))))) (defun org-clock-cancel () - "Cancel the running clock be removing the start timestamp." + "Cancel the running clock by removing the start timestamp." (interactive) - (if (not (org-clocking-p)) - (error "No active clock")) - (save-excursion - (set-buffer (org-clocking-buffer)) + (when (not (org-clocking-p)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (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))) (goto-char org-clock-marker) (delete-region (1- (point-at-bol)) (point-at-eol)) ;; Just in case, remove any empty LOGBOOK left over @@ -1313,10 +1357,13 @@ 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) +(defun org-clock-sum (&optional tstart tend headline-filter) "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." +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." (interactive) (let* ((bmp (buffer-modified-p)) (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" @@ -1332,7 +1379,9 @@ TSTART and TEND can mark a time range to be considered." (if (stringp tend) (setq tend (org-time-string-to-seconds tend))) (if (consp tstart) (setq tstart (org-float-time tstart))) (if (consp tend) (setq tend (org-float-time tend))) - (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) + (remove-text-properties (point-min) (point-max) + '(:org-clock-minutes t + :org-clock-force-headline-inclusion t)) (save-excursion (goto-char (point-max)) (while (re-search-backward re nil t) @@ -1357,24 +1406,47 @@ TSTART and TEND can mark a time range to be considered." ;; Add the currently clocking item time to the total (when (and org-clock-report-include-clocking-task (equal (org-clocking-buffer) (current-buffer)) - (equal (marker-position org-clock-hd-marker) (point))) - (let ((time (floor (- (org-float-time) - (org-float-time org-clock-start-time)) 60))) - (setq t1 (+ t1 time)))) - (setq level (- (match-end 1) (match-beginning 1))) - (when (or (> t1 0) (> (aref ltimes level) 0)) - (loop for l from 0 to level do - (aset ltimes l (+ (aref ltimes l) t1))) - (setq t1 0 time (aref ltimes level)) - (loop for l from level to (1- lmax) do - (aset ltimes l 0)) - (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) :org-clock-minutes time))))) + (equal (marker-position org-clock-hd-marker) (point)) + tstart + tend + (>= (org-float-time org-clock-start-time) tstart) + (<= (org-float-time org-clock-start-time) tend)) + (let ((time (floor (- (org-float-time) + (org-float-time org-clock-start-time)) 60))) + (setq t1 (+ t1 time)))) + (let* ((headline-forced + (get-text-property (point) + :org-clock-force-headline-inclusion)) + (headline-included + (or (null headline-filter) + (save-excursion + (save-match-data (funcall headline-filter)))))) + (setq level (- (match-end 1) (match-beginning 1))) + (when (or (> t1 0) (> (aref ltimes level) 0)) + (when (or headline-included headline-forced) + (if headline-included + (loop for l from 0 to level do + (aset ltimes l (+ (aref ltimes l) t1)))) + (setq time (aref ltimes level)) + (goto-char (match-beginning 0)) + (put-text-property (point) (point-at-eol) :org-clock-minutes time) + (if headline-filter + (save-excursion + (save-match-data + (while + (> (funcall outline-level) 1) + (outline-up-heading 1 t) + (put-text-property + (point) (point-at-eol) + :org-clock-force-headline-inclusion t)))))) + (setq t1 0) + (loop for l from level to (1- lmax) do + (aset ltimes l 0))))))) (setq org-clock-file-total-minutes (aref ltimes 0))) (set-buffer-modified-p bmp))) (defun org-clock-sum-current-item (&optional tstart) - "Returns time, clocked on current item in total" + "Return time, clocked on current item in total." (save-excursion (save-restriction (org-narrow-to-subtree) @@ -1430,7 +1502,7 @@ will be easy to remove." (org-move-to-column c) (unless (eolp) (skip-chars-backward "^ \t")) (skip-chars-backward " \t") - (setq ov (org-make-overlay (1- (point)) (point-at-eol)) + (setq ov (make-overlay (1- (point)) (point-at-eol)) tx (concat (buffer-substring (1- (point)) (point)) (make-string (+ off (max 0 (- c (current-column)))) ?.) (org-add-props (if org-time-clocksum-use-fractional @@ -1444,9 +1516,9 @@ will be easy to remove." (list 'face 'org-clock-overlay)) "")) (if (not (featurep 'xemacs)) - (org-overlay-put ov 'display tx) - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'end-glyph (make-glyph tx))) + (overlay-put ov 'display tx) + (overlay-put ov 'invisible t) + (overlay-put ov 'end-glyph (make-glyph tx))) (push ov org-clock-overlays))) (defun org-clock-remove-overlays (&optional beg end noremove) @@ -1455,7 +1527,7 @@ BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) (unless org-inhibit-highlight-removal - (mapc 'org-delete-overlay org-clock-overlays) + (mapc 'delete-overlay org-clock-overlays) (setq org-clock-overlays nil) (unless noremove (remove-hook 'before-change-functions @@ -1689,6 +1761,8 @@ the currently selected interval size." (te (plist-get params :tend)) (block (plist-get params :block)) (link (plist-get params :link)) + (tags (plist-get params :tags)) + (matcher (if tags (cdr (org-make-tags-matcher tags)))) ipos time p level hlc hdl tsp props content recalc formula pcol cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list st) (setq org-clock-file-total-minutes nil) @@ -1770,7 +1844,14 @@ the currently selected interval size." (goto-char pos) (unless scope-is-list - (org-clock-sum ts te) + (org-clock-sum ts te + (unless (null matcher) + (lambda () + (let ((tags-list + (org-split-string + (or (org-entry-get (point) "ALLTAGS") "") + ":"))) + (eval matcher))))) (goto-char (point-min)) (setq st t) (while (or (and (bobp) (prog1 st (setq st nil)) @@ -1874,7 +1955,8 @@ the currently selected interval size." (org-table-recalculate 'all)) (when rm-file-column (forward-char 1) - (org-table-delete-column))))))) + (org-table-delete-column)) + total-time))))) (defun org-clocktable-steps (params) (let* ((p1 (copy-sequence params)) @@ -1882,8 +1964,9 @@ the currently selected interval size." (te (plist-get p1 :tend)) (step0 (plist-get p1 :step)) (step (cdr (assoc step0 '((day . 86400) (week . 604800))))) + (stepskip0 (plist-get p1 :stepskip0)) (block (plist-get p1 :block)) - cc range-text) + cc range-text step-time) (when block (setq cc (org-clock-special-range block nil t) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) @@ -1904,8 +1987,14 @@ the currently selected interval size." (seconds-to-time (setq ts (+ ts step)))))) (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ") (plist-get p1 :tstart) "\n") - (org-dblock-write:clocktable p1) + (setq step-time (org-dblock-write:clocktable p1)) (re-search-forward "#\\+END:") + (when (and (equal step-time 0) stepskip0) + ;; Remove the empty table + (delete-region (point-at-bol) + (save-excursion + (re-search-backward "^\\(Daily\\|Weekly\\) report" nil t) + (point)))) (end-of-line 0)))) (defun org-clocktable-add-file (file table) @@ -2038,7 +2127,7 @@ The details of what will be saved are regulated by the variable ;;;###autoload (defun org-clock-persistence-insinuate () - "Set up hooks for clock persistence" + "Set up hooks for clock persistence." (add-hook 'org-mode-hook 'org-clock-load) (add-hook 'kill-emacs-hook 'org-clock-save)) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index 38938a53837..8e45fdf3e3c 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -36,6 +36,9 @@ (declare-function org-agenda-redo "org-agenda" ()) (declare-function org-agenda-do-context-action "org-agenda" ()) +(when (featurep 'xemacs) + (error "Do not load this file into XEmacs, use 'org-colview-xemacs.el'.")) + ;;; Column View (defvar org-columns-overlays nil @@ -146,8 +149,8 @@ This is the compiled version of the format.") (defun org-columns-new-overlay (beg end &optional string face) "Create a new column overlay and add it to the list." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face (or face 'secondary-selection)) + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face (or face 'secondary-selection)) (org-overlay-display ov string face) (push ov org-columns-overlays) ov)) @@ -220,12 +223,12 @@ This is the compiled version of the format.") (org-unmodified (setq ov (org-columns-new-overlay beg (setq beg (1+ beg)) string (if dateline face1 face))) - (org-overlay-put ov 'keymap org-columns-map) - (org-overlay-put ov 'org-columns-key property) - (org-overlay-put ov 'org-columns-value (cdr ass)) - (org-overlay-put ov 'org-columns-value-modified modval) - (org-overlay-put ov 'org-columns-pom pom) - (org-overlay-put ov 'org-columns-format f)) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'org-columns-key property) + (overlay-put ov 'org-columns-value (cdr ass)) + (overlay-put ov 'org-columns-value-modified modval) + (overlay-put ov 'org-columns-pom pom) + (overlay-put ov 'org-columns-format f)) (if (or (not (char-after beg)) (equal (char-after beg) ?\n)) (let ((inhibit-read-only t)) @@ -235,12 +238,12 @@ This is the compiled version of the format.") ;; Make the rest of the line disappear. (org-unmodified (setq ov (org-columns-new-overlay beg (point-at-eol))) - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'keymap org-columns-map) - (org-overlay-put ov 'intangible t) + (overlay-put ov 'invisible t) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'intangible t) (push ov org-columns-overlays) - (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) - (org-overlay-put ov 'keymap org-columns-map) + (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))) @@ -298,7 +301,7 @@ for the duration of the command.") (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))) (defun org-columns-hscoll-title () - "Set the header-line-format so that it scrolls along with the table." + "Set the `header-line-format' so that it scrolls along with the table." (sit-for .0001) ; need to force a redisplay to update window-hscroll (when (not (= (window-hscroll) org-columns-previous-hscroll)) (setq header-line-format @@ -323,7 +326,7 @@ for the duration of the command.") (move-marker org-columns-begin-marker nil) (move-marker org-columns-top-level-marker nil) (org-unmodified - (mapc 'org-delete-overlay org-columns-overlays) + (mapc 'delete-overlay org-columns-overlays) (setq org-columns-overlays nil) (let ((inhibit-read-only t)) (remove-text-properties (point-min) (point-max) '(read-only t)))) @@ -495,7 +498,7 @@ Where possible, use the standard interface for changing this line." (progn (setq org-columns-overlays (org-delete-all line-overlays org-columns-overlays)) - (mapc 'org-delete-overlay line-overlays) + (mapc 'delete-overlay line-overlays) (org-columns-eval eval)) (org-columns-display-here))) (org-move-to-column col) @@ -624,7 +627,7 @@ an integer, select that value." (progn (setq org-columns-overlays (org-delete-all line-overlays org-columns-overlays)) - (mapc 'org-delete-overlay line-overlays) + (mapc 'delete-overlay line-overlays) (org-columns-eval '(org-entry-put pom key nval))) (org-columns-display-here))) (org-move-to-column col) @@ -746,17 +749,17 @@ around it." (lambda (x) (- org-columns-time x)))) "Operator <-> format,function,calc map. Used to compile/uncompile columns format and completing read in -interactive function org-columns-new. +interactive function `org-columns-new'. operator string used in #+COLUMNS definition describing the summary type format symbol describing summary type selected interactively in - org-columns-new and internally in - org-columns-number-to-string and - org-columns-string-to-number + `org-columns-new' and internally in + `org-columns-number-to-string' and + `org-columns-string-to-number' function called with a list of values as argument to calculate the summary value -calc function called on every element before summarizing. This is +calc function called on every element before summarizing. This is optional and should only be specified if needed") (defun org-columns-new (&optional prop title width op fmt fun &rest rest) @@ -918,15 +921,15 @@ Don't set this, this is meant for dynamic scoping.") (let (fmt val pos) (save-excursion (mapc (lambda (ov) - (when (equal (org-overlay-get ov 'org-columns-key) property) - (setq pos (org-overlay-start ov)) + (when (equal (overlay-get ov 'org-columns-key) property) + (setq pos (overlay-start ov)) (goto-char pos) (when (setq val (cdr (assoc property (get-text-property (point-at-bol) 'org-summaries)))) - (setq fmt (org-overlay-get ov 'org-columns-format)) - (org-overlay-put ov 'org-columns-value val) - (org-overlay-put ov 'display (format fmt val))))) + (setq fmt (overlay-get ov 'org-columns-format)) + (overlay-put ov 'org-columns-value val) + (overlay-put ov 'display (format fmt val))))) org-columns-overlays)))) (defun org-columns-compute (property) @@ -1109,8 +1112,7 @@ operator the operator if any format the output format for computed results, derived from operator printf a printf format for computed values fun the lisp function to compute summary values, derived from operator -calc function to get values from base elements -" +calc function to get values from base elements" (let ((start 0) width prop title op op-match f printf fun calc) (setq org-columns-current-fmt-compiled nil) (while (string-match @@ -1479,7 +1481,7 @@ This will add overlays to the date lines, to show the summary for each day." (org-columns-compute (car fm))))))))))) (defun org-format-time-period (interval) - "Convert time in fractional days to days/hours/minutes/seconds" + "Convert time in fractional days to days/hours/minutes/seconds." (if (numberp interval) (let* ((days (floor interval)) (frac-hours (* 24 (- interval days))) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 80a45d61f22..1b96b8d0535 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -39,7 +39,10 @@ (declare-function find-library-name "find-func" (library)) (declare-function w32-focus-frame "term/w32-win" (frame)) -(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself +;; The following constant is for backward compatibility. We do not use +;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) +;; at compilation time and can therefore optimize code better. +(defconst org-xemacs-p (featurep 'xemacs)) (defconst org-format-transports-properties-p (let ((x "a")) (add-text-properties 0 1 '(test t) x) @@ -86,25 +89,44 @@ any other entries, and any resulting duplicates will be removed entirely." (t specs))) (put 'org-compatible-face 'lisp-indent-function 1) +(defun org-version-check (version feature level) + (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) + (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) + (rmaj (or (nth 0 v1) 99)) + (rmin (or (nth 1 v1) 99)) + (rbld (or (nth 2 v1) 99)) + (maj (or (nth 0 v2) 0)) + (min (or (nth 1 v2) 0)) + (bld (or (nth 2 v2) 0))) + (if (or (< maj rmaj) + (and (= maj rmaj) + (< min rmin)) + (and (= maj rmaj) + (= min rmin) + (< bld rbld))) + (if (eq level :predicate) + ;; just return if we have the version + nil + (let ((msg (format "Emacs %s or greater is recommended for %s" + version feature))) + (display-warning 'org msg level) + t)) + t))) + ;;;; Emacs/XEmacs compatibility +;; Keys +(defconst org-xemacs-key-equivalents + '(([mouse-1] . [button1]) + ([mouse-2] . [button2]) + ([mouse-3] . [button3]) + ([C-mouse-4] . [(control mouse-4)]) + ([C-mouse-5] . [(control mouse-5)])) + "Translation alist for a couple of keys.") + ;; Overlay compatibility functions -(defun org-make-overlay (beg end &optional buffer) - (if (featurep 'xemacs) - (make-extent beg end buffer) - (make-overlay beg end buffer))) -(defun org-delete-overlay (ovl) - (if (featurep 'xemacs) (progn (delete-extent ovl) nil) (delete-overlay ovl))) (defun org-detach-overlay (ovl) (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) -(defun org-move-overlay (ovl beg end &optional buffer) - (if (featurep 'xemacs) - (set-extent-endpoints ovl beg end (or buffer (current-buffer))) - (move-overlay ovl beg end buffer))) -(defun org-overlay-put (ovl prop value) - (if (featurep 'xemacs) - (set-extent-property ovl prop value) - (overlay-put ovl prop value))) (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." (if (featurep 'xemacs) @@ -124,32 +146,24 @@ any other entries, and any resulting duplicates will be removed entirely." (if face (org-add-props text nil 'face face)) (overlay-put ovl 'before-string text) (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-get (ovl prop) - (if (featurep 'xemacs) - (extent-property ovl prop) - (overlay-get ovl prop))) -(defun org-overlays-at (pos) - (if (featurep 'xemacs) (extents-at pos) (overlays-at pos))) -(defun org-overlays-in (&optional start end) - (if (featurep 'xemacs) - (extent-list nil start end) - (overlays-in start end))) -(defun org-overlay-start (o) - (if (featurep 'xemacs) (extent-start-position o) (overlay-start o))) -(defun org-overlay-end (o) - (if (featurep 'xemacs) (extent-end-position o) (overlay-end o))) -(defun org-overlay-buffer (o) - (if (featurep 'xemacs) (extent-buffer o) (overlay-buffer o))) (defun org-find-overlays (prop &optional pos delete) "Find all overlays specifying PROP at POS or point. If DELETE is non-nil, delete all those overlays." - (let ((overlays (org-overlays-at (or pos (point)))) + (let ((overlays (overlays-at (or pos (point)))) ov found) (while (setq ov (pop overlays)) - (if (org-overlay-get ov prop) - (if delete (org-delete-overlay ov) (push ov found)))) + (if (overlay-get ov prop) + (if delete (delete-overlay ov) (push ov found)))) found)) +(defun org-get-x-clipboard (value) + "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21." + (if (eq window-system 'x) + (let ((x (org-get-x-clipboard-compat value))) + (if x (org-no-properties x))))) + +;; Miscellaneous functions + (defun org-add-hook (hook function &optional append local) "Add-hook, compatible with both Emacsen." (if (and local (featurep 'xemacs)) @@ -170,7 +184,7 @@ that will be added to PLIST. Returns the string that was modified." "Fit WINDOW to the buffer, but only if it is not a side-by-side window. WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call -`shrink-window-if-larger-than-buffer' instead, the hight limit are +`shrink-window-if-larger-than-buffer' instead, the height limit is ignored in this case." (cond ((if (fboundp 'window-full-width-p) (not (window-full-width-p window)) @@ -206,19 +220,6 @@ Works on both Emacs and XEmacs." ;; Invisibility compatibility -(defun org-add-to-invisibility-spec (arg) - "Add elements to `buffer-invisibility-spec'. -See documentation for `buffer-invisibility-spec' for the kind of elements -that can be added." - (cond - ((fboundp 'add-to-invisibility-spec) - (add-to-invisibility-spec arg)) - ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) - (setq buffer-invisibility-spec (list arg))) - (t - (setq buffer-invisibility-spec - (cons arg buffer-invisibility-spec))))) - (defun org-remove-from-invisibility-spec (arg) "Remove elements from `buffer-invisibility-spec'." (if (fboundp 'remove-from-invisibility-spec) @@ -233,62 +234,42 @@ that can be added." (member arg buffer-invisibility-spec) nil)) +(defmacro org-xemacs-without-invisibility (&rest body) + "Turn off exents with invisibility while executing BODY." + `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol) + 'all-extents-closed-open 'invisible)) + ext-inv-specs) + (dolist (ext ext-inv) + (when (extent-property ext 'invisible) + (add-to-list 'ext-inv-specs (list ext (extent-property + ext 'invisible))) + (set-extent-property ext 'invisible nil))) + ,@body + (dolist (ext-inv-spec ext-inv-specs) + (set-extent-property (car ext-inv-spec) 'invisible + (cadr ext-inv-spec))))) + (defun org-indent-to-column (column &optional minimum buffer) "Work around a bug with extents with invisibility in XEmacs." (if (featurep 'xemacs) - (let ((ext-inv (extent-list - nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property - ext 'invisible))) - (set-extent-property ext 'invisible nil))) - (indent-to-column column minimum buffer) - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec)))) + (org-xemacs-without-invisibility (indent-to-column column minimum buffer)) (indent-to-column column minimum))) (defun org-indent-line-to (column) "Work around a bug with extents with invisibility in XEmacs." (if (featurep 'xemacs) - (let ((ext-inv (extent-list - nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property - ext 'invisible))) - (set-extent-property ext 'invisible nil))) - (indent-line-to column) - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec)))) + (org-xemacs-without-invisibility (indent-line-to column)) (indent-line-to column))) (defun org-move-to-column (column &optional force buffer) (if (featurep 'xemacs) - (let ((ext-inv (extent-list - nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property ext - 'invisible))) - (set-extent-property ext 'invisible nil))) - (move-to-column column force buffer) - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec)))) + (org-xemacs-without-invisibility (move-to-column column force buffer)) (move-to-column column force))) (defun org-get-x-clipboard-compat (value) - "Get the clipboard value on XEmacs or Emacs 21" - (cond (org-xemacs-p (org-no-warnings (get-selection-no-error value))) + "Get the clipboard value on XEmacs or Emacs 21." + (cond ((featurep 'xemacs) + (org-no-warnings (get-selection-no-error value))) ((fboundp 'x-get-selection) (condition-case nil (or (x-get-selection value 'UTF8_STRING) @@ -362,6 +343,18 @@ TIME defaults to the current time." (time-to-seconds (or time (current-time))) (float-time time))) +(defun org-string-match-p (&rest args) + (if (fboundp 'string-match-p) + (apply 'string-match-p args) + (save-match-data + (apply 'string-match args)))) + +(defun org-looking-at-p (&rest args) + (if (fboundp 'looking-at-p) + (apply 'looking-at-p args) + (save-match-data + (apply 'looking-at-p args)))) + ; XEmacs does not have `looking-back'. (if (fboundp 'looking-back) (defalias 'org-looking-back 'looking-back) diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index 04f519a7aa9..d93981227e5 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -4,7 +4,7 @@ ;; Emacs Lisp Archive Entry ;; Filename: org-crypt.el -;; Version: 6.35i +;; Version: 7.01 ;; Keywords: org-mode ;; Author: John Wiegley <johnw@gnu.org> ;; Maintainer: Peter Jones <pjones@pmade.com> @@ -45,6 +45,7 @@ ;; decrypt it. This makes it possible to leave secure notes that ;; only the intended recipient can read in a shared-org-mode-files ;; scenario. +;; If the key is not set, org-crypt will default to symmetric encryption. ;; ;; 3. To later decrypt an entry, use `org-decrypt-entries' or ;; `org-decrypt-entry'. It might be useful to bind this to a key, @@ -66,6 +67,8 @@ (require 'org) +;;; Code: + (declare-function epg-decrypt-string "epg" (context cipher)) (declare-function epg-list-keys "epg" (context &optional name mode)) (declare-function epg-make-context "epg" @@ -80,24 +83,25 @@ :tag "Org Crypt" :group 'org) (defcustom org-crypt-tag-matcher "crypt" - "The tag matcher used to find headings whose contents should be -encrypted. See the \"Match syntax\" section of the org manual -for more details." + "The tag matcher used to find headings whose contents should be encrypted. + +See the \"Match syntax\" section of the org manual for more details." :type 'string :group 'org-crypt) (defcustom org-crypt-key nil - "The default key to use when encrypting the contents of a -heading. This can also be overridden in the CRYPTKEY property." + "The default key to use when encrypting the contents of a heading. + +This setting can also be overridden in the CRYPTKEY property." :type 'string :group 'org-crypt) (defun org-crypt-key-for-heading () - "Returns the encryption key for the current heading." + "Return the encryption key for the current heading." (save-excursion (org-back-to-heading t) (or (org-entry-get nil "CRYPTKEY" 'selective) org-crypt-key (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to) - (error "No crypt key set")))) + (message "No crypt key set, using symmetric encryption.")))) (defun org-encrypt-entry () "Encrypt the content of the current headline." @@ -105,52 +109,54 @@ heading. This can also be overridden in the CRYPTKEY property." (require 'epg) (save-excursion (org-back-to-heading t) - (forward-line) - (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) - (let ((folded (org-invisible-p)) - (epg-context (epg-make-context nil t t)) - (crypt-key (org-crypt-key-for-heading)) - (beg (point)) - end encrypted-text) - (org-end-of-subtree t t) - (org-back-over-empty-lines) - (setq end (point) - encrypted-text - (epg-encrypt-string - epg-context - (buffer-substring-no-properties beg end) - (epg-list-keys epg-context crypt-key))) - (delete-region beg end) - (insert encrypted-text) - (when folded - (save-excursion - (org-back-to-heading t) - (hide-subtree))) - nil)))) + (let ((start-heading (point))) + (forward-line) + (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) + (let ((folded (org-invisible-p)) + (epg-context (epg-make-context nil t t)) + (crypt-key (org-crypt-key-for-heading)) + (beg (point)) + end encrypted-text) + (goto-char start-heading) + (org-end-of-subtree t t) + (org-back-over-empty-lines) + (setq end (point) + encrypted-text + (epg-encrypt-string + epg-context + (buffer-substring-no-properties beg end) + (epg-list-keys epg-context crypt-key))) + (delete-region beg end) + (insert encrypted-text) + (when folded + (goto-char start-heading) + (hide-subtree)) + nil))))) (defun org-decrypt-entry () "Decrypt the content of the current headline." (interactive) (require 'epg) - (save-excursion - (org-back-to-heading t) - (forward-line) - (when (looking-at "-----BEGIN PGP MESSAGE-----") - (let* ((beg (point)) - (end (save-excursion - (search-forward "-----END PGP MESSAGE-----") - (forward-line) - (point))) - (epg-context (epg-make-context nil t t)) - (decrypted-text - (decode-coding-string - (epg-decrypt-string - epg-context - (buffer-substring-no-properties beg end)) - 'utf-8))) - (delete-region beg end) - (insert decrypted-text) - nil)))) + (unless (org-before-first-heading-p) + (save-excursion + (org-back-to-heading t) + (forward-line) + (when (looking-at "-----BEGIN PGP MESSAGE-----") + (let* ((beg (point)) + (end (save-excursion + (search-forward "-----END PGP MESSAGE-----") + (forward-line) + (point))) + (epg-context (epg-make-context nil t t)) + (decrypted-text + (decode-coding-string + (epg-decrypt-string + epg-context + (buffer-substring-no-properties beg end)) + 'utf-8))) + (delete-region beg end) + (insert decrypted-text) + nil))))) (defun org-encrypt-entries () "Encrypt all top-level entries in the current buffer." @@ -167,8 +173,7 @@ heading. This can also be overridden in the CRYPTKEY property." (cdr (org-make-tags-matcher org-crypt-tag-matcher)))) (defun org-crypt-use-before-save-magic () - "Adds a hook that will automatically encrypt entries before a -file is saved to disk." + "Add a hook to automatically encrypt entries before a file is saved to disk." (add-hook 'org-mode-hook (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t)))) diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 0a0023898a5..fc6b192e566 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -3,10 +3,10 @@ ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Paul Sexton <eeeickythump@gmail.com> -;; Version: 1.0 +;; Version: 7.01 ;; Keywords: org, wp -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -134,7 +134,10 @@ ;; (message "-- rebuilding tags tables...") ;; (mapc 'org-create-tags tags-table-list)) +;;; Code: + (eval-when-compile (require 'cl)) + (require 'org) (defgroup org-ctags nil @@ -146,8 +149,8 @@ "Activate ctags support in org mode?") (defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/" - "Regexp expression used by ctags external program, that matches -tag destinations in org-mode files. + "Regexp expression used by ctags external program. +The regexp matches tag destinations in org-mode files. Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/ See the ctags documentation for more information.") @@ -164,8 +167,7 @@ See the ctags documentation for more information.") '(org-ctags-find-tag org-ctags-ask-rebuild-tags-file-then-find-tag org-ctags-ask-append-topic) - "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when -ORG-CTAGS is active." + "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when ORG-CTAGS is active." :group 'org-ctags :type 'hook :options '(org-ctags-find-tag @@ -179,8 +181,8 @@ ORG-CTAGS is active." (defvar org-ctags-tag-list nil - "List of all tags in the active TAGS file. Created as a local -variable in each buffer.") + "List of all tags in the active TAGS file. +Created as a local variable in each buffer.") (defcustom org-ctags-new-topic-template "* <<%t>>\n\n\n\n\n\n" @@ -218,12 +220,12 @@ The following patterns are replaced in the string: (add-hook 'org-open-link-functions fn t))) -;;; General utility functions. =============================================== +;;; General utility functions. =============================================== ;; These work outside org-ctags mode. (defun org-ctags-get-filename-for-tag (tag) - "TAG is a string. Search the active TAGS file for a matching tag, -and if found, return a list containing the filename, line number, and + "TAG is a string. Search the active TAGS file for a matching tag. +If the tag is found, return a list containing the filename, line number, and buffer position where the tag is found." (interactive "sTag: ") (unless tags-file-name @@ -279,8 +281,8 @@ Return the list." (defun org-ctags-open-file (name &optional title) - "Visit or create a file called `NAME.org', and insert a new topic titled -NAME (or TITLE if supplied)." + "Visit or create a file called `NAME.org', and insert a new topic. +The new topic will be titled NAME (or TITLE if supplied)." (interactive "sFile name: ") (let ((filename (substitute-in-file-name (expand-file-name name)))) (condition-case v @@ -349,7 +351,7 @@ If there is no plausible default, return nil." (defun org-ctags-find-tag (name) "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Look for a tag called `NAME' in the current TAGS table. If it is found, +Look for a tag called `NAME' in the current TAGS table. If it is found, visit the file and location where the tag is found." (interactive "sTag: ") (let ((old-buf (current-buffer)) @@ -368,11 +370,11 @@ visit the file and location where the tag is found." (defun org-ctags-visit-buffer-or-file (name &optional create) "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Visit buffer named `NAME.org'. If there is no such buffer, visit the file -with the same name if it exists. If the file does not exist, then behaviour +Visit buffer named `NAME.org'. If there is no such buffer, visit the file +with the same name if it exists. If the file does not exist, then behavior depends on the value of CREATE. -If CREATE is nil (default), then return nil. Do not create a new file. +If CREATE is nil (default), then return nil. Do not create a new file. If CREATE is t, create the new file and visit it. If CREATE is the symbol `ask', then ask the user if they wish to create the new file." @@ -453,7 +455,7 @@ 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?" + "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) @@ -463,7 +465,7 @@ Wrapper for org-ctags-rebuild-tags-file-then-find-tag." (defun org-ctags-fail-silently (name) "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. Put as the last function in the list if you want to prevent org's default -behaviour of free text search." +behavior of free text search." t) @@ -471,14 +473,14 @@ behaviour of free text search." (defun org-ctags-create-tags (&optional directory-name) - "(Re)create tags file in the directory of the active buffer, -containing tag definitions for all the files in the directory and its -subdirectories which are recognised by ctags. This will include -files ending in `.org' as well as most other source files (.C, -.H, .EL, .LISP, etc). All the resulting tags end up in one file, -called TAGS, located in the directory. This function -may take several seconds to finish if the directory or its -subdirectories contain large numbers of taggable files." + "(Re)create tags file in the directory of the active buffer. +The file will contain tag definitions for all the files in the +directory and its subdirectories which are recognized by ctags. +This will include files ending in `.org' as well as most other +source files (.C, .H, .EL, .LISP, etc). All the resulting tags +end up in one file, called TAGS, located in the directory. This +function may take several seconds to finish if the directory or +its subdirectories contain large numbers of taggable files." (interactive) (assert (buffer-file-name)) (let ((dir-name (or directory-name @@ -509,8 +511,8 @@ subdirectories contain large numbers of taggable files." "History of tags visited by org-ctags-find-tag-interactive.") (defun org-ctags-find-tag-interactive () - "Prompt for the name of a tag, with autocompletion, then visit -the named tag. Uses ido-mode if available. + "Prompt for the name of a tag, with autocompletion, then visit the named tag. +Uses `ido-mode' if available. If the user enters a string that does not match an existing tag, create a new topic." (interactive) diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index d1a42731b51..331d6d6a1d1 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -36,8 +36,8 @@ (defvar org-datetree-base-level 1 "The level at which years should be placed in the date tree. This is normally one, but if the buffer has an entry with a DATE_TREE -property, the date tree will become a subtree under that entry, so the -base level will be properly adjusted.") +property (any value), the date tree will become a subtree under that entry, +so the base level will be properly adjusted.") ;;;###autoload (defun org-datetree-find-date-create (date &optional keep-restriction) diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el index e5ee98bb344..12ab96deff9 100644 --- a/lisp/org/org-docbook.el +++ b/lisp/org/org-docbook.el @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-docbook.el -;; Version: 6.35i +;; Version: 7.01 ;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Keywords: org, wp, docbook @@ -26,7 +26,7 @@ ;; 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: +;;; Commentary: ;; ;; This library implements a DocBook exporter for org-mode. The basic ;; idea and design is very similar to what `org-export-as-html' has. @@ -76,6 +76,7 @@ (require 'org) (require 'org-exp) (require 'org-html) +(require 'format-spec) ;;; Variables: @@ -141,8 +142,8 @@ people work on the same document." :type 'string) (defcustom org-export-docbook-footnote-id-prefix "fn-" - "The prefix of footnote IDs used during exporting. Like -`org-export-docbook-section-id-prefix', this variable can help + "The prefix of footnote IDs used during exporting. +Like `org-export-docbook-section-id-prefix', this variable can help avoid same set of footnote IDs being used multiple times." :group 'org-export-docbook :type 'string) @@ -154,7 +155,7 @@ avoid same set of footnote IDs being used multiple times." ("=" "<code>" "</code>") ("~" "<literal>" "</literal>") ("+" "<emphasis role=\"strikethrough\">" "</emphasis>")) - "Alist of DocBook expressions to convert emphasis fontifiers. + "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. @@ -183,32 +184,39 @@ default, but users can override them using `#+ATTR_DocBook:'." :group 'org-export-docbook :type 'coding-system) +(defcustom org-export-docbook-xslt-stylesheet nil + "File name of the XSLT stylesheet used by DocBook exporter. +This XSLT stylesheet is used by +`org-export-docbook-xslt-proc-command' to generate the Formatting +Object (FO) files. You can use either `fo/docbook.xsl' that +comes with DocBook, or any customization layer you may have." + :group 'org-export-docbook + :type 'string) + (defcustom org-export-docbook-xslt-proc-command nil - "XSLT processor command used by DocBook exporter. -This is the command used to process a DocBook XML file to -generate the formatting object (FO) file. + "Format of XSLT processor command used by DocBook exporter. +This command is used to process a DocBook XML file to generate +the Formatting Object (FO) file. The value of this variable should be a format control string that -includes two `%s' arguments: the first one is for the output FO -file name, and the second one is for the input DocBook XML file -name. +includes three arguments: `%i', `%o', and `%s'. During exporting +time, `%i' is replaced by the input DocBook XML file name, `%o' +is replaced by the output FO file name, and `%s' is replaced by +`org-export-docbook-xslt-stylesheet' (or the #+XSLT option if it +is specified in the Org file). For example, if you use Saxon as the XSLT processor, you may want to set the variable to - \"java com.icl.saxon.StyleSheet -o %s %s /path/to/docbook.xsl\" + \"java com.icl.saxon.StyleSheet -o %o %i %s\" If you use Xalan, you can set it to - \"java org.apache.xalan.xslt.Process -out %s -in %s -xsl /path/to/docbook.xsl\" + \"java org.apache.xalan.xslt.Process -out %o -in %i -xsl %s\" For xsltproc, the following string should work: - \"xsltproc --output %s /path/to/docbook.xsl %s\" - -You need to replace \"/path/to/docbook.xsl\" with the actual path -to the DocBook stylesheet file on your machine. You can also -replace it with your own customization layer if you have one. + \"xsltproc --output %o %s %i\" You can include additional stylesheet parameters in this command. Just make sure that they meet the syntax requirement of each @@ -217,18 +225,19 @@ processor." :type 'string) (defcustom org-export-docbook-xsl-fo-proc-command nil - "XSL-FO processor command used by DocBook exporter. -This is the command used to process a formatting object (FO) file -to generate the PDF file. + "Format of XSL-FO processor command used by DocBook exporter. +This command is used to process a Formatting Object (FO) file to +generate the PDF file. The value of this variable should be a format control string that -includes two `%s' arguments: the first one is for the input FO -file name, and the second one is for the output PDF file name. +includes two arguments: `%i' and `%o'. During exporting time, +`%i' is replaced by the input FO file name, and `%o' is replaced +by the output PDF file name. For example, if you use FOP as the XSL-FO processor, you can set the variable to - \"fop %s %s\"" + \"fop %i %o\"" :group 'org-export-docbook :type 'string) @@ -333,13 +342,18 @@ in a window. A non-interactive call will only return the buffer." "Export as DocBook XML file, and generate PDF file." (interactive "P") (if (or (not org-export-docbook-xslt-proc-command) - (not (string-match "%s.+%s" org-export-docbook-xslt-proc-command))) + (not (string-match "%[ios].+%[ios].+%[ios]" org-export-docbook-xslt-proc-command))) (error "XSLT processor command is not set correctly")) (if (or (not org-export-docbook-xsl-fo-proc-command) - (not (string-match "%s.+%s" org-export-docbook-xsl-fo-proc-command))) + (not (string-match "%[io].+%[io]" org-export-docbook-xsl-fo-proc-command))) (error "XSL-FO processor command is not set correctly")) (message "Exporting to PDF...") (let* ((wconfig (current-window-configuration)) + (opt-plist + (org-export-process-option-filters + (org-combine-plists (org-default-export-plist) + ext-plist + (org-infile-export-plist)))) (docbook-buf (org-export-as-docbook hidden ext-plist to-buffer body-only pub-dir)) (filename (buffer-file-name docbook-buf)) @@ -348,10 +362,17 @@ in a window. A non-interactive call will only return the buffer." (pdffile (concat base ".pdf"))) (and (file-exists-p pdffile) (delete-file pdffile)) (message "Processing DocBook XML file...") - (shell-command (format org-export-docbook-xslt-proc-command - fofile (shell-quote-argument filename))) - (shell-command (format org-export-docbook-xsl-fo-proc-command - fofile pdffile)) + (shell-command (format-spec org-export-docbook-xslt-proc-command + (format-spec-make + ?i (shell-quote-argument filename) + ?o (shell-quote-argument fofile) + ?s (shell-quote-argument + (or (plist-get opt-plist :xslt) + org-export-docbook-xslt-stylesheet))))) + (shell-command (format-spec org-export-docbook-xsl-fo-proc-command + (format-spec-make + ?i (shell-quote-argument fofile) + ?o (shell-quote-argument pdffile)))) (message "Processing DocBook file...done") (if (not (file-exists-p pdffile)) (error "PDF file was not produced") @@ -533,7 +554,7 @@ publishing directory." table-buffer table-orig-buffer ind item-type starter didclose rpl path attr caption label desc descp desc1 desc2 link - fnc item-tag + fnc item-tag initial-number footref-seen footnote-list id-file ) @@ -998,7 +1019,11 @@ publishing directory." starter (if (match-beginning 2) (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5)) - item-tag nil) + item-tag nil + initial-number nil) + (if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line) + (setq initial-number (match-string 1 line) + line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) (setq item-type "d" item-tag (match-string 1 line) @@ -1031,7 +1056,18 @@ publishing directory." (org-export-docbook-close-para-maybe) (insert (cond ((equal item-type "u") "<itemizedlist>\n<listitem>\n") - ((equal item-type "o") "<orderedlist>\n<listitem>\n") + ((equal item-type "o") + ;; Check for a specific start number. If it + ;; is specified, we use the ``override'' + ;; attribute of element <listitem> to pass the + ;; info to DocBook. We could also use the + ;; ``startingnumber'' attribute of element + ;; <orderedlist>, but the former works on both + ;; DocBook 5.0 and prior versions. + (if initial-number + (format "<orderedlist>\n<listitem override=\"%s\">\n" + initial-number) + "<orderedlist>\n<listitem>\n")) ((equal item-type "d") (format "<variablelist>\n<varlistentry><term>%s</term><listitem>\n" item-tag)))) ;; For DocBook, we need to open a para right after tag @@ -1228,7 +1264,8 @@ When TITLE is nil, just close all open levels." (setq section-number (org-section-number level)) (insert (format "\n<section xml:id=\"%s%s\">\n<title>%s</title>" org-export-docbook-section-id-prefix - section-number title)) + (replace-regexp-in-string "\\." "_" section-number) + title)) (org-export-docbook-open-para)))) (defun org-docbook-expand (string) diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el index ad507546696..cac13e6ddfc 100644 --- a/lisp/org/org-docview.el +++ b/lisp/org/org-docview.el @@ -2,10 +2,10 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Jan Bcker <jan.boecker at jboecker dot de> +;; Author: Jan Böcker <jan.boecker at jboecker dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -62,7 +62,7 @@ ))) (defun org-docview-store-link () - "Store a link to a docview buffer" + "Store a link to a docview buffer." (when (eq major-mode 'doc-view-mode) ;; This buffer is in doc-view-mode (let* ((path buffer-file-name) @@ -75,11 +75,16 @@ :description path)))) (defun org-docview-complete-link () - "Use the existing file name completion for file: links to get the file name, - then ask the user for the page number and append it." + "Use the existing file name completion for file. +Links to get the file name, then ask the user for the page number +and append it." (concat (replace-regexp-in-string "^file:" "docview:" (org-file-complete-link)) "::" (read-from-minibuffer "Page:" "1"))) (provide 'org-docview) + +;; arch-tag: dd147a78-cce1-481b-b40a-15869417debe + +;;; org-docview.el ends here diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 709c037d488..70c88afa6a2 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -6,7 +6,7 @@ ;; Ulf Stegemann <ulf at zeitform dot de> ;; Keywords: outlines, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,6 +26,8 @@ ;; ;;; Commentary: +;;; Code: + (require 'org-macs) (declare-function org-table-align "org-table" ()) @@ -46,11 +48,11 @@ in backends where the corresponding character is not available." :type 'boolean) (defcustom org-entities-user nil - "User-defined entities used in Org-mode to preduce special characters. -Each entry in this list is a list of strings. It associate the name + "User-defined entities used in Org-mode to produce special characters. +Each entry in this list is a list of strings. It associates the name of the entity that can be inserted into an Org file as \\name with the appropriate replacements for the different export backends. The order -of the fields is he following +of the fields is the following name As a string, without the leading backslash LaTeX replacement In ready LaTeX, no further processing will take place @@ -59,10 +61,10 @@ LaTeX mathp A Boolean, either t or nil. t if this entity needs HTML replacement In ready HTML, no further processing will take place. Usually this will be an &...; entity. ASCII replacement Plain ASCII, no extensions. Symbols that cannot be - represented will be written out as an explanatory text. - But see the variable `org-entities-ascii-keep-macro-form'. + represented will be left as they are, but see the. + variable `org-entities-ascii-explanatory'. Latin1 replacement Use the special characters available in latin1. -utf-8 replacement Use special character available in utf-8. +utf-8 replacement Use the special characters available in utf-8. If you define new entities here that require specific LaTeX packages to be loaded, add these packages to `org-export-latex-packages-alist'." @@ -78,229 +80,245 @@ loaded, add these packages to `org-export-latex-packages-alist'." (string :tag "utf-8 ")))) (defconst org-entities - '(("nbsp" "~" nil " " " " " " " ") - ("iexcl" "!`" nil "¡" "!" "¡" "¡") - ("cent" "\\textcent{}" nil "¢" "cent" "¢" "¢") - ("pound" "\\pounds{}" nil "£" "pound" "£" "£") - ("curren" "\\textcurrency{}" nil "¤" "curr." "¤" "¤") - ("yen" "\\textyen{}" nil "¥" "yen" "¥" "¥") - ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") - ("vert" "\\vert{}" t "|" "|" "|" "|") - ("sect" "\\S" nil "§" "paragraph" "§" "§") - ("uml" "\\textasciidieresis{}" nil "¨" "[diaeresis]" "¨" "¨") - ("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©") - ("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ª" "ª") - ("laquo" "\\guillemotleft{}" nil "«" "<<" "«" "«") - ("not" "\\textlnot{}" nil "¬" "[angled dash]" "¬" "¬") - ("shy" "\\-" nil "­" "" "" "") - ("reg" "\\textregistered{}" nil "®" "(r)" "®" "®") - ("macr" "\\textasciimacron{}" nil "¯" "[macron]" "¯" "¯") - ("deg" "\\textdegree{}" nil "deg" "degree" "°" "°") - ("pm" "\\textpm{}" nil "±" "+-" "±" "±") - ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") - ("sup2" "\\texttwosuperior{}" nil "²" "^2" "²" "²") - ("sup3" "\\textthreesuperior{}" nil "³" "^3" "³" "³") - ("acutex" "\\acute x" t "´x" "'x" "'x" "𝑥́") - ("micro" "\\textmu{}" nil "µ" "micro" "µ" "µ") - ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") - ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") - ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ") - ("star" "\\star" t "*" "*" "*" "⋆") - ("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸") - ("sup1" "\\textonesuperior{}" nil "¹" "^1" "¹" "¹") - ("ordm" "\\textordmasculine{}" nil "º" "_o_" "º" "º") - ("raquo" "\\guillemotright{}" nil "»" ">>" "»" "»") - ("iquest" "?`" nil "¿" "?" "¿" "¿") + '( + "* Letters" + "** Latin" ("Agrave" "\\`{A}" nil "À" "A" "À" "À") + ("agrave" "\\`{a}" nil "à" "a" "à" "à") ("Aacute" "\\'{A}" nil "Á" "A" "Á" "Á") + ("aacute" "\\'{a}" nil "á" "a" "á" "á") ("Acirc" "\\^{A}" nil "Â" "A" "Â" "Â") + ("acirc" "\\^{a}" nil "â" "a" "â" "â") ("Atilde" "\\~{A}" nil "Ã" "A" "Ã" "Ã") + ("atilde" "\\~{a}" nil "ã" "a" "ã" "ã") ("Auml" "\\\"{A}" nil "Ä" "Ae" "Ä" "Ä") + ("auml" "\\\"{a}" nil "ä" "ae" "ä" "ä") ("Aring" "\\AA{}" nil "Å" "A" "Å" "Å") ("AA" "\\AA{}" nil "Å" "A" "Å" "Å") - ("AElig" "\\AE{}" nil "Æ" "AE" "Æ" "Æ") - ("Ccedil" "\\c{C}" nil "Ç" "C" "Ç" "Ç") - ("Egrave" "\\`{E}" nil "È" "E" "È" "È") - ("Eacute" "\\'{E}" nil "É" "E" "É" "É") - ("Ecirc" "\\^{E}" nil "Ê" "E" "Ê" "Ê") - ("Euml" "\\\"{E}" nil "Ë" "E" "Ë" "Ë") - ("Igrave" "\\`{I}" nil "Ì" "I" "Ì" "Ì") - ("Iacute" "\\'{I}" nil "Í" "I" "Í" "Í") - ("Icirc" "\\^{I}" nil "Î" "I" "Î" "Î") - ("Iuml" "\\\"{I}" nil "Ï" "I" "Ï" "Ï") - ("ETH" "\\DH{}" nil "Ð" "D" "Ð" "Ð") - ("Ntilde" "\\~{N}" nil "Ñ" "N" "Ñ" "Ñ") - ("Ograve" "\\`{O}" nil "Ò" "O" "Ò" "Ò") - ("Oacute" "\\'{O}" nil "Ó" "O" "Ó" "Ó") - ("Ocirc" "\\^{O}" nil "Ô" "O" "Ô" "Ô") - ("Otilde" "\\~{O}" nil "Õ" "O" "Õ" "Õ") - ("Ouml" "\\\"{O}" nil "Ö" "Oe" "Ö" "Ö") - ("times" "\\texttimes{}" nil "×" "*" "×" "×") - ("Oslash" "\\O" nil "Ø" "O" "Ø" "Ø") - ("Ugrave" "\\`{U}" nil "Ù" "U" "Ù" "Ù") - ("Uacute" "\\'{U}" nil "Ú" "U" "Ú" "Ú") - ("Ucirc" "\\^{U}" nil "Û" "U" "Û" "Û") - ("Uuml" "\\\"{U}" nil "Ü" "Ue" "Ü" "Ü") - ("Yacute" "\\'{Y}" nil "Ý" "Y" "Ý" "Ý") - ("THORN" "\\TH{}" nil "Þ" "TH" "Þ" "Þ") - ("szlig" "\\ss{}" nil "ß" "ss" "ß" "ß") - ("agrave" "\\`{a}" nil "à" "a" "à" "à") - ("aacute" "\\'{a}" nil "á" "a" "á" "á") - ("acirc" "\\^{a}" nil "â" "a" "â" "â") - ("atilde" "\\~{a}" nil "ã" "a" "ã" "ã") - ("auml" "\\\"{a}" nil "ä" "ae" "ä" "ä") ("aring" "\\aa{}" nil "å" "a" "å" "å") + ("AElig" "\\AE{}" nil "Æ" "AE" "Æ" "Æ") ("aelig" "\\ae{}" nil "æ" "ae" "æ" "æ") + ("Ccedil" "\\c{C}" nil "Ç" "C" "Ç" "Ç") ("ccedil" "\\c{c}" nil "ç" "c" "ç" "ç") - ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + ("Egrave" "\\`{E}" nil "È" "E" "È" "È") ("egrave" "\\`{e}" nil "è" "e" "è" "è") + ("Eacute" "\\'{E}" nil "É" "E" "É" "É") ("eacute" "\\'{e}" nil "é" "e" "é" "é") + ("Ecirc" "\\^{E}" nil "Ê" "E" "Ê" "Ê") ("ecirc" "\\^{e}" nil "ê" "e" "ê" "ê") + ("Euml" "\\\"{E}" nil "Ë" "E" "Ë" "Ë") ("euml" "\\\"{e}" nil "ë" "e" "ë" "ë") + ("Igrave" "\\`{I}" nil "Ì" "I" "Ì" "Ì") ("igrave" "\\`{i}" nil "ì" "i" "ì" "ì") + ("Iacute" "\\'{I}" nil "Í" "I" "Í" "Í") ("iacute" "\\'{i}" nil "í" "i" "í" "í") + ("Icirc" "\\^{I}" nil "Î" "I" "Î" "Î") ("icirc" "\\^{i}" nil "î" "i" "î" "î") + ("Iuml" "\\\"{I}" nil "Ï" "I" "Ï" "Ï") ("iuml" "\\\"{i}" nil "ï" "i" "ï" "ï") - ("eth" "\\dh{}" nil "ð" "dh" "ð" "ð") + ("Ntilde" "\\~{N}" nil "Ñ" "N" "Ñ" "Ñ") ("ntilde" "\\~{n}" nil "ñ" "n" "ñ" "ñ") + ("Ograve" "\\`{O}" nil "Ò" "O" "Ò" "Ò") ("ograve" "\\`{o}" nil "ò" "o" "ò" "ò") + ("Oacute" "\\'{O}" nil "Ó" "O" "Ó" "Ó") ("oacute" "\\'{o}" nil "ó" "o" "ó" "ó") + ("Ocirc" "\\^{O}" nil "Ô" "O" "Ô" "Ô") ("ocirc" "\\^{o}" nil "ô" "o" "ô" "ô") + ("Otilde" "\\~{O}" nil "Õ" "O" "Õ" "Õ") ("otilde" "\\~{o}" nil "õ" "o" "õ" "õ") + ("Ouml" "\\\"{O}" nil "Ö" "Oe" "Ö" "Ö") ("ouml" "\\\"{o}" nil "ö" "oe" "ö" "ö") + ("Oslash" "\\O" nil "Ø" "O" "Ø" "Ø") ("oslash" "\\o{}" nil "ø" "o" "ø" "ø") + ("OElig" "\\OE{}" nil "Œ" "OE" "OE" "Œ") + ("oelig" "\\oe{}" nil "œ" "oe" "oe" "œ") + ("Scaron" "\\v{S}" nil "Š" "S" "S" "Š") + ("scaron" "\\v{s}" nil "š" "s" "s" "š") + ("szlig" "\\ss{}" nil "ß" "ss" "ß" "ß") + ("Ugrave" "\\`{U}" nil "Ù" "U" "Ù" "Ù") ("ugrave" "\\`{u}" nil "ù" "u" "ù" "ù") + ("Uacute" "\\'{U}" nil "Ú" "U" "Ú" "Ú") ("uacute" "\\'{u}" nil "ú" "u" "ú" "ú") + ("Ucirc" "\\^{U}" nil "Û" "U" "Û" "Û") ("ucirc" "\\^{u}" nil "û" "u" "û" "û") + ("Uuml" "\\\"{U}" nil "Ü" "Ue" "Ü" "Ü") ("uuml" "\\\"{u}" nil "ü" "ue" "ü" "ü") + ("Yacute" "\\'{Y}" nil "Ý" "Y" "Ý" "Ý") ("yacute" "\\'{y}" nil "ý" "y" "ý" "ý") - ("thorn" "\\th{}" nil "þ" "th" "þ" "þ") + ("Yuml" "\\\"{Y}" nil "Ÿ" "Y" "Y" "Ÿ") ("yuml" "\\\"{y}" nil "ÿ" "y" "ÿ" "ÿ") + + "** Latin (special face)" ("fnof" "\\textit{f}" nil "ƒ" "f" "f" "ƒ") + ("real" "\\Re" t "ℜ" "R" "R" "ℜ") + ("image" "\\Im" t "ℑ" "I" "I" "ℑ") + ("weierp" "\\wp" t "℘" "P" "P" "℘") + + "** Greek" ("Alpha" "A" nil "Α" "Alpha" "Alpha" "Α") - ("Beta" "B" nil "Β" "Beta" "Beta" "Β") - ("Gamma" "\\Gamma" t "Γ" "Gamma" "Gamma" "Γ") - ("Delta" "\\Delta" t "Δ" "Delta" "Gamma" "Δ") - ("Epsilon" "E" nil "Ε" "Epsilon" "Epsilon" "Ε") - ("Zeta" "Z" nil "Ζ" "Zeta" "Zeta" "Ζ") - ("Eta" "H" nil "Η" "Eta" "Eta" "Η") - ("Theta" "\\Theta" t "Θ" "Theta" "Theta" "Θ") - ("Iota" "I" nil "Ι" "Iota" "Iota" "Ι") - ("Kappa" "K" nil "Κ" "Kappa" "Kappa" "Κ") - ("Lambda" "\\Lambda" t "Λ" "Lambda" "Lambda" "Λ") - ("Mu" "M" nil "Μ" "Mu" "Mu" "Μ") - ("Nu" "N" nil "Ν" "Nu" "Nu" "Ν") - ("Xi" "\\Xi" t "Ξ" "Xi" "Xi" "Ξ") - ("Omicron" "O" nil "Ο" "Omicron" "Omicron" "Ο") - ("Pi" "\\Pi" t "Π" "Pi" "Pi" "Π") - ("Rho" "P" nil "Ρ" "Rho" "Rho" "Ρ") - ("Sigma" "\\Sigma" t "Σ" "Sigma" "Sigma" "Σ") - ("Tau" "T" nil "Τ" "Tau" "Tau" "Τ") - ("Upsilon" "\\Upsilon" t "Υ" "Upsilon" "Upsilon" "Υ") - ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") - ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") - ("Psi" "\\Psi" t "Ψ" "Psi" "Psi" "Ψ") - ("Omega" "\\Omega" t "Ω" "Omega" "Omega" "Ω") ("alpha" "\\alpha" t "α" "alpha" "alpha" "α") + ("Beta" "B" nil "Β" "Beta" "Beta" "Β") ("beta" "\\beta" t "β" "beta" "beta" "β") + ("Gamma" "\\Gamma" t "Γ" "Gamma" "Gamma" "Γ") ("gamma" "\\gamma" t "γ" "gamma" "gamma" "γ") + ("Delta" "\\Delta" t "Δ" "Delta" "Gamma" "Δ") ("delta" "\\delta" t "δ" "delta" "delta" "δ") + ("Epsilon" "E" nil "Ε" "Epsilon" "Epsilon" "Ε") ("epsilon" "\\epsilon" t "ε" "epsilon" "epsilon" "ε") ("varepsilon" "\\varepsilon" t "ε" "varepsilon" "varepsilon" "ε") + ("Zeta" "Z" nil "Ζ" "Zeta" "Zeta" "Ζ") ("zeta" "\\zeta" t "ζ" "zeta" "zeta" "ζ") + ("Eta" "H" nil "Η" "Eta" "Eta" "Η") ("eta" "\\eta" t "η" "eta" "eta" "η") + ("Theta" "\\Theta" t "Θ" "Theta" "Theta" "Θ") ("theta" "\\theta" t "θ" "theta" "theta" "θ") + ("thetasym" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") + ("vartheta" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") + ("Iota" "I" nil "Ι" "Iota" "Iota" "Ι") ("iota" "\\iota" t "ι" "iota" "iota" "ι") + ("Kappa" "K" nil "Κ" "Kappa" "Kappa" "Κ") ("kappa" "\\kappa" t "κ" "kappa" "kappa" "κ") + ("Lambda" "\\Lambda" t "Λ" "Lambda" "Lambda" "Λ") ("lambda" "\\lambda" t "λ" "lambda" "lambda" "λ") + ("Mu" "M" nil "Μ" "Mu" "Mu" "Μ") ("mu" "\\mu" t "μ" "mu" "mu" "μ") ("nu" "\\nu" t "ν" "nu" "nu" "ν") + ("Nu" "N" nil "Ν" "Nu" "Nu" "Ν") + ("Xi" "\\Xi" t "Ξ" "Xi" "Xi" "Ξ") ("xi" "\\xi" t "ξ" "xi" "xi" "ξ") + ("Omicron" "O" nil "Ο" "Omicron" "Omicron" "Ο") ("omicron" "\\textit{o}" nil "ο" "omicron" "omicron" "ο") + ("Pi" "\\Pi" t "Π" "Pi" "Pi" "Π") ("pi" "\\pi" t "π" "pi" "pi" "π") + ("Rho" "P" nil "Ρ" "Rho" "Rho" "Ρ") ("rho" "\\rho" t "ρ" "rho" "rho" "ρ") + ("Sigma" "\\Sigma" t "Σ" "Sigma" "Sigma" "Σ") + ("sigma" "\\sigma" t "σ" "sigma" "sigma" "σ") ("sigmaf" "\\varsigma" t "ς" "sigmaf" "sigmaf" "ς") ("varsigma" "\\varsigma" t "ς" "varsigma" "varsigma" "ς") - ("sigma" "\\sigma" t "σ" "sigma" "sigma" "σ") - ("tau" "\\tau" t "τ" "tau" "tau" "τ") + ("Tau" "T" nil "Τ" "Tau" "Tau" "Τ") + ("Upsilon" "\\Upsilon" t "Υ" "Upsilon" "Upsilon" "Υ") + ("upsih" "\\Upsilon" t "ϒ" "upsilon" "upsilon" "ϒ") ("upsilon" "\\upsilon" t "υ" "upsilon" "upsilon" "υ") + ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") ("phi" "\\phi" t "φ" "phi" "phi" "φ") + ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") ("chi" "\\chi" t "χ" "chi" "chi" "χ") + ("acutex" "\\acute x" t "´x" "'x" "'x" "𝑥́") + ("Psi" "\\Psi" t "Ψ" "Psi" "Psi" "Ψ") ("psi" "\\psi" t "ψ" "psi" "psi" "ψ") + ("tau" "\\tau" t "τ" "tau" "tau" "τ") + ("Omega" "\\Omega" t "Ω" "Omega" "Omega" "Ω") ("omega" "\\omega" t "ω" "omega" "omega" "ω") - ("thetasym" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") - ("vartheta" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") - ("upsih" "\\Upsilon" t "ϒ" "upsilon" "upsilon" "ϒ") ("piv" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") - ("bull" "\\textbullet{}" nil "•" "*" "*" "•") - ("bullet" "\\textbullet{}" nil "•" "*" "*" "•") - ("hellip" "\\dots{}" nil "…" "..." "..." "…") + ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "∂") + + "** Hebrew" + ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + + "** Dead languages" + ("ETH" "\\DH{}" nil "Ð" "D" "Ð" "Ð") + ("eth" "\\dh{}" nil "ð" "dh" "ð" "ð") + ("THORN" "\\TH{}" nil "Þ" "TH" "Þ" "Þ") + ("thorn" "\\th{}" nil "þ" "th" "þ" "þ") + + "* Punctuation" + "** Dots and Marks" ("dots" "\\dots{}" nil "…" "..." "..." "…") - ("prime" "\\prime" t "′" "'" "'" "′") - ("Prime" "\\prime{}\\prime" t "″" "''" "''" "″") - ("oline" "\\overline{~}" t "‾" "[overline]" "¯" "‾") - ("frasl" "/" nil "⁄" "/" "/" "⁄") - ("weierp" "\\wp" t "℘" "P" "P" "℘") - ("image" "\\Im" t "ℑ" "I" "I" "ℑ") - ("real" "\\Re" t "ℜ" "R" "R" "ℜ") + ("hellip" "\\dots{}" nil "…" "..." "..." "…") + ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") + ("iexcl" "!`" nil "¡" "!" "¡" "¡") + ("iquest" "?`" nil "¿" "?" "¿" "¿") + + "** Dash-like" + ("shy" "\\-" nil "­" "" "" "") + ("ndash" "--" nil "–" "-" "-" "–") + ("mdash" "---" nil "—" "--" "--" "—") + + "** Quotations" + ("quot" "\\textquotedbl{}" nil """ "\"" "\"" "\"") + ("acute" "\\textasciiacute{}" nil "´" "'" "´" "´") + ("ldquo" "\\textquotedblleft{}" nil "“" "\"" "\"" "“") + ("rdquo" "\\textquotedblright{}" nil "”" "\"" "\"" "”") + ("bdquo" "\\quotedblbase{}" nil "„" "\"" "\"" "„") + ("lsquo" "\\textquoteleft{}" nil "‘" "`" "`" "‘") + ("rsquo" "\\textquoteright{}" nil "’" "'" "'" "’") + ("sbquo" "\\quotesinglbase{}" nil "‚" "," "," "‚") + ("laquo" "\\guillemotleft{}" nil "«" "<<" "«" "«") + ("raquo" "\\guillemotright{}" nil "»" ">>" "»" "»") + ("lsaquo" "\\guilsinglleft{}" nil "‹" "<" "<" "‹") + ("rsaquo" "\\guilsinglright{}" nil "›" ">" ">" "›") + + "* Other" + "** Misc. (often used)" + ("circ" "\\circ" t "ˆ" "^" "^" "ˆ") + ("vert" "\\vert{}" t "|" "|" "|" "|") + ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") + ("sect" "\\S" nil "§" "paragraph" "§" "§") + ("amp" "\\&" nil "&" "&" "&" "&") + ("lt" "\\textless{}" nil "<" "<" "<" "<") + ("gt" "\\textgreater{}" nil ">" ">" ">" ">") + ("tilde" "\\~{}" nil "˜" "~" "~" "~") + ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") + ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") + + "** Whitespace" + ("nbsp" "~" nil " " " " " " " ") + ("ensp" "\\hspace*{.5em}" nil " " " " " " " ") + ("emsp" "\\hspace*{1em}" nil " " " " " " " ") + ("thinsp" "\\hspace*{.2em}" nil " " " " " " " ") + + "** Currency" + ("curren" "\\textcurrency{}" nil "¤" "curr." "¤" "¤") + ("cent" "\\textcent{}" nil "¢" "cent" "¢" "¢") + ("pound" "\\pounds{}" nil "£" "pound" "£" "£") + ("yen" "\\textyen{}" nil "¥" "yen" "¥" "¥") + ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") + ("EUR" "\\EUR{}" nil "€" "EUR" "EUR" "€") + ("EURdig" "\\EURdig{}" nil "€" "EUR" "EUR" "€") + ("EURhv" "\\EURhv{}" nil "€" "EUR" "EUR" "€") + ("EURcr" "\\EURcr{}" nil "€" "EUR" "EUR" "€") + ("EURtm" "\\EURtm{}" nil "€" "EUR" "EUR" "€") + + "** Property Marks" + ("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©") + ("reg" "\\textregistered{}" nil "®" "(r)" "®" "®") ("trade" "\\texttrademark{}" nil "™" "TM" "TM" "™") - ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") - ("larr" "\\leftarrow" t "←" "<-" "<-" "←") - ("leftarrow" "\\leftarrow" t "←" "<-" "<-" "←") - ("gets" "\\gets" t "←" "<-" "<-" "←") - ("uarr" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") - ("uparrow" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") - ("rarr" "\\rightarrow" t "→" "->" "->" "→") - ("to" "\\to" t "→" "->" "->" "→") - ("rightarrow" "\\rightarrow" t "→" "->" "->" "→") - ("darr" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") - ("downarrow" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") - ("harr" "\\leftrightarrow" t "↔" "<->" "<->" "↔") - ("leftrightarrow" "\\leftrightarrow" t "↔" "<->" "<->" "↔") - ("crarr" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") - ("hookleftarrow" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") - ("lArr" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") - ("Leftarrow" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") - ("uArr" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") - ("Uparrow" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") - ("rArr" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") - ("Rightarrow" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") - ("dArr" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") - ("Downarrow" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") - ("hArr" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") - ("Leftrightarrow" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") - ("forall" "\\forall" t "∀" "[for all]" "[for all]" "∀") - ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "∂") - ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") - ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") - ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "∅") - ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "∅") - ("nabla" "\\nabla" t "∇" "[nabla]" "[nabla]" "∇") - ("isin" "\\in" t "∈" "[element of]" "[element of]" "∈") - ("in" "\\in" t "∈" "[element of]" "[element of]" "∈") - ("notin" "\\notin" t "∉" "[not an element of]" "[not an element of]" "∉") - ("ni" "\\ni" t "∋" "[contains as member]" "[contains as member]" "∋") - ("prod" "\\prod" t "∏" "[product]" "[n-ary product]" "∏") - ("sum" "\\sum" t "∑" "[sum]" "[sum]" "∑") -; ("minus" "\\minus" t "−" "-" "-" "−") - ("minus" "-" t "−" "-" "-" "−") - ("lowast" "\\ast" t "∗" "*" "*" "∗") - ("ast" "\\ast" t "∗" "*" "*" "*") + + "** Science et al." + ("minus" "\\minus" t "−" "-" "-" "−") + ("pm" "\\textpm{}" nil "±" "+-" "±" "±") + ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") + ("times" "\\texttimes{}" nil "×" "*" "×" "×") + ("frasl" "/" nil "⁄" "/" "/" "⁄") + ("div" "\\textdiv{}" nil "÷" "/" "÷" "÷") + ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") + ("frac14" "\\textonequarter{}" nil "¼" "1/4" "¼" "¼") + ("frac34" "\\textthreequarters{}" nil "¾" "3/4" "¾" "¾") + ("permil" "\\textperthousand{}" nil "‰" "per thousand" "per thousand" "‰") + ("sup1" "\\textonesuperior{}" nil "¹" "^1" "¹" "¹") + ("sup2" "\\texttwosuperior{}" nil "²" "^2" "²" "²") + ("sup3" "\\textthreesuperior{}" nil "³" "^3" "³" "³") ("radic" "\\sqrt{\\,}" t "√" "[square root]" "[square root]" "√") - ("prop" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") - ("proptp" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") + ("sum" "\\sum" t "∑" "[sum]" "[sum]" "∑") + ("prod" "\\prod" t "∏" "[product]" "[n-ary product]" "∏") + ("micro" "\\textmu{}" nil "µ" "micro" "µ" "µ") + ("macr" "\\textasciimacron{}" nil "¯" "[macron]" "¯" "¯") + ("deg" "\\textdegree{}" nil "deg" "degree" "°" "°") + ("prime" "\\prime" t "′" "'" "'" "′") + ("Prime" "\\prime{}\\prime" t "″" "''" "''" "″") ("infin" "\\propto" t "∞" "[infinity]" "[infinity]" "∞") ("infty" "\\infty" t "∞" "[infinity]" "[infinity]" "∞") - ("ang" "\\angle" t "∠" "[angle]" "[angle]" "∠") - ("angle" "\\angle" t "∠" "[angle]" "[angle]" "∠") - ("and" "\\wedge" t "∧" "[logical and]" "[logical and]" "∧") + ("prop" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") + ("proptp" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") + ("not" "\\textlnot{}" nil "¬" "[angled dash]" "¬" "¬") + ("land" "\\land" t "∧" "[logical and]" "[logical and]" "∧") ("wedge" "\\wedge" t "∧" "[logical and]" "[logical and]" "∧") - ("or" "\\vee" t "∨" "[logical or]" "[logical or]" "∨") + ("lor" "\\lor" t "∨" "[logical or]" "[logical or]" "∨") ("vee" "\\vee" t "∨" "[logical or]" "[logical or]" "∨") ("cap" "\\cap" t "∩" "[intersection]" "[intersection]" "∩") ("cup" "\\cup" t "∪" "[union]" "[union]" "∪") ("int" "\\int" t "∫" "[integral]" "[integral]" "∫") -; ("there4" "\\uptherefore" t "∴" "[therefore]" "[therefore]" "∴") ("there4" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") ("sim" "\\sim" t "∼" "~" "~" "∼") ("cong" "\\cong" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") @@ -318,9 +336,20 @@ loaded, add these packages to `org-export-latex-packages-alist'." ("supset" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") ("nsub" "\\not\\subset" t "⊄" "[not a subset of]" "[not a subset of" "⊄") ("sube" "\\subseteq" t "⊆" "[subset of or equal to]" "[subset of or equal to]" "⊆") + ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") ("supe" "\\supseteq" t "⊇" "[superset of or equal to]" "[superset of or equal to]" "⊇") - ("oplus" "\\oplus" t "⊕" "[circled plus]" "[circled plus]" "⊕") - ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") + ("forall" "\\forall" t "∀" "[for all]" "[for all]" "∀") + ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") + ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") + ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "∅") + ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "∅") + ("isin" "\\in" t "∈" "[element of]" "[element of]" "∈") + ("in" "\\in" t "∈" "[element of]" "[element of]" "∈") + ("notin" "\\notin" t "∉" "[not an element of]" "[not an element of]" "∉") + ("ni" "\\ni" t "∋" "[contains as member]" "[contains as member]" "∋") + ("nabla" "\\nabla" t "∇" "[nabla]" "[nabla]" "∇") + ("ang" "\\angle" t "∠" "[angle]" "[angle]" "∠") + ("angle" "\\angle" t "∠" "[angle]" "[angle]" "∠") ("perp" "\\perp" t "⊥" "[up tack]" "[up tack]" "⊥") ("sdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") ("cdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") @@ -330,56 +359,34 @@ loaded, add these packages to `org-export-latex-packages-alist'." ("rfloor" "\\rfloor" t "⌋" "[right floor]" "[right floor]" "⌋") ("lang" "\\langle" t "⟨" "<" "<" "⟨") ("rang" "\\rangle" t "⟩" ">" ">" "⟩") - ("loz" "\\diamond" t "◊" "[lozenge]" "[lozenge]" "◊") - ("Diamond" "\\diamond" t "⋄" "[diamond]" "[diamond]" "⋄") - ("spades" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") - ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") - ("clubs" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") - ("clubsuit" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") - ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") - ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") - ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") - ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") - ("smile" "\\smile" t "☺" ":-)" ":-)" "⌣") - ("blacksmile" "\\blacksmiley{}" nil "☻" ":-)" ":-)" "☻") - ("sad" "\\frownie{}" nil "☹" ":-(" ":-(" "☹") - ("quot" "\\textquotedbl{}" nil """ "\"" "\"" "\"") - ("amp" "\\&" nil "&" "&" "&" "&") - ("lt" "\\textless{}" nil "<" "<" "<" "<") - ("gt" "\\textgreater{}" nil ">" ">" ">" ">") - ("OElig" "\\OE{}" nil "Œ" "OE" "OE" "Œ") - ("oelig" "\\oe{}" nil "œ" "oe" "oe" "œ") - ("Scaron" "\\v{S}" nil "Š" "S" "S" "Š") - ("scaron" "\\v{s}" nil "š" "s" "s" "š") - ("Yuml" "\\\"{Y}" nil "Ÿ" "Y" "Y" "Ÿ") - ("circ" "\\circ" t "ˆ" "^" "^" "ˆ") - ("tilde" "\\~{}" nil "˜" "~" "~" "~") - ("ensp" "\\hspace*{.5em}" nil " " " " " " " ") - ("emsp" "\\hspace*{1em}" nil " " " " " " " ") - ("thinsp" "\\hspace*{.2em}" nil " " " " " " " ") - ("zwnj" "\\/{}" nil "‌" "" "" "") - ("zwj" "" nil "‍" "" "" "") - ("lrm" "" nil "‎" "" "" "") - ("rlm" "" nil "‏" "" "" "") - ("ndash" "--" nil "–" "-" "-" "–") - ("mdash" "---" nil "—" "--" "--" "—") - ("lsquo" "\\textquoteleft{}" nil "‘" "`" "`" "‘") - ("rsquo" "\\textquoteright{}" nil "’" "'" "'" "’") - ("sbquo" "\\quotesinglbase{}" nil "‚" "," "," "‚") - ("ldquo" "\\textquotedblleft{}" nil "“" "\"" "\"" "“") - ("rdquo" "\\textquotedblright{}" nil "”" "\"" "\"" "”") - ("bdquo" "\\quotedblbase{}" nil "„" "\"" "\"" "„") - ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") - ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") - ("permil" "\\textperthousand{}" nil "‰" "per thousand" "per thousand" "‰") - ("lsaquo" "\\guilsinglleft{}" nil "‹" "<" "<" "‹") - ("rsaquo" "\\guilsinglright{}" nil "›" ">" ">" "›") - ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") - ("EUR" "\\EUR{}" nil "€" "EUR" "EUR" "€") - ("EURdig" "\\EURdig{}" nil "€" "EUR" "EUR" "€") - ("EURhv" "\\EURhv{}" nil "€" "EUR" "EUR" "€") - ("EURcr" "\\EURcr{}" nil "€" "EUR" "EUR" "€") - ("EURtm" "\\EURtm{}" nil "€" "EUR" "EUR" "€") + + "** Arrows" + ("larr" "\\leftarrow" t "←" "<-" "<-" "←") + ("leftarrow" "\\leftarrow" t "←" "<-" "<-" "←") + ("gets" "\\gets" t "←" "<-" "<-" "←") + ("lArr" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") + ("Leftarrow" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") + ("uarr" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") + ("uparrow" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") + ("uArr" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") + ("Uparrow" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") + ("rarr" "\\rightarrow" t "→" "->" "->" "→") + ("to" "\\to" t "→" "->" "->" "→") + ("rightarrow" "\\rightarrow" t "→" "->" "->" "→") + ("rArr" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") + ("Rightarrow" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") + ("darr" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") + ("downarrow" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") + ("dArr" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") + ("Downarrow" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") + ("harr" "\\leftrightarrow" t "↔" "<->" "<->" "↔") + ("leftrightarrow" "\\leftrightarrow" t "↔" "<->" "<->" "↔") + ("hArr" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") + ("Leftrightarrow" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") + ("crarr" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") + ("hookleftarrow" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") + + "** Function names" ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos") ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin") ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan") @@ -412,15 +419,49 @@ loaded, add these packages to `org-export-latex-packages-alist'." ("sup" "\\sup" t "⊃" "sup" "sup" "sup") ("tan" "\\tan" t "tan" "tan" "tan" "tan") ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh") - ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") - ("frac14" "\\textonequarter{}" nil "¼" "1/4" "¼" "¼") - ("frac34" "\\textthreequarters{}" nil "¾" "3/4" "¾" "¾") - ("div" "\\textdiv{}" nil "÷" "/" "÷" "÷") - ("acute" "\\textasciiacute{}" nil "´" "'" "´" "´") - ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") + + "** Signs & Symbols" + ("bull" "\\textbullet{}" nil "•" "*" "*" "•") + ("bullet" "\\textbullet{}" nil "•" "*" "*" "•") + ("star" "\\star" t "*" "*" "*" "⋆") + ("lowast" "\\ast" t "∗" "*" "*" "∗") + ("ast" "\\ast" t "∗" "*" "*" "*") + ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ") + ("oplus" "\\oplus" t "⊕" "[circled plus]" "[circled plus]" "⊕") + ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") + ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + + "** Miscellaneous (seldom used)" + ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") + ("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ª" "ª") + ("ordm" "\\textordmasculine{}" nil "º" "_o_" "º" "º") + ("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸") + ("oline" "\\overline{~}" t "‾" "[overline]" "¯" "‾") + ("uml" "\\textasciidieresis{}" nil "¨" "[diaeresis]" "¨" "¨") + ("zwnj" "\\/{}" nil "‌" "" "" "") + ("zwj" "" nil "‍" "" "" "") + ("lrm" "" nil "‎" "" "" "") + ("rlm" "" nil "‏" "" "" "") + + "** Smilies" + ("smile" "\\smile" t "☺" ":-)" ":-)" "⌣") ("smiley" "\\smiley{}" nil "☺" ":-)" ":-)" "☺") + ("blacksmile" "\\blacksmiley{}" nil "☻" ":-)" ":-)" "☻") + ("sad" "\\frownie{}" nil "☹" ":-(" ":-(" "☹") + + "** Suits" + ("clubs" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") + ("clubsuit" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") + ("spades" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") + ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") + ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") + ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") + ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") + ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") + ("Diamond" "\\diamond" t "⋄" "[diamond]" "[diamond]" "⋄") + ("loz" "\\diamond" t "◊" "[lozenge]" "[lozenge]" "◊") ) - "Default entities used in Org-mode to preduce special characters. + "Default entities used in Org-mode to produce special characters. For details see `org-entities-user'.") (defsubst org-entity-get (name) @@ -457,37 +498,76 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." e latex mathp html latin utf8 name ascii) (insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n") (while ll - (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")) + (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"))) (goto-char pos) (org-table-align))) +(defun org-entities-help () + "Create a Help buffer with all available entities." + (interactive) + (with-output-to-temp-buffer "*Org Entity Help*" + (princ "Org-mode entities\n=================\n\n") + (let ((ll (append '("* User-defined additions (variable org-entities-user)") + org-entities-user + org-entities)) + e latex mathp html latin utf8 name ascii + (lastwasstring t) + (head (concat + "\n" + " Symbol Org entity LaTeX code HTML code\n" + " -----------------------------------------------------------\n"))) + (while ll + (setq e (pop ll)) + (if (stringp e) + (progn + (princ e) + (princ "\n") + (setq lastwasstring t)) + (if lastwasstring (princ head)) + (setq lastwasstring nil) + (setq name (car e) + latex (nth 1 e) + html (nth 3 e) + utf8 (nth 6 e)) + (princ (format " %-8s \\%-16s %-22s %-13s\n" + utf8 name latex html)))))) + (with-current-buffer "*Org Entity Help*" + (org-mode)) + (select-window (get-buffer-window "*Org Entity Help*"))) + + (defun replace-amp () - "Postprocess HTML file to unescape the ampersant." + "Postprocess HTML file to unescape the ampersand." (interactive) (while (re-search-forward "<td>&\\([^<;]+;\\)" nil t) (replace-match (concat "<td>&" (match-string 1)) t t))) (provide 'org-entities) +;; Local variables: +;; coding: utf-8 +;; End: + ;; arch-tag: e6bd163f-7419-4009-9c93-a74623016424 ;;; org-entities.el ends here diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el index 90cb610c538..4676f5b1aaf 100644 --- a/lisp/org/org-exp-blocks.el +++ b/lisp/org/org-exp-blocks.el @@ -4,7 +4,7 @@ ;; Free Software Foundation, Inc. ;; Author: Eric Schulte -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. ;; @@ -68,6 +68,8 @@ ;; `org-export-blocks-add-block' to add your block type to ;; `org-export-blocks'. +;;; Code: + (eval-when-compile (require 'cl)) (require 'org) @@ -93,10 +95,10 @@ '((comment org-export-blocks-format-comment t) (ditaa org-export-blocks-format-ditaa nil) (dot org-export-blocks-format-dot nil)) - "Use this a-list to associate block types with block exporting -functions. The type of a block is determined by the text -immediately following the '#+BEGIN_' portion of the block header. -Each block export function should accept three argumets..." + "Use this alist to associate block types with block exporting functions. +The type of a block is determined by the text immediately +following the '#+BEGIN_' portion of the block header. Each block +export function should accept three arguments." :group 'org-export-general :type '(repeat (list @@ -106,14 +108,14 @@ Each block export function should accept three argumets..." :set 'org-export-blocks-set) (defun org-export-blocks-add-block (block-spec) - "Add a new block type to `org-export-blocks'. BLOCK-SPEC -should be a three element list the first element of which should -indicate the name of the block, the second element should be the -formatting function called by `org-export-blocks-preprocess' and -the third element a flag indicating whether these types of blocks -should be fontified in org-mode buffers (see -`org-protecting-blocks'). For example the BLOCK-SPEC for ditaa -blocks is as follows... + "Add a new block type to `org-export-blocks'. +BLOCK-SPEC should be a three element list the first element of +which should indicate the name of the block, the second element +should be the formatting function called by +`org-export-blocks-preprocess' and the third element a flag +indicating whether these types of blocks should be fontified in +org-mode buffers (see `org-protecting-blocks'). For example the +BLOCK-SPEC for ditaa blocks is as follows. (ditaa org-export-blocks-format-ditaa nil)" (unless (member block-spec org-export-blocks) @@ -122,25 +124,28 @@ blocks is as follows... (defcustom org-export-interblocks '() - "Use this a-list to associate block types with block exporting -functions. The type of a block is determined by the text -immediately following the '#+BEGIN_' portion of the block header. -Each block export function should accept three argumets..." + "Use this a-list to associate block types with block exporting functions. +The type of a block is determined by the text immediately +following the '#+BEGIN_' portion of the block header. Each block +export function should accept three arguments." :group 'org-export-general :type 'alist) (defcustom org-export-blocks-witheld '(hidden) - "List of block types (see `org-export-blocks') which should not -be exported." + "List of block types (see `org-export-blocks') which should not be exported." :group 'org-export-general :type 'list) -(defvar org-export-blocks-postblock-hooks nil "") +(defcustom org-export-blocks-postblock-hook nil + "Run after blocks have been processed with `org-export-blocks-preprocess'." + :group 'org-export-general + :type 'hook) (defun org-export-blocks-html-quote (body &optional open close) - "Protext BODY from org html export. The optional OPEN and -CLOSE tags will be inserted around BODY." + "Protect BODY from org html export. +The optional OPEN and CLOSE tags will be inserted around BODY." + (concat "\n#+BEGIN_HTML\n" (or open "") @@ -149,8 +154,8 @@ CLOSE tags will be inserted around BODY." "#+END_HTML\n")) (defun org-export-blocks-latex-quote (body &optional open close) - "Protext BODY from org latex export. The optional OPEN and -CLOSE tags will be inserted around BODY." + "Protect BODY from org latex export. +The optional OPEN and CLOSE tags will be inserted around BODY." (concat "\n#+BEGIN_LaTeX\n" (or open "") @@ -159,10 +164,9 @@ CLOSE tags will be inserted around BODY." "#+END_LaTeX\n")) (defun org-export-blocks-preprocess () - "Export all blocks according to the `org-export-blocks' block -exportation alist. Does not export block types specified in -specified in BLOCKS which default to the value of -`org-export-blocks-witheld'." + "Export all blocks according to the `org-export-blocks' block export alist. +Does not export block types specified in specified in BLOCKS +which defaults to the value of `org-export-blocks-witheld'." (interactive) (save-window-excursion (let ((case-fold-search t) @@ -174,7 +178,7 @@ specified in BLOCKS which default to the value of (goto-char (point-min)) (setq start (point)) (while (re-search-forward - "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n][ \t]*#\\+end_\\S-+.*" nil t) + "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n][ \t]*#\\+end_\\S-+.*[\r\n]?" nil t) (setq indentation (length (match-string 1))) (setq type (intern (downcase (match-string 2)))) (setq headers (save-match-data (org-split-string (match-string 3) "[ \t]+"))) @@ -194,7 +198,8 @@ specified in BLOCKS which default to the value of (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))))) (setq start (match-end 0))) - (interblock start (point-max)))))) + (interblock start (point-max)) + (run-hooks 'org-export-blocks-postblock-hook))))) (add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess) @@ -212,7 +217,7 @@ specified in BLOCKS which default to the value of (expand-file-name "../contrib" (file-name-directory (or load-file-name buffer-file-name))))))) - "Path to the ditaa jar executable") + "Path to the ditaa jar executable.") (defun org-export-blocks-format-ditaa (body &rest headers) "Pass block BODY to the ditaa utility creating an image. @@ -222,13 +227,15 @@ passed to the ditaa utility as command line arguments." (message "ditaa-formatting...") (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) (data-file (make-temp-file "org-ditaa")) - (hash (sha1 (prin1-to-string (list body args)))) - (raw-out-file (if headers (car headers))) - (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) - (cons (match-string 1 raw-out-file) - (match-string 2 raw-out-file)) - (cons raw-out-file "png"))) - (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) + (hash (progn + (set-text-properties 0 (length body) nil body) + (sha1 (prin1-to-string (list body args))))) + (raw-out-file (if headers (car headers))) + (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) + (cons (match-string 1 raw-out-file) + (match-string 2 raw-out-file)) + (cons raw-out-file "png"))) + (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) (unless (file-exists-p org-ditaa-jar-path) (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path))) (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body) @@ -282,13 +289,15 @@ digraph data_relationships { (message "dot-formatting...") (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) (data-file (make-temp-file "org-ditaa")) - (hash (sha1 (prin1-to-string (list body args)))) - (raw-out-file (if headers (car headers))) - (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) - (cons (match-string 1 raw-out-file) - (match-string 2 raw-out-file)) - (cons raw-out-file "png"))) - (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) + (hash (progn + (set-text-properties 0 (length body) nil body) + (sha1 (prin1-to-string (list body args))))) + (raw-out-file (if headers (car headers))) + (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) + (cons (match-string 1 raw-out-file) + (match-string 2 raw-out-file)) + (cons raw-out-file "png"))) + (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) (cond ((or htmlp latexp docbookp) (unless (file-exists-p out-file) diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el index 87ebfd20062..c3f27cf0e15 100644 --- a/lisp/org/org-exp.el +++ b/lisp/org/org-exp.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,11 +26,15 @@ ;; ;;; Commentary: +;;; Code: + (require 'org) (require 'org-macs) (require 'org-agenda) (require 'org-exp-blocks) +(require 'ob-exp) (require 'org-src) + (eval-when-compile (require 'cl)) @@ -42,6 +46,8 @@ (declare-function org-export-htmlize-region-for-paste "org-html" (beg end)) (declare-function htmlize-buffer "ext:htmlize" (&optional buffer)) (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-table-cookie-line-p "org-table" (line)) +(declare-function org-table-colgroup-line-p "org-table" (line)) (autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t) (defgroup org-export nil "Options for exporting org-listings." @@ -93,9 +99,10 @@ This works by starting up a separate Emacs process visiting the same file and doing the export from there. Not all export commands are affected by this - only the ones which actually write to a file, and that do not depend on the buffer state. - +\\<org-mode-map> If this option is nil, you can still get background export by calling -`org-export' with a double prefix arg: `C-u C-u C-c C-e'. +`org-export' with a double prefix arg: \ +\\[universal-argument] \\[universal-argument] \\[org-export]. If this option is t, the double prefix can be used to exceptionally force an export command into the current process." @@ -231,7 +238,7 @@ This option can also be set with the +OPTIONS line, e.g. \"num:t\"." "Format of section numbers for export. The variable has two components. 1. A list of lists, each indicating a counter type and a separator. - The counter type can be any of \"1\", \"A\", \"a\", \"I\", or \"a\". + The counter type can be any of \"1\", \"A\", \"a\", \"I\", or \"i\". It causes causes numeric, alphabetic, or roman counters, respectively. The separator is only used if another counter for a subsection is being added. @@ -446,35 +453,6 @@ This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." :group 'org-export-translation :type 'boolean) -(defcustom org-export-with-sub-superscripts t - "Non-nil means interpret \"_\" and \"^\" for export. -When this option is turned on, you can use TeX-like syntax for sub- and -superscripts. Several characters after \"_\" or \"^\" will be -considered as a single item - so grouping with {} is normally not -needed. For example, the following things will be parsed as single -sub- or superscripts. - - 10^24 or 10^tau several digits will be considered 1 item. - 10^-12 or 10^-tau a leading sign with digits or a word - x^2-y^3 will be read as x^2 - y^3, because items are - terminated by almost any nonword/nondigit char. - x_{i^2} or x^(2-i) braces or parenthesis do grouping. - -Still, ambiguity is possible - so when in doubt use {} to enclose the -sub/superscript. If you set this variable to the symbol `{}', -the braces are *required* in order to trigger interpretations as -sub/superscript. This can be helpful in documents that need \"_\" -frequently in plain text. - -Not all export backends support this, but HTML does. - -This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." - :group 'org-export-translation - :type '(choice - (const :tag "Always interpret" t) - (const :tag "Only with braces" {}) - (const :tag "Never interpret" nil))) - (defcustom org-export-with-TeX-macros t "Non-nil means interpret simple TeX-like macros when exporting. For example, HTML export converts \\alpha to α and \\AA to Å. @@ -518,12 +496,6 @@ This option can also be set with the +OPTIONS line, e.g. \"::nil\"." :group 'org-export-translation :type 'boolean) -(defcustom org-match-sexp-depth 3 - "Number of stacked braces for sub/superscript matching. -This has to be set before loading org.el to be effective." - :group 'org-export-translation - :type 'integer) - (defgroup org-export-tables nil "Options for exporting tables in Org-mode." :tag "Org Export Tables" @@ -702,7 +674,7 @@ modified) list.") "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE" "LATEX_HEADER" "LATEX_CLASS" "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS" - "KEYWORDS" "DESCRIPTION" "MACRO" "BIND") + "KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT") (mapcar 'car org-export-inbuffer-options-extra)))) p key val text options a pr style latex-header latex-class macros letbind @@ -738,6 +710,8 @@ modified) list.") (setq options (concat val " " options))) ((string-equal key "BIND") (push (read (concat "(" val ")")) letbind)) + ((string-equal key "XSLT") + (setq p (plist-put p :xslt val))) ((string-equal key "LINK_UP") (setq p (plist-put p :link-up val))) ((string-equal key "LINK_HOME") @@ -873,7 +847,8 @@ in the background. This will be done only for commands that write to a file. For details see the docstring of `org-export-run-in-background'. The prefix argument ARG will be passed to the exporter. However, if -ARG is a double universal prefix `C-u C-u', that means to inverse the +ARG is a double universal prefix \\[universal-argument] \\[universal-argument], \ +that means to inverse the value of `org-export-run-in-background'." (interactive "P") (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background)) @@ -883,7 +858,7 @@ value of `org-export-run-in-background'." \[1] only export the current subtree \[SPC] publish enclosing subtree (with LaTeX_CLASS or EXPORT_FILE_NAME prop) -\[a/n/u] export as ASCII/Latin-1/UFT-8 [A/N/U] to temporary buffer +\[a/n/u] export as ASCII/Latin-1/UTF-8 [A/N/U] to temporary buffer \[h] export as HTML [H] to temporary buffer [R] export region \[b] export as HTML and open in browser @@ -893,6 +868,8 @@ value of `org-export-run-in-background'." \[D] export as DocBook [V] export as DocBook, process to PDF, and open +\[j] export as TaskJuggler [J] ... and open + \[m] export as Freemind mind map \[x] export as XOXO \[g] export using Wes Hardaker's generic exporter @@ -919,6 +896,8 @@ value of `org-export-run-in-background'." (?g org-export-generic t) (?D org-export-as-docbook t) (?V org-export-as-docbook-pdf-and-open t) + (?j org-export-as-taskjuggler t) + (?J org-export-as-taskjuggler-and-open t) (?m org-export-as-freemind t) (?l org-export-as-latex t) (?p org-export-as-pdf t) @@ -1003,7 +982,7 @@ value of `org-export-run-in-background'." (defvar org-export-id-target-alist nil "Alist of section id's with preferred aliases.") (defvar org-export-code-refs nil - "Alist of code references and line numbers") + "Alist of code references and line numbers.") (defun org-export-preprocess-string (string &rest parameters) "Cleanup STRING so that that the true exported has a more consistent source. @@ -1059,7 +1038,7 @@ on this string to produce the exported version." (untabify (point-min) (point-max)) ;; Handle include files, and call a hook - (org-export-handle-include-files) + (org-export-handle-include-files-recurse) (run-hooks 'org-export-preprocess-after-include-files-hook) ;; Get rid of archived trees @@ -1187,6 +1166,9 @@ 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) + ;; Run the final hook (run-hooks 'org-export-preprocess-final-hook) @@ -1205,43 +1187,48 @@ on this string to produce the exported version." (defun org-export-define-heading-targets (target-alist) "Find all headings and define the targets for them. -The new targets are added to TARGET-ALIST, which is also returned." +The new targets are added to TARGET-ALIST, which is also returned. +Also find all ID and CUSTOM_ID properties and store them." (goto-char (point-min)) (org-init-section-numbers) (let ((re (concat "^" org-outline-regexp - "\\| [ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)")) + "\\|" + "^[ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)")) level target last-section-target a id) (while (re-search-forward re nil t) - (if (match-end 2) - (progn - (setq id (org-match-string-no-properties 2)) - (push (cons id target) target-alist) - (setq a (or (assoc last-section-target org-export-target-aliases) - (progn - (push (list last-section-target) - org-export-target-aliases) - (car org-export-target-aliases)))) - (push (caar target-alist) (cdr a)) - (when (equal (match-string 1) "CUSTOM_ID") - (if (not (assoc last-section-target - org-export-preferred-target-alist)) - (push (cons last-section-target id) - org-export-preferred-target-alist))) - (when (equal (match-string 1) "ID") - (if (not (assoc last-section-target - org-export-id-target-alist)) - (push (cons last-section-target (concat "ID-" id)) - org-export-id-target-alist)))) - (setq level (org-reduced-level - (save-excursion (goto-char (point-at-bol)) - (org-outline-level)))) - (setq target (org-solidify-link-text - (format "sec-%s" (org-section-number level)))) - (setq last-section-target target) - (push (cons target target) target-alist) - (add-text-properties - (point-at-bol) (point-at-eol) - (list 'target target))))) + (org-if-unprotected-at (match-beginning 0) + (if (match-end 2) + (progn + (setq id (org-match-string-no-properties 2)) + (push (cons id target) target-alist) + (setq a (or (assoc last-section-target org-export-target-aliases) + (progn + (push (list last-section-target) + org-export-target-aliases) + (car org-export-target-aliases)))) + (push (caar target-alist) (cdr a)) + (when (equal (match-string 1) "CUSTOM_ID") + (if (not (assoc last-section-target + org-export-preferred-target-alist)) + (push (cons last-section-target id) + org-export-preferred-target-alist))) + (when (equal (match-string 1) "ID") + (if (not (assoc last-section-target + org-export-id-target-alist)) + (push (cons last-section-target (concat "ID-" id)) + org-export-id-target-alist)))) + (setq level (org-reduced-level + (save-excursion (goto-char (point-at-bol)) + (org-outline-level)))) + (setq target (org-solidify-link-text + (format "sec-%s" (replace-regexp-in-string + "\\." "_" + (org-section-number level))))) + (setq last-section-target target) + (push (cons target target) target-alist) + (add-text-properties + (point-at-bol) (point-at-eol) + (list 'target target)))))) target-alist) (defun org-export-handle-invisible-targets (target-alist) @@ -1338,9 +1325,9 @@ the current file." (defvar org-export-format-drawer-function nil "Function to be called to format the contents of a drawer. The function must accept three parameters: - BACKEND one of the symbols html, docbook, latex, ascii, xoxo NAME the drawer name, like \"PROPERTIES\" CONTENT the content of the drawer. + BACKEND one of the symbols html, docbook, latex, ascii, xoxo The function should return the text to be inserted into the buffer. If this is nil, `org-export-format-drawer' is used as a default.") @@ -1547,15 +1534,25 @@ from the buffer." (while formatters (setq fmt (pop formatters)) - (when (eq (car fmt) backend) - ;; This is selected code, put it into the file for real - (goto-char (point-min)) - (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" (cadr fmt) - ":[ \t]*\\(.*\\)") nil t) + ;; Handle #+Backend: stuff + (goto-char (point-min)) + (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" (cadr fmt) + ":[ \t]*\\(.*\\)") nil t) + (if (not (eq (car fmt) backend)) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) (replace-match "\\1\\2" t) (add-text-properties (point-at-bol) (min (1+ (point-at-eol)) (point-max)) '(org-protected t)))) + ;; 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)) + (while (re-search-forward (concat "^\\([ \t]*\\)#\\+attr_" (cadr fmt) + ":[ \t]*\\(.*\\)") nil t) + (when (not (eq (car fmt) backend)) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) + ;; Handle #+begin_Backend and #+end_Backend stuff (goto-char (point-min)) (while (re-search-forward (concat "^[ \t]*#\\+" (caddr fmt) "\\>.*\n?") nil t) @@ -1589,8 +1586,8 @@ These special cookies will later be interpreted by the backend." (setq beg (match-beginning 0) beg1 (1+ (match-end 0))) (when (re-search-forward (concat "^[ \t]*#\\+end_" type "\\>.*") nil t) - (setq end (1+ (point-at-eol)) - end1 (1- (match-beginning 0))) + (setq end1 (1- (match-beginning 0)) + end (+ (point-at-eol) (if (looking-at "\n$") 1 0))) (setq content (org-remove-indentation (buffer-substring beg1 end1))) (setq content (concat "ORG-" (upcase t1) "-START\n" content "\n" @@ -1615,15 +1612,24 @@ table line. If it is a link, add it to the line containing the link." "^[ \t]*\\(|[^-]\\)" "\\|" "^[ \t]*\\[\\[.*\\]\\][ \t]*$")) - cap attr label end) + cap shortn attr label end) (while (re-search-forward re nil t) (cond ((match-end 1) - (setq cap (concat cap (if cap " " "") (org-trim (match-string 1))))) + (progn + (setq cap (concat cap (if cap " " "") (org-trim (match-string 1)))) + (when (string-match "\\[\\(.*\\)\\]{\\(.*\\)}" cap) + (setq shortn (match-string 1 cap) + cap (match-string 2 cap))) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) ((match-end 2) - (setq attr (concat attr (if attr " " "") (org-trim (match-string 2))))) + (progn + (setq attr (concat attr (if attr " " "") (org-trim (match-string 2)))) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) ((match-end 3) - (setq label (org-trim (match-string 3)))) + (progn + (setq label (org-trim (match-string 3))) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) (t (setq end (if (match-end 4) (let ((ee (org-table-end))) @@ -1631,6 +1637,7 @@ table line. If it is a link, add it to the line containing the link." (point-at-eol))) (add-text-properties (point-at-bol) end (list 'org-caption cap + 'org-caption-shortn shortn 'org-attributes attr 'org-label label)) (if label (push (cons label label) target-alist)) @@ -1659,21 +1666,36 @@ table line. If it is a link, add it to the line containing the link." "Remove comments, or convert to backend-specific format. COMMENTSP can be a format string for publishing comments. When it is nil, all comments will be removed." - (let ((re "^\\(#\\|[ \t]*#\\+\\)\\(.*\n?\\)") + (let ((re "^\\(#\\|[ \t]*#\\+ \\)\\(.*\n?\\)") + pos) + (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 commentsp + (not (equal (char-before (match-end 1)) ?+))) + (progn (add-text-properties + (match-beginning 0) (match-end 0) '(org-protected t)) + (replace-match (format commentsp (match-string 2)) t t)) + (goto-char (1+ pos)) + (replace-match "") + (goto-char (max (point-min) (1- pos)))))))) + +(defun org-export-handle-table-metalines () + "Remove table specific metalines #+TBLNAME: and #+TBLFM:." + (let ((re "^[ \t]*#\\+TBL\\(NAME\\|FM\\):\\(.*\n?\\)") pos) (goto-char (point-min)) (while (or (looking-at re) (re-search-forward re nil t)) (setq pos (match-beginning 0)) - (if (and commentsp - (not (equal (char-before (match-end 1)) ?+))) - (progn (add-text-properties - (match-beginning 0) (match-end 0) '(org-protected t)) - (replace-match (format commentsp (match-string 2)) t t)) + (if (get-text-property (point) 'org-protected) + (goto-char (1+ pos)) (goto-char (1+ pos)) - (org-if-unprotected - (replace-match "") - (goto-char (max (point-min) (1- pos)))))))) + (replace-match "") + (goto-char (max (point-min) (1- pos))))))) (defun org-export-mark-radio-links () "Find all matches for radio targets and turn them into internal links." @@ -1694,22 +1716,23 @@ When it is nil, all comments will be removed." "Remove tables lines that are used for internal purposes." (goto-char (point-min)) (while (re-search-forward "^[ \t]*|" nil t) - (beginning-of-line 1) - (if (or (looking-at "[ \t]*| *[!_^] *|") - (not - (memq - nil - (mapcar - (lambda (f) - (or (= (length f) 0) - (string-match - "\\`<\\([0-9]\\|[rl]\\|[rl][0-9]+\\)>\\'" f))) - (org-split-string ;; FIXME, can't we do this without splitting??? - (buffer-substring (point-at-bol) (point-at-eol)) - "[ \t]*|[ \t]*"))))) - (delete-region (max (point-min) (1- (point-at-bol))) - (point-at-eol)) - (end-of-line 1)))) + (org-if-unprotected-at (1- (point)) + (beginning-of-line 1) + (if (or (looking-at "[ \t]*| *[!_^] *|") + (not + (memq + nil + (mapcar + (lambda (f) + (or (= (length f) 0) + (string-match + "\\`<\\([0-9]\\|[rl]\\|[rl][0-9]+\\)>\\'" f))) + (org-split-string ;; FIXME, can't we do without splitting??? + (buffer-substring (point-at-bol) (point-at-eol)) + "[ \t]*|[ \t]*"))))) + (delete-region (max (point-min) (1- (point-at-bol))) + (point-at-eol)) + (end-of-line 1))))) (defun org-export-protect-sub-super (s) (save-match-data @@ -1990,7 +2013,7 @@ 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) + params file markup lang start end prefix prefix1 switches all) (goto-char (point-min)) (while (re-search-forward "^#\\+INCLUDE:?[ \t]+\\(.*\\)" nil t) (setq params (read (concat "(" (match-string 1) ")")) @@ -2007,6 +2030,7 @@ TYPE must be a string, any of: (not (file-exists-p file)) (not (file-readable-p file))) (insert (format "CANNOT INCLUDE FILE %s" file)) + (setq all (cons file all)) (when markup (if (equal (downcase markup) "src") (setq start (format "#+begin_src %s %s\n" @@ -2019,7 +2043,20 @@ TYPE must be a string, any of: (insert (org-get-file-contents (expand-file-name file) prefix prefix1 markup)) (or (bolp) (newline)) - (insert (or end "")))))) + (insert (or end "")))) + all)) + +(defun org-export-handle-include-files-recurse () + "Recursively include files aborting on circular inclusion." + (let ((now (list org-current-export-file)) all) + (while now + (setq all (append now all)) + (setq now (org-export-handle-include-files)) + (let ((intersection + (delq nil + (mapcar (lambda (el) (when (member el all) el)) now)))) + (when intersection + (error "Recursive #+INCLUDE: %S" intersection)))))) (defun org-get-file-contents (file &optional prefix prefix1 markup) "Get the contents of FILE and return them as a string. @@ -2034,7 +2071,7 @@ take care of the block they are in." (goto-char (point-min)) (while (not (eobp)) (insert (or prefix1 prefix)) - (setq prefix1 nil) + (setq prefix1 "") (beginning-of-line 2))) (buffer-string) (when (member markup '("src" "example")) @@ -2075,19 +2112,29 @@ in the list) and remove property and value from the list in LISTVAR." lang code trans opts indent caption) (goto-char (point-min)) (while (re-search-forward - "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?[ \t]+\\([^ \t\n]+\\)\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\n?\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\n?\\)" + "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?\\([ \t]+\\([^ \t\n]+\\)\\)?\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\n?\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\n?\\)" nil t) (if (match-end 1) - ;; src segments - (setq lang (match-string 3) - opts (match-string 4) - code (match-string 5) - indent (length (match-string 2)) - caption (get-text-property 0 'org-caption (match-string 0))) + (if (not (match-string 4)) + (error "Source block missing language specification: %s" + (let* ((body (match-string 6)) + (nothing (message "body:%s" body)) + (preview (or (and (string-match + "^[ \t]*\\([^\n\r]*\\)" body) + (match-string 1 body)) body))) + (if (> (length preview) 35) + (concat (substring preview 0 32) "...") + preview))) + ;; src segments + (setq lang (match-string 4) + opts (match-string 5) + code (match-string 6) + indent (length (match-string 2)) + caption (get-text-property 0 'org-caption (match-string 0)))) (setq lang nil - opts (match-string 8) - code (match-string 9) - indent (length (match-string 7)) + opts (match-string 9) + code (match-string 10) + indent (length (match-string 8)) caption (get-text-property 0 'org-caption (match-string 0)))) (setq trans (org-export-format-source-code-or-example @@ -2153,12 +2200,14 @@ INDENT was the original indentation of the block." (org-add-props (concat "<programlisting><![CDATA[" rtn "]]></programlisting>\n") - '(org-protected t)) + '(org-protected t org-example t)) "#+END_DOCBOOK\n")) ((eq backend 'html) ;; We are exporting to HTML (when lang - (require 'htmlize nil t) + (if (featurep 'xemacs) + (require 'htmlize) + (require 'htmlize nil t)) (when (not (fboundp 'htmlize-region-for-paste)) ;; we do not have htmlize.el, or an old version of it (setq lang nil) @@ -2221,7 +2270,7 @@ INDENT was the original indentation of the block." cont rpllbl fmt))) (if (string-match "\\(\\`<[^>]*>\\)\n" rtn) (setq rtn (replace-match "\\1" t nil rtn))) - (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t)) "\n#+END_HTML\n\n")) + (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t org-example t)) "\n#+END_HTML\n\n")) ((eq backend 'latex) (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt)) (concat "#+BEGIN_LaTeX\n" @@ -2245,7 +2294,7 @@ INDENT was the original indentation of the block." rtn "\\end{lstlisting}\n") (concat (car org-export-latex-verbatim-wrap) rtn (cdr org-export-latex-verbatim-wrap))) - '(org-protected t)) + '(org-protected t org-example t)) "#+END_LaTeX\n")) ((eq backend 'ascii) ;; This is not HTML or LaTeX, so just make it an example. @@ -2259,7 +2308,7 @@ INDENT was the original indentation of the block." (org-split-string rtn "\n") "\n") "\n") - '(org-protected t)) + '(org-protected t org-example t)) "#+END_ASCII\n")))) (org-add-props rtn nil 'original-indentation indent)))) @@ -2362,8 +2411,8 @@ INDENT was the original indentation of the block." (defun org-export-visible (type arg) "Create a copy of the visible part of the current buffer, and export it. The copy is created in a temporary buffer and removed after use. -TYPE is the final key (as a string) that also select the export command in -the `C-c C-e' export dispatcher. +TYPE is the final key (as a string) that also selects the export command in +the \\<org-mode-map>\\[org-export] export dispatcher. As a special case, if the you type SPC at the prompt, the temporary org-mode file will not be removed but presented to you so that you can continue to use it. The prefix arg ARG is passed through to the exporting @@ -2490,7 +2539,8 @@ directory." filename))) (backup-inhibited t) (buffer (find-file-noselect filename)) - (region (buffer-string))) + (region (buffer-string)) + str-ret) (save-excursion (switch-to-buffer buffer) (erase-buffer) @@ -2536,7 +2586,11 @@ directory." (write-file (concat filename ".html"))) (kill-buffer newbuf))) (set-buffer-modified-p nil) - (kill-buffer (current-buffer))))) + (if (equal to-buffer 'string) + (progn (setq str-ret (buffer-string)) + (kill-buffer (current-buffer)) + str-ret) + (kill-buffer (current-buffer)))))) (defvar org-archive-location) ;; gets loaded with the org-archive require. (defun org-get-current-options () @@ -2558,6 +2612,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+EXPORT_EXCLUDE_TAGS: %s #+LINK_UP: %s #+LINK_HOME: %s +#+XSLT: #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s @@ -2650,13 +2705,16 @@ If yes remove the column and the special lines." "^[ \t]*| *\\([\#!$*_^ /]\\) *|") x))) lines)) + ;; No special marking column (progn (setq org-table-clean-did-remove-column nil) (delq nil (mapcar (lambda (x) (cond - ((string-match "^[ \t]*| */ *|" x) + ((org-table-colgroup-line-p x) + ;; This line contains colgroup info, extract it + ;; and then discard the line (setq org-table-colgroup-info (mapcar (lambda (x) (cond ((member x '("<" "<")) :start) @@ -2665,14 +2723,20 @@ If yes remove the column and the special lines." (t nil))) (org-split-string x "[ \t]*|[ \t]*"))) nil) + ((org-table-cookie-line-p x) + ;; This line contains formatting cookies, discard it + nil) (t x))) lines))) + ;; there is a special marking column (setq org-table-clean-did-remove-column t) (delq nil (mapcar (lambda (x) (cond - ((string-match "^[ \t]*| */ *|" x) + ((org-table-colgroup-line-p x) + ;; This line contains colgroup info, extract it + ;; and then discard the line (setq org-table-colgroup-info (mapcar (lambda (x) (cond ((member x '("<" "<")) :start) @@ -2681,8 +2745,12 @@ If yes remove the column and the special lines." (t nil))) (cdr (org-split-string x "[ \t]*|[ \t]*")))) nil) + ((org-table-cookie-line-p x) + ;; This line contains formatting cookies, discard it + nil) ((string-match "^[ \t]*| *[!_^/] *|" x) - nil) ; ignore this line + ;; ignore this line + nil) ((or (string-match "^\\([ \t]*\\)|-+\\+" x) (string-match "^\\([ \t]*\\)|[^|]*|" x)) ;; remove the first column @@ -2704,41 +2772,6 @@ If yes remove the column and the special lines." (setq s (replace-match "" t t s))) s) -(defun org-create-multibrace-regexp (left right n) - "Create a regular expression which will match a balanced sexp. -Opening delimiter is LEFT, and closing delimiter is RIGHT, both given -as single character strings. -The regexp returned will match the entire expression including the -delimiters. It will also define a single group which contains the -match except for the outermost delimiters. The maximum depth of -stacked delimiters is N. Escaping delimiters is not possible." - (let* ((nothing (concat "[^" left right "]*?")) - (or "\\|") - (re nothing) - (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) - (while (> n 1) - (setq n (1- n) - re (concat re or next) - next (concat "\\(?:" nothing left next right "\\)+" nothing))) - (concat left "\\(" re "\\)" right))) - -(defvar org-match-substring-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\|" - "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" - "\\|" - "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") - "The regular expression matching a sub- or superscript.") - -(defvar org-match-substring-with-braces-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\)") - "The regular expression matching a sub- or superscript, forcing braces.") - (defun org-get-text-property-any (pos prop &optional object) (or (get-text-property pos prop object) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index f86d1b31cb9..740f2629f2b 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -458,7 +458,7 @@ changes." (:foreground "green")) (((class color) (min-colors 8) (background dark)) (:foreground "yellow")))) - "Face for fixed-with text like code snippets." + "Face for fixed-width text like code snippets." :group 'org-faces :version "22.1") @@ -600,7 +600,7 @@ belong to the weekend." (defface org-agenda-dimmed-todo-face '((((background light)) (:foreground "grey50")) (((background dark)) (:foreground "grey50"))) - "Face used to dimm blocked tasks in the agenda." + "Face used to dim blocked tasks in the agenda." :group 'org-faces) (defface org-scheduled-previously diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index c06c7331cca..9d14daea9df 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -45,7 +45,7 @@ ;; With this setup, the command `M-x org-feed-update-all' will ;; collect new entries in the feed at the given URL and create ;; entries as subheadings under the "ReQall Entries" heading in the -;; file "~/org-feeds.org". Each feed should normally have its own +;; file "~/org/feeds.org". Each feed should normally have its own ;; heading - however see the `:drawer' parameter. ;; ;; Besides these standard elements that need to be specified for each @@ -83,8 +83,8 @@ ;; ;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS ;; -;; Acknowledgements -;; ---------------- +;; Acknowledgments +;; --------------- ;; ;; org-feed.el is based on ideas by Brad Bozarth who implemented a ;; similar mechanism using shell and awk scripts. @@ -99,6 +99,7 @@ (declare-function xml-get-children "xml" (node child-name)) (declare-function xml-get-attribute "xml" (node attribute)) (declare-function xml-get-attribute-or-nil "xml" (node attribute)) +(defvar xml-entity-alist) (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." @@ -165,10 +166,11 @@ Here are the keyword-value pair allows in `org-feed-alist'. When the handler is called, point will be at the feed headline. :parse-feed function - This function gets passed a buffer, and should return a list of entries, - each being a property list containing the `:guid' and `:item-full-text' - keys. The default is `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' - is an alternative. + This function gets passed a buffer, and should return a list + of entries, each being a property list containing the + `:guid' and `:item-full-text' keys. The default is + `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' is an + alternative. :parse-entry function This function gets passed an entry as returned by the parse-feed @@ -199,12 +201,12 @@ Here are the keyword-value pair allows in `org-feed-alist'. (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")) + (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" @@ -267,6 +269,17 @@ have been saved." (defvar org-feed-buffer "*Org feed*" "The buffer used to retrieve a feed.") +(defun org-feed-unescape (s) + "Unescape protected entities in S." + (require 'xml) + (let ((re (concat "&\\(" + (mapconcat 'car xml-entity-alist "\\|") + "\\);"))) + (while (string-match re s) + (setq s (replace-match + (cdr (assoc (match-string 1 s) xml-entity-alist)) nil nil s))) + s)) + ;;;###autoload (defun org-feed-update-all () "Get inbox items from all feeds in `org-feed-alist'." @@ -302,10 +315,10 @@ it can be a list structured like an entry in `org-feed-alist'." org-feed-default-template)) (drawer (or (nth 1 (memq :drawer feed)) org-feed-drawer)) - (parse-feed (or (nth 1 (memq :parse-feed feed)) - 'org-feed-parse-rss-feed)) - (parse-entry (or (nth 1 (memq :parse-entry feed)) - 'org-feed-parse-rss-entry)) + (parse-feed (or (nth 1 (memq :parse-feed feed)) + 'org-feed-parse-rss-feed)) + (parse-entry (or (nth 1 (memq :parse-entry feed)) + 'org-feed-parse-rss-entry)) feed-buffer inbox-pos new-formatted entries old-status status new changed guid-alist e guid olds) (setq feed-buffer (org-feed-get-feed url)) @@ -321,10 +334,11 @@ it can be a list structured like an entry in `org-feed-alist'." (setq old-status (org-feed-read-previous-status inbox-pos drawer)) ;; Add the "handled" status to the appropriate entries (setq entries (mapcar (lambda (e) - (setq e (plist-put e :handled - (nth 1 (assoc - (plist-get e :guid) - old-status))))) + (setq e + (plist-put e :handled + (nth 1 (assoc + (plist-get e :guid) + old-status))))) entries)) ;; Find out which entries are new and which are changed (dolist (e entries) @@ -579,11 +593,12 @@ Assumes headers are indeed present!" "Parse BUFFER for RSS feed entries. Returns a list of entries, with each entry a property list, containing the properties `:guid' and `:item-full-text'." - (let (entries beg end item guid entry) + (let ((case-fold-search t) + entries beg end item guid entry) (with-current-buffer buffer (widen) (goto-char (point-min)) - (while (re-search-forward "<item>" nil t) + (while (re-search-forward "<item\\>.*?>" nil t) (setq beg (point) end (and (re-search-forward "</item>" nil t) (match-beginning 0))) @@ -605,7 +620,7 @@ containing the properties `:guid' and `:item-full-text'." nil t) (setq entry (plist-put entry (intern (concat ":" (match-string 1))) - (match-string 2)))) + (org-feed-unescape (match-string 2))))) (goto-char (point-min)) (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t) (setq entry (plist-put entry :guid-permalink t)))) @@ -618,14 +633,15 @@ containing the properties `:guid' and `:item-full-text'. The `:item-full-text' property actually contains the sexp formatted as a string, not the original XML data." + (require 'xml) (with-current-buffer buffer (widen) (let ((feed (car (xml-parse-region (point-min) (point-max))))) (mapcar (lambda (entry) - (list - :guid (car (xml-node-children (car (xml-get-children entry 'id)))) - :item-full-text (prin1-to-string entry))) + (list + :guid (car (xml-node-children (car (xml-get-children entry 'id)))) + :item-full-text (prin1-to-string entry))) (xml-get-children feed 'entry))))) (defun org-feed-parse-atom-entry (entry) @@ -633,28 +649,36 @@ formatted as a string, not the original XML data." (let ((xml (car (read-from-string (plist-get entry :item-full-text))))) ;; Get first <link href='foo'/>. (setq entry (plist-put entry :link - (xml-get-attribute - (car (xml-get-children xml 'link)) - 'href))) + (xml-get-attribute + (car (xml-get-children xml 'link)) + 'href))) ;; Add <title/> as :title. (setq entry (plist-put entry :title - (car (xml-node-children - (car (xml-get-children xml 'title)))))) + (org-feed-unescape + (car (xml-node-children + (car (xml-get-children xml 'title))))))) (let* ((content (car (xml-get-children xml 'content))) - (type (xml-get-attribute-or-nil content 'type))) + (type (xml-get-attribute-or-nil content 'type))) (when content - (cond - ((string= type "text") - ;; We like plain text. - (setq entry (plist-put entry :description (car (xml-node-children content))))) - ((string= type "html") - ;; TODO: convert HTML to Org markup. - (setq entry (plist-put entry :description (car (xml-node-children content))))) - ((string= type "xhtml") - ;; TODO: convert XHTML to Org markup. - (setq entry (plist-put entry :description (prin1-to-string (xml-node-children content))))) - (t - (setq entry (plist-put entry :description (format "Unknown '%s' content." type))))))) + (cond + ((string= type "text") + ;; We like plain text. + (setq entry (plist-put entry :description + (org-feed-unescape + (car (xml-node-children content)))))) + ((string= type "html") + ;; TODO: convert HTML to Org markup. + (setq entry (plist-put entry :description + (org-feed-unescape + (car (xml-node-children content)))))) + ((string= type "xhtml") + ;; TODO: convert XHTML to Org markup. + (setq entry (plist-put entry :description + (prin1-to-string + (xml-node-children content))))) + (t + (setq entry (plist-put entry :description + (format "Unknown '%s' content." type))))))) entry)) (provide 'org-feed) diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index 5964ef4ce2c..2a2c4c0f426 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -65,6 +65,11 @@ (org-re "^\\(\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]\\)") "Regular expression matching the definition of a footnote.") +(defgroup org-footnote nil + "Footnotes in Org-mode." + :tag "Org Footnote" + :group 'org) + (defcustom org-footnote-section "Footnotes" "Outline heading containing footnote definitions before export. This can be nil, to place footnotes locally at the end of the current @@ -75,7 +80,7 @@ automatically, i.e. when creating the footnote, and when sorting the notes. However, by hand you may place definitions *anywhere*. If this is a string, during export, all subtrees starting with this heading will be removed after extracting footnote definitions." - :group 'org-footnotes + :group 'org-footnote :type '(choice (string :tag "Collect footnotes under heading") (const :tag "Define footnotes locally" nil))) @@ -87,7 +92,7 @@ as in Org-mode. Outside Org-mode, new footnotes are always placed at the end of the file. When you normalize the notes, any line containing only this tag will be removed, a new one will be inserted at the end of the file, followed by the collected and normalized footnotes." - :group 'org-footnotes + :group 'org-footnote :type 'string) (defcustom org-footnote-define-inline nil @@ -182,25 +187,25 @@ with start and label of the footnote if there is a definition at point." (org-show-context 'link-search) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))) -(defun org-footnote-goto-next-reference (label) - "Find the next reference of the footnote with label LABEL." +(defun org-footnote-goto-previous-reference (label) + "Find the next previous of the footnote with label LABEL." (interactive "sLabel: ") (org-mark-ring-push) (setq label (org-footnote-normalize-label label)) (let ((re (format ".\\[%s[]:]" label)) (p0 (point)) pos) (save-excursion - (setq pos (or (re-search-forward re nil t) - (and (goto-char (point-min)) - (re-search-forward re nil t)) + (setq pos (or (re-search-backward re nil t) + (and (goto-char (point-max)) + (re-search-backward re nil t)) (and (progn (widen) t) (goto-char p0) - (re-search-forward re nil t)) - (and (goto-char (point-min)) + (re-search-backward re nil t)) + (and (goto-char (point-max)) (re-search-forward re nil t))))) (if pos (progn - (goto-char pos) + (goto-char (match-end 0)) (org-show-context 'link-search)) (error "Cannot find reference of footnote %s" label)))) @@ -339,7 +344,7 @@ With prefix arg SPECIAL, offer additional commands in a menu." (org-footnote-goto-definition (nth 1 tmp)) (goto-char (match-beginning 4)))) ((setq tmp (org-footnote-at-definition-p)) - (org-footnote-goto-next-reference (nth 1 tmp))) + (org-footnote-goto-previous-reference (nth 1 tmp))) (t (org-footnote-new))))) ;;;###autoload diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index b431cad20fa..f2fca8c29f4 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -7,7 +7,7 @@ ;; Tassilo Horn <tassilo at member dot fsf dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -48,7 +48,7 @@ (defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)) (defcustom org-gnus-prefer-web-links nil - "Non-nil means `org-store-link' will create web links to Google groups. + "If non-nil, `org-store-link' creates web links to Google groups or Gmane. When nil, Gnus will be used for such links. Using a prefix arg to the command \\[org-store-link] (`org-store-link') negates this setting for the duration of the command." @@ -120,22 +120,26 @@ If `org-store-link' was called with a prefix arg the meaning of ((memq major-mode '(gnus-summary-mode gnus-article-mode)) (let* ((group gnus-newsgroup-name) - (header (with-current-buffer gnus-summary-buffer + (header (with-current-buffer gnus-summary-buffer (gnus-summary-article-header))) (from (mail-header-from header)) (message-id (org-remove-angle-brackets (mail-header-id header))) (date (mail-header-date header)) - (subject (mail-header-subject header)) - (to (cdr (assq 'To (mail-header-extra header)))) - newsgroups x-no-archive desc link) + (subject (copy-sequence (mail-header-subject header))) + (to (cdr (assq 'To (mail-header-extra header)))) + newsgroups x-no-archive desc link) + ;; Remove text properties of subject string to avoid Emacs bug + ;; #3506 + (set-text-properties 0 (length subject) nil subject) + ;; Fetching an article is an expensive operation; newsgroup and ;; x-no-archive are only needed for web links. (when (org-xor current-prefix-arg org-gnus-prefer-web-links) - ;; Make sure the original article buffer is up-to-date - (save-window-excursion (gnus-summary-select-article)) - (setq to (or to (gnus-fetch-original-field "To")) - newsgroups (gnus-fetch-original-field "Newsgroups") - x-no-archive (gnus-fetch-original-field "x-no-archive"))) + ;; Make sure the original article buffer is up-to-date + (save-window-excursion (gnus-summary-select-article)) + (setq to (or to (gnus-fetch-original-field "To")) + newsgroups (gnus-fetch-original-field "Newsgroups") + x-no-archive (gnus-fetch-original-field "x-no-archive"))) (org-store-link-props :type "gnus" :from from :subject subject :message-id message-id :group group :to to) (setq desc (org-email-link-description) diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 93be08ca37b..71e0a9583f1 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -5,7 +5,7 @@ ;; Author: John Wiegley <johnw at gnu dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -27,11 +27,13 @@ ;; This file contains the habit tracking code for Org-mode +;;; Code: + (require 'org) (require 'org-agenda) + (eval-when-compile - (require 'cl) - (require 'calendar)) + (require 'cl)) (defgroup org-habit nil "Options concerning habit tracking in Org-mode." @@ -179,8 +181,10 @@ This list represents a \"habit\" for the rest of this module." (defsubst org-habit-deadline (habit) (let ((deadline (nth 2 habit))) (or deadline - (+ (org-habit-scheduled habit) - (1- (org-habit-scheduled-repeat habit)))))) + (if (nth 3 habit) + (+ (org-habit-scheduled habit) + (1- (org-habit-scheduled-repeat habit))) + (org-habit-scheduled habit))))) (defsubst org-habit-deadline-repeat (habit) (or (nth 3 habit) (org-habit-scheduled-repeat habit))) @@ -281,9 +285,16 @@ current time." donep))) markedp face) (if donep - (progn + (let ((done-time (time-add + starting + (days-to-time + (- start (time-to-days starting)))))) + (aset graph index ?*) (setq markedp t) + (put-text-property + index (1+ index) 'help-echo + (format-time-string (org-time-stamp-format) done-time) graph) (while (and done-dates (= start (car done-dates))) (setq last-done-date (car done-dates) diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el index f891e5a85a5..e20b92147fc 100644 --- a/lisp/org/org-html.el +++ b/lisp/org/org-html.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,7 +26,10 @@ ;; ;;; Commentary: +;;; Code: + (require 'org-exp) + (eval-when-compile (require 'cl)) (declare-function org-id-find-id-file "org-id" (id)) @@ -57,7 +60,7 @@ by the footnotes themselves." :type 'string) (defcustom org-export-html-coding-system nil - "Coding system for HTML export, defaults to buffer-file-coding-system." + "Coding system for HTML export, defaults to `buffer-file-coding-system'." :group 'org-export-html :type 'coding-system) @@ -81,7 +84,7 @@ and corresponding declarations." (string :tag "Declaration"))))) (defcustom org-export-html-style-include-scripts t - "Non-nil means include the javascript snippets in exported HTML files. + "Non-nil means include the JavaScript snippets in exported HTML files. The actual script is defined in `org-export-html-scripts' and should not be modified." :group 'org-export-html @@ -110,7 +113,7 @@ 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\"> @@ -207,20 +210,20 @@ settings with <style>...</style> tags." (put 'org-export-html-style-extra 'safe-local-variable 'stringp) (defcustom org-export-html-tag-class-prefix "" - "Prefix to clas names for TODO keywords. + "Prefix to class names for TODO keywords. Each tag gets a class given by the tag itself, with this prefix. The default prefix is empty because it is nice to just use the keyword as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefic can be very useful." +CSS classes, then this prefix can be very useful." :group 'org-export-html :type 'string) (defcustom org-export-html-todo-kwd-class-prefix "" - "Prefix to clas names for TODO keywords. + "Prefix to class names for TODO keywords. Each TODO keyword gets a class given by the keyword itself, with this prefix. The default prefix is empty because it is nice to just use the keyword as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefic can be very useful." +CSS classes, then this prefix can be very useful." :group 'org-export-html :type 'string) @@ -235,10 +238,11 @@ CSS classes, then this prefic can be very useful." | <a accesskey=\"H\" href=\"%s\"> HOME </a> </div>" - "Snippet used to insert the HOME and UP links. This is a format, -the first %s will receive the UP link, the second the HOME link. -If both `org-export-html-link-up' and `org-export-html-link-home' are -empty, the entire snippet will be ignored." + "Snippet used to insert the HOME and UP links. +This is a format string, the first %s will receive the UP link, +the second the HOME link. If both `org-export-html-link-up' and +`org-export-html-link-home' are empty, the entire snippet will be +ignored." :group 'org-export-html :type 'string) @@ -340,7 +344,7 @@ When nil, also column one will use data tags." :type 'boolean) (defcustom org-export-html-validation-link nil - "Non-nil means add validationlink to postamble of HTML exported files." + "Non-nil means add validation link to postamble of HTML exported files." :group 'org-export-html :type '(choice (const :tag "Nothing" nil) @@ -349,9 +353,10 @@ When nil, also column one will use data tags." (defcustom org-export-html-with-timestamp nil - "If non-nil, write `org-export-html-html-helper-timestamp' -into the exported HTML text. Otherwise, the buffer will just be saved -to a file." + "If non-nil, write timestamp into the exported HTML text. +If non-nil Write `org-export-html-html-helper-timestamp' into the +exported HTML text. Otherwise, the buffer will just be saved to +a file." :group 'org-export-html :type 'boolean) @@ -405,10 +410,10 @@ with a link to this URL." ;;; Variables, constants, and parameter plists (defvar org-export-html-preamble nil - "Preamble, to be inserted just before <body>. Set by publishing functions. + "Preamble, to be inserted just after <body>. Set by publishing functions. This may also be a function, building and inserting the preamble.") (defvar org-export-html-postamble nil - "Preamble, to be inserted just after </body>. Set by publishing functions. + "Preamble, to be inserted just before </body>. Set by publishing functions. This may also be a function, building and inserting the postamble.") (defvar org-export-html-auto-preamble t "Should default preamble be inserted? Set by publishing functions.") @@ -426,14 +431,15 @@ This may also be a function, building and inserting the postamble.") ;;; HTML export (defun org-export-html-preprocess (parameters) - ;; Convert LaTeX fragments to images + "Convert LaTeX fragments to images." (when (and org-current-export-file (plist-get parameters :LaTeX-fragments)) (org-format-latex (concat "ltxpng/" (file-name-sans-extension (file-name-nondirectory org-current-export-file))) - org-current-export-dir nil "Creating LaTeX image %s")) + org-current-export-dir nil "Creating LaTeX image %s" + nil nil (eq (plist-get parameters :LaTeX-fragments) 'verbatim))) (goto-char (point-min)) (let (label l1) (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) @@ -455,11 +461,12 @@ headlines. The default is 3. Lower levels will become bulleted lists." (org-export-as-html arg 'hidden) (org-open-file buffer-file-name) (when org-export-kill-product-buffer-when-displayed - (kill-buffer))) + (kill-buffer (current-buffer)))) ;;;###autoload (defun org-export-as-html-batch () - "Call `org-export-as-html', may be used in batch processing as + "Call the function `org-export-as-html'. +This function can be used in batch processing as: emacs --batch --load=$HOME/lib/emacs/org.el --eval \"(setq org-export-headline-levels 2)\" @@ -533,6 +540,131 @@ in a window. A non-interactive call will only return the buffer." (defvar html-table-tag nil) ; dynamically scoped into this. (defvar org-par-open nil) + +;;; org-html-cvt-link-fn +(defconst org-html-cvt-link-fn + 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. +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 + "http" + (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. +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)) + (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. +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#locationx) +FRAGMENT is the fragment part of the link, if any (foo.html#THIS) +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) + (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")) + (if fragment + (setq thefile (concat thefile "#" fragment)))) + + (t)) + + ;;Final URL-build, for all types. + (setq thefile + (let + ((str (org-export-html-format-href thefile))) + (if (and type (not (string= "file" type)) + (org-string-match-p "^//" str)) + (concat type ":" 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 "\"" attr ">" + (org-export-html-format-desc desc) + "</a>"))))) + +;;; org-export-as-html ;;;###autoload (defun org-export-as-html (arg &optional hidden ext-plist to-buffer body-only pub-dir) @@ -710,7 +842,7 @@ PUB-DIR is set, use this as the publishing directory." table-buffer table-orig-buffer ind item-type starter didclose rpl path attr desc descp desc1 desc2 link - snumber fnc item-tag + snumber fnc item-tag initial-number footnotes footref-seen id-file href ) @@ -789,7 +921,7 @@ lang=\"%s\" xml:lang=\"%s\"> "") (or charset "iso-8859-1")) language language - (org-html-expand title) + title (or charset "iso-8859-1") date author description keywords style @@ -871,7 +1003,9 @@ lang=\"%s\" xml:lang=\"%s\"> t t line))) (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) (setq txt (replace-match "" t t txt))) - (setq href (format "sec-%s" snumber)) + (setq href + (replace-regexp-in-string + "\\." "_" (format "sec-%s" snumber))) (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href)) (push (format @@ -959,10 +1093,12 @@ lang=\"%s\" xml:lang=\"%s\"> (when (equal "ORG-VERSE-START" 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) (insert "</p>\n") + (setq org-par-open nil) (org-open-par) (setq inverse nil) (throw 'nextline nil)) @@ -1042,70 +1178,79 @@ lang=\"%s\" xml:lang=\"%s\"> desc2 (if (match-end 2) (concat type ":" path) path) descp (and desc1 (not (equal desc1 desc2))) desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted + ;; Make an image out of the description if that is so wanted (when (and descp (org-file-image-p - desc org-export-html-inline-image-extensions)) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0))))) - (setq desc (org-add-props + desc org-export-html-inline-image-extensions)) + (save-match-data + (if (string-match "^file:" desc) + (setq desc (substring desc (match-end 0))))) + (setq desc (org-add-props (concat "<img src=\"" desc "\"/>") '(org-protected t)))) - ;; FIXME: do we need to unescape here somewhere? (cond ((equal type "internal") - (setq rpl - (concat - "<a href=\"" - (if (= (string-to-char path) ?#) "" "#") - (org-solidify-link-text - (save-match-data (org-link-unescape path)) nil) - "\"" attr ">" - (org-export-html-format-desc desc) - "</a>"))) + (let + ((frag-0 + (if (= (string-to-char path) ?#) + (substring path 1) + path))) + (setq rpl + (org-html-make-link + opt-plist + "" + "" + (org-solidify-link-text + (save-match-data (org-link-unescape frag-0)) + nil) + desc attr nil)))) ((and (equal type "id") (setq id-file (org-id-find-id-file path))) ;; This is an id: link to another file (if it was the same file, ;; it would have become an internal link...) (save-match-data (setq id-file (file-relative-name - id-file (file-name-directory org-current-export-file))) - (setq id-file (concat (file-name-sans-extension id-file) - "." html-extension)) - (setq rpl (concat "<a href=\"" id-file "#" - (if (org-uuidgen-p path) "ID-") - path "\"" - attr ">" - (org-export-html-format-desc desc) - "</a>")))) + id-file + (file-name-directory org-current-export-file))) + (setq rpl + (org-html-make-link opt-plist + "file" id-file + (concat (if (org-uuidgen-p path) "ID-") path) + desc + attr + nil)))) ((member type '("http" "https")) - ;; standard URL, just check if we need to inline an image - (if (and (or (eq t org-export-html-inline-images) - (and org-export-html-inline-images (not descp))) - (org-file-image-p - path org-export-html-inline-image-extensions)) - (setq rpl (org-export-html-format-image - (concat type ":" path) org-par-open)) - (setq link (concat type ":" path)) - (setq rpl (concat "<a href=\"" - (org-export-html-format-href link) - "\"" attr ">" - (org-export-html-format-desc desc) - "</a>")))) + ;; standard URL, can inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + (org-html-should-inline-p path descp)))) ((member type '("ftp" "mailto" "news")) - ;; standard URL - (setq link (concat type ":" path)) - (setq rpl (concat "<a href=\"" - (org-export-html-format-href link) - "\"" attr ">" - (org-export-html-format-desc desc) - "</a>"))) + ;; standard URL, can't inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + nil))) ((string= type "coderef") - (setq rpl (format "<a href=\"#coderef-%s\" class=\"coderef\" onmouseover=\"CodeHighlightOn(this, 'coderef-%s');\" onmouseout=\"CodeHighlightOff(this, 'coderef-%s');\">%s</a>" - path path path - (format (org-export-get-coderef-format path (and descp desc)) - (cdr (assoc path org-export-code-refs)))))) + (let* + ((coderef-str (format "coderef-%s" path)) + (attr-1 + (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" + coderef-str coderef-str))) + (setq rpl + (org-html-make-link opt-plist + type "" coderef-str + (format + (org-export-get-coderef-format + path + (and descp desc)) + (cdr (assoc path org-export-code-refs))) + attr-1 + nil)))) ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) ;; The link protocol has a function for format the link @@ -1114,52 +1259,55 @@ lang=\"%s\" xml:lang=\"%s\"> (funcall fnc (org-link-unescape path) desc1 'html)))) ((string= type "file") - ;; FILE link - (let* ((filename path) - (abs-p (file-name-absolute-p filename)) - thefile file-is-image-p search) + ;; FILE link (save-match-data - (if (string-match "::\\(.*\\)" filename) - (setq search (match-string 1 filename) - filename (replace-match "" t nil filename))) - (setq valid - (if (functionp link-validate) - (funcall link-validate filename current-dir) - t)) - (setq file-is-image-p - (org-file-image-p - filename org-export-html-inline-image-extensions)) - (setq thefile (if abs-p (expand-file-name filename) filename)) - (when (and org-export-html-link-org-files-as-html - (string-match "\\.org$" thefile)) - (setq thefile (concat (substring thefile 0 - (match-beginning 0)) - "." html-extension)) - (if (and search - ;; make sure this is can be used as target search - (not (string-match "^[0-9]*$" search)) - (not (string-match "^\\*" search)) - (not (string-match "^/.*/$" search))) - (setq thefile - (concat thefile - (if (= (string-to-char search) ?#) "" "#") - (org-solidify-link-text - (org-link-unescape search))))) - (when (string-match "^file:" desc) - (setq desc (replace-match "" t t desc)) - (if (string-match "\\.org$" desc) - (setq desc (replace-match "" t t desc)))))) - (setq rpl (if (and file-is-image-p - (or (eq t org-export-html-inline-images) - (and org-export-html-inline-images - (not descp)))) - (progn - (message "image %s %s" thefile org-par-open) - (org-export-html-format-image thefile org-par-open)) - (concat "<a href=\"" thefile "\"" attr ">" - (org-export-html-format-desc desc) - "</a>"))) - (if (not valid) (setq rpl desc)))) + (let* + ((components + (if + (string-match "::\\(.*\\)" path) + (list + (replace-match "" t nil path) + (match-string 1 path)) + (list path nil))) + + ;;The proper path, without a fragment + (path-1 + (first components)) + + ;;The raw fragment + (fragment-0 + (second components)) + + ;;Check the fragment. If it can't be used as + ;;target fragment we'll pass nil instead. + (fragment-1 + (if + (and fragment-0 + (not (string-match "^[0-9]*$" fragment-0)) + (not (string-match "^\\*" fragment-0)) + (not (string-match "^/.*/$" fragment-0))) + (org-solidify-link-text + (org-link-unescape fragment-0)) + nil)) + (desc-2 + ;;Description minus "file:" and ".org" + (if (string-match "^file:" desc) + (let + ((desc-1 (replace-match "" t t desc))) + (if (string-match "\\.org$" desc-1) + (replace-match "" t t desc-1) + desc-1)) + desc))) + + (setq rpl + (if + (and + (functionp link-validate) + (not (funcall link-validate path-1 current-dir))) + desc + (org-html-make-link opt-plist + "file" path-1 fragment-1 desc-2 attr + (org-html-should-inline-p path-1 descp))))))) (t ;; just publish the path, as default @@ -1280,7 +1428,11 @@ lang=\"%s\" xml:lang=\"%s\"> starter (if (match-beginning 2) (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5)) + initial-number nil item-tag nil) + (if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line) + (setq initial-number (match-string 1 line) + line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) (setq item-type "d" item-tag (match-string 1 line) @@ -1305,11 +1457,15 @@ lang=\"%s\" xml:lang=\"%s\"> ((and starter (or (not in-local-list) (> ind (car local-list-indent)))) + ;; check for a specified start number ;; Start new (level of) list (org-close-par-maybe) (insert (cond ((equal item-type "u") "<ul>\n<li>\n") - ((equal item-type "o") "<ol>\n<li>\n") + ((equal item-type "o") + (if initial-number + (format "<ol start=%s>\n<li>\n" initial-number) + "<ol>\n<li>\n")) ((equal item-type "d") (format "<dl>\n<dt>%s</dt><dd>\n" item-tag)))) (push item-type local-list-type) @@ -1621,7 +1777,7 @@ lang=\"%s\" xml:lang=\"%s\"> (lambda (x) (string-match "^[ \t]*|-" x)) (cdr lines))))) - (nline 0) fnum i + (nline 0) fnum nfields i tbopen line fields html gr colgropen rowstart rowend) (setq caption (and caption (org-html-do-expand caption))) (if splice (setq head nil)) @@ -1639,7 +1795,8 @@ lang=\"%s\" xml:lang=\"%s\"> (throw 'next-line t))) ;; Break the line into fields (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0))) + (unless fnum (setq fnum (make-vector (length fields) 0) + nfields (length fnum))) (setq nline (1+ nline) i -1 rowstart (eval (car org-export-table-row-tags)) rowend (eval (cdr org-export-table-row-tags))) @@ -1647,7 +1804,7 @@ lang=\"%s\" xml:lang=\"%s\"> (mapconcat (lambda (x) (setq i (1+ i)) - (if (and (< i nline) + (if (and (< i nfields) ; make sure no rogue line causes an error here (string-match org-table-number-regexp x)) (incf (aref fnum i))) (cond @@ -1867,7 +2024,7 @@ that uses these same face definitions." (goto-char (point-min))) (defun org-html-protect (s) - ;; convert & to &, < to < and > to > + "convert & to &, < to < and > to >" (let ((start 0)) (while (string-match "&" s start) (setq s (replace-match "&" t t s) @@ -1882,7 +2039,7 @@ that uses these same face definitions." s) (defun org-html-expand (string) - "Prepare STRING for HTML export. Applies all active conversions. + "Prepare STRING for HTML export. Apply all active conversions. If there are links in the string, don't modify these." (let* ((re (concat org-bracket-link-regexp "\\|" (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) @@ -1996,10 +2153,18 @@ If there are links in the string, don't modify these." (defvar local-list-indent) (defvar local-list-type) (defun org-export-html-close-lists-maybe (line) - (let ((ind (or (get-text-property 0 'original-indentation line))) -; (and (string-match "\\S-" line) -; (org-get-indentation line)))) - didclose) + "Close local lists based on the original indentation of the line." + (let* ((rawhtml (and in-local-list + (get-text-property 0 'org-protected line) + (not (get-text-property 0 'org-example line)))) + ;; rawhtml means: This was between #+begin_html..#+end_html + ;; originally, thus it excludes stuff that was a source code example + ;; Actually, this code seems wrong, I don't know why it works, but + ;; it seems to work.... So keep it like this for now. + (ind (if rawhtml + (org-get-indentation line) + (get-text-property 0 'original-indentation line))) + didclose) (when ind (while (and in-local-list (<= ind (car local-list-indent))) @@ -2023,7 +2188,7 @@ When TITLE is nil, just close all open levels." (cdr (assoc target org-export-preferred-target-alist)))) (remove (or preferred target)) (l org-level-max) - snumber href suffix) + snumber snu href suffix) (setq extra-targets (remove remove extra-targets)) (setq extra-targets (mapconcat (lambda (x) @@ -2072,7 +2237,8 @@ When TITLE is nil, just close all open levels." extra-targets title "<br/>\n") (insert "<ul>\n<li>" title "<br/>\n")))) (aset org-levels-open (1- level) t) - (setq snumber (org-section-number level)) + (setq snumber (org-section-number level) + snu (replace-regexp-in-string "\\." "_" snumber)) (setq level (+ level org-export-html-toplevel-hlevel -1)) (if (and org-export-with-section-numbers (not body-only)) (setq title (concat @@ -2080,9 +2246,9 @@ When TITLE is nil, just close all open levels." level snumber) " " title))) (unless (= head-count 1) (insert "\n</div>\n")) - (setq href (cdr (assoc (concat "sec-" snumber) org-export-preferred-target-alist))) - (setq suffix (or href snumber)) - (setq href (or href (concat "sec-" snumber))) + (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist))) + (setq suffix (or href snu)) + (setq href (or href (concat "sec-" snu))) (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d%s\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n" suffix level (if extra-class (concat " " extra-class) "") level href diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el index 144f261e42d..1c4d7d6ac5b 100644 --- a/lisp/org/org-icalendar.el +++ b/lisp/org/org-icalendar.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,8 +26,13 @@ ;; ;;; Commentary: +;;; Code: + (require 'org-exp) +(eval-when-compile + (require 'cl)) + (declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) (defgroup org-export-icalendar nil @@ -47,6 +52,11 @@ The file name should be absolute, the file will be overwritten without warning." :group 'org-export-icalendar :type 'string) +(defcustom org-icalendar-combined-description nil + "Calendar description for the combined iCalendar representing all agenda files." + :group 'org-export-icalendar + :type 'string) + (defcustom org-icalendar-use-plain-timestamp t "Non-nil means make an event from every plain time stamp." :group 'org-export-icalendar @@ -157,7 +167,7 @@ The iCalendar standard requires that all entries have a unique identifier. Org will create these identifiers as needed. When this variable is non-nil, the created UIDs will be stored in the ID property of the entry. Then the next time this entry is exported, it will be exported with the same UID, -superceding the previous form of it. This is essential for +superseding the previous form of it. This is essential for synchronization services. This variable is not turned on by default because we want to avoid creating a property drawer in every entry if people are only playing with this feature, @@ -185,7 +195,7 @@ file, but with extension `.ics'." ;;;###autoload (defun org-export-icalendar-all-agenda-files () - "Export all files in `org-agenda-files' to iCalendar .ics files. + "Export all files in the variable `org-agenda-files' to iCalendar .ics files. Each iCalendar file will be located in the same directory as the Org-mode file, but with extension `.ics'." (interactive) @@ -511,11 +521,12 @@ whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH characters." (if (not s) nil - (when is-body + (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))))) + (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) (setq start (+ (match-beginning 0) 2) @@ -563,14 +574,16 @@ not used right now." (name (or name "unknown")) (timezone (if (> (length org-icalendar-timezone) 0) org-icalendar-timezone - (cadr (current-time-zone))))) + (cadr (current-time-zone)))) + (description org-icalendar-combined-description)) (princ (format "BEGIN:VCALENDAR VERSION:2.0 X-WR-CALNAME:%s PRODID:-//%s//Emacs with Org-mode//EN X-WR-TIMEZONE:%s -CALSCALE:GREGORIAN\n" name user timezone)))) +X-WR-CALDESC:%s +CALSCALE:GREGORIAN\n" name user timezone description)))) (defun org-finish-icalendar-file () "Finish an iCalendar file by inserting the END statement." @@ -581,22 +594,24 @@ CALSCALE:GREGORIAN\n" name user timezone)))) KEYWORD is added in front, to make a complete line like DTSTART.... When INC is non-nil, increase the hour by two (if time string contains a time), or the day by one (if it does not contain a time)." - (let ((t1 (org-parse-time-string s 'nodefault)) + (let ((t1 (ignore-errors (org-parse-time-string s 'nodefault))) t2 fmt have-time time) - (if (and (car t1) (nth 1 t1) (nth 2 t1)) - (setq t2 t1 have-time t) - (setq t2 (org-parse-time-string s))) - (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) - (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) - (when inc - (if have-time - (if org-agenda-default-appointment-duration - (setq mi (+ org-agenda-default-appointment-duration mi)) - (setq h (+ 2 h))) - (setq d (1+ d)))) - (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time)))) + (if (not t1) + "" + (if (and (car t1) (nth 1 t1) (nth 2 t1)) + (setq t2 t1 have-time t) + (setq t2 (org-parse-time-string s))) + (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) + (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) + (when inc + (if have-time + (if org-agenda-default-appointment-duration + (setq mi (+ org-agenda-default-appointment-duration mi)) + (setq h (+ 2 h))) + (setq d (1+ d)))) + (setq time (encode-time s mi h d m y))) + (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) + (concat keyword (format-time-string fmt time))))) (provide 'org-icalendar) diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index d0bb53456e9..d16e5d81c8e 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -37,8 +37,9 @@ ;; time of the ID, with microsecond accuracy. This virtually ;; guarantees globally unique identifiers, even if several people are ;; creating IDs at the same time in files that will eventually be used -;; together. As an external method `uuidgen' is supported, if installed -;; on the system. +;; together. +;; +;; By default Org uses UUIDs as global unique identifiers. ;; ;; This file defines the following API: ;; @@ -68,6 +69,8 @@ ;; Find the location of an entry with specific id. ;; +;;; Code: + (require 'org) (declare-function message-make-fqdn "message" ()) @@ -84,18 +87,9 @@ :group 'org-id :type 'string) -(defcustom org-id-method - (condition-case nil - (if (string-match "\\`[-0-9a-fA-F]\\{36\\}\\'" - (org-trim (shell-command-to-string - org-id-uuid-program))) - 'uuidgen - 'org) - (error 'org)) +(defcustom org-id-method 'uuid "The method that should be used to create new IDs. -If `uuidgen' is available on the system, it will be used as the default method. -if not, the method `org' is used. An ID will consist of the optional prefix specified in `org-id-prefix', and a unique part created by the method this variable specifies. @@ -105,11 +99,13 @@ org Org's own internal method, using an encoding of the current time to microsecond accuracy, and optionally the current domain of the computer. See the variable `org-id-include-domain'. -uuidgen Call the external command uuidgen." +uuid Create random (version 4) UUIDs. If the program defined in + `org-id-uuid-program' is available it is used to create the ID. + Otherwise an internal functions is used." :group 'org-id :type '(choice (const :tag "Org's internal method" org) - (const :tag "external: uuidgen" uuidgen))) + (const :tag "external: uuidgen" uuid))) (defcustom org-id-prefix nil "The prefix for IDs. @@ -306,8 +302,10 @@ So a typical ID could look like \"Org:4nd91V40HI\"." unique) (if (equal prefix ":") (setq prefix "")) (cond - ((eq org-id-method 'uuidgen) - (setq unique (org-trim (shell-command-to-string org-id-uuid-program)))) + ((memq org-id-method '(uuidgen uuid)) + (setq unique (org-trim (shell-command-to-string org-id-uuid-program))) + (unless (org-uuidgen-p unique) + (setq unique (org-id-uuid)))) ((eq org-id-method 'org) (let* ((etime (org-id-reverse-string (org-id-time-to-b36))) (postfix (if org-id-include-domain @@ -318,6 +316,30 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (t (error "Invalid `org-id-method'"))) (concat prefix unique))) +(defun org-id-uuid () + "Return string with random (version 4) UUID." + (let ((rnd (md5 (format "%s%s%s%s%s%s%s" + (random t) + (current-time) + (user-uid) + (emacs-pid) + (user-full-name) + user-mail-address + (recent-keys))))) + (format "%s-%s-4%s-%s%s-%s" + (substring rnd 0 8) + (substring rnd 8 12) + (substring rnd 13 16) + (format "%x" + (logior + #b10000000 + (logand + #b10111111 + (string-to-number + (substring rnd 16 18) 16)))) + (substring rnd 18 20) + (substring rnd 20 32)))) + (defun org-id-reverse-string (s) (mapconcat 'char-to-string (nreverse (string-to-list s)) "")) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 7fb4e421dcc..d88688d19ba 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -29,22 +29,24 @@ ;; by adding text properties to a buffer to make sure lines are ;; indented according to outline structure. +;;; Code: + (require 'org-macs) (require 'org-compat) (require 'org) + (eval-when-compile (require 'cl)) - (defgroup org-indent nil "Options concerning dynamic virtual outline indentation." :tag "Org Indent" :group 'org) (defconst org-indent-max 40 - "Maximum indentation in characters") + "Maximum indentation in characters.") (defconst org-indent-max-levels 40 - "Maximum indentation in characters") + "Maximum indentation in characters.") (defvar org-indent-strings nil "Vector with all indentation strings. @@ -53,7 +55,7 @@ It will be set in `org-indent-initialize'.") "Vector with all indentation star strings. It will be set in `org-indent-initialize'.") (defvar org-hide-leading-stars-before-indent-mode nil - "Used locally") + "Used locally.") (defcustom org-indent-boundary-char ?\ ; comment to protect space char "The end of the virtual indentation strings, a single-character string. @@ -67,13 +69,15 @@ it may be prettier to customize the org-indent face." :type 'character) (defcustom org-indent-mode-turns-off-org-adapt-indentation t - "Non-nil means turning on `org-indent-mode' turns off indentation adaptation. + "Non-nil means setting the variable `org-indent-mode' will \ +turn off indentation adaptation. For details see the variable `org-adapt-indentation'." :group 'org-indent :type 'boolean) (defcustom org-indent-mode-turns-on-hiding-stars t - "Non-nil means turning on `org-indent-mode' turns on `org-hide-leading-stars'." + "Non-nil means setting the variable `org-indent-mode' will \ +turn on `org-hide-leading-stars'." :group 'org-indent :type 'boolean) @@ -127,44 +131,57 @@ Internally this works by adding `line-prefix' properties to all non-headlines. These properties are updated locally in idle time. FIXME: How to update when broken?" nil " Ind" nil - (if (org-bound-and-true-p org-inhibit-startup) - (setq org-indent-mode nil) - (if org-indent-mode - (progn - (or org-indent-strings (org-indent-initialize)) - (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 'org-after-demote-entry-hook - 'org-indent-refresh-section nil 'local) - (org-add-hook 'org-after-promote-entry-hook - 'org-indent-refresh-section nil 'local) - (org-add-hook 'org-font-lock-hook - 'org-indent-refresh-to nil 'local) - (and font-lock-mode (org-restart-font-lock)) - ) - (save-excursion - (save-restriction - (org-indent-remove-properties (point-min) (point-max)) - (kill-local-variable 'org-adapt-indentation) - (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 'org-after-promote-entry-hook - 'org-indent-refresh-section 'local) - (remove-hook 'org-after-demote-entry-hook - 'org-indent-refresh-section 'local) - (and font-lock-mode (org-restart-font-lock)) - (redraw-display)))))) + (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 - refused 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 is can crash Emacs 23.1 - refused 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)) + (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 'org-after-demote-entry-hook + 'org-indent-refresh-section nil 'local) + (org-add-hook 'org-after-promote-entry-hook + 'org-indent-refresh-section nil 'local) + (org-add-hook 'org-font-lock-hook + 'org-indent-refresh-to nil 'local) + (and font-lock-mode (org-restart-font-lock)) + ) + (t + ;; mode was turned off (or we refused to turn it on) + (save-excursion + (save-restriction + (org-indent-remove-properties (point-min) (point-max)) + (kill-local-variable 'org-adapt-indentation) + (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 'org-after-promote-entry-hook + 'org-indent-refresh-section 'local) + (remove-hook 'org-after-demote-entry-hook + 'org-indent-refresh-section 'local) + (and font-lock-mode (org-restart-font-lock)) + (redraw-display)))))) (defface org-indent diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index e33adf43ee0..3c6bf7d2ca4 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 5232f2c264b..43d59b0b558 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; and properties. However, these nodes are treated specially by the ;; visibility cycling and export commands. ;; -;; Visibility cycling exempts these nodes from cycling. So whenever their +;; Visibility cycling exempts these nodes from cycling. So whenever their ;; parent is opened, so are these tasks. This will only work with ;; `org-cycle', so if you are also using other commands to show/hide ;; entries, you will occasionally find these tasks to behave like @@ -74,8 +74,7 @@ ;; ;; C-c C-x t Insert a new inline task with END line - -;;; Code +;;; Code: (require 'org) @@ -105,12 +104,28 @@ When nil, they will not be exported." (defvar org-complex-heading-regexp) (defvar org-property-end-re) -(defun org-inlinetask-insert-task () - "Insert an inline task." - (interactive) +(defcustom org-inlinetask-defaut-state nil + "Non-nil means make inline tasks have a TODO keyword initially. +This should be the state `org-inlinetask-insert-task' should use by +default, or nil of no state should be assigned." + :group 'org-inlinetask + :type '(choice + (const :tag "No state" nil) + (string :tag "Specific state"))) + +(defun org-inlinetask-insert-task (&optional no-state) + "Insert an inline task. +If prefix arg NO-STATE is set, ignore `org-inlinetask-defaut-state'." + (interactive "P") (or (bolp) (newline)) - (insert (make-string org-inlinetask-min-level ?*) " \n" - (make-string org-inlinetask-min-level ?*) " END\n") + (let ((indent org-inlinetask-min-level)) + (if org-odd-levels-only + (setq indent (- (* 2 indent) 1))) + (insert (make-string indent ?*) + (if (or no-state (not org-inlinetask-defaut-state)) + " \n" + (concat " " org-inlinetask-defaut-state " \n")) + (make-string indent ?*) " END\n")) (end-of-line -1)) (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 2639e303e85..3e3631ae979 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -4,7 +4,7 @@ ;; ;; Author: Philip Jackson <emacs@shellarchive.co.uk> ;; Keywords: erc, irc, link, org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el index 61d225e8276..de0f46d5293 100644 --- a/lisp/org/org-jsinfo.el +++ b/lisp/org/org-jsinfo.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,12 +26,12 @@ ;; ;;; Commentary: -;; This file implements the support for Sebastian Rose's Javascript +;; This file implements the support for Sebastian Rose's JavaScript ;; org-info.js to display an org-mode file exported to HTML in an ;; Info-like way, or using folding similar to the outline structure ;; org org-mode itself. -;; Documentation for using this module is in the Org manual. The script +;; Documentation for using this module is in the Org manual. The script ;; itself is documented by Sebastian Rose in a file distributed with ;; the script. FIXME: Accurate pointers! @@ -87,7 +87,7 @@ line in the buffer. See also the variable `org-infojs-options'." (defcustom org-infojs-options (mapcar (lambda (x) (cons (car x) (nth 2 x))) org-infojs-opts-table) - "Options settings for the INFOJS Javascript. + "Options settings for the INFOJS JavaScript. Each of the options must have an entry in `org-export-html/infojs-opts-table'. The value can either be a string that will be passed to the script, or a property. This property is then assumed to be a property that is defined diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el index 4241fd20f7f..55444c08bbe 100644 --- a/lisp/org/org-latex.el +++ b/lisp/org/org-latex.el @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-latex.el -;; Version: 6.35i +;; Version: 7.01 ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -144,10 +144,11 @@ class, you can use the following macro-like placeholders. [DEFAULT-PACKAGES] \\usepackage statements for default packages [NO-DEFAULT-PACKAGES] do not include any of the default packages - [PACKAGES] \\usepackage statements for packages + [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 + [BEAMER-HEADER-EXTRA] the beamer extra headers So a header like @@ -384,7 +385,7 @@ for example using customize, or with something like (shell-script "bash") (gnuplot "Gnuplot") (ocaml "Caml") (caml "Caml") - (sql "SQL")) + (sql "SQL") (sqlite "sql")) "Alist mapping languages to their listing language counterpart. The key is a symbol, the major mode symbol without the \"-mode\". The value is the string that should be inserted as the language parameter @@ -399,7 +400,7 @@ hurt if it is present." (defcustom org-export-latex-remove-from-headlines '(:todo nil :priority nil :tags nil) - "A plist of keywords to remove from headlines. OBSOLETE. + "A plist of keywords to remove from headlines. OBSOLETE. Non-nil means remove this keyword type from the headline. Don't remove the keys, just change their values. @@ -415,6 +416,11 @@ and `org-export-with-tags' instead." :group 'org-export-latex :type 'string) +(defcustom org-export-latex-tabular-environment "tabular" + "Default environment used to build tables." + :group 'org-export-latex + :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. @@ -426,7 +432,7 @@ allowed. The default we use here encompasses both." :type '(repeat (string :tag "Extension"))) (defcustom org-export-latex-coding-system nil - "Coding system for the exported LaTex file." + "Coding system for the exported LaTeX file." :group 'org-export-latex :type 'coding-system) @@ -580,10 +586,11 @@ non-nil, create a buffer with that name and export to that buffer. If TO-BUFFER is the symbol `string', don't leave any buffer behind but just return the resulting LaTeX as a string. When BODY-ONLY is set, don't produce the file header and footer, -simply return the content of \begin{document}...\end{document}, -without even the \begin{document} and \end{document} commands. +simply return the content of \\begin{document}...\\end{document}, +without even the \\begin{document} and \\end{document} commands. when PUB-DIR is set, use this as the publishing directory." (interactive "P") + (when (and (not body-only) arg (listp arg)) (setq body-only t)) (run-hooks 'org-export-first-hook) ;; Make sure we have a file name when we need it. @@ -649,7 +656,7 @@ when PUB-DIR is set, use this as the publishing directory." (org-entry-get rbeg "EXPORT_FILE_NAME" t)) (file-name-nondirectory ;sans-extension (or buffer-file-name - (error "Don't know which export file to use."))))) + (error "Don't know which export file to use"))))) ".tex"))) (filename (and filename @@ -792,7 +799,9 @@ when PUB-DIR is set, use this as the publishing directory." (replace-match "\n"))) (run-hooks 'org-export-latex-final-hook) - (or to-buffer (save-buffer)) + (if to-buffer + (unless (eq major-mode 'latex-mode) (latex-mode)) + (save-buffer)) (org-export-latex-fix-inputenc) (run-hooks 'org-export-latex-after-save-hook) (goto-char (point-min)) @@ -827,7 +836,7 @@ when PUB-DIR is set, use this as the publishing directory." (with-current-buffer outbuf (erase-buffer)) (message "Processing LaTeX file...") (if (and cmds (symbolp cmds)) - (funcall cmds file) + (funcall cmds (shell-quote-argument file)) (while cmds (setq cmd (pop cmds)) (while (string-match "%b" cmd) @@ -1085,7 +1094,7 @@ LEVEL indicates the default depth for export." (save-restriction (widen) (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([a-zA-Z]+\\)" nil t) + (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\(-[a-zA-Z]+\\)" nil t) (match-string 1)))) (plist-get org-export-latex-options-plist :latex-class) org-export-latex-default-class) @@ -1127,7 +1136,7 @@ LEVEL indicates the default depth for export." (defvar org-export-latex-format-toc-function 'org-export-latex-format-toc-default - "The function formatting returning the string to createthe table of contents. + "The function formatting returning the string to create the table of contents. The function mus take one parameter, the depth of the table of contents.") (defun org-export-latex-make-header (title opt-plist) @@ -1144,7 +1153,7 @@ OPT-PLIST is the options plist for current buffer." (org-splice-latex-header (org-export-apply-macros-in-string org-export-latex-header) org-export-latex-default-packages-alist - org-export-latex-packages-alist + org-export-latex-packages-alist nil (org-export-apply-macros-in-string (plist-get opt-plist :latex-header-extra))) ;; append another special variable @@ -1212,9 +1221,16 @@ If END is non-nil, it is the end of the region." :timestamps (plist-get opt-plist :timestamps) :footnotes (plist-get opt-plist :footnotes))) (org-unmodified - (let ((inhibit-read-only t)) - (add-text-properties pt (max pt (1- end)) - '(:org-license-to-kill t)))))))) + (let ((inhibit-read-only t) + (limit (max pt (1- end)))) + (add-text-properties pt limit + '(:org-license-to-kill t)) + (save-excursion + (goto-char pt) + (while (re-search-forward "^[ \t]*#+.*\n?" limit t) + (remove-text-properties (match-beginning 0) (match-end 0) + '(:org-license-to-kill t)))))))))) + (defvar org-export-latex-header-defs nil "The header definitions that might be used in the LaTeX body.") @@ -1286,7 +1302,8 @@ links, keywords, lists, tables, fixed-width" (cdr todo-markup) (car todo-markup))) (t (cdr (or (assoc (match-string 1) todo-markup) (car todo-markup)))))) - (replace-match (format fmt (match-string 1)) t t))) + (replace-match (org-export-latex-protect-string + (format fmt (match-string 1))) t t))) ;; convert priority string (when (re-search-forward "\\[\\\\#.\\]" nil t) (if (plist-get remove-list :priority) @@ -1323,7 +1340,7 @@ links, keywords, lists, tables, fixed-width" (unless (or ;; check for comment line (save-excursion (goto-char (match-beginning 0)) - (equal (char-after (point-at-bol)) ?#)) + (org-in-indented-comment-line)) ;; Check if this is a defined entity, so that is may need conversion (org-entity-get (match-string 1))) (add-text-properties (match-beginning 0) (match-end 0) @@ -1469,7 +1486,9 @@ Convert CHAR depending on STRING-BEFORE and STRING-AFTER." ((and (> (length string-after) 1) (or (eq subsup t) (and (equal subsup '{}) (eq (string-to-char string-after) ?\{))) - (string-match "[({]?\\([^)}]+\\)[)}]?" string-after)) + (or (string-match "[{]?\\([^}]+\\)[}]?" string-after) + (string-match "[(]?\\([^)]+\\)[)]?" string-after))) + (org-export-latex-protect-string (format "%s$%s{%s}$" string-before char (if (and (> (match-end 1) (1+ (match-beginning 1))) @@ -1531,20 +1550,20 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "When OPT is non-nil convert fixed-width sections to LaTeX." (goto-char (point-min)) (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t) - (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\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)))))) - + (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\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 @@ -1570,7 +1589,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 label attr floatp longtblp) + caption shortn label attr floatp longtblp) (if org-export-latex-tables-verbatim (let* ((tbl (concat "\\begin{verbatim}\n" raw-table "\\end{verbatim}\n"))) @@ -1579,6 +1598,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (progn (setq caption (org-find-text-property-in-string 'org-caption raw-table) + shortn (org-find-text-property-in-string + 'org-caption-shortn raw-table) attr (org-find-text-property-in-string 'org-attributes raw-table) label (org-find-text-property-in-string @@ -1586,7 +1607,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." longtblp (and attr (stringp attr) (string-match "\\<longtable\\>" attr)) align (and attr (stringp attr) - (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr) + (string-match "\\<align=\\([^ \t\n\r]+\\)" attr) (match-string 1 attr)) floatp (or caption label)) (setq caption (and caption (org-export-latex-fontify-headline caption))) @@ -1646,13 +1667,15 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (if floatp "\\begin{table}[htb]\n")) (if floatp (format - "\\caption{%s%s}" - (if label (concat "\\\label{" label "}") "") + "\\caption%s{%s}" + (if shortn (concat "[" shortn "]") "") (or caption ""))) (if (and longtblp caption) "\\\\\n" "\n") (if (and org-export-latex-tables-centered (not longtblp)) "\\begin{center}\n") - (if (not longtblp) (concat "\\begin{tabular}{" align "}\n")) + (if (not longtblp) + (format "\\begin{%s}{%s}\n" + org-export-latex-tabular-environment align)) (orgtbl-to-latex lines `(:tstart nil :tend nil @@ -1664,7 +1687,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." \\endfoot \\endlastfoot" (length org-table-last-alignment)) nil))) - (if (not longtblp) (concat "\n\\end{tabular}")) + (if (not longtblp) + (format "\n\\end{%s}" + org-export-latex-tabular-environment)) (if longtblp "\n" (if org-export-latex-tables-centered "\n\\end{center}\n" "\n")) (if longtblp @@ -1674,10 +1699,11 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defun org-export-latex-convert-table.el-table () "Replace table.el table at point with LaTeX code." - (let (tbl caption label line floatp attr align rmlines) + (let (tbl caption shortn label line floatp attr align rmlines) (setq line (buffer-substring (point-at-bol) (point-at-eol)) label (org-get-text-property-any 0 'org-label line) caption (org-get-text-property-any 0 'org-caption line) + shortn (org-get-text-property-any 0 'org-caption-shortn line) attr (org-get-text-property-any 0 'org-attributes line) align (and attr (stringp attr) (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr) @@ -1715,7 +1741,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}"))) (when floatp (setq tbl (concat "\\begin{table}\n" - (format "\\caption{%s%s}\n" + (format "\\caption%s{%s%s}\n" + (if shortn (format "[%s]" shortn) "") (if label (format "\\label{%s}" label) "") (or caption "")) tbl @@ -1738,6 +1765,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (unless (or (and (get-text-property (- (point) 2) 'org-protected) (not (get-text-property (- (point) 2) 'org-verbatim-emph))) + (equal (char-after (match-beginning 3)) + (char-after (1+ (match-beginning 3)))) (save-excursion (goto-char (match-beginning 1)) (save-match-data @@ -1814,10 +1843,11 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "file"))) (coderefp (equal type "coderef")) (caption (org-find-text-property-in-string 'org-caption raw-path)) + (shortn (org-find-text-property-in-string 'org-caption-shortn raw-path)) (attr (or (org-find-text-property-in-string 'org-attributes raw-path) (plist-get org-export-latex-options-plist :latex-image-options))) (label (org-find-text-property-in-string 'org-label raw-path)) - imgp radiop + imgp radiop fnc ;; define the path of the link (path (cond ((member type '("coderef")) @@ -1851,7 +1881,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (plist-get org-export-latex-options-plist :inline-images)) ;; OK, we need to inline an image (insert - (org-export-latex-format-image raw-path caption label attr))) + (org-export-latex-format-image raw-path caption label attr shortn))) (coderefp (insert (format (org-export-get-coderef-format path desc) @@ -1871,19 +1901,28 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (setq path (org-export-latex-protect-amp path) desc (org-export-latex-protect-amp desc))) (insert (format org-export-latex-hyperref-format path desc))) + + ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) + ;; The link protocol has a function for formatting the link + (insert + (save-match-data + (funcall fnc (org-link-unescape raw-path) desc 'latex)))) + (t (insert "\\texttt{" desc "}"))))))) -(defun org-export-latex-format-image (path caption label attr) +(defun org-export-latex-format-image (path caption label attr &optional shortn) "Format the image element, depending on user settings." - (let (ind floatp wrapp placement figenv) + (let (ind floatp wrapp multicolumnp placement figenv) (setq floatp (or caption label)) (setq ind (org-get-text-property-any 0 'original-indentation path)) (when (and attr (stringp attr)) (if (string-match "[ \t]*\\<wrap\\>" attr) (setq wrapp t floatp nil attr (replace-match "" t t attr))) (if (string-match "[ \t]*\\<float\\>" attr) - (setq wrapp nil floatp t attr (replace-match "" t t attr)))) + (setq wrapp nil floatp t attr (replace-match "" t t attr))) + (if (string-match "[ \t]*\\<multicolumn\\>" attr) + (setq multicolumnp t attr (replace-match "" t t attr)))) (setq placement (cond @@ -1905,8 +1944,13 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (wrapp "\\begin{wrapfigure}%placement \\centering \\includegraphics[%attr]{%path} -\\caption{%labelcmd%caption} +\\caption%shortn{%labelcmd%caption} \\end{wrapfigure}") + (multicolumnp "\\begin{figure*}%placement +\\centering +\\includegraphics[%attr]{%path} +\\caption{%labelcmd%caption} +\\end{figure*}") (floatp "\\begin{figure}%placement \\centering \\includegraphics[%attr]{%path} @@ -1931,6 +1975,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (expand-file-name path) path)) (cons "attr" attr) + (cons "shortn" (if shortn (format "[%s]" shortn) "")) (cons "labelcmd" (if label (format "\\label{%s}" label)"")) (cons "caption" (or caption "")) @@ -1949,7 +1994,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." s)) (defvar org-latex-entities) ; defined below (defvar org-latex-entities-regexp) ; defined below -(defvar org-latex-entities-exceptions) ; defined below (defun org-export-latex-preprocess (parameters) "Clean stuff in the LaTeX export." @@ -1962,7 +2006,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ;; Preserve latex environments (goto-char (point-min)) (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t) - (let* ((start (progn (beginning-of-line) (point))) + (org-if-unprotected + (let* ((start (progn (beginning-of-line) (point))) (end (and (re-search-forward (concat "^[ \t]*\\\\end{" (regexp-quote (match-string 1)) @@ -1970,7 +2015,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (point-at-eol)))) (if end (add-text-properties start end '(org-protected t)) - (goto-char (point-at-eol))))) + (goto-char (point-at-eol)))))) ;; Preserve math snippets @@ -2052,25 +2097,28 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\(?:<[^<>\n]*>\\)*" "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}"))) (while (re-search-forward re nil t) - (unless (or + (unless (or ;; check for comment line (save-excursion (goto-char (match-beginning 0)) - (equal (char-after (point-at-bol)) ?#)) + (org-in-indented-comment-line)) ;; Check if this is a defined entity, so that is may need conversion (org-entity-get (match-string 1)) ) (add-text-properties (match-beginning 0) (match-end 0) '(org-protected t))))) + ;; Special case for \nbsp + (goto-char (point-min)) + (while (re-search-forward "\\\\nbsp\\({}\\|\\>\\)" nil t) + (org-if-unprotected + (replace-match (org-export-latex-protect-string "~")))) + ;; Protect LaTeX entities (goto-char (point-min)) - (let (a) - (while (re-search-forward org-latex-entities-regexp nil t) - (if (setq a (assoc (match-string 0) org-latex-entities-exceptions)) - (replace-match (org-add-props (nth 1 a) nil 'org-protected t) - t t) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))))) + (while (re-search-forward org-latex-entities-regexp nil t) + (org-if-unprotected + (add-text-properties (match-beginning 0) (match-end 0) + '(org-protected t)))) ;; Replace radio links (goto-char (point-min)) @@ -2142,7 +2190,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (replace-match ""))))) (defun org-export-latex-fix-inputenc () - "Set the codingsystem in inputenc to what the buffer is." + "Set the coding system in inputenc to what the buffer is." (let* ((cs buffer-file-coding-system) (opt (or (ignore-errors (latexenc-coding-system-to-inputenc cs)) "utf8"))) @@ -2163,13 +2211,22 @@ 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." - (goto-char (point-min)) - (while (re-search-forward org-list-beginning-re nil t) - (org-if-unprotected - (beginning-of-line) - (insert (org-list-to-latex (org-list-parse-list t) - org-export-latex-list-parameters)) - "\n"))) + (let (res) + (goto-char (point-min)) + (while (org-re-search-forward-unprotected org-list-beginning-re nil t) + (beginning-of-line) + (setq res (org-list-to-latex (org-list-parse-list t) + org-export-latex-list-parameters)) + (while (string-match "^\\(\\\\item[ \t]+\\)\\[@start:\\([0-9]+\\)\\]" + res) + (setq res (replace-match + (concat (format "\\setcounter{enumi}{%d}" + (1- (string-to-number + (match-string 2 res)))) + "\n" + (match-string 1 res)) + t t res))) + (insert res "\n")))) (defconst org-latex-entities '("\\!" @@ -2276,7 +2333,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\medskip" "\\multicolumn" "\\multiput" - ("\\nbsp" "~") "\\newcommand" "\\newcounter" "\\newenvironment" @@ -2348,14 +2404,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\vspace") "A list of LaTeX commands to be protected when performing conversion.") -(defvar org-latex-entities-exceptions nil) - (defconst org-latex-entities-regexp (let (names rest) (dolist (x org-latex-entities) - (when (consp x) - (add-to-list 'org-latex-entities-exceptions x) - (setq x (car x))) (if (string-match "[a-zA-Z]$" x) (push x names) (push x rest))) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 84eb78c1303..19ba1a96395 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -7,7 +7,7 @@ ;; Bastien Guerry <bzg AT altern DOT org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -31,6 +31,8 @@ ;;; Code: +(eval-when-compile + (require 'cl)) (require 'org-macs) (require 'org-compat) @@ -49,7 +51,8 @@ (declare-function org-get-indentation "org" (&optional line)) (declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-combine-plists "org" (&rest plists)) -(declare-function org-entry-get "org" (pom property &optional inherit)) +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-show-subtree "org" ()) @@ -84,7 +87,29 @@ heading will be exposed in a children' view." (defcustom org-list-demote-modify-bullet nil "Default bullet type installed when demoting an item. This is an association list, for each bullet type, this alist will point -to the bulled that should be used when this item is demoted." +to the bullet that should be used when this item is demoted. +For example, + + (setq org-list-demote-modify-bullet + '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\"))) + +will make + + + Movies + + Silence of the Lambs + + My Cousin Vinny + + Books + + The Hunt for Red October + + The Road to Omaha + +into + + + Movies + - Silence of the Lambs + - My Cousin Vinny + + Books + - The Hunt for Red October + - The Road to Omaha" :group 'org-plain-lists :type '(repeat (cons @@ -119,7 +144,7 @@ When a string, it will be used as a regular expression. When the bullet type of a list is changed, the new bullet type will be matched against this regexp. If it matches, there will be two spaces instead of one after the bullet in each item of he list." - :group 'org-plain-list + :group 'org-plain-lists :type '(choice (const :tag "never" nil) (regexp))) @@ -171,19 +196,19 @@ When the indentation would be larger than this, it will become % END RECEIVE ORGLST %n \\begin{comment} #+ORGLST: SEND %n org-list-to-latex -| | | +- \\end{comment}\n") (texinfo-mode "@c BEGIN RECEIVE ORGLST %n @c END RECEIVE ORGLST %n @ignore #+ORGLST: SEND %n org-list-to-texinfo -| | | +- @end ignore\n") (html-mode "<!-- BEGIN RECEIVE ORGLST %n --> <!-- END RECEIVE ORGLST %n --> <!-- #+ORGLST: SEND %n org-list-to-html -| | | +- -->\n")) "Templates for radio lists in different major modes. All occurrences of %n in a template will be replaced with the name of the @@ -197,17 +222,25 @@ list, obtained by prompting the user." ;;; Plain list items +(defun org-item-re (&optional general) + "Return the correct regular expression for plain lists. +If GENERAL is non-nil, return the general regexp independent of the value +of `org-plain-list-ordered-item-terminator'." + (cond + ((or general (eq org-plain-list-ordered-item-terminator t)) + "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + ((= org-plain-list-ordered-item-terminator ?.) + "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + ((= org-plain-list-ordered-item-terminator ?\)) + "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))) + (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" - (let ((llt org-plain-list-ordered-item-terminator)) - (save-excursion - (goto-char (point-at-bol)) - (looking-at - (cond - ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) + + (save-excursion + (goto-char (point-at-bol)) + (looking-at (org-item-re)))) (defun org-at-item-bullet-p () "Is point at the bullet of a plain list item?" @@ -216,7 +249,7 @@ list, obtained by prompting the user." (< (point) (match-end 0)))) (defun org-in-item-p () - "It the cursor inside a plain list item. + "Is the cursor inside a plain list item. Does not have to be the first line." (save-excursion (condition-case nil @@ -590,6 +623,17 @@ If the cursor is not in an item, throw an error." (goto-char pos) (error "Not in an item")))) +(defun org-end-of-item-text-before-children () + "Move to the end of the item text, stops before the first child if any. +Assumes that the cursor is in the first line of an item." + (goto-char + (min (save-excursion (org-end-of-item) (point)) + (save-excursion + (goto-char (point-at-eol)) + (if (re-search-forward (concat "^" (org-item-re t)) nil 'move) + (match-beginning 0) + (point-max)))))) + (defun org-next-item () "Move to the beginning of the next item in the current plain list. Error if not at a plain list, or if this is the last item in the list." @@ -823,6 +867,10 @@ with something like \"1.\" or \"2)\"." (setq bobp (bobp)) (looking-at "[ \t]*[0-9]+\\([.)]\\)") (setq fmt (concat "%d" (or (match-string 1) "."))) + (save-excursion + (goto-char (match-end 0)) + (if (looking-at "[ \t]*\\[@start:\\([0-9]+\\)") + (setq n (1- (string-to-number (match-string 1)))))) (beginning-of-line 0) ;; walk forward and replace these numbers (catch 'exit @@ -961,12 +1009,24 @@ I.e. to the text after the last item." (defvar org-last-indent-end-marker (make-marker)) (defun org-outdent-item (arg) - "Outdent a local list item." + "Outdent a local list item, but not its children." (interactive "p") - (org-indent-item (- arg))) + (org-indent-item-tree (- arg) 'no-subtree)) (defun org-indent-item (arg) - "Indent a local list item." + "Indent a local list item, but not its children." + (interactive "p") + (org-indent-item-tree arg 'no-subtree)) + +(defun org-outdent-item-tree (arg &optional no-subtree) + "Outdent a local list item including its children. +If NO-SUBTREE is set, only outdent the item itself, not its children." + (interactive "p") + (org-indent-item-tree (- arg) no-subtree)) + +(defun org-indent-item-tree (arg &optional no-subtree) + "Indent a local list item including its children. +If NO-SUBTREE is set, only indent the item itself, not its children." (interactive "p") (and (org-region-active-p) (org-cursor-to-region-beginning)) (unless (org-at-item-p) @@ -975,12 +1035,15 @@ I.e. to the text after the last item." (setq firstp (org-first-list-item-p)) (save-excursion (setq end (and (org-region-active-p) (region-end))) - (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) (setq beg org-last-indent-begin-marker end org-last-indent-end-marker) (org-beginning-of-item) (setq beg (move-marker org-last-indent-begin-marker (point))) - (org-end-of-item) + (if no-subtree + (org-end-of-item-text-before-children) + (org-end-of-item)) (setq end (move-marker org-last-indent-end-marker (or end (point))))) (goto-char beg) (setq ind-bul (org-item-indent-positions) @@ -1108,7 +1171,7 @@ sublevels as a list of strings." (match-beginning 0)) end)))) (item (buffer-substring (point) - (or (and (re-search-forward + (or (and (org-re-search-forward-unprotected org-list-beginning-re end t) (goto-char (match-beginning 0))) (goto-char end)))) @@ -1215,36 +1278,34 @@ this list." (save-excursion (org-list-goto-true-beginning) (beginning-of-line 0) - (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") + (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") (if maybe (throw 'exit nil) (error "Don't know how to transform this list")))) (let* ((name (match-string 1)) (transform (intern (match-string 2))) (item-beginning (org-list-item-beginning)) - (txt (buffer-substring-no-properties - (car item-beginning) - (org-list-end (cdr item-beginning)))) - (list (org-list-parse-list)) - beg) + (list (save-excursion (org-list-goto-true-beginning) + (org-list-parse-list))) + txt beg) (unless (fboundp transform) (error "No such transformation function %s" transform)) - (setq txt (funcall transform list)) - ;; Find the insertion place - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t) - (error "Don't know where to insert translated list")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (setq beg (point)) - (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) - (error "Cannot find end of insertion region")) - (beginning-of-line 1) - (delete-region beg (point)) - (goto-char beg) - (insert txt "\n")) + (let ((txt (funcall transform list))) + ;; Find the insertion place + (save-excursion + (goto-char (point-min)) + (unless (re-search-forward + (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t) + (error "Don't know where to insert translated list")) + (goto-char (match-beginning 0)) + (beginning-of-line 2) + (setq beg (point)) + (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) + (error "Cannot find end of insertion region")) + (beginning-of-line 1) + (delete-region beg (point)) + (goto-char beg) + (insert txt "\n"))) (message "List converted and installed at receiver location")))) (defun org-list-to-generic (list params) @@ -1326,7 +1387,7 @@ Valid parameters PARAMS are (defun org-list-to-latex (list &optional params) "Convert LIST into a LaTeX list. -LIST is as returnd by `org-list-parse-list'. PARAMS is a property list +LIST is as returned by `org-list-parse-list'. PARAMS is a property list with overruling parameters for `org-list-to-generic'." (org-list-to-generic list @@ -1343,7 +1404,7 @@ with overruling parameters for `org-list-to-generic'." (defun org-list-to-html (list &optional params) "Convert LIST into a HTML list. -LIST is as returnd by `org-list-parse-list'. PARAMS is a property list +LIST is as returned by `org-list-parse-list'. PARAMS is a property list with overruling parameters for `org-list-to-generic'." (org-list-to-generic list @@ -1360,7 +1421,7 @@ with overruling parameters for `org-list-to-generic'." (defun org-list-to-texinfo (list &optional params) "Convert LIST into a Texinfo list. -LIST is as returnd by `org-list-parse-list'. PARAMS is a property list +LIST is as returned by `org-list-parse-list'. PARAMS is a property list with overruling parameters for `org-list-to-generic'." (org-list-to-generic list diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el index b5b380e4072..06591703da9 100644 --- a/lisp/org/org-mac-message.el +++ b/lisp/org/org-mac-message.el @@ -5,7 +5,7 @@ ;; Author: John Wiegley <johnw@gnu.org> ;; Christopher Suckling <suckling at gmail dot com> -;; Version: 6.35i +;; Version: 7.01 ;; Keywords: outlines, hypermedia, calendar, wp ;; This file is part of GNU Emacs. @@ -39,7 +39,7 @@ ;; messages selected in Mail.app. ;; (org-mac-message-insert-flagged) searches within an org-mode buffer -;; for a specific heading, creating it if it doesn't exist. Any +;; for a specific heading, creating it if it doesn't exist. Any ;; message:// links within the first level of the heading are deleted ;; and replaced with links to flagged messages. @@ -53,7 +53,7 @@ :group 'org-link) (defcustom org-mac-mail-account "customize" - "The Mail.app account in which to search for flagged messages" + "The Mail.app account in which to search for flagged messages." :group 'org-mac-flagged-mail :type 'string) @@ -81,7 +81,7 @@ This will use the command `open' with the message URL." "open" (concat "message://<" (substring message-id 2) ">"))) (defun as-get-selected-mail () - "AppleScript to create links to selected messages in Mail.app" + "AppleScript to create links to selected messages in Mail.app." (do-applescript (concat "tell application \"Mail\"\n" @@ -97,7 +97,7 @@ This will use the command `open' with the message URL." "end tell"))) (defun as-get-flagged-mail () - "AppleScript to create links to flagged messages in Mail.app" + "AppleScript to create links to flagged messages in Mail.app." (do-applescript (concat ;; Is Growl installed? @@ -179,7 +179,7 @@ The Org-syntax text will be pushed to the kill ring, and also returned." (defun org-mac-message-insert-selected () "Insert a link to the messages currently selected in Mail.app. -This will use applescript to get the message-id and the subject of the +This will use AppleScript to get the message-id and the subject of the active mail in Mail.app and make a link out of it." (interactive) (insert (org-mac-message-get-links "s"))) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 562715fc680..abcdcdc94eb 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -43,6 +43,11 @@ "Return the value of symbol VAR if it is bound, else nil." `(and (boundp (quote ,var)) ,var)) +(defun org-not-nil (v) + "If V not nil, and also not the string \"nil\", then return V. +Otherwise return nil." + (and v (not (equal v "nil")) v)) + (defmacro org-unmodified (&rest body) "Execute body without changing `buffer-modified-p'. Also, do not record undo information." @@ -87,7 +92,7 @@ Also, do not record undo information." (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 +In Emacs 21, invisible text is not avoided by the command loop, so the intangible property is needed to make sure point skips this text. In Emacs 22, this is not necessary. The intangible text property has led to problems with flyspell. These problems are fixed in flyspell.el, @@ -162,7 +167,8 @@ We use a macro so that the test can happen at compilation time." `(let ((inhibit-read-only t)) ,@body)) (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t - rear-nonsticky t mouse-map t fontified t) + rear-nonsticky t mouse-map t fontified t + org-emphasis t) "Properties to remove when a string without properties is wanted.") (defsubst org-match-string-no-properties (num &optional string) @@ -270,7 +276,6 @@ This is in contrast to merely setting it to 0." (setq plist (cddr plist))) p)) - (defun org-replace-match-keep-properties (newtext &optional fixedcase literal string) "Like `replace-match', but add the text properties found original text." @@ -287,7 +292,7 @@ This is in contrast to merely setting it to 0." (defvar org-inlinetask-min-level) ; defined in org-inlinetask.el (defun org-get-limited-outline-regexp () "Return outline-regexp with limited number of levels. -The number of levels is controlled by " +The number of levels is controlled by `org-inlinetask-min-level'" (if (or (not (org-mode-p)) (not (featurep 'org-inlinetask))) outline-regexp diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el index 7e9ce1e31f3..92ac2342dae 100644 --- a/lisp/org/org-mew.el +++ b/lisp/org/org-mew.el @@ -5,7 +5,7 @@ ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index dd6519475ad..91551cd828f 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -6,7 +6,7 @@ ;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el new file mode 100644 index 00000000000..4a567614af3 --- /dev/null +++ b/lisp/org/org-mks.el @@ -0,0 +1,137 @@ +;;; org-mks.el --- Multi-key-selection for Org-mode + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 7.01 +;; +;; 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: +;; + +;;; Code: + +(require 'org) +(eval-when-compile + (require 'cl)) + +(defun org-mks (table title &optional prompt specials) + "Select a member of an alist with multiple keys. +TABLE is the alist which should contain entries where the car is a string. +There should be two types of entries. + +1. prefix descriptions like (\"a\" \"Description\") + This indicates that `a' is a prefix key for multi-letter selection, and + that there are entries following with keys like \"ab\", \"ax\"... + +2. Selectable members must have more than two elements, with the first + being the string of keys that lead to selecting it, and the second a + short description string of the item. + +The command will then make a temporary buffer listing all entries +that can be selected with a single key, and all the single key +prefixes. When you press the key for a single-letter entry, it is selected. +When you press a prefix key, the commands (and maybe further prefixes) +under this key will be shown and offered for selection. + +TITLE will be placed over the selection in the temporary buffer, +PROMPT will be used when prompting for a key. SPECIAL is an alist with +also (\"key\" \"description\") entries. When one of these is selection, +only the bare key is returned." + (setq prompt (or prompt "Select: ")) + (let (tbl orig-table dkey ddesc des-keys allowed-keys + current prefix rtn re pressed buffer (inhibit-quit t)) + (save-window-excursion + (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) + (setq orig-table table) + (catch 'exit + (while t + (erase-buffer) + (insert title "\n\n") + (setq tbl table + des-keys nil + allowed-keys nil) + (setq prefix (if current (concat current " ") "")) + (while tbl + (cond + ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) + ;; This is a description on this level + (setq dkey (caar tbl) ddesc (cadar tbl)) + (pop tbl) + (push dkey des-keys) + (push dkey allowed-keys) + (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") + ;; Skip keys which are below this prefix + (setq re (concat "\\`" (regexp-quote dkey))) + (while (and tbl (string-match re (caar tbl))) (pop tbl))) + ((= 2 (length (car tbl))) + ;; Not yet a usable description, skip it + ) + (t + ;; usable entry on this level + (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") + (push (caar tbl) allowed-keys) + (pop tbl)))) + (when specials + (insert "-------------------------------------------------------------------------------\n") + (let ((sp specials)) + (while sp + (insert (format "[%s] %s\n" + (caar sp) (nth 1 (car sp)))) + (push (caar sp) allowed-keys) + (pop sp)))) + (push "\C-g" allowed-keys) + (goto-char (point-min)) + (if (not (pos-visible-in-window-p (point-max))) + (org-fit-window-to-buffer)) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive))) + (while (not (member pressed allowed-keys)) + (message "Invalid key `%s'" pressed) (sit-for 1) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive)))) + (when (equal pressed "\C-g") + (kill-buffer buffer) + (error "Abort")) + (when (and (not (assoc pressed table)) + (not (member pressed des-keys)) + (assoc pressed specials)) + (throw 'exit (setq rtn pressed))) + (unless (member pressed des-keys) + (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) + orig-table)))) + (setq current (concat current pressed)) + (setq table (mapcar + (lambda (x) + (if (and (> (length (car x)) 1) + (equal (substring (car x) 0 1) pressed)) + (cons (substring (car x) 1) (cdr x)) + nil)) + table)) + (setq table (remove nil table))))) + (when buffer (kill-buffer buffer)) + rtn)) + +(provide 'org-mks) + +;; arch-tag: 4ea90d0e-c6e4-4684-bd61-baf878712f9f + +;;; org-mks.el ends here diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 8492280c07c..e9c1ad2bf3f 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -33,6 +33,8 @@ (require 'org) (require 'org-agenda) +;;; Code: + (eval-when-compile (require 'cl)) (defgroup org-mobile nil @@ -66,18 +68,19 @@ org-agenda-text-search-extra-files :type 'directory) (defcustom org-mobile-use-encryption nil - "Non-nil means keep only encrypted files on the webdav server. + "Non-nil means keep only encrypted files on the WebDAV server. Encryption uses AES-256, with a password given in `org-mobile-encryption-password'. When nil, plain files are kept on the server. Turning on encryption requires to set the same password in the MobileOrg -application." +application. Before turning this on, check of MobileOrg does already +support it - at the time of this writing it did not yet." :group 'org-mobile :type 'boolean) (defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt" "File that is being used as a temporary file for encryption. -This must be local file on your local machine (not on the webdav server). +This must be local file on your local machine (not on the WebDAV server). You might want to put this file into a directory where only you have access." :group 'org-mobile :type 'directory) @@ -87,7 +90,7 @@ You might want to put this file into a directory where only you have access." This is a single password which is used for AES-256 encryption. The same password must also be set in the MobileOrg application. All Org files, including mobileorg.org will be encrypted using this password. -Note that, whe Org runs the encryption commands, the password could +Note that, when Org runs the encryption commands, the password could be visible on your system with the `ps' command. So this method is only intended to keep the files secure on the server, not on your own machine." :group 'org-mobile @@ -349,15 +352,18 @@ agenda view showing the flagged items." (file-name-directory org-mobile-inbox-for-pull))) (error "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory")) + (unless (and org-mobile-checksum-binary + (string-match "\\S-" org-mobile-checksum-binary)) + (error "No executable found to compute checksums")) (when org-mobile-use-encryption (unless (string-match "\\S-" org-mobile-encryption-password) (error "To use encryption, you must set `org-mobile-encryption-password'")) (unless (file-writable-p org-mobile-encryption-tempfile) - (error "Cannot write to entryption tempfile %s" + (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." @@ -898,42 +904,6 @@ FIXME: Hmmm, not sure if we can make his work against the auto-correction feature. Needs a bit more thinking. So this function is currently a noop.") - -(defun org-find-olp (path) - "Return a marker pointing to the entry at outline path OLP. -If anything goes wrong, the return value will instead an error message, -as a string." - (let* ((file (pop path)) - (buffer (find-file-noselect file)) - (level 1) - (lmin 1) - (lmax 1) - limit re end found pos heading cnt) - (unless buffer (error "File not found :%s" file)) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (setq limit (point-max)) - (goto-char (point-min)) - (while (setq heading (pop path)) - (setq re (format org-complex-heading-regexp-format - (regexp-quote heading))) - (setq cnt 0 pos (point)) - (while (re-search-forward re end t) - (setq level (- (match-end 1) (match-beginning 1))) - (if (and (>= level lmin) (<= level lmax)) - (setq found (match-beginning 0) cnt (1+ cnt)))) - (when (= cnt 0) (error "Heading not found on level %d: %s" - lmax heading)) - (when (> cnt 1) (error "Heading not unique on level %d: %s" - lmax heading)) - (goto-char found) - (setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0))) - (setq end (save-excursion (org-end-of-subtree t t)))) - (when (org-on-heading-p) - (move-marker (make-marker) (point)))))))) - (defun org-mobile-locate-entry (link) (if (string-match "\\`id:\\(.*\\)$" link) (org-id-find (match-string 1 link) 'marker) @@ -1033,7 +1003,6 @@ be returned that indicates what went wrong." t) (t (error "Body was changed in MobileOrg and on the computer"))))))) - (defun org-mobile-tags-same-p (list1 list2) "Are the two tag lists the same?" (not (or (org-delete-all list1 list2) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index d3a7dd155c8..12a7dcb85af 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -4,7 +4,7 @@ ;; ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -137,6 +137,8 @@ ;; ;; Versions 0.01 -- 0.07: (I don't remember) +;;; Code: + (eval-when-compile (require 'cl)) (require 'org) @@ -225,7 +227,7 @@ this function is called. Otherwise, the current major mode menu is used." (mouse-save-then-kill event))) (defun org-mouse-line-position () - "Returns `:beginning' or `:middle' or `:end', depending on the point position. + "Return `:beginning' or `:middle' or `:end', depending on the point position. If the point is at the end of the line, return `:end'. If the point is separated from the beginning of the line only by white @@ -290,7 +292,7 @@ ITEMFORMAT governs formatting of the elements of KEYWORDS. If it is a function, it is invoked with the keyword as the only argument. If it is a string, it is interpreted as the format string to (format ITEMFORMAT keyword). If it is neither a string -nor a function, elements of KEYWORDS are used directly. " +nor a function, elements of KEYWORDS are used directly." (mapcar `(lambda (keyword) (vector (cond @@ -342,8 +344,7 @@ ITEMFORMAT governs formatting of the elements of KEYWORDS. If it is a function, it is invoked with the keyword as the only argument. If it is a string, it is interpreted as the format string to (format ITEMFORMAT keyword). If it is neither a string -nor a function, elements of KEYWORDS are used directly. -" +nor a function, elements of KEYWORDS are used directly." (setq group (or group 0)) (let ((replace (org-mouse-match-closure (if nosurround 'replace-match @@ -432,7 +433,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (lambda (kwd) (equal state kwd)))))) (defun org-mouse-tag-menu () ;todo - "Create the tags menu" + "Create the tags menu." (append (let ((tags (org-get-tags))) (org-mouse-keyword-menu @@ -585,7 +586,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (org-next-item))))) (defun org-mouse-bolp () - "Returns true if there only spaces, tabs, and '*', between the beginning of line and the point" + "Return true if there only spaces, tabs, and '*' before point. +This means, between the beginning of line and the point." (save-excursion (skip-chars-backward " \t*") (bolp))) @@ -909,18 +911,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (setq org-mouse-context-menu-function 'org-mouse-context-menu) (when (memq 'context-menu org-mouse-features) - (define-key org-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) nil) - (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu)) - (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse) + (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) - (define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) - (define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) + (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) - (define-key org-mode-map [S-mouse-2] 'org-mouse-yank-link) - (define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) + (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) - (define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) - (define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) + (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 @@ -1131,13 +1133,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (add-hook 'org-agenda-mode-hook '(lambda () (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) - (define-key org-agenda-mode-map - (if (featurep 'xemacs) [button3] [mouse-3]) - 'org-mouse-show-context-menu) - (define-key org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) - (define-key org-agenda-mode-map (if (featurep 'xemacs) [(control mouse-4)] [C-mouse-4]) 'org-agenda-earlier) - (define-key org-agenda-mode-map (if (featurep 'xemacs) [(control mouse-5)] [C-mouse-5]) 'org-agenda-later) - (define-key org-agenda-mode-map [drag-mouse-3] + (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)) @@ -1147,4 +1147,4 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f -;;; org-mouse.el ends-here +;;; org-mouse.el ends here diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index a0a24dcfecd..c6953f11d37 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: tables, plotting ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -44,7 +44,7 @@ '((:plot-type . 2d) (:with . lines) (:ind . 0)) - "Default options to gnuplot used by `org-plot/gnuplot'") + "Default options to gnuplot used by `org-plot/gnuplot'.") (defvar org-plot-timestamp-fmt nil) @@ -272,7 +272,7 @@ manner suitable for prepending to a user-specified script." ;; facade functions ;;;###autoload (defun org-plot/gnuplot (&optional params) - "Plot table using gnuplot. Gnuplot options can be specified with PARAMS. + "Plot table using gnuplot. Gnuplot options can be specified with PARAMS. If not given options will be taken from the +PLOT line directly before or after the table." (interactive) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 1b32f515f79..2c6345ab817 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -9,7 +9,7 @@ ;; Author: Ross Patterson <me AT rpatterson DOT net> ;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de> ;; Keywords: org, emacsclient, wp -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. ;; @@ -31,8 +31,8 @@ ;; ;; Intercept calls from emacsclient to trigger custom actions. ;; -;; This is done by advising `server-visit-files' to scann the list of filenames -;; for `org-protocol-the-protocol' and sub-procols defined in +;; This is done by advising `server-visit-files' to scan the list of filenames +;; for `org-protocol-the-protocol' and sub-protocols defined in ;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'. ;; ;; Any application that supports calling external programs with an URL @@ -58,7 +58,7 @@ ;; (setq org-protocol-protocol-alist ;; '(("my-protocol" ;; :protocol "my-protocol" -;; :function my-protocol-handler-fuction))) +;; :function my-protocol-handler-function))) ;; ;; A "sub-protocol" will be found in URLs like this: ;; @@ -84,15 +84,20 @@ ;; URLs to local filenames defined in `org-protocol-project-alist'. ;; ;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and -;; pushes the browsers URL to the `kill-ring' for yanking. This handler is +;; pushes the browsers URL to the `kill-ring' for yanking. This handler is ;; triggered through the sub-protocol \"store-link\". ;; -;; * Call `org-protocol-remember' by using the sub-protocol \"remember\". If -;; Org-mode is loaded, emacs will pop-up a remember buffer and fill the -;; template with the data provided. I.e. the browser's URL is inserted as an -;; Org-link of which the page title will be the description part. If text +;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If +;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the +;; template with the data provided. I.e. the browser's URL is inserted as an +;; Org-link of which the page title will be the description part. If text ;; was select in the browser, that text will be the body of the entry. ;; +;; * Call `org-protocol-remember' by using the sub-protocol \"remember\". +;; This is provided for backward compatibility. +;; You may read `org-capture' as `org-remember' throughout this file if +;; you still use `org-remember'. +;; ;; You may use the same bookmark URL for all those standard handlers and just ;; adjust the sub-protocol used: ;; @@ -101,7 +106,7 @@ ;; encodeURIComponent(document.title)+'/'+ ;; encodeURIComponent(window.getSelection()) ;; -;; The handler for the sub-protocol \"remember\" detects an optional template +;; The handler for the sub-protocol \"capture\" detects an optional template ;; char that, if present, triggers the use of a special template. ;; Example: ;; @@ -121,8 +126,6 @@ (eval-when-compile (require 'cl)) -(declare-function org-publish-initialize-files-alist "org-publish" - (&optional refresh)) (declare-function org-publish-get-project-from-filename "org-publish" (filename &optional up)) (declare-function server-edit "server" (&optional arg)) @@ -143,6 +146,7 @@ for `org-protocol-the-protocol' and sub-procols defined in (defconst org-protocol-protocol-alist-default '(("org-remember" :protocol "remember" :function org-protocol-remember :kill-client t) + ("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t) ("org-store-link" :protocol "store-link" :function org-protocol-store-link) ("org-open-source" :protocol "open-source" :function org-protocol-open-source)) "Default protocols to use. @@ -151,18 +155,19 @@ See `org-protocol-protocol-alist' for a description of this variable.") (defconst org-protocol-the-protocol "org-protocol" "This is the protocol to detect if org-protocol.el is loaded. -`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold the -sub-protocols that trigger the required action. You will have to define just one -protocol handler OS-wide (MS-Windows) or per application (Linux). That protocol -handler should call emacsclient.") +`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold +the sub-protocols that trigger the required action. You will have to define +just one protocol handler OS-wide (MS-Windows) or per application (Linux). +That protocol handler should call emacsclient.") ;;; User variables: (defcustom org-protocol-reverse-list-of-files t - "* The filenames passed on the commandline are passed to the emacs-server in -reversed order. Set to `t' (default) to re-reverse the list, i.e. use the -sequence on the command line. If nil, the sequence of the filenames is + "* Non-nil means re-reverse the list of filenames passed on the command line. +The filenames passed on the command line are passed to the emacs-server in +reverse order. Set to t (default) to re-reverse the list, i.e. use the +sequence on the command line. If nil, the sequence of the filenames is unchanged." :group 'org-protocol :type 'boolean) @@ -225,7 +230,7 @@ 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 tripple 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 @@ -239,7 +244,7 @@ function - function that handles requests with protocol and takes exactly one 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 dangeling emacsclients. Note, that all other command + `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. @@ -248,10 +253,10 @@ Here is an example: (setq org-protocol-protocol-alist '((\"my-protocol\" :protocol \"my-protocol\" - :function my-protocol-handler-fuction) + :function my-protocol-handler-function) (\"your-protocol\" :protocol \"your-protocol\" - :function your-protocol-handler-fuction)))" + :function your-protocol-handler-function)))" :group 'org-protocol :type '(alist)) @@ -260,11 +265,10 @@ Here is an example: :group 'org-protocol :type 'string) - ;;; Helper functions: (defun org-protocol-sanitize-uri (uri) - "emacsclient compresses double and tripple slashes. + "emacsclient compresses double and triple slashes. Slashes are sanitized to double slashes here." (when (string-match "^\\([a-z]+\\):/" uri) (let* ((splitparts (split-string uri "/+"))) @@ -273,12 +277,13 @@ Slashes are sanitized to double slashes here." (defun org-protocol-split-data(data &optional unhexify separator) - "Split, what a org-protocol handler function gets as only argument. -data is that one argument. Data is splitted at each occurrence of separator - (regexp). If no separator is specified or separator is nil, assume \"/+\". -The results of that splitting are return as a list. If unhexify is non-nil, -hex-decode each split part. If unhexify is a function, use that function to -decode each split part." + "Split, what an org-protocol handler function gets as only argument. +DATA is that one argument. DATA is split at each occurrence of +SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is +nil, assume \"/+\". The results of that splitting are returned +as a list. If UNHEXIFY is non-nil, hex-decode each split part. If +UNHEXIFY is a function, use that function to decode each split +part." (let* ((sep (or separator "/+")) (split-parts (split-string data sep))) (if unhexify @@ -316,7 +321,7 @@ encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'." (defun org-protocol-unhex-compound (hex) - "Unhexify unicode hex-chars. E.g. `%C3%B6' is the german Umlaut `ü'." + "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ü'." (let* ((bytes (remove "" (split-string hex "%"))) (ret "") (eat 0) @@ -412,9 +417,9 @@ This function transforms it into a flat list." ;;; Standard protocol handlers: (defun org-protocol-store-link (fname) - "Process an org-protocol://store-link:// style url -and store a browser URL as an org link. Also pushes the links URL to the -`kill-ring'. + "Process an org-protocol://store-link:// style url. +Additionally store a browser URL as an org link. Also pushes the +link's URL to the `kill-ring'. The location for a browser's bookmark has to look like this: @@ -443,51 +448,75 @@ The sub-protocol used to reach this function is set in (defun org-protocol-remember (info) "Process an org-protocol://remember:// style url. +The location for a browser's bookmark has to look like this: + + javascript:location.href='org-protocol://remember://'+ \\ + encodeURIComponent(location.href)+'/' \\ + encodeURIComponent(document.title)+'/'+ \\ + encodeURIComponent(window.getSelection()) + +See the docs for `org-protocol-capture' for more information." + + (if (and (boundp 'org-stored-links) + (or (fboundp 'org-capture)) + (org-protocol-do-capture info 'org-remember)) + (message "Org-mode not loaded.")) + nil) + +(defun org-protocol-capture (info) + "Process an org-protocol://capture:// style url. + The sub-protocol used to reach this function is set in `org-protocol-protocol-alist'. This function detects an URL, title and optional text, separated by '/' The location for a browser's bookmark has to look like this: - javascript:location.href='org-protocol://remember://'+ \\ + javascript:location.href='org-protocol://capture://'+ \\ encodeURIComponent(location.href)+'/' \\ encodeURIComponent(document.title)+'/'+ \\ encodeURIComponent(window.getSelection()) By default, it uses the character `org-protocol-default-template-key', -which should be associated with a template in `org-remember-templates'. +which should be associated with a template in `org-capture-templates'. But you may prepend the encoded URL with a character and a slash like so: - javascript:location.href='org-protocol://org-store-link://b/'+ ... + javascript:location.href='org-protocol://capture://b/'+ ... Now template ?b will be used." - (if (and (boundp 'org-stored-links) - (fboundp 'org-remember)) - (let* ((parts (org-protocol-split-data info t)) - (template (or (and (= 1 (length (car parts))) (pop parts)) - org-protocol-default-template-key)) - (url (org-protocol-sanitize-uri (car parts))) - (type (if (string-match "^\\([a-z]+\\):" url) - (match-string 1 url))) - (title (or (cadr parts) "")) - (region (or (caddr parts) "")) - (orglink (org-make-link-string - url (if (string-match "[^[:space:]]" title) title url))) - remember-annotation-functions) - (setq org-stored-links - (cons (list url title) org-stored-links)) - (kill-new orglink) - (org-store-link-props :type type - :link url - :description title - :initial region) - (raise-frame) - (org-remember nil (string-to-char template))) - - (message "Org-mode not loaded.")) + (or (fboundp 'org-capture)) + (org-protocol-do-capture info 'org-capture)) + (message "Org-mode not loaded.")) nil) +(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)) + (template (or (and (= 1 (length (car parts))) (pop parts)) + org-protocol-default-template-key)) + (url (org-protocol-sanitize-uri (car parts))) + (type (if (string-match "^\\([a-z]+\\):" url) + (match-string 1 url))) + (title(or (cadr parts) "")) + (region (or (caddr parts) "")) + (orglink (org-make-link-string + url (if (string-match "[^[:space:]]" title) title url))) + (org-capture-link-is-already-stored t) ;; avoid call to org-store-link + remember-annotation-functions) + (setq org-stored-links + (cons (list url title) org-stored-links)) + (kill-new orglink) + (org-store-link-props :type type + :link url + :description title + :annotation orglink + :initial region) + (raise-frame) + (funcall capture-func nil template))) + + (defun org-protocol-open-source (fname) "Process an org-protocol://open-source:// style url. @@ -561,7 +590,7 @@ This is, how the matching is done: protocol and sub-protocol are regexp-quoted. -If a matching protcol is found, the protcol is stripped from fname and the +If a matching protocol is found, the protocol is stripped from fname and the result is passed to the protocols function as the only parameter. If the function returns nil, the filename is removed from the list of filenames passed from emacsclient to the server. @@ -614,11 +643,10 @@ as filename." (defun org-protocol-create-for-org () "Create a org-protocol project for the current file's Org-mode project. This works, if the file visited is part of a publishing project in -`org-publish-project-alist'. This functions calls `org-protocol-create' to do +`org-publish-project-alist'. This function calls `org-protocol-create' to do most of the work." (interactive) (require 'org-publish) - (org-publish-initialize-files-alist) (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?" diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el index 79655235505..943bbca6b7b 100644 --- a/lisp/org/org-publish.el +++ b/lisp/org/org-publish.el @@ -5,7 +5,7 @@ ;; Author: David O'Toole <dto@gnu.org> ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> ;; Keywords: hypermedia, outlines, wp -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. ;; @@ -174,12 +174,26 @@ sitemap of files or summary page for a given project. of the titles of the files involved) or `tree' (the directory structure of the source files is reflected in the sitemap). Defaults to - `tree'." + `tree'. + + If you create a sitemap file, adjust the sorting like this: + + :sitemap-sort-folders Where folders should appear in the sitemap. + Set this to `first' (default) or `last' to + display folders first or last, respectively. + Any other value will mix files and folders. + :sitemap-alphabetically The site map is normally sorted alphabetically. + Set this explicitly to nil to turn off sorting. + :sitemap-ignore-case Should sorting be case-sensitive? Default nil. + +The following properties control the creation of a concept index. + + :makeindex Create a concept index." :group 'org-publish :type 'alist) (defcustom org-publish-use-timestamps-flag t - "When non-nil, use timestamp checking to publish only changed files. + "Non-nil means use timestamp checking to publish only changed files. When nil, do no timestamp checking and always publish all files." :group 'org-publish :type 'boolean) @@ -208,6 +222,34 @@ Any changes made by this hook will be saved." :group 'org-publish :type 'hook) +(defcustom org-publish-sitemap-sort-alphabetically t + "Should sitemaps be sorted alphabetically by default? + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-alphabetically'." + :group 'org-publish + :type 'boolean) + +(defcustom org-publish-sitemap-sort-folders 'first + "A symbol, denoting if folders are sorted first in sitemaps. +Possible values are `first', `last', and nil. +If `first', folders will be sorted before files. +If `last', folders are sorted to the end after the files. +Any other value will not mix files and folders. + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-sort-folders'." + :group 'org-publish + :type 'symbol) + +(defcustom org-publish-sitemap-sort-ignore-case nil + "Sort sitemaps case insensitively by default? + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-ignore-case'." + :group 'org-publish + :type 'boolean) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Timestamp-related functions @@ -215,29 +257,19 @@ Any changes made by this hook will be saved." "Return path to timestamp file for filename FILENAME." (setq filename (concat filename "::" (or pub-dir "") "::" (format "%s" (or pub-func "")))) - (concat (file-name-as-directory org-publish-timestamp-directory) - "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) + (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) (defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir) - "Return `t' if FILENAME should be published in PUB-DIR using PUB-FUNC. -TRUE-PUB-DIR is there the file will truely end up. Currently we are not using + "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 the target location, and how old it is. Right ow we cannot do this, because we do not know under what file name the file will be stored - the publishing function can still decide about that independently." (let ((rtn (if org-publish-use-timestamps-flag - (if (file-exists-p org-publish-timestamp-directory) - ;; first handle possible wrong timestamp directory - (if (not (file-directory-p org-publish-timestamp-directory)) - (error "Org publish timestamp: %s is not a directory" - org-publish-timestamp-directory) - ;; there is a timestamp, check if FILENAME is newer - (file-newer-than-file-p - filename (org-publish-timestamp-filename - filename pub-dir pub-func))) - (make-directory org-publish-timestamp-directory) - t) + (org-publish-cache-file-needs-publishing + filename pub-dir pub-func) ;; don't use timestamps, always return t t))) (if rtn @@ -249,55 +281,33 @@ function can still decide about that independently." (defun org-publish-update-timestamp (filename &optional pub-dir pub-func) "Update publishing timestamp for file FILENAME. If there is no timestamp, create one." - (let ((timestamp-file (org-publish-timestamp-filename - filename pub-dir pub-func)) - newly-created-timestamp) - (if (not (file-exists-p timestamp-file)) - ;; create timestamp file if needed - (with-temp-buffer - (make-directory (file-name-directory timestamp-file) t) - (write-file timestamp-file) - (setq newly-created-timestamp t))) - ;; Emacs 21 doesn't have `set-file-times' - (if (and (fboundp 'set-file-times) - (not newly-created-timestamp)) - (set-file-times timestamp-file) - (call-process "touch" nil 0 nil (expand-file-name timestamp-file))))) + (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) + (stamp (org-publish-cache-ctime-of-src filename))) + (org-publish-cache-set key stamp))) (defun org-publish-remove-all-timestamps () - "Remove all files in the timstamp directory." + "Remove all files in the timestamp directory." (let ((dir org-publish-timestamp-directory) files) (when (and (file-exists-p dir) (file-directory-p dir)) - (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))))) + (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) + (org-publish-reset-cache)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Mapping files to project names - -(defvar org-publish-files-alist nil - "Alist of files and their parent projects. -Each element of this alist is of the form: - - (file-name . project-name)") +;;; (defvar org-publish-initial-buffer nil "The buffer `org-publish' has been called from.") (defvar org-publish-temp-files nil "Temporary list of files to be published.") -(defun org-publish-initialize-files-alist (&optional refresh) - "Set `org-publish-files-alist' if it is not set. -Also set it if the optional argument REFRESH is non-nil." - (interactive "P") - (when (or refresh (not org-publish-files-alist)) - (setq org-publish-files-alist - (org-publish-get-files org-publish-project-alist)))) +;; Here, so you find the variable right before it's used the first time: +(defvar org-publish-cache nil + "This will cache timestamps and titles for files in publishing projects. +Blocks could hash sha1 values here.") -(defun org-publish-validate-link (link &optional directory) - "Check if LINK points to a file in the current project." - (assoc (expand-file-name link directory) org-publish-files-alist)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Compatibility aliases @@ -325,23 +335,6 @@ This is a compatibility function for Emacsen without `delete-dups'." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Getting project information out of org-publish-project-alist -(defun org-publish-get-files (projects-alist &optional no-exclusion) - "Return the list of all publishable files for PROJECTS-ALIST. -If NO-EXCLUSION is non-nil, don't exclude files." - (let (all-files) - ;; add all projects - (mapc - (lambda(p) - (let* ((exclude (plist-get (cdr p) :exclude)) - (files (and p (org-publish-get-base-files p exclude)))) - ;; add all files from this project - (mapc (lambda(f) - (add-to-list 'all-files - (cons (expand-file-name f) (car p)))) - files))) - (org-publish-expand-projects projects-alist)) - all-files)) - (defun org-publish-expand-projects (projects-alist) "Expand projects in PROJECTS-ALIST. This splices all the components into the list." @@ -355,6 +348,42 @@ This splices all the components into the list." (push p rtn))) (nreverse (org-publish-delete-dups (delq nil rtn))))) + +(defvar sitemap-alphabetically) +(defvar sitemap-sort-folders) +(defvar sitemap-ignore-case) +(defvar sitemap-requested) +(defun org-publish-compare-directory-files (a b) + "Predicate for `sort', that sorts folders-first/last and alphabetically." + (let ((retval t)) + (when (or sitemap-alphabetically sitemap-sort-folders) + ;; First we sort alphabetically: + (when sitemap-alphabetically + (let* ((adir (file-directory-p a)) + (aorg (and (string-match "\\.org$" a) (not adir))) + (bdir (file-directory-p b)) + (borg (and (string-match "\\.org$" b) (not bdir))) + (A (if aorg + (concat (file-name-directory a) + (org-publish-find-title a)) a)) + (B (if borg + (concat (file-name-directory b) + (org-publish-find-title b)) b))) + (setq retval (if sitemap-ignore-case + (not (string-lessp (upcase B) (upcase A))) + (not (string-lessp B A)))))) + + ;; Directory-wise wins: + (when sitemap-sort-folders + ;; a is directory, b not: + (cond + ((and (file-directory-p a) (not (file-directory-p b))) + (setq retval (equal sitemap-sort-folders 'first))) + ;; a is not a directory, but b is: + ((and (not (file-directory-p a)) (file-directory-p b)) + (setq retval (equal sitemap-sort-folders 'last)))))) + retval)) + (defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir) "Set `org-publish-temp-files' with files from BASE-DIR directory. If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is @@ -373,8 +402,12 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR." (and skip-file (string-match skip-file fnd)) (not (file-exists-p (file-truename f))) (not (string-match match fnd))) + (pushnew f org-publish-temp-files))))) - (directory-files base-dir t (unless recurse match)))) + (if sitemap-requested + (sort (directory-files base-dir t (unless recurse match)) + 'org-publish-compare-directory-files) + (directory-files base-dir t (unless recurse match))))) (defun org-publish-get-base-files (project &optional exclude-regexp) "Return a list of all files in PROJECT. @@ -386,9 +419,29 @@ matching filenames." (include-list (plist-get project-plist :include)) (recurse (plist-get project-plist :recursive)) (extension (or (plist-get project-plist :base-extension) "org")) + ;; sitemap-... variables are dynamically scoped for + ;; org-publish-compare-directory-files: + (sitemap-requested + (plist-get project-plist :auto-sitemap)) + (sitemap-sort-folders + (if (plist-member project-plist :sitemap-sort-folders) + (plist-get project-plist :sitemap-sort-folders) + org-publish-sitemap-sort-folders)) + (sitemap-alphabetically + (if (plist-member project-plist :sitemap-alphabetically) + (plist-get project-plist :sitemap-alphabetically) + org-publish-sitemap-sort-alphabetically)) + (sitemap-ignore-case + (if (plist-member project-plist :sitemap-ignore-case) + (plist-get project-plist :sitemap-ignore-case) + org-publish-sitemap-sort-ignore-case)) (match (if (eq extension 'any) "^[^\\.]" (concat "^[^\\.].*\\.\\(" extension "\\)$")))) + ;; Make sure sitemap-sort-folders' has an accepted value + (unless (memq sitemap-sort-folders '(first last)) + (setq sitemap-sort-folders nil)) + (setq org-publish-temp-files nil) (org-publish-get-base-files-1 base-dir recurse match ;; FIXME distinguish exclude regexp @@ -402,9 +455,27 @@ matching filenames." org-publish-temp-files)) (defun org-publish-get-project-from-filename (filename &optional up) - "Return the project FILENAME belongs." - (let* ((project-name (cdr (assoc (expand-file-name filename) - org-publish-files-alist)))) + "Return the project that FILENAME belongs to." + (let* ((filename (expand-file-name filename)) + project-name) + + (catch 'p-found + (dolist (prj org-publish-project-alist) + (unless (plist-get (cdr prj) :components) + ;; [[info:org:Selecting%20files]] shows how this is supposed to work: + (let* ((r (plist-get (cdr prj) :recursive)) + (b (expand-file-name (plist-get (cdr prj) :base-directory))) + (x (or (plist-get (cdr prj) :base-extension) "org")) + (e (plist-get (cdr prj) :exclude)) + (i (plist-get (cdr prj) :include)) + (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) + (when (or + (and i (string-match i 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 (dolist (prj org-publish-project-alist) (if (member project-name (plist-get (cdr prj) :components)) @@ -502,20 +573,17 @@ See `org-publish-org-to' to the list of arguments." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Publishing files, sets of files, and indices -(defun org-publish-file (filename &optional project) - "Publish file FILENAME from PROJECT." +(defun org-publish-file (filename &optional project no-cache) + "Publish file FILENAME from PROJECT. +If NO-CACHE is not nil, do not initialize org-publish-cache and +write it to disk. This is needed, since this function is used to +publish single files, when entire projects are published. +See `org-publish-projects'." (let* ((project (or project (or (org-publish-get-project-from-filename filename) - (if (y-or-n-p - (format "%s is not in a project. Re-read the list of projects files? " - (abbreviate-file-name filename))) - ;; If requested, re-initialize the list of projects files - (progn (org-publish-initialize-files-alist t) - (or (org-publish-get-project-from-filename filename) - (error "File %s not part of any known project" - (abbreviate-file-name filename)))) - (error "Can't publish file outside of a project"))))) + (error "File %s not part of any known project" + (abbreviate-file-name filename))))) (project-plist (cdr project)) (ftname (file-truename filename)) (publishing-function @@ -526,6 +594,10 @@ See `org-publish-org-to' to the list of arguments." (pub-dir (file-name-as-directory (file-truename (plist-get project-plist :publishing-directory)))) tmp-pub-dir) + + (unless no-cache + (org-publish-initialize-cache (car project))) + (setq tmp-pub-dir (file-name-directory (concat pub-dir @@ -542,7 +614,8 @@ See `org-publish-org-to' to the list of arguments." tmp-pub-dir) (funcall publishing-function project-plist filename tmp-pub-dir) (org-publish-update-timestamp - filename pub-dir publishing-function))))) + filename pub-dir publishing-function))) + (unless no-cache (org-publish-write-cache-file)))) (defun org-publish-projects (projects) "Publish all files belonging to the PROJECTS alist. @@ -550,6 +623,8 @@ If :auto-sitemap is set, publish the sitemap too. If :makeindex is set, also produce a file theindex.org." (mapc (lambda (project) + ;; Each project uses it's own cache file: + (org-publish-initialize-cache (car project)) (let* ((project-plist (cdr project)) (exclude-regexp (plist-get project-plist :exclude)) @@ -564,19 +639,20 @@ If :makeindex is set, also produce a file theindex.org." (when preparation-function (run-hooks 'preparation-function)) (if sitemap-p (funcall sitemap-function project sitemap-filename)) (while (setq file (pop files)) - (org-publish-file file project)) + (org-publish-file file project t)) (when (plist-get project-plist :makeindex) (org-publish-index-generate-theindex.inc (plist-get project-plist :base-directory)) (org-publish-file (expand-file-name "theindex.org" (plist-get project-plist :base-directory)) - project)) - (when completion-function (run-hooks 'completion-function)))) + project t)) + (when completion-function (run-hooks 'completion-function)) + (org-publish-write-cache-file))) (org-publish-expand-projects projects))) (defun org-publish-org-sitemap (project &optional sitemap-filename) - "Create an sitemap of pages in set defined by PROJECT. + "Create a sitemap of pages in set defined by PROJECT. Optionally set the filename of the sitemap with SITEMAP-FILENAME. Default for SITEMAP-FILENAME is 'sitemap.org'." (let* ((project-plist (cdr project)) @@ -639,8 +715,10 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (or visiting (kill-buffer sitemap-buffer)))) (defun org-publish-find-title (file) - "Find the title of file in project." - (let* ((visiting (find-buffer-visiting file)) + "Find the title of FILE in project." + (or + (org-publish-cache-get-file-property file :title nil t) + (let* ((visiting (find-buffer-visiting file)) (buffer (or visiting (find-file-noselect file))) title) (with-current-buffer buffer @@ -654,7 +732,8 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (file-name-nondirectory (file-name-sans-extension file)))))) (unless visiting (kill-buffer buffer)) - title)) + (org-publish-cache-set-file-property file :title title) + title))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Interactive publishing functions @@ -676,7 +755,12 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (save-window-excursion (let* ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects (list project))))) + (org-publish-projects + (if (stringp project) + ;; If this function is called in batch mode, + ;; project is still a string here. + (list (assoc project org-publish-project-alist)) + (list project)))))) ;;;###autoload (defun org-publish-all (&optional force) @@ -686,7 +770,7 @@ directory and force publishing all files." (interactive "P") (when force (org-publish-remove-all-timestamps)) - (org-publish-initialize-files-alist force) + ;; (org-publish-initialize-files-alist force) (save-window-excursion (let ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) @@ -698,7 +782,6 @@ directory and force publishing all files." "Publish the current file. With prefix argument, force publish the file." (interactive "P") - (org-publish-initialize-files-alist force) (save-window-excursion (let ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) @@ -710,13 +793,13 @@ With prefix argument, force publish the file." With a prefix argument, force publishing of all files in the project." (interactive "P") - (org-publish-initialize-files-alist force) (save-window-excursion (let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up)) (org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) (if (not project) (error "File %s is not part of any known project" (buffer-file-name))) + ;; FIXME: force is not used here? (org-publish project)))) @@ -736,11 +819,11 @@ the project." (when (eq backend 'latex) (replace-match (format "\\index{%s}" entry) t t)) (save-excursion - (org-back-to-heading t) + (ignore-errors (org-back-to-heading t)) (setq target (get-text-property (point) 'target)) (setq target (or (cdr (assoc target org-export-preferred-target-alist)) (cdr (assoc target org-export-id-target-alist)) - target)) + target "")) (push (cons entry target) index))) (with-temp-file (concat (file-name-sans-extension org-current-export-file) ".orgx") @@ -760,7 +843,7 @@ the project." full-files)) (default-directory directory) index origfile buf target entry ibuffer - main last-main letter last-letter file sub link) + main last-main letter last-letter file sub link tgext) ;; `files' contains the list of relative file names (dolist (file files) (setq origfile (substring file 0 -1)) @@ -781,6 +864,9 @@ the project." (setq last-letter nil) (dolist (idx index) (setq entry (car idx) file (nth 1 idx) target (nth 2 idx)) + (if (and (stringp target) (string-match "\\S-" target)) + (setq tgext (concat "::#" target)) + (setq tgext "")) (setq letter (upcase (substring entry 0 1))) (when (not (equal letter last-letter)) (insert "** " letter "\n") @@ -792,7 +878,7 @@ the project." (when (and main (not (equal main last-main))) (insert " - " main "\n") (setq last-main main)) - (setq link (concat "[[file:" file "::#" target "]" + (setq link (concat "[[file:" file tgext "]" "[" (or sub entry) "]]")) (if (and main sub) (insert " - " link "\n") @@ -809,8 +895,143 @@ the project." (save-buffer)) (kill-buffer ibuffer))))) -(provide 'org-publish) +;; 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")) + + (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'")) + (with-temp-file cache-file + (let ((print-level nil) + (print-length nil)) + (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") + (maphash (lambda (k v) + (insert + (format (concat "(puthash %S " + (if (or (listp v) (symbolp v)) + "'" "") + "%S org-publish-cache)\n") k v))) + org-publish-cache))) + (when free-cache (org-publish-reset-cache)))) + +(defun org-publish-initialize-cache (project-name) + "Initialize the projects cache if not initialized yet and return it." + + (unless project-name + (error "%s%s" "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)) + (if (not (file-directory-p org-publish-timestamp-directory)) + (error "Org publish timestamp: %s is not a directory" + org-publish-timestamp-directory)) + + (unless (and org-publish-cache + (string= (org-publish-cache-get ":project:") project-name)) + (let* ((cache-file (concat + (expand-file-name org-publish-timestamp-directory) + project-name + ".cache")) + (cexists (file-exists-p cache-file))) + + (when org-publish-cache + (org-publish-reset-cache)) + + (if cexists + (load-file cache-file) + (setq org-publish-cache + (make-hash-table :test 'equal :weakness nil :size 100)) + (org-publish-cache-set ":project:" project-name) + (org-publish-cache-set ":cache-file:" cache-file)) + (unless cexists (org-publish-write-cache-file nil)))) + org-publish-cache) + +(defun org-publish-reset-cache () + "Empty org-publish-cache and reset it nil." + (message "%s" "Resetting org-publish-cache") + (if (hash-table-p org-publish-cache) + (clrhash org-publish-cache)) + (setq org-publish-cache nil)) + +(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func) + "Check the timestamp of the last publishing of FILENAME. +Return `t', if the file needs publishing" + (unless org-publish-cache + (error "%s" "`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))) + (if (null pstamp) + t + (let ((ctime (org-publish-cache-ctime-of-src filename))) + (< pstamp ctime))))) + +(defun org-publish-cache-set-file-property (filename property value &optional project-name) + "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. +Use cache file of PROJECT-NAME. If the entry does not exist, it will be +created. Return VALUE." + ;; Evtl. load the requested cache file: + (if project-name (org-publish-initialize-cache project-name)) + (let ((pl (org-publish-cache-get filename))) + (if pl + (progn + (plist-put pl property value) + value) + (org-publish-cache-get-file-property + filename property value nil project-name)))) + +(defun org-publish-cache-get-file-property + (filename property &optional default no-create project-name) + "Return the value for a PROPERTY of file FILENAME in publishing cache. +Use cache file of PROJECT-NAME. Return the value of that PROPERTY or +DEFAULT, if the value does not yet exist. +If the entry will be created, unless NO-CREATE is not nil." + ;; Evtl. load the requested cache file: + (if project-name (org-publish-initialize-cache project-name)) + (let ((pl (org-publish-cache-get filename)) + (retval nil)) + (if pl + (if (plist-member pl property) + (setq retval (plist-get pl property)) + (setq retval default)) + ;; no pl yet: + (unless no-create + (org-publish-cache-set filename (list property default))) + (setq retval default)) + retval)) + +(defun org-publish-cache-get (key) + "Return the value stored in `org-publish-cache' for key KEY. +Returns nil, if no value or nil is found, or the cache does not +exist." + (unless org-publish-cache + (error "%s" "`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")) + (puthash key value org-publish-cache)) + +(defun org-publish-cache-ctime-of-src (filename) + "Get the files ctime as integer." + (let ((src-attr (file-attributes filename))) + (+ + (lsh (car (nth 5 src-attr)) 16) + (cadr (nth 5 src-attr))))) + + + +(provide 'org-publish) ;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index a20539dd85a..d8252b65c3d 100644 --- a/lisp/org/org-remember.el +++ b/lisp/org/org-remember.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -54,14 +54,15 @@ :group 'org) (defcustom org-remember-store-without-prompt t - "Non-nil means `C-c C-c' stores remember note without further prompts. + "Non-nil means \\<org-remember-mode-map>\\[org-remember-finalize] \ +stores the remember note without further prompts. It then uses the file and headline specified by the template or (if the template does not specify them) by the variables `org-default-notes-file' and `org-remember-default-headline'. To force prompting anyway, use -`C-u C-c C-c' to file the note. +\\[universal-argument] \\[org-remember-finalize] to file the note. -When this variable is nil, `C-c C-c' gives you the prompts, and -`C-u C-c C-c' triggers the fasttrack." +When this variable is nil, \\[org-remember-finalize] gives you the prompts, and +\\[universal-argument] \\[org-remember-finalize] triggers the fasttrack." :group 'org-remember :type 'boolean) @@ -94,10 +95,10 @@ You can set this on a per-template basis with the variable (defcustom org-remember-templates nil "Templates for the creation of remember buffers. When nil, just let remember make the buffer. -When non-nil, this is a list of 5-element lists. In each entry, the first -element is the name of the template, which should be a single short word. -The second element is a character, a unique key to select this template. -The third element is the template. +When non-nil, this is a list of (up to) 6-element lists. In each entry, +the first element is the name of the template, which should be a single +short word. The second element is a character, a unique key to select +this template. The third element is the template. The fourth element is optional and can specify a destination file for remember items created with this template. The default file is given @@ -114,41 +115,44 @@ An optional sixth element specifies the contexts in which the template will be offered to the user. This element can be a list of major modes or a function, and the template will only be offered if `org-remember' is called from a mode in the list, or if the function returns t. -Templates that specify t or nil for the context will be always be added +Templates that specify t or nil for the context will always be added to the list of selectable templates. The template specifies the structure of the remember buffer. It should have a first line starting with a star, to act as the org-mode headline. Furthermore, the following %-escapes will be replaced with content: - %^{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} prompt the user for a string and replace this sequence with it. + A default value and a completion table can be specified like this: %^{prompt|default|completion2|completion3|...} + The arrow keys access a prompt-specific history. + %a annotation, normally the link created with `org-store-link' + %A like %a, but prompt for the description part + %i initial content, copied from the active region. If %i is + indented, the entire inserted text will be indented as well. %t time stamp, date only %T time stamp with date and time %u, %U like the above, but inactive time stamps %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. - You may define a prompt like %^{Please specify birthday + You may define a prompt like %^{Please specify birthday}t %n user name (taken from `user-full-name') - %a annotation, normally the link created with org-store-link - %i initial content, copied from the active region. If %i is - indented, the entire inserted text will be indented as well. %c current kill ring head %x content of the X clipboard - %^C Interactive selection of which kill or clip to use - %^L Like %^C, but insert as link - %k title of currently clocked task - %K link to currently clocked task - %^g prompt for tags, with completion on tags in target file - %^G prompt for tags, with completion all tags in all agenda files - %^{prop}p Prompt the user for a value for property `prop' %:keyword specific information for certain link types, see below - %[pathname] insert the contents of the file given by `pathname' - %(sexp) evaluate elisp `(sexp)' and replace with the result - %! Store this note immediately after filling the template - %& Visit note immediately after storing it - - %? After completing the template, position cursor here. + %^C interactive selection of which kill or clip to use + %^L like %^C, but insert as link + %k title of the currently clocked task + %K link to the currently clocked task + %^g prompt for tags, completing tags in the target file + %^G prompt for tags, completing all tags in all agenda files + %^{PROP}p Prompt the user for a value for property PROP + %[PATHNAME] insert the contents of the file given by PATHNAME + %(SEXP) evaluate elisp `(SEXP)' and replace with the result + %! store this note immediately after completing the template\ + \\<org-remember-mode-map> + (skipping the \\[org-remember-finalize] that normally triggers storing) + %& jump to target location immediately after storing note + %? after completing the template, position cursor here. Apart from these general escapes, you can access information specific to the link type that is created. For example, calling `remember' in emails or gnus @@ -211,7 +215,7 @@ The remember buffer is still current when this hook runs." :type 'hook) (defvar org-remember-mode-map (make-sparse-keymap) - "Keymap for org-remember-mode, a minor mode. + "Keymap for `org-remember-mode', a minor mode. Use this map to set additional keybindings for when Org-mode is used for a Remember buffer.") (defvar org-remember-mode-hook nil @@ -229,7 +233,7 @@ for a Remember buffer.") This only applies if the clock is running in the remember buffer. If the clock is not stopped, it continues to run in the storage location. Instead of nil or t, this may also be the symbol `query' to prompt the -user each time a remember buffer with a running clock is filed away. " +user each time a remember buffer with a running clock is filed away." :group 'org-remember :type '(choice (const :tag "Never" nil) @@ -265,7 +269,7 @@ Set this to nil if you find that you don't need the warning. If you cancel remember calls frequently and know when they contain useful information (because you know that you made an -error or emacs crashed, for example) nil is more useful. In the +error or Emacs crashed, for example) nil is more useful. In the opposite case, the default, t, is more useful." :group 'org-remember :type 'boolean) @@ -388,12 +392,6 @@ RET at beg-of-buf -> Append to file as level 2 headline char0)))))) (cddr (assoc char templates))))) -(defun org-get-x-clipboard (value) - "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21." - (if (eq window-system 'x) - (let ((x (org-get-x-clipboard-compat value))) - (if x (org-no-properties x))))) - ;;;###autoload (defun org-remember-apply-template (&optional use-char skip-interactive) "Initialize *remember* buffer with template, invoke `org-mode'. @@ -727,9 +725,11 @@ from that hook." If there is an active region, make sure remember uses it as initial content of the remember buffer. -When called interactively with a `C-u' prefix argument GOTO, don't remember +When called interactively with a \\[universal-argument] \ +prefix argument GOTO, don't remember anything, just go to the file/headline where the selected template usually -stores its notes. With a double prefix arg `C-u C-u', go to the last +stores its notes. With a double prefix argument \ +\\[universal-argument] \\[universal-argument], go to the last note stored by remember. Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character @@ -801,21 +801,24 @@ The user is queried for the template." When the template has specified a file and a headline, the entry is filed there, or in the location defined by `org-default-notes-file' and `org-remember-default-headline'. - +\\<org-remember-mode-map> If no defaults have been defined, or if the current prefix argument -is 1 (so you must use `C-1 C-c C-c' to exit remember), an interactive +is 1 (using C-1 \\[org-remember-finalize] to exit remember), an interactive process is used to select the target location. -When the prefix is 0 (i.e. when remember is exited with `C-0 C-c C-c'), +When the prefix is 0 (i.e. when remember is exited with \ +C-0 \\[org-remember-finalize]), the entry is filed to the same location as the previous note. -When the prefix is 2 (i.e. when remember is exited with `C-2 C-c C-c'), +When the prefix is 2 (i.e. when remember is exited with \ +C-2 \\[org-remember-finalize]), the entry is filed as a subentry of the entry where the clock is currently running. -When `C-u' has been used as prefix argument, the note is stored and emacs -moves point to the new location of the note, so that editing can be -continued there (similar to inserting \"%&\" into the template). +When \\[universal-argument] has been used as prefix argument, the +note is stored and Emacs moves point to the new location of the +note, so that editing can be continued there (similar to +inserting \"%&\" into the template). Before storing the note, the function ensures that the text has an org-mode-style headline, i.e. a first line that starts with diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index 28e991f0214..4ddfadaafa5 100644 --- a/lisp/org/org-rmail.el +++ b/lisp/org/org-rmail.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 395c592e696..453f3b0b534 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -8,7 +8,7 @@ ;; Dan Davison <davison at stats dot ox dot ac dot uk> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -63,7 +63,7 @@ there are kept outside the narrowed region." "The default coderef format. This format string will be used to search for coderef labels in literal examples (EXAMPLE and SRC blocks). The format can be overwritten in -an individual literal example with the -f option, like +an individual literal example with the -l option, like #+BEGIN_SRC pascal +n -r -l \"((%s))\" ... @@ -87,10 +87,11 @@ These are the regions where each line starts with a colon." (function :tag "Other (specify)"))) (defcustom org-src-preserve-indentation nil - "If non-nil, leading whitespace characters in source code -blocks are preserved on export, and when switching between the -org buffer and the language mode edit buffer. If this variable -is nil then, after editing with \\[org-edit-src-code], the + "If non-nil preserve leading whitespace characters on export. +If non-nil leading whitespace characters in source code blocks +are preserved on export, and when switching between the org +buffer and the language mode edit buffer. If this variable is nil +then, after editing with \\[org-edit-src-code], the minimum (across-lines) number of leading whitespace characters are removed from all lines, and the code block is uniformly indented according to the value of `org-edit-src-content-indentation'." @@ -101,7 +102,7 @@ indented according to the value of `org-edit-src-content-indentation'." "Indentation for the content of a source code block. This should be the number of spaces added to the indentation of the #+begin line in order to compute the indentation of the block content after -editing it with \\[org-edit-src-code]. Has no effect if +editing it with \\[org-edit-src-code]. Has no effect if `org-src-preserve-indentation' is non-nil." :group 'org-edit-structure :type 'integer) @@ -146,7 +147,7 @@ but which mess up the display of a snippet in Org exported files.") (defcustom org-src-lang-modes '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) - ("asymptote" . asy) ("dot" . fundamental)) + ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)) "Alist mapping languages to their major mode. The key is the language name, the value is the string that should be inserted as the name of the major mode. For many languages this is @@ -166,6 +167,7 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) +(defvar org-edit-src-allow-write-back-p t) (defvar org-edit-src-picture nil) (defvar org-edit-src-beg-marker nil) (defvar org-edit-src-end-marker nil) @@ -187,7 +189,7 @@ This minor mode is turned on in two situations: There is a mode hook, and keybindings for `org-edit-src-exit' and `org-edit-src-save'") -(defun org-edit-src-code (&optional context) +(defun org-edit-src-code (&optional context code edit-buffer-name) "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]. @@ -200,19 +202,22 @@ the edited version. Optional argument CONTEXT is used by (let ((line (org-current-line)) (col (current-column)) (case-fold-search t) - (msg (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote)")) (info (org-edit-src-find-region-and-lang)) (org-mode-p (eq major-mode 'org-mode)) (beg (make-marker)) (end (make-marker)) (preserve-indentation org-src-preserve-indentation) - block-nindent total-nindent ovl lang lang-f single lfmt code begline buffer) + (allow-write-back-p (null code)) + block-nindent total-nindent ovl lang lang-f single lfmt begline buffer msg) (if (not info) nil (setq beg (move-marker beg (nth 0 info)) end (move-marker end (nth 1 info)) - code (buffer-substring-no-properties beg end) + msg (if allow-write-back-p + (substitute-command-keys + "Edit, then exit with C-c ' (C-c and single quote)") + "Exit with C-c ' (C-c and single quote)") + code (or code (buffer-substring-no-properties beg end)) lang (or (cdr (assoc (nth 2 info) org-src-lang-modes)) (nth 2 info)) lang (if (symbolp lang) (symbol-name lang) lang) @@ -238,20 +243,21 @@ the edited version. Optional argument CONTEXT is used by (when buffer (with-current-buffer buffer (if (boundp 'org-edit-src-overlay) - (org-delete-overlay org-edit-src-overlay))) + (delete-overlay org-edit-src-overlay))) (kill-buffer buffer)) (setq buffer (generate-new-buffer - (org-src-construct-edit-buffer-name (buffer-name) lang))) - (setq ovl (org-make-overlay beg end)) - (org-overlay-put ovl 'edit-buffer buffer) - (org-overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") - (org-overlay-put ovl 'face 'secondary-selection) - (org-overlay-put ovl - 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'org-edit-src-continue) - map)) - (org-overlay-put ovl :read-only "Leave me alone") + (or edit-buffer-name + (org-src-construct-edit-buffer-name (buffer-name) lang)))) + (setq ovl (make-overlay beg end)) + (overlay-put ovl 'edit-buffer buffer) + (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl + 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'org-edit-src-continue) + map)) + (overlay-put ovl :read-only "Leave me alone") (org-src-switch-to-buffer buffer 'edit) (if (eq single 'macro-definition) (setq code (replace-regexp-in-string "\\\\n" "\n" code t t))) @@ -264,6 +270,7 @@ the edited version. Optional argument CONTEXT is used by (funcall lang-f)) (set (make-local-variable 'org-edit-src-force-single-line) single) (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) + (set (make-local-variable 'org-edit-src-allow-write-back-p) allow-write-back-p) (set (make-local-variable 'org-src-preserve-indentation) preserve-indentation) (when lfmt (set (make-local-variable 'org-coderef-label-format) lfmt)) @@ -320,7 +327,7 @@ the edited version. Optional argument CONTEXT is used by (switch-to-buffer buffer)))) (defun org-src-construct-edit-buffer-name (org-buffer-name lang) - "Construct the buffer name for a source editing buffer" + "Construct the buffer name for a source editing buffer." (concat "*Org Src " org-buffer-name "[ " lang " ]*")) (defun org-edit-src-find-buffer (beg end) @@ -381,22 +388,22 @@ the fragment in the Org-mode buffer." (when buffer (with-current-buffer buffer (if (boundp 'org-edit-src-overlay) - (org-delete-overlay org-edit-src-overlay))) + (delete-overlay org-edit-src-overlay))) (kill-buffer buffer)) (setq buffer (generate-new-buffer (org-src-construct-edit-buffer-name (buffer-name) "Fixed Width"))) - (setq ovl (org-make-overlay beg end)) - (org-overlay-put ovl 'face 'secondary-selection) - (org-overlay-put ovl 'edit-buffer buffer) - (org-overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") - (org-overlay-put ovl 'face 'secondary-selection) - (org-overlay-put ovl + (setq ovl (make-overlay beg end)) + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl 'edit-buffer buffer) + (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl 'keymap (let ((map (make-sparse-keymap))) (define-key map [mouse-1] 'org-edit-src-continue) map)) - (org-overlay-put ovl :read-only "Leave me alone") + (overlay-put ovl :read-only "Leave me alone") (switch-to-buffer buffer) (insert code) (remove-text-properties (point-min) (point-max) @@ -406,7 +413,7 @@ the fragment in the Org-mode buffer." ((eq org-edit-fixed-width-region-mode 'artist-mode) (fundamental-mode) (artist-mode 1)) - (t (funcall org-edit-fixed-width-region-mode))) + (t (funcall org-edit-fixed-width-region-mode))) (set (make-local-variable 'org-edit-src-force-single-line) nil) (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) (set (make-local-variable 'org-edit-src-picture) t) @@ -459,15 +466,6 @@ the language, a switch telling if the content should be in a single line." (pos (point)) re1 re2 single beg end lang lfmt match-re1 ind entry) (catch 'exit - (when (org-at-table.el-p) - (re-search-backward "^[\t]*[^ \t|\\+]" nil t) - (setq beg (1+ (point-at-eol))) - (goto-char beg) - (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t) - (progn (goto-char (point-max)) (newline))) - (setq end (point-at-bol)) - (setq ind (org-edit-src-get-indentation beg)) - (throw 'exit (list beg end 'table.el nil nil ind))) (while (setq entry (pop re-list)) (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry) single (nth 3 entry)) @@ -498,7 +496,16 @@ the language, a switch telling if the content should be in a single line." (throw 'exit (list (match-end 0) end (org-edit-src-get-lang lang) - single lfmt ind)))))))))))) + single lfmt ind))))))))) + (when (org-at-table.el-p) + (re-search-backward "^[\t]*[^ \t|\\+]" nil t) + (setq beg (1+ (point-at-eol))) + (goto-char beg) + (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t) + (progn (goto-char (point-max)) (newline))) + (setq end (point-at-bol)) + (setq ind (org-edit-src-get-indentation beg)) + (throw 'exit (list beg end 'table.el nil nil ind)))))) (defun org-edit-src-get-lang (lang) "Extract the src language." @@ -521,7 +528,7 @@ the language, a switch telling if the content should be in a single line." (match-string 1 s)))) (defun org-edit-src-get-indentation (pos) - "Count leading whitespace characters on line" + "Count leading whitespace characters on line." (save-match-data (goto-char pos) (org-get-indentation))) @@ -529,8 +536,8 @@ the language, a switch telling if the content should be in a single line." (defun org-edit-src-exit (&optional context) "Exit special edit and protect problematic lines." (interactive) - (unless org-edit-src-from-org-mode - (error "This is not a sub-editing buffer, something is wrong...")) + (unless (org-bound-and-true-p org-edit-src-from-org-mode) + (error "This is not a sub-editing buffer, something is wrong")) (widen) (let* ((beg org-edit-src-beg-marker) (end org-edit-src-end-marker) @@ -541,61 +548,65 @@ the language, a switch telling if the content should be in a single line." (total-nindent (+ (or org-edit-src-block-indentation 0) org-edit-src-content-indentation)) (preserve-indentation org-src-preserve-indentation) + (allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p)) (delta 0) code line col indent) - (unless preserve-indentation (untabify (point-min) (point-max))) - (save-excursion - (goto-char (point-min)) - (if (looking-at "[ \t\n]*\n") (replace-match "")) - (unless macro - (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))) + (when allow-write-back-p + (unless preserve-indentation (untabify (point-min) (point-max))) + (save-excursion + (goto-char (point-min)) + (if (looking-at "[ \t\n]*\n") (replace-match "")) + (unless macro + (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))) (setq line (if (org-bound-and-true-p org-edit-src-force-single-line) 1 (org-current-line)) col (current-column)) - (when single - (goto-char (point-min)) - (if (re-search-forward "\\s-+\\'" nil t) (replace-match "")) - (goto-char (point-min)) - (let ((cnt 0)) - (while (re-search-forward "\n" nil t) - (setq cnt (1+ cnt)) - (replace-match (if macro "\\n" " ") t t)) - (when (and macro (> cnt 0)) - (goto-char (point-max)) (insert "\\n"))) - (goto-char (point-min)) - (if (looking-at "\\s-*") (replace-match " "))) - (when (org-bound-and-true-p org-edit-src-from-org-mode) - (goto-char (point-min)) - (while (re-search-forward - (if (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t) - (if (eq (org-current-line) line) (setq delta (1+ delta))) - (replace-match ",\\1"))) - (when (org-bound-and-true-p org-edit-src-picture) - (setq preserve-indentation nil) - (untabify (point-min) (point-max)) - (goto-char (point-min)) - (while (re-search-forward "^" nil t) - (replace-match ": "))) - (unless (or single preserve-indentation (= total-nindent 0)) - (setq indent (make-string total-nindent ?\ )) - (goto-char (point-min)) - (while (re-search-forward "^" nil t) - (replace-match indent))) - (if (org-bound-and-true-p org-edit-src-picture) - (setq total-nindent (+ total-nindent 2))) - (setq code (buffer-string)) - (set-buffer-modified-p nil) + (when allow-write-back-p + (when single + (goto-char (point-min)) + (if (re-search-forward "\\s-+\\'" nil t) (replace-match "")) + (goto-char (point-min)) + (let ((cnt 0)) + (while (re-search-forward "\n" nil t) + (setq cnt (1+ cnt)) + (replace-match (if macro "\\n" " ") t t)) + (when (and macro (> cnt 0)) + (goto-char (point-max)) (insert "\\n"))) + (goto-char (point-min)) + (if (looking-at "\\s-*") (replace-match " "))) + (when (org-bound-and-true-p org-edit-src-from-org-mode) + (goto-char (point-min)) + (while (re-search-forward + (if (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t) + (if (eq (org-current-line) line) (setq delta (1+ delta))) + (replace-match ",\\1"))) + (when (org-bound-and-true-p org-edit-src-picture) + (setq preserve-indentation nil) + (untabify (point-min) (point-max)) + (goto-char (point-min)) + (while (re-search-forward "^" nil t) + (replace-match ": "))) + (unless (or single preserve-indentation (= total-nindent 0)) + (setq indent (make-string total-nindent ?\ )) + (goto-char (point-min)) + (while (re-search-forward "^" nil t) + (replace-match indent))) + (if (org-bound-and-true-p org-edit-src-picture) + (setq total-nindent (+ total-nindent 2))) + (setq code (buffer-string)) + (set-buffer-modified-p nil)) (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) (kill-buffer buffer) (goto-char beg) - (delete-region beg end) - (insert code) - (goto-char beg) - (if single (just-one-space)) + (when allow-write-back-p + (delete-region beg end) + (insert code) + (goto-char beg) + (if single (just-one-space))) (if (memq t (mapcar (lambda (overlay) - (eq (org-overlay-get overlay 'invisible) + (eq (overlay-get overlay 'invisible) 'org-hide-block)) - (org-overlays-at (point)))) + (overlays-at (point)))) ;; Block is hidden; put point at start of block (beginning-of-line 0) ;; Block is visible, put point where it was in the code buffer @@ -625,15 +636,21 @@ the language, a switch telling if the content should be in a single line." (message (or msg "")))) (defun org-src-mode-configure-edit-buffer () - (when org-edit-src-from-org-mode - (setq buffer-offer-save t) - (setq buffer-file-name - (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) - "[" (buffer-name) "]")) - (set (if (featurep 'xemacs) 'write-contents-hooks 'write-contents-functions) - '(org-edit-src-save)) + (when (org-bound-and-true-p org-edit-src-from-org-mode) (org-add-hook 'kill-buffer-hook - '(lambda () (org-delete-overlay org-edit-src-overlay)) nil 'local))) + '(lambda () (delete-overlay org-edit-src-overlay)) nil 'local) + (if (org-bound-and-true-p org-edit-src-allow-write-back-p) + (progn + (setq buffer-offer-save t) + (setq buffer-file-name + (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) + "[" (buffer-name) "]")) + (if (featurep 'xemacs) + (progn + (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4 + (setq write-contents-hooks '(org-edit-src-save))) + (setq write-contents-functions '(org-edit-src-save)))) + (setq buffer-read-only t)))) (org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index bbf9f10bc25..6a7120e0e55 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -196,7 +196,7 @@ t: accept as input and present for editing" 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. + "List with Calc mode settings for use in `calc-eval' for table formulas. The list must contain alternating symbols (Calc modes variables and values). Don't remove any of the default settings, just change the values. Org-mode relies on the variables to be present in the list." @@ -276,10 +276,11 @@ portability of tables." :group 'org-table) (defcustom org-table-export-default-format "orgtbl-to-tsv" - "Default export parameters for org-table-export. These can be -overridden on for a specific table by setting the TABLE_EXPORT_FORMAT -property. See the manual section on orgtbl radio tables for the different -export transformations and available parameters." + "Default export parameters for `org-table-export'. +These can be overridden for a specific table by setting the +TABLE_EXPORT_FORMAT property. See the manual section on orgtbl +radio tables for the different export transformations and +available parameters." :group 'org-table-import-export :type 'string) @@ -290,8 +291,7 @@ export transformations and available parameters." (defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" "Detects a table line marked for automatic recalculation.") (defconst org-table-border-regexp "^[ \t]*[^| \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") + "Searching from within a table (any type) this finds the first line outside the table.") (defvar org-table-last-highlighted-reference nil) (defvar org-table-formula-history nil) @@ -305,11 +305,11 @@ outside the table.") "Alist with locations of named fields.") (defvar org-table-current-line-types nil - "Table row types, non-nil only for the duration of a comand.") + "Table row types, non-nil only for the duration of a command.") (defvar org-table-current-begin-line nil - "Table begin line, non-nil only for the duration of a comand.") + "Table begin line, non-nil only for the duration of a command.") (defvar org-table-current-begin-pos nil - "Table begin position, non-nil only for the duration of a comand.") + "Table begin position, non-nil only for the duration of a command.") (defvar org-table-dlines nil "Vector of data line line numbers in the current table.") (defvar org-table-hlines nil @@ -327,6 +327,33 @@ outside the table.") "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") "Match a range for reference display.") +(defun org-table-colgroup-line-p (line) + "Is this a table line colgroup information?" + (save-match-data + (and (string-match "[<>]\\|&[lg]t;" line) + (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" + line) + (not (delq + nil + (mapcar + (lambda (s) + (not (member s '("" "<" ">" "<>" "<" ">" "<>")))) + (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) + +(defun org-table-cookie-line-p (line) + "Is this a table line with only alignment/width cookies?" + + (save-match-data + (and (string-match "[<>]\\|&[lg]t;" line) + (or (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" line) + (string-match "\\(\\`[ \t<>lr0-9|gt&;]+\\'\\)" line)) + (not (delq nil (mapcar + (lambda (s) + (not (or (equal s "") + (string-match "\\`<\\([lr]?[0-9]+\\|[lr]\\)>\\'" s) + (string-match "\\`<\\([lr]?[0-9]+\\|[lr]\\)>\\'" s)))) + (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) + (defconst org-table-translate-regexp (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") "Match a reference that needs translation, for reference display.") @@ -470,7 +497,7 @@ 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 +`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." @@ -602,7 +629,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) (hfmt1 (concat (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings links dates emph narrow falign falign1 fmax f1 len c e) + emptystrings links dates emph raise narrow + falign falign1 fmax f1 len c e space) (untabify beg end) (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) ;; Check if we have links or dates @@ -612,6 +640,9 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (setq emph (and org-hide-emphasis-markers (re-search-forward org-emph-re end t))) (goto-char beg) + (setq raise (and org-use-sub-superscripts + (re-search-forward org-match-substring-regexp end t))) + (goto-char beg) (setq dates (and org-display-custom-times (re-search-forward org-ts-regexp-both end t))) ;; Make sure the link properties are right @@ -619,6 +650,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; Make sure the date properties are right (when dates (goto-char beg) (while (org-activate-dates end))) (when emph (goto-char beg) (while (org-do-emphasis-faces end))) + (when raise (goto-char beg) (while (org-raise-scripts end))) ;; Check if we are narrowing any columns (goto-char beg) @@ -709,16 +741,22 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; With invisible characters, `format' does not get the field width right ;; So we need to make these fields wide by hand. - (when (or links emph) + (when (or links emph raise) (loop for i from 0 upto (1- maxfields) do (setq len (nth i lengths)) (loop for j from 0 upto (1- (length fields)) do (setq c (nthcdr i (car (nthcdr j fields)))) (if (and (stringp (car c)) - (text-property-any 0 (length (car c)) 'invisible 'org-link (car c)) -; (string-match org-bracket-link-regexp (car c)) + (or (text-property-any 0 (length (car c)) + 'invisible 'org-link (car c)) + (text-property-any 0 (length (car c)) + 'org-dwidth t (car c))) (< (org-string-width (car c)) len)) - (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) + (progn + (setq space (make-string (- len (org-string-width (car c))) ?\ )) + (setcar c (if (nth i typenums) + (concat space (car c)) + (concat (car c) space)))))))) ;; Compute the formats needed for output of the table (setq rfmt (concat indent "|") hfmt (concat indent "|")) @@ -764,14 +802,6 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (setq org-table-may-need-update nil) )) - - - - - - - - (defun org-table-begin (&optional table-type) "Find the beginning of the table and return its position. With argument TABLE-TYPE, go to the beginning of a table.el-type table." @@ -830,6 +860,7 @@ Optional argument NEW may specify text to replace the current field content." (if (<= (length new) l) ;; FIXME: length -> str-width? (setq n (format f new)) (setq n (concat new "|") org-table-may-need-update t))) + (if (equal (string-to-char n) ?-) (setq n (concat " " n))) (or (equal n o) (let (org-table-may-need-update) (replace-match n t t)))) @@ -1021,7 +1052,7 @@ If column is nil, use the current column." (defun org-table-put (line column value &optional align) "Put VALUE into line LINE, column COLUMN. -When ALIGN is set, als realign the table." +When ALIGN is set, also realign the table." (setq column (or column (org-table-current-column))) (prog1 (save-excursion (and (or (not line) (org-table-goto-line line)) @@ -1128,7 +1159,7 @@ is always the old value." (defun org-table-current-dline () "Find out what table data line we are in. -Only datalines count for this." +Only data lines count for this." (interactive) (if (interactive-p) (org-table-check-inside-data-field)) (save-excursion @@ -1189,7 +1220,7 @@ However, when FORCE is non-nil, create new columns if necessary." (org-table-fix-formulas "$LR" nil (1- col) 1))) (defun org-table-find-dataline () - "Find a dataline in the current table, which is needed for column commands." + "Find a data line in the current table, which is needed for column commands." (if (and (org-at-table-p) (not (org-at-table-hline-p))) t @@ -1729,23 +1760,6 @@ the table and kill the editing buffer." (org-table-align) (message "New field value inserted"))) - - - - - - - - - - - - - - - - - (defvar org-timecnt) ; dynamically scoped parameter (defun org-table-sum (&optional beg end nlast) @@ -1830,7 +1844,7 @@ If NLAST is a number, only the NLAST fields will actually be summed." "Return the formula active for the current field. Assumes that specials are in place. If KEY is given, return the key to this formula. -Otherwise return the formula preceeded with \"=\" or \":=\"." +Otherwise return the formula preceded with \"=\" or \":=\"." (let* ((name (car (rassoc (list (org-current-line) (org-table-current-column)) org-table-named-field-locations))) @@ -2372,7 +2386,7 @@ $1-> %s\n" orig formula form0 form)) (org-fit-window-to-buffer bw) (unless (and (interactive-p) (not ndown)) (unless (let (inhibit-redisplay) - (y-or-n-p "Debugging Formula. Continue to next? ")) + (y-or-n-p "Debugging Formula. Continue to next? ")) (org-table-align) (error "Abort")) (delete-window bw) @@ -2469,7 +2483,7 @@ and TABLE is a vector with line types." ;; 1 2 3 4 5 6 (and (not (match-end 3)) (not (match-end 6))) (and (match-end 3) (match-end 6) (not (match-end 5)))) - (error "invalid row descriptor `%s'" desc)) + (error "Invalid row descriptor `%s'" desc)) (let* ((hdir (and (match-end 2) (match-string 2 desc))) (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) (odir (and (match-end 5) (match-string 5 desc))) @@ -2483,7 +2497,7 @@ and TABLE is a vector with line types." (setq i 0 hdir "+") (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) (if (and (not hn) on (not odir)) - (error "should never happen");;(aref org-table-dlines on) + (error "Should never happen");;(aref org-table-dlines on) (if (and hn (> hn 0)) (setq i (org-table-find-row-type table i 'hline (equal hdir "-") nil hn cline desc))) @@ -2554,7 +2568,8 @@ LISPP means to return something appropriate for a Lisp list." (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. With prefix arg ALL, do this for all lines in the table. -With the prefix argument ALL is `(16)' (a double `C-c C-u' prefix), or if +With the prefix argument ALL is `(16)' \ +\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if it is the symbol `iterate', recompute the table until it no longer changes. If NOALIGN is not nil, do not re-align the table after the computations are done. This is typically used internally to save time, if it is @@ -2682,6 +2697,36 @@ known that the table will be realigned a little later anyway." (throw 'exit t))) (error "No convergence after %d iterations" i)))) +(defun org-table-recalculate-buffer-tables () + "Recalculate all tables in the current buffer." + (interactive) + (save-excursion + (save-restriction + (widen) + (org-table-map-tables (lambda () (org-table-recalculate t)) t)))) + +(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)))))) + (defun org-table-formula-substitute-names (f) "Replace $const with values in string F." (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) @@ -2720,6 +2765,7 @@ Parameters get priority." (org-defkey map "\C-x\C-s" 'org-table-fedit-finish) (org-defkey map "\C-c\C-s" 'org-table-fedit-finish) (org-defkey map "\C-c\C-c" 'org-table-fedit-finish) + (org-defkey map "\C-c'" 'org-table-fedit-finish) (org-defkey map "\C-c\C-q" 'org-table-fedit-abort) (org-defkey map "\C-c?" 'org-table-show-reference) (org-defkey map [(meta shift up)] 'org-table-fedit-line-up) @@ -2816,7 +2862,7 @@ Parameters get priority." (if (eq org-table-use-standard-references t) (org-table-fedit-toggle-ref-type)) (org-goto-line startline) - (message "Edit formulas and finish with `C-c C-c'. See menu for more commands."))) + (message "Edit formulas, finish with `C-c C-c' or `C-c ' '. See menu for more commands."))) (defun org-table-fedit-post-command () (when (not (memq this-command '(lisp-complete-symbol))) @@ -2964,7 +3010,7 @@ For example: 28 -> AB." (org-rematch-and-replace 5 (eq dir 'left)))))) (defun org-rematch-and-replace (n &optional decr hline) - "Re-match the group N, and replace it with the shifted refrence." + "Re-match the group N, and replace it with the shifted reference." (or (match-end n) (error "Cannot shift reference in this direction")) (goto-char (match-beginning n)) (and (looking-at (regexp-quote (match-string n))) @@ -2972,7 +3018,7 @@ For example: 28 -> AB." t t))) (defun org-table-shift-refpart (ref &optional decr hline) - "Shift a refrence part REF. + "Shift a reference part REF. If DECR is set, decrease the references row/column, else increase. If HLINE is set, this may be a hline reference, it certainly is not a translation reference." @@ -3040,7 +3086,7 @@ With prefix ARG, apply the new formulas to the table." (select-window sel-win) (goto-char pos) (unless (org-at-table-p) - (error "Lost table position - cannot install formulae")) + (error "Lost table position - cannot install formulas")) (org-table-store-formulas eql) (move-marker pos nil) (kill-buffer "*Edit Formulas*") @@ -3282,8 +3328,8 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (defun org-table-add-rectangle-overlay (beg end &optional face) "Add a new overlay." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face (or face 'secondary-selection)) + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face (or face 'secondary-selection)) (push ov org-table-rectangle-overlays))) (defun org-table-highlight-rectangle (&optional beg end face) @@ -3318,7 +3364,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." "Remove the rectangle overlays." (unless org-inhibit-highlight-removal (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) - (mapc 'org-delete-overlay org-table-rectangle-overlays) + (mapc 'delete-overlay org-table-rectangle-overlays) (setq org-table-rectangle-overlays nil))) (defvar org-table-coordinate-overlays nil @@ -3328,14 +3374,14 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (defun org-table-overlay-coordinates () "Add overlays to the table at point, to show row/column coordinates." (interactive) - (mapc 'org-delete-overlay org-table-coordinate-overlays) + (mapc 'delete-overlay org-table-coordinate-overlays) (setq org-table-coordinate-overlays nil) (save-excursion (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg) (goto-char (org-table-begin)) (while (org-at-table-p) (setq eol (point-at-eol)) - (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-bol)))) + (setq ov (make-overlay (point-at-bol) (1+ (point-at-bol)))) (push ov org-table-coordinate-overlays) (setq hline (looking-at org-table-hline-regexp)) (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) @@ -3349,7 +3395,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." s1 (concat "$" (int-to-string ic)) s2 (org-number-to-letters ic) str (if (eq org-table-use-standard-references t) s2 s1)) - (setq ov (org-make-overlay beg (+ beg (length str)))) + (setq ov (make-overlay beg (+ beg (length str)))) (push ov org-table-coordinate-overlays) (org-overlay-display ov str 'org-special-keyword 'evaporate))) (beginning-of-line 2))))) @@ -3363,7 +3409,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (if (and (org-at-table-p) org-table-overlay-coordinates) (org-table-align)) (unless org-table-overlay-coordinates - (mapc 'org-delete-overlay org-table-coordinate-overlays) + (mapc 'delete-overlay org-table-coordinate-overlays) (setq org-table-coordinate-overlays nil))) (defun org-table-toggle-formula-debugger () @@ -3401,6 +3447,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." ;; active, this binding is ignored inside tables and replaced with a ;; modified self-insert. + (defvar orgtbl-mode-map (make-keymap) "Keymap for `orgtbl-mode'.") @@ -3410,7 +3457,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (orgtbl-mode 1)) (defvar org-old-auto-fill-inhibit-regexp nil - "Local variable used by `orgtbl-mode'") + "Local variable used by `orgtbl-mode'.") (defconst orgtbl-line-start-regexp "[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\|TBLNAME\\):\\)" @@ -3419,11 +3466,12 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (defconst orgtbl-extra-font-lock-keywords (list (list (concat "^" orgtbl-line-start-regexp ".*") 0 (quote 'org-table) 'prepend)) - "Extra font-lock-keywords to be added when orgtbl-mode is active.") + "Extra `font-lock-keywords' to be added when `orgtbl-mode' is active.") ;; Install it as a minor mode. (put 'orgtbl-mode :included t) (put 'orgtbl-mode :menu-tag "Org Table Mode") + ;;;###autoload (define-minor-mode orgtbl-mode "The `org-mode' table editor as a minor mode for use in other modes." @@ -3451,7 +3499,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (concat orgtbl-line-start-regexp "\\|" auto-fill-inhibit-regexp) orgtbl-line-start-regexp)) - (org-add-to-invisibility-spec '(org-cwidth)) + (add-to-invisibility-spec '(org-cwidth)) (when (fboundp 'font-lock-add-keywords) (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) (org-restart-font-lock)) @@ -3785,13 +3833,13 @@ overwritten, and the table is not marked as requiring realignment." (funcall func table nil))) (defun orgtbl-gather-send-defs () - "Gathers a plist of :name, :transform, :params for each destination before + "Gather a plist of :name, :transform, :params for each destination before a radio table." (save-excursion (goto-char (org-table-begin)) (let (rtn) (beginning-of-line 0) - (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") + (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") (let ((name (org-no-properties (match-string 1))) (transform (intern (match-string 2))) (params (if (match-end 3) @@ -3942,17 +3990,17 @@ First element has index 0, or I0 if given." (defvar *orgtbl-rtn* nil "Formatting routines push the output lines here.") ;; Formatting parameters for the current table section. -(defvar *orgtbl-hline* nil "Text used for horizontal lines") -(defvar *orgtbl-sep* nil "Text used as a column separator") -(defvar *orgtbl-default-fmt* nil "Default format for each entry") -(defvar *orgtbl-fmt* nil "Format for each entry") -(defvar *orgtbl-efmt* nil "Format for numbers") -(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt") -(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row") -(defvar *orgtbl-lstart* nil "Text starting a row") -(defvar *orgtbl-llstart* nil "Specializes lstart for the last row") -(defvar *orgtbl-lend* nil "Text ending a row") -(defvar *orgtbl-llend* nil "Specializes lend for the last row") +(defvar *orgtbl-hline* nil "Text used for horizontal lines.") +(defvar *orgtbl-sep* nil "Text used as a column separator.") +(defvar *orgtbl-default-fmt* nil "Default format for each entry.") +(defvar *orgtbl-fmt* nil "Format for each entry.") +(defvar *orgtbl-efmt* nil "Format for numbers.") +(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.") +(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.") +(defvar *orgtbl-lstart* nil "Text starting a row.") +(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.") +(defvar *orgtbl-lend* nil "Text ending a row.") +(defvar *orgtbl-llend* nil "Specializes lend for the last row.") (defsubst orgtbl-get-fmt (fmt i) "Retrieve the format from FMT corresponding to the Ith column." @@ -4072,6 +4120,7 @@ directly by `orgtbl-send-table'. See manual." (let* ((splicep (plist-get params :splice)) (hline (plist-get params :hline)) (remove-nil-linesp (plist-get params :remove-nil-lines)) + (remove-newlines (plist-get params :remove-newlines)) (*orgtbl-hline* hline) (*orgtbl-table* table) (*orgtbl-sep* (plist-get params :sep)) @@ -4126,9 +4175,13 @@ directly by `orgtbl-send-table'. See manual." (let ((tend (orgtbl-eval-str (plist-get params :tend)))) (if tend (push tend *orgtbl-rtn*))))) - (mapconcat 'identity (nreverse (if remove-nil-linesp - (remq nil *orgtbl-rtn*) - *orgtbl-rtn*)) "\n"))) + (mapconcat (if remove-newlines + (lambda (tend) + (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend)) + 'identity) + (nreverse (if remove-nil-linesp + (remq nil *orgtbl-rtn*) + *orgtbl-rtn*)) "\n"))) (defun orgtbl-to-tsv (table params) "Convert the orgtbl-mode table to TAB separated material." @@ -4179,7 +4232,7 @@ this function is called." (orgtbl-to-generic table (org-combine-plists params2 params)))) (defun orgtbl-to-html (table params) - "Convert the orgtbl-mode TABLE to LaTeX. + "Convert the orgtbl-mode TABLE to HTML. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. PARAMS is a property list of parameters that can influence the conversion. @@ -4254,6 +4307,7 @@ and :tend suppress strings without splicing; they can be set to provide ORGTBL directives for the generated table." (let* ((params2 (list + :remove-newlines t :tstart nil :tend nil :hline "|---" :sep " | " @@ -4301,23 +4355,23 @@ list of the fields in the rectangle ." (setq buffer (marker-buffer id-loc) loc (marker-position id-loc)) (move-marker id-loc nil))) - (switch-to-buffer buffer) - (save-excursion - (save-restriction - (widen) - (goto-char loc) - (forward-char 1) - (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) - (not (match-beginning 1))) - (error "Cannot find a table at NAME or ID %s" name-or-id)) - (setq tbeg (point-at-bol)) - (org-table-get-specials) - (setq form (org-table-formula-substitute-names form)) - (if (and (string-match org-table-range-regexp form) - (> (length (match-string 0 form)) 1)) - (save-match-data - (org-table-get-range (match-string 0 form) tbeg 1)) - form)))))))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char loc) + (forward-char 1) + (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) + (not (match-beginning 1))) + (error "Cannot find a table at NAME or ID %s" name-or-id)) + (setq tbeg (point-at-bol)) + (org-table-get-specials) + (setq form (org-table-formula-substitute-names form)) + (if (and (string-match org-table-range-regexp form) + (> (length (match-string 0 form)) 1)) + (save-match-data + (org-table-get-range (match-string 0 form) tbeg 1)) + form))))))))) (provide 'org-table) diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el new file mode 100644 index 00000000000..da9e156870e --- /dev/null +++ b/lisp/org/org-taskjuggler.el @@ -0,0 +1,648 @@ +;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode +;; +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; +;; Emacs Lisp Archive Entry +;; Filename: org-taskjuggler.el +;; Version: 7.01 +;; Author: Christian Egli +;; Maintainer: Christian Egli +;; Keywords: org, taskjuggler, project planning +;; Description: Converts an org-mode buffer into a taskjuggler project plan +;; URL: + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;; Commentary: +;; +;; This library implements a 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 +;; 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 +;; platform. +;; +;; The exporter is a bit different from other exporters, such as the +;; HTML and LaTeX exporters for example, in that it does not export +;; all the nodes of a document or strictly follow the order of the +;; nodes in the document. +;; +;; 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 +;; and the attributes defined in all the nodes. +;; +;; * Installation +;; +;; Put this file into your load-path and the following line into your +;; ~/.emacs: +;; +;; (require 'org-taskjuggler) +;; +;; The interactive functions are similar to those of the HTML and LaTeX +;; exporters: +;; +;; M-x `org-export-as-taskjuggler' +;; M-x `org-export-as-taskjuggler-and-open' +;; +;; * 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 +;; 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. +;; Now mark the top node of your tasks with a tag named +;; "taskjuggler_project" (or whatever you customized +;; `org-export-taskjuggler-project-tag' to). You are now ready to +;; export the project plan with `org-export-as-taskjuggler-and-open' +;; which will export the project plan and open a gant chart in +;; TaskJugglerUI. +;; +;; * Resources +;; +;; Next you can define resources and assign those to work on specific +;; 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 +;; resources (using the standard org properties commands) or you can +;; let the exporter generate identifiers automatically (the exporter +;; 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 +;; the task type +;; +;; C-c C-x p allocate RET <resource_id> RET +;; +;; Once the allocations are done you can again export to TaskJuggler +;; and check in the Resource Allocation Graph which person is working +;; on what task at what time. +;; +;; * Export of properties +;; +;; The exporter also takes TODO state information into consideration, +;; i.e. if a task is marked as done it will have the corresponding +;; attribute in TaskJuggler ("complete 100"). Also it will export any +;; property on a task resource or resource node which is known to +;; TaskJuggler, such as limits, vacation, shift, booking, efficiency, +;; journalentry, rate for resources or account, start, note, duration, +;; end, journalentry, milestone, reference, responsible, scheduling, +;; etc for tasks. +;; +;; * Dependencies +;; +;; 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 +;; 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 +;; also specify optional attributes on the dependency by simply +;; appending it. The following examples should illustrate this: +;; +;; * Training material +;; :PROPERTIES: +;; :task_id: training_material +;; :ORDERED: t +;; :END: +;; ** Markup Guidelines +;; :PROPERTIES: +;; :Effort: 2.0 +;; :END: +;; ** Workflow Guidelines +;; :PROPERTIES: +;; :Effort: 2.0 +;; :END: +;; * Presentation +;; :PROPERTIES: +;; :Effort: 2.0 +;; :BLOCKER: training_material { gapduration 1d } some_other_task +;; :END: +;; +;;;; * TODO +;; - Use SCHEDULED and DEADLINE information (not just start and end +;; properties). +;; - Look at org-file-properties, org-global-properties and +;; 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 +;; previous-sibling and on a specific task_id) in multiple +;; attributes are properly exported. +;; +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'org) +(require 'org-exp) + +;;; User variables: + +(defgroup org-export-taskjuggler nil + "Options for exporting Org-mode files to TaskJuggler." + :tag "Org Export TaskJuggler" + :group 'org-export) + +(defcustom org-export-taskjuggler-extension ".tjp" + "Extension of TaskJuggler files." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-export-taskjuggler-project-tag "taskjuggler_project" + "Tag, property or todo used to find the tree containing all +the tasks for the project." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-export-taskjuggler-resource-tag "taskjuggler_resource" + "Tag, property or todo used to find the tree containing all the +resources for the project." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-export-taskjuggler-default-project-version "1.0" + "Default version string for the project." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-export-taskjuggler-default-project-duration 280 + "Default project duration if no start and end date have been defined +in the root node of the task tree, i.e. the tree that has been marked +with `org-export-taskjuggler-project-tag'" + :group 'org-export-taskjuggler + :type 'integer) + +(defcustom org-export-taskjuggler-default-reports + '("taskreport \"Gantt Chart\" { + headline \"Project Gantt Chart\" + columns hierarchindex, name, start, end, effort, duration, completed, chart + timeformat \"%Y-%m-%d\" + hideresource 1 + loadunit shortauto +}" +"resourcereport \"Resource Graph\" { + headline \"Resource Allocation Graph\" + columns no, name, utilization, freeload, chart + loadunit shortauto + sorttasks startup + hidetask ~isleaf() +}") + "Default reports for the project." + :group 'org-export-taskjuggler + :type '(repeat (string :tag "Report"))) + +(defcustom org-export-taskjuggler-default-global-properties + "shift s40 \"Part time shift\" { + workinghours wed, thu, fri off +} +" + "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 +include another TaskJuggler file. + +The global properties are inserted after the project declaration +but before any resource and task declarations." + :group 'org-export-taskjuggler + :type '(string :tag "Preamble")) + +;;; Hooks + +(defvar org-export-taskjuggler-final-hook nil + "Hook run at the end of TaskJuggler export, in the new buffer.") + +;;; Autoload functions: + +;; avoid compiler warning about free variable +(defvar org-export-taskjuggler-old-level) + +;;;###autoload +(defun org-export-as-taskjuggler () + "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 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 +the taskjuggler project will be created with default reports as +defined in `org-export-taskjuggler-default-reports'." + (interactive) + + (message "Exporting...") + (setq-default org-done-keywords org-done-keywords) + (let* ((tasks + (org-taskjuggler-resolve-dependencies + (org-taskjuggler-assign-task-ids + (org-map-entries + '(org-taskjuggler-components) + org-export-taskjuggler-project-tag nil 'archive 'comment)))) + (resources + (org-taskjuggler-assign-resource-ids + (org-map-entries + '(org-taskjuggler-components) + org-export-taskjuggler-resource-tag nil 'archive 'comment))) + (filename (expand-file-name + (concat + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + org-export-taskjuggler-extension))) + (buffer (find-file-noselect filename)) + (org-export-taskjuggler-old-level 0) + task resource) + (unless tasks + (error "No tasks specified")) + ;; add a default resource + (unless resources + (setq resources + `((("resource_id" . ,(user-login-name)) + ("headline" . ,user-full-name) + ("level" . 1))))) + ;; add a default allocation to the first task if none was given + (unless (assoc "allocate" (car tasks)) + (let ((task (car tasks)) + (resource-id (cdr (assoc "resource_id" (car resources))))) + (setcar tasks (push (cons "allocate" resource-id) task)))) + ;; add a default start date to the first task if none was given + (unless (assoc "start" (car tasks)) + (let ((task (car tasks)) + (time-string (format-time-string "%Y-%m-%d"))) + (setcar tasks (push (cons "start" time-string) task)))) + ;; add a default version if none was given + (unless (assoc "version" (car tasks)) + (let ((task (car tasks)) + (version org-export-taskjuggler-default-project-version)) + (setcar tasks (push (cons "version" version) task)))) + (with-current-buffer buffer + (erase-buffer) + (org-taskjuggler-open-project (car tasks)) + (insert org-export-taskjuggler-default-global-properties) + (insert "\n") + (dolist (resource resources) + (let ((level (cdr (assoc "level" resource)))) + (org-taskjuggler-close-maybe level) + (org-taskjuggler-open-resource resource) + (setq org-export-taskjuggler-old-level level))) + (org-taskjuggler-close-maybe 1) + (setq org-export-taskjuggler-old-level 0) + (dolist (task tasks) + (let ((level (cdr (assoc "level" task)))) + (org-taskjuggler-close-maybe level) + (org-taskjuggler-open-task task) + (setq org-export-taskjuggler-old-level level))) + (org-taskjuggler-close-maybe 1) + (org-taskjuggler-insert-reports) + (save-buffer) + (or (org-export-push-to-kill-ring "TaskJuggler") + (message "Exporting... done")) + (current-buffer)))) + +;;;###autoload +(defun org-export-as-taskjuggler-and-open () + "Export the current buffer as a TaskJuggler file and open it +with the TaskJuggler GUI." + (interactive) + (let* ((file-name (buffer-file-name (org-export-as-taskjuggler))) + (process-name "TaskJugglerUI") + (command (concat process-name " " file-name))) + (start-process-shell-command process-name nil command))) + +(defun org-taskjuggler-parent-is-ordered-p () + "Return true if the parent of the current node has a property +\"ORDERED\". Return nil otherwise." + (save-excursion + (and (org-up-heading-safe) (org-entry-get (point) "ORDERED")))) + +(defun org-taskjuggler-components () + "Return an alist containing all the pertinent information for +the current node such as the headline, the level, todo state +information, all the properties, etc." + (let* ((props (org-entry-properties)) + (components (org-heading-components)) + (level (nth 1 components)) + (headline (nth 4 components)) + (parent-ordered (org-taskjuggler-parent-is-ordered-p))) + (push (cons "level" level) props) + (push (cons "headline" headline) props) + (push (cons "parent-ordered" parent-ordered) props))) + +(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. +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) + unique-ids unique-id + path + task resolved-tasks tmp) + (dolist (task tasks resolved-tasks) + (let ((level (cdr (assoc "level" task)))) + (cond + ((< previous-level level) + (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) + (dotimes (tmp (- level previous-level)) + (push (list unique-id) unique-ids) + (push unique-id path))) + ((= previous-level level) + (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) + (push unique-id (car unique-ids)) + (setcar path unique-id)) + ((> previous-level level) + (dotimes (tmp (- previous-level level)) + (pop unique-ids) + (pop path)) + (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) + (push unique-id (car unique-ids)) + (setcar path unique-id))) + (push (cons "unique-id" unique-id) task) + (push (cons "path" (mapconcat 'identity (reverse path) ".")) task) + (setq previous-level level) + (setq resolved-tasks (append resolved-tasks (list task))))))) + +(defun org-taskjuggler-assign-resource-ids (resources &optional unique-ids) + "Given a list of resources return the same list, assigning a +unique id to each resource." + (cond + ((null resources) nil) + (t + (let* ((resource (car resources)) + (unique-id (org-taskjuggler-get-unique-id resource unique-ids))) + (push (cons "unique-id" unique-id) resource) + (cons resource + (org-taskjuggler-assign-resource-ids (cdr resources) + (cons unique-id unique-ids))))))) + +(defun org-taskjuggler-resolve-dependencies (tasks) + (let ((previous-level 0) + siblings + task resolved-tasks) + (dolist (task tasks resolved-tasks) + (let* ((level (cdr (assoc "level" task))) + (depends (cdr (assoc "depends" task))) + (parent-ordered (cdr (assoc "parent-ordered" task))) + (blocker (cdr (assoc "BLOCKER" task))) + (blocked-on-previous + (and blocker (string-match "previous-sibling" blocker))) + (dependencies + (org-taskjuggler-resolve-explicit-dependencies + (append + (and depends (org-taskjuggler-tokenize-dependencies depends)) + (and blocker (org-taskjuggler-tokenize-dependencies blocker))) + tasks)) + previous-sibling) + ; update previous sibling info + (cond + ((< previous-level level) + (dotimes (tmp (- level previous-level)) + (push task siblings))) + ((= previous-level level) + (setq previous-sibling (car siblings)) + (setcar siblings task)) + ((> previous-level level) + (dotimes (tmp (- previous-level level)) + (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" + (when (or (and previous-sibling parent-ordered) blocked-on-previous) + (push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies)) + ; store dependency information + (when dependencies + (push (cons "depends" (mapconcat 'identity dependencies ", ")) task)) + (setq previous-level level) + (setq resolved-tasks (append resolved-tasks (list task))))))) + +(defun org-taskjuggler-tokenize-dependencies (dependencies) + "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_]+'." + (cond + ((string-match "^ *$" dependencies) nil) + ((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies) + (cons + (substring dependencies (match-beginning 1) (match-end 1)) + (org-taskjuggler-tokenize-dependencies (substring dependencies (match-end 0))))) + (t (error (format "invalid dependency id %s" dependencies))))) + +(defun org-taskjuggler-resolve-explicit-dependencies (dependencies tasks) + "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 +\"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 ." + (unless (null dependencies) + (let* + ;; the dependency might have optional attributes such as "{ + ;; gapduration 5d }", so only use the first string as id for the + ;; dependency + ((dependency (car dependencies)) + (id (car (split-string dependency))) + (optional-attributes + (mapconcat 'identity (cdr (split-string dependency)) " ")) + (path (org-taskjuggler-find-task-with-id id tasks))) + (cond + ;; ignore previous sibling dependencies + ((equal (car dependencies) "previous-sibling") + (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)) + ;; if the id is found in another task use its path + ((not (null path)) + (cons (mapconcat 'identity (list path optional-attributes) " ") + (org-taskjuggler-resolve-explicit-dependencies + (cdr dependencies) tasks))) + ;; warn about dangling dependency but otherwise ignore it + (t (display-warning + 'org-export-taskjuggler + (format "No task with matching property \"task_id\" found for id %s" id)) + (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 +return nil." + (let ((task-id (cdr (assoc "task_id" (car tasks)))) + (path (cdr (assoc "path" (car tasks))))) + (cond + ((null tasks) nil) + ((equal task-id id) path) + (t (org-taskjuggler-find-task-with-id id (cdr tasks)))))) + +(defun org-taskjuggler-get-unique-id (item unique-ids) + "Return a unique id for an ITEM which can be a task or a resource. +The id is derived from the headline and made unique against +UNIQUE-IDS. If the (downcased) first token of the headline is not +unique try to add more (downcased) tokens of the headline or +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 + (while (member id unique-ids) + (setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts)))))) + ; if its still not unique add "_" + (while (member id unique-ids) + (setq id (concat id "_"))) + id)) + +(defun org-taskjuggler-clean-id (id) + "Clean and return ID to make it acceptable for taskjuggler." + (and id (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" 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 +specified it is calculated +`org-export-taskjuggler-default-project-duration' days from now." + (let* ((unique-id (cdr (assoc "unique-id" project))) + (headline (cdr (assoc "headline" project))) + (version (cdr (assoc "version" project))) + (start (cdr (assoc "start" project))) + (end (cdr (assoc "end" project)))) + (insert + (format "project %s \"%s\" \"%s\" %s +%sd {\n }\n" + unique-id headline version start + org-export-taskjuggler-default-project-duration)))) + +(defun org-taskjuggler-filter-and-join (items) + "Filter all nil elements from ITEMS and join the remaining ones +with separator \"\n\"." + (let ((filtered-items (remq nil items))) + (and filtered-items (mapconcat 'identity filtered-items "\n")))) + +(defun org-taskjuggler-get-attributes (item attributes) + "Return all attribute as a single formated 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 + (lambda (attribute) + (org-taskjuggler-filter-and-join + (org-taskjuggler-get-attribute item attribute))) + attributes))) + +(defun org-taskjuggler-get-attribute (item attribute) + "Return a list of strings containing the properly formatted +taskjuggler declaration for a given ATTRIBUTE in ITEM (an alist). +If the ATTRIBUTE is not in ITEM return nil." + (cond + ((null item) nil) + ((equal (symbol-name attribute) (car (car item))) + (cons (format "%s %s" (symbol-name attribute) (cdr (car item))) + (org-taskjuggler-get-attribute (cdr item) attribute))) + (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 +defines a property \"resource_id\" it will be used as the id for +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 + (or (cdr (assoc "resource_id" resource)) + (cdr (assoc "ID" resource)) + (cdr (assoc "unique-id" resource))))) + (headline (cdr (assoc "headline" resource))) + (attributes '(limits vacation shift booking efficiency journalentry rate))) + (insert + (concat + "resource " id " \"" headline "\" {\n " + (org-taskjuggler-get-attributes resource attributes) "\n")))) + +(defun org-taskjuggler-clean-effort (effort) + "Translate effort strings into a format acceptable to taskjuggler, +i.e. REAL UNIT. If the effort string is something like 5:30 it +will be assumed to be hours and will be translated into 5.5h. +Otherwise if it contains something like 3.0 it is assumed to be +days and will be translated into 3.0d. Other formats that +taskjuggler supports (like weeks, months and years) are currently +not supported." + (cond + ((null effort) effort) + ((string-match "\\([0-9]+\\):\\([0-9]+\\)" effort) + (let ((hours (string-to-number (match-string 1 effort))) + (minutes (string-to-number (match-string 2 effort)))) + (format "%dh" (+ hours (/ minutes 60.0))))) + ((string-match "\\([0-9]+\\).\\([0-9]+\\)" effort) (concat effort "d")) + (t (error "Not a valid effort (%s)" effort)))) + +(defun org-taskjuggler-get-priority (priority) + "Return a priority between 1 and 1000 based on PRIORITY, an +org-mode priority string." + (max 1 (/ (* 1000 (- org-lowest-priority (string-to-char priority))) + (- org-lowest-priority org-highest-priority)))) + +(defun org-taskjuggler-open-task (task) + (let* ((unique-id (cdr (assoc "unique-id" task))) + (headline (cdr (assoc "headline" task))) + (effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task)))) + (depends (cdr (assoc "depends" task))) + (allocate (cdr (assoc "allocate" task))) + (priority-raw (cdr (assoc "PRIORITY" task))) + (priority (and priority-raw (org-taskjuggler-get-priority priority-raw))) + (state (cdr (assoc "TODO" task))) + (complete (or (and (member state org-done-keywords) "100") + (cdr (assoc "complete" task)))) + (parent-ordered (cdr (assoc "parent-ordered" task))) + (previous-sibling (cdr (assoc "previous-sibling" task))) + (attributes + '(account start note duration endbuffer endcredit end + flags journalentry length maxend maxstart milestone + minend minstart period reference responsible + scheduling startbuffer startcredit statusnote))) + (insert + (concat + "task " unique-id " \"" headline "\" {\n" + (if (and parent-ordered previous-sibling) + (format " depends %s\n" previous-sibling) + (and depends (format " depends %s\n" depends))) + (and allocate (format " purge allocations\n allocate %s\n" allocate)) + (and complete (format " complete %s\n" complete)) + (and effort (format " effort %s\n" effort)) + (and priority (format " priority %s\n" priority)) + + (org-taskjuggler-get-attributes task attributes) + "\n")))) + +(defun org-taskjuggler-close-maybe (level) + (while (> org-export-taskjuggler-old-level level) + (insert "}\n") + (setq org-export-taskjuggler-old-level (1- org-export-taskjuggler-old-level))) + (when (= org-export-taskjuggler-old-level level) + (insert "}\n"))) + +(defun org-taskjuggler-insert-reports () + (let (report) + (dolist (report org-export-taskjuggler-default-reports) + (insert report "\n")))) + +(provide 'org-taskjuggler) + +;;; org-taskjuggler.el ends here diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index 91664eb7b1a..b773274e93b 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -27,6 +27,8 @@ ;; This file contains the relative timer code for Org-mode +;;; Code: + (require 'org) (declare-function org-show-notification "org-clock" (parameters)) @@ -48,6 +50,12 @@ the value of the relative timer." :group 'org-time :type 'string) +(defcustom org-timer-default-timer 0 + "The default timer when a timer is set. +When 0, the user is prompted for a value." + :group 'org-time + :type 'number) + (defvar org-timer-start-hook nil "Hook run after relative timer is started.") @@ -96,7 +104,7 @@ the region 0:00:00." (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) (setq org-timer-start-time (seconds-to-time - (- (org-float-time) (org-timer-hms-to-secs s))))) + (- (org-float-time) delta)))) (org-timer-set-mode-line 'on) (message "Timer start time set to %s, current value is %s" (format-time-string "%T" org-timer-start-time) @@ -104,7 +112,8 @@ the region 0:00:00." (run-hooks 'org-timer-start-hook)))) (defun org-timer-pause-or-continue (&optional stop) - "Pause or continue the relative timer. With prefix arg, stop it entirely." + "Pause or continue the relative timer. +With prefix arg STOP, stop it entirely." (interactive "P") (cond (stop (org-timer-stop)) @@ -139,8 +148,9 @@ the region 0:00:00." (defun org-timer (&optional restart) "Insert a H:MM:SS string from the timer into the buffer. The first time this command is used, the timer is started. When used with -a `C-u' prefix, force restarting the timer. -When used with a double prefix arg `C-u C-u', change all the timer string +a \\[universal-argument] prefix, force restarting the timer. +When used with a double prefix argument \ +\\[universal-argument] \\universal-argument], change all the timer string in the region by a fixed amount. This can be used to recalibrate a timer that was not started at the correct moment." (interactive "P") @@ -299,12 +309,37 @@ VALUE can be `on', `off', or `pause'." (message "%d minute(s) %d seconds left before next time out" rmins rsecs)))) +(defun bzg-test (&optional test) + (interactive "P") + test) + ;;;###autoload -(defun org-timer-set-timer (minutes) - "Set a timer." - (interactive "sTime out in (min)? ") - (if (not (string-match "[0-9]+" minutes)) - (org-timer-show-remaining-time) +(defun org-timer-set-timer (&optional opt) + "Prompt for a duration and set a timer. + +If `org-timer-default-timer' is not zero, suggest this value as +the default duration for the timer. If a timer is already set, +prompt the use if she wants to replace it. + +Called with a numeric prefix argument, use this numeric value as +the duration of the timer. + +Called with a `C-u' prefix arguments, use `org-timer-default-timer' +without prompting the user for a duration. + +With two `C-u' prefix arguments, use `org-timer-default-timer' +without prompting the user for a duration and automatically +replace any running timer." + (interactive "P") + (let ((minutes (or (and (numberp opt) (number-to-string opt)) + (and (listp opt) (not (null opt)) + (number-to-string org-timer-default-timer)) + (read-from-minibuffer + "How many minutes left? " + (if (not (eq org-timer-default-timer 0)) + (number-to-string org-timer-default-timer)))))) + (if (not (string-match "[0-9]+" minutes)) + (org-timer-show-remaining-time) (let* ((mins (string-to-number (match-string 0 minutes))) (secs (* mins 60)) (hl (cond @@ -323,15 +358,21 @@ VALUE can be `on', `off', or `pause'." (org-get-heading)) (t (error "Not in an Org buffer")))) timer-set) - (if org-timer-current-timer - (error "You cannot run several timers at the same time") - (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) - (run-hooks 'org-timer-done-hook)))) - (run-hooks 'org-timer-set-hook))))) + (if (or (and org-timer-current-timer + (or (equal opt '(16)) + (y-or-n-p "Replace current timer? "))) + (not org-timer-current-timer)) + (progn + (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) + (run-hooks 'org-timer-done-hook)))) + (run-hooks 'org-timer-set-hook)) + (message "No timer set")))))) (provide 'org-timer) diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el index 5677fe74644..4a28df6caa0 100644 --- a/lisp/org/org-vm.el +++ b/lisp/org/org-vm.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index 24b5f4e7c3c..b457156f573 100644 --- a/lisp/org/org-w3m.el +++ b/lisp/org/org-w3m.el @@ -5,7 +5,7 @@ ;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -28,11 +28,11 @@ ;; This file implements copying HTML content from a w3m buffer and ;; transforming the text on the fly so that it can be pasted into ;; an org-mode buffer with hot links. It will also work for regions -;; in gnus buffers that have ben washed with w3m. +;; in gnus buffers that have been washed with w3m. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -;;; Acknowledgements: +;;; Acknowledgments: ;; Richard Riley <rileyrgdev at googlemail dot com> ;; @@ -40,8 +40,9 @@ ;; proposed by Richard, I'm just coding it. ;; +;;; Code: + (require 'org) -(declare-function w3m-anchor "ext:w3m-util" (position)) (defun org-w3m-copy-for-org-mode () "Copy current buffer content or active region with `org-mode' style links. @@ -68,7 +69,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." ;; store current point before jump next anchor (setq temp-position (point)) ;; move to next anchor when current point is not at anchor - (or (w3m-anchor (point)) (org-w3m-get-next-link-start)) + (or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start)) (if (<= (point) transform-end) ; if point is inside transform bound (progn ;; get content between two links. @@ -77,7 +78,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (buffer-substring temp-position (point))))) ;; get link location at current point. - (setq link-location (w3m-anchor (point))) + (setq link-location (get-text-property (point) 'w3m-href-anchor)) ;; get link title at current point. (setq link-title (buffer-substring (point) (org-w3m-get-anchor-end))) @@ -115,7 +116,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (while (next-single-property-change (point) 'w3m-anchor-sequence) ;; jump to next anchor (goto-char (next-single-property-change (point) 'w3m-anchor-sequence)) - (when (w3m-anchor (point)) + (when (get-text-property (point) 'w3m-href-anchor) ;; return point when current is valid link (throw 'reach nil)))) (point)) @@ -126,7 +127,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (while (previous-single-property-change (point) 'w3m-anchor-sequence) ;; jump to previous anchor (goto-char (previous-single-property-change (point) 'w3m-anchor-sequence)) - (when (w3m-anchor (point)) + (when (get-text-property (point) 'w3m-href-anchor) ;; return point when current is valid link (throw 'reach nil)))) (point)) diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index e0b438f0111..4d2f8ec1280 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -4,9 +4,10 @@ ;; Free Software Foundation, Inc. ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> +;; David Maus <dmaus at ictsoc dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -40,9 +41,36 @@ :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." - :group 'org-wl - :type 'boolean) + "Create a link to the refile destination if the message is marked as refile." + :group 'org-wl + :type 'boolean) + +(defcustom org-wl-link-remove-filter nil + "Remove filter condition if message is filter folder." + :group 'org-wl + :type 'boolean) + +(defcustom org-wl-shimbun-prefer-web-links nil + "If non-nil create web links for shimbun messages." + :group 'org-wl + :type 'boolean) + +(defcustom org-wl-nntp-prefer-web-links nil + "If non-nil create web links for nntp messages. +When folder name contains string \"gmane\" link to gmane, +googlegroups otherwise." + :type 'boolean + :group 'org-wl) + +(defcustom org-wl-disable-folder-check t + "Disable check for new messages when open a link." + :type 'boolean + :group 'org-wl) + +(defcustom org-wl-namazu-default-index nil + "Default namazu search index." + :type 'directory + :group 'org-wl) ;; Declare external functions and variables (declare-function elmo-folder-exists-p "ext:elmo" (folder) t) @@ -63,84 +91,185 @@ (declare-function wl-summary-registered-temp-mark "ext:wl-action" (number)) (declare-function wl-folder-goto-folder-subr "ext:wl-folder" (&optional folder sticky)) +(declare-function wl-folder-get-petname "ext:wl-folder" (name)) +(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder" + (&optional getid)) +(declare-function wl-folder-buffer-group-p "ext:wl-folder") (defvar wl-init) (defvar wl-summary-buffer-elmo-folder) (defvar wl-summary-buffer-folder-name) +(defvar wl-folder-group-regexp) +(defvar wl-auto-check-folder-name) + +(defconst org-wl-folder-types + '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool) + ("$" . archive) ("&" . pop) ("@" . shimbun) ("[" . search) + ("*" . multi) ("/" . filter) ("|" . pipe) ("'" . internal)) + "List of folder indicators. See Wanderlust manual, section 3.") ;; Install the link type (org-add-link-type "wl" 'org-wl-open) (add-hook 'org-store-link-functions 'org-wl-store-link) ;; Implementation + +(defun org-wl-folder-type (folder) + "Return symbol that indicates the type of FOLDER. +FOLDER is the wanderlust folder name. The first character of the +folder name determines the the folder type." + (let* ((indicator (substring folder 0 1)) + (type (cdr (assoc indicator org-wl-folder-types)))) + ;; maybe access or file folder + (when (not type) + (setq type + (cond + ((and (>= (length folder) 5) + (string= (substring folder 0 5) "file:")) + 'file) + ((and (>= (length folder) 7) + (string= (substring folder 0 7) "access:")) + 'access) + (t + nil)))) + type)) + +(defun org-wl-message-field (field entity) + "Return content of FIELD in ENTITY. +FIELD is a symbol of a rfc822 message header field. +ENTITY is a message entity." + (let ((content (elmo-message-entity-field entity field))) + (if (listp content) (car content) content))) + (defun org-wl-store-link () - "Store a link to a WL folder or message." - (when (eq major-mode 'wl-summary-mode) - (let* ((msgnum (wl-summary-message-number)) - (mark-info (wl-summary-registered-temp-mark msgnum)) - (folder-name - (if (and org-wl-link-to-refile-destination - mark-info - (equal (nth 1 mark-info) "o")) ; marked as refile - (nth 2 mark-info) - wl-summary-buffer-folder-name)) - (message-id (elmo-message-field wl-summary-buffer-elmo-folder - msgnum 'message-id)) - (wl-message-entity - (if (fboundp 'elmo-message-entity) - (elmo-message-entity - wl-summary-buffer-elmo-folder msgnum) - (elmo-msgdb-overview-get-entity - msgnum (wl-summary-buffer-msgdb)))) - (from (let ((from-field (elmo-message-entity-field wl-message-entity - 'from))) - (if (listp from-field) - (car from-field) - from-field))) - (to (let ((to-field (elmo-message-entity-field wl-message-entity - 'to))) - (if (listp to-field) - (car to-field) - to-field))) - (subject (let (wl-thr-indent-string wl-parent-message-entity) - (wl-summary-line-subject))) - desc link) - ;; remove text properties of subject string to avoid possible bug - ;; when formatting the subject - (set-text-properties 0 (length subject) nil subject) - - (org-store-link-props :type "wl" :from from :to to - :subject subject :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq desc (org-email-link-description)) - (setq link (org-make-link "wl:" folder-name - "#" message-id)) - (org-add-link-props :link link :description desc) - link))) + "Store a link to a WL message or folder." + (cond + ((memq major-mode '(wl-summary-mode mime-view-mode)) + (org-wl-store-link-message)) + ((eq major-mode 'wl-folder-mode) + (org-wl-store-link-folder)) + (t + nil))) + +(defun org-wl-store-link-folder () + "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))) + (save-excursion + (beginning-of-line) + (unless (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) + (org-store-link-props :type "wl" :description petname + :link link) + link)))) + +(defun org-wl-store-link-message () + "Store a link to a WL message." + (save-excursion + (let ((buf (if (eq major-mode 'wl-summary-mode) + (current-buffer) + (and (boundp 'wl-message-buffer-cur-summary-buffer) + wl-message-buffer-cur-summary-buffer)))) + (when buf + (with-current-buffer buf + (let* ((msgnum (wl-summary-message-number)) + (mark-info (wl-summary-registered-temp-mark msgnum)) + (folder-name + (if (and org-wl-link-to-refile-destination + mark-info + (equal (nth 1 mark-info) "o")) ; marked as refile + (nth 2 mark-info) + wl-summary-buffer-folder-name)) + (folder-type (org-wl-folder-type folder-name)) + (wl-message-entity + (if (fboundp 'elmo-message-entity) + (elmo-message-entity + wl-summary-buffer-elmo-folder msgnum) + (elmo-msgdb-overview-get-entity + msgnum (wl-summary-buffer-msgdb)))) + (message-id + (org-wl-message-field 'message-id wl-message-entity)) + (from (org-wl-message-field 'from wl-message-entity)) + (to (org-wl-message-field 'to wl-message-entity)) + (xref (org-wl-message-field 'xref wl-message-entity)) + (subject (org-wl-message-field 'subject wl-message-entity)) + desc link) + + ;; remove text properties of subject string to avoid possible bug + ;; when formatting the subject + ;; (Emacs bug #5306, fixed) + (set-text-properties 0 (length subject) nil subject) + + ;; maybe remove filter condition + (when (and (eq folder-type 'filter) org-wl-link-remove-filter) + (while (eq (org-wl-folder-type folder-name) 'filter) + (setq folder-name + (replace-regexp-in-string "^/[^/]+/" "" folder-name)))) + + ;; maybe create http link + (cond + ((and (eq folder-type 'shimbun) + org-wl-shimbun-prefer-web-links xref) + (org-store-link-props :type "http" :link xref :description subject + :from from :to to :message-id message-id + :subject subject)) + ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links) + (setq link + (format + (if (string-match "gmane\\." folder-name) + "http://mid.gmane.org/%s" + "http://groups.google.com/groups/search?as_umsgid=%s") + (org-fixup-message-id-for-http message-id))) + (org-store-link-props :type "http" :link link :description subject + :from from :to to :message-id message-id + :subject subject)) + (t + (org-store-link-props :type "wl" :from from :to to + :subject subject :message-id message-id) + (setq message-id (org-remove-angle-brackets message-id)) + (setq desc (org-email-link-description)) + (setq link (org-make-link "wl:" folder-name "#" message-id)) + (org-add-link-props :link link :description desc))) + (or link xref))))))) (defun org-wl-open (path) - "Follow the WL message link specified by PATH." - (require 'wl) - (unless wl-init (wl)) - ;; XXX: The imap-uw's MH folder names start with "%#". - (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in Wanderlust link")) - (let ((folder (match-string 1 path)) - (article (match-string 3 path))) - (if (not (elmo-folder-exists-p (org-no-warnings - (wl-folder-get-elmo-folder folder)))) - (error "No such folder: %s" folder)) - (let ((old-buf (current-buffer)) - (old-point (point-marker))) - (wl-folder-goto-folder-subr folder) - (save-excursion - ;; XXX: `wl-folder-goto-folder-subr' moves point to the - ;; beginning of the current line. So, restore the point - ;; in the old buffer. - (set-buffer old-buf) - (goto-char old-point)) - (and (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets - article)) - (wl-summary-redisplay))))) + "Follow the WL message link specified by PATH. +When called with one prefix, open message in namazu search folder +with `org-wl-namazu-default-index' as search index. When called +with two prefixes or `org-wl-namazu-default-index' is nil, ask +for namazu index." + (require 'wl) + (let ((wl-auto-check-folder-name + (if org-wl-disable-folder-check + 'none + wl-auto-check-folder-name))) + (unless wl-init (wl)) + ;; XXX: The imap-uw's MH folder names start with "%#". + (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in Wanderlust link")) + (let ((folder (match-string 1 path)) + (article (match-string 3 path))) + ;; maybe open message in namazu search folder + (when current-prefix-arg + (setq folder (concat "[" article "]" + (if (and (equal current-prefix-arg '(4)) + org-wl-namazu-default-index) + org-wl-namazu-default-index + (read-directory-name "Namazu index: "))))) + (if (not (elmo-folder-exists-p (org-no-warnings + (wl-folder-get-elmo-folder folder)))) + (error "No such folder: %s" folder)) + (let ((old-buf (current-buffer)) + (old-point (point-marker))) + (wl-folder-goto-folder-subr folder) + (with-current-buffer old-buf + ;; XXX: `wl-folder-goto-folder-subr' moves point to the + ;; beginning of the current line. So, restore the point + ;; in the old buffer. + (goto-char old-point)) + (and article (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets + article)) + (wl-summary-redisplay)))))) (provide 'org-wl) diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el index 6a907f2267a..af501058e86 100644 --- a/lisp/org/org-xoxo.el +++ b/lisp/org/org-xoxo.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -25,10 +25,11 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: +;; XOXO export -(require 'org-exp) +;;; Code: -;;; XOXO export +(require 'org-exp) (defvar org-export-xoxo-final-hook nil "Hook run after XOXO export, in the new buffer.") diff --git a/lisp/org/org.el b/lisp/org/org.el index 7aa385fee9d..5b37e0aa260 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -72,8 +72,20 @@ (eval-when-compile (require 'cl) - (require 'gnus-sum) - (require 'calendar)) + (require 'gnus-sum)) + +(require 'calendar) +;; Emacs 22 calendar compatibility: Make sure the new variables are available +(when (fboundp 'defvaralias) + (unless (boundp 'calendar-view-holidays-initially-flag) + (defvaralias 'calendar-view-holidays-initially-flag + 'view-calendar-holidays-initially)) + (unless (boundp 'calendar-view-diary-initially-flag) + (defvaralias 'calendar-view-diary-initially-flag + 'view-diary-entries-initially)) + (unless (boundp 'diary-fancy-buffer) + (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))) + ;; For XEmacs, noutline is not yet provided by outline.el, so arrange for ;; the file noutline.el being loaded. (if (featurep 'xemacs) (condition-case nil (require 'noutline))) @@ -83,6 +95,7 @@ (require 'time-date) (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) (require 'easymenu) +(require 'overlay) (require 'org-macs) (require 'org-entities) @@ -92,11 +105,86 @@ (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) + +;; load languages based on value of `org-babel-load-languages' +(defvar org-babel-load-languages) +;;;###autoload +(defun org-babel-do-load-languages (sym value) + "Load the languages defined in `org-babel-load-languages'." + (set-default sym value) + (mapc (lambda (pair) + (let ((active (cdr pair)) (lang (symbol-name (car pair)))) + (if active + (progn + (require (intern (concat "ob-" lang)))) + (progn + (funcall 'fmakunbound + (intern (concat "org-babel-execute:" lang))) + (funcall 'fmakunbound + (intern (concat "org-babel-expand-body:" lang))))))) + org-babel-load-languages)) + +(defcustom org-babel-load-languages '((emacs-lisp . t)) + "Languages which can be evaluated in Org-mode buffers. +This list can be used to load support for any of the languages +below, note that each language will depend on a different set of +system executables and/or Emacs modes. When a language is +\"loaded\", then code blocks in that language can be evaluated +with `org-babel-execute-src-block' bound by default to C-c +C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can +be set to remove code block evaluation from the C-c C-c +keybinding. By default only Emacs Lisp (which has no +requirements) is loaded." + :group 'org-babel + :set 'org-babel-do-load-languages + :type '(alist :tag "Babel Languages" + :key-type + (choice + (const :tag "C" C) + (const :tag "R" R) + (const :tag "Asymptote" asymptote) + (const :tag "Clojure" clojure) + (const :tag "CSS" css) + (const :tag "Ditaa" ditaa) + (const :tag "Dot" dot) + (const :tag "Emacs Lisp" emacs-lisp) + (const :tag "Gnuplot" gnuplot) + (const :tag "Haskell" haskell) + (const :tag "Latex" latex) + (const :tag "Matlab" matlab) + (const :tag "Mscgen" mscgen) + (const :tag "Ocaml" ocaml) + (const :tag "Octave" octave) + (const :tag "Perl" perl) + (const :tag "Python" python) + (const :tag "Ruby" ruby) + (const :tag "Sass" sass) + (const :tag "Screen" screen) + (const :tag "Shell Script" sh) + (const :tag "Sql" sql) + (const :tag "Sqlite" sqlite)) + :value-type (boolean :tag "Activate" :value t))) + ;;;; Customization variables +(defcustom org-clone-delete-id nil + "Remove ID property of clones of a subtree. +When non-nil, clones of a subtree don't inherit the ID property. +Otherwise they inherit the ID property with a new unique +identifier." + :type 'boolean + :group 'org-id) ;;; Version -(defconst org-version "6.35i" +(defconst org-version "7.01" "The version number of the file org.el.") (defun org-version (&optional here) @@ -228,6 +316,7 @@ to add the symbol `xyz', and the package must have a call to (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) + (const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber) (const :tag "C man: Support for links to manpages in Org-mode" org-man) (const :tag "C mtags: Support for muse-like tags" org-mtags) (const :tag "C panel: Simple routines for us with bad memory" org-panel) @@ -239,13 +328,14 @@ to add the symbol `xyz', and the package must have a call to (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) (const :tag "C track: Keep up with Org-mode development" org-track) + (const :tag "C TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start -selecting a region, or enlarge thusly regions started in this way. +selecting a region, or enlarge regions started in this way. In Org-mode, in special contexts, these same keys are used for other purposes, important enough to compete with shift selection. Org tries to balance these needs by supporting `shift-select-mode' outside these @@ -324,6 +414,40 @@ the following lines anywhere in the buffer: (const :tag "Not" nil) (const :tag "Globally (slow on startup in large files)" t))) +(defcustom org-use-sub-superscripts t + "Non-nil means interpret \"_\" and \"^\" for export. +When this option is turned on, you can use TeX-like syntax for sub- and +superscripts. Several characters after \"_\" or \"^\" will be +considered as a single item - so grouping with {} is normally not +needed. For example, the following things will be parsed as single +sub- or superscripts. + + 10^24 or 10^tau several digits will be considered 1 item. + 10^-12 or 10^-tau a leading sign with digits or a word + x^2-y^3 will be read as x^2 - y^3, because items are + terminated by almost any nonword/nondigit char. + x_{i^2} or x^(2-i) braces or parenthesis do grouping. + +Still, ambiguity is possible - so when in doubt use {} to enclose the +sub/superscript. If you set this variable to the symbol `{}', +the braces are *required* in order to trigger interpretations as +sub/superscript. This can be helpful in documents that need \"_\" +frequently in plain text. + +Not all export backends support this, but HTML does. + +This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." + :group 'org-startup + :group 'org-export-translation + :type '(choice + (const :tag "Always interpret" t) + (const :tag "Only with braces" {}) + (const :tag "Never interpret" nil))) + +(if (fboundp 'defvaralias) + (defvaralias 'org-export-with-sub-superscripts 'org-use-sub-superscripts)) + + (defcustom org-startup-with-beamer-mode nil "Non-nil means turn on `org-beamer-mode' on startup. This can also be configured on a per-file basis by adding one of @@ -371,10 +495,10 @@ become effective." :type 'boolean) (defcustom org-use-extra-keys nil - "Non-nil means use extra key sequence definitions for certain -commands. This happens automatically if you run XEmacs or if -window-system is nil. This variable lets you do the same -manually. You must set it before loading org. + "Non-nil means use extra key sequence definitions for certain commands. +This happens automatically if you run XEmacs or if `window-system' +is nil. This variable lets you do the same manually. You must +set it before loading org. Example: on Carbon Emacs 22 running graphically, with an external keyboard on a Powerbook, the default way of setting M-left might @@ -405,14 +529,17 @@ therefore you'll have to restart Emacs to apply it after changing." (defun org-key (key) "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. -Or return the original if not disputed." - (if org-replace-disputed-keys - (let* ((nkey (key-description key)) - (x (org-find-if (lambda (x) - (equal (key-description (car x)) nkey)) - org-disputed-keys))) - (if x (cdr x) key)) - key)) +Or return the original if not disputed. +Also apply the translations defined in `org-xemacs-key-equivalents'." + (when org-replace-disputed-keys + (let* ((nkey (key-description key)) + (x (org-find-if (lambda (x) + (equal (key-description (car x)) nkey)) + org-disputed-keys))) + (setq key (if x (cdr x) key)))) + (when (featurep 'xemacs) + (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key))) + key) (defun org-find-if (predicate seq) (catch 'exit @@ -625,7 +752,7 @@ The cdr is either a command to be called interactively, a function to be called, or a form to be evaluated. An entry that is just a list with a single string will be interpreted as a descriptive headline that will be added when listing the speed -copmmands in the Help buffer using the `?' speed command." +commands in the Help buffer using the `?' speed command." :group 'org-structure :type '(repeat :value ("k" . ignore) (choice :value ("k" . ignore) @@ -691,7 +818,8 @@ 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 -C-u TAB. For this special case to work, the first line 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 disables temporarily, to make sure the cursor stays at the beginning of the buffer. @@ -705,7 +833,7 @@ of the buffer." When the cursor is at the end of an empty headline, i.e with only stars and maybe a TODO keyword, TAB will then switch the entry to become a child, -and then all possible anchestor states, before returning to the original state. +and then all possible ancestor states, before returning to the original state. This makes data entry extremely fast: M-RET to create a new headline, on TAB to make it a child, two or more tabs to make it a (grand-)uncle. @@ -868,6 +996,18 @@ When t, the following will happen while the cursor is in the headline: :group 'org-edit-structure :type 'boolean) +(defcustom org-ctrl-k-protect-subtree nil + "Non-nil means, do not delete a hidden subtree with C-k. +When set to the symbol `error', simply throw an error when C-k is +used to kill (part-of) a headline that has hidden text behind it. +Any other non-nil value will result in a query to the user, if it is +OK to kill that hidden subtree. When nil, kill without remorse." + :group 'org-edit-structure + :type '(choice + (const :tag "Do not protect hidden subtrees" nil) + (const :tag "Protect hidden subtrees with a security query" t) + (const :tag "Never kill a hidden subtree with C-k" error))) + (defcustom org-yank-folded-subtrees t "Non-nil means when yanking subtrees, fold them. If the kill is a single subtree, or a sequence of subtrees, i.e. if @@ -951,9 +1091,8 @@ See also the QUOTE keyword." :group 'org-edit-structure :type 'boolean) - (defcustom org-goto-auto-isearch t - "Non-nil means typing characters in org-goto starts incremental search." + "Non-nil means typing characters in `org-goto' starts incremental search." :group 'org-edit-structure :type 'boolean) @@ -1139,11 +1278,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 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." :group 'org-link :type 'function) @@ -1280,8 +1419,7 @@ implementation is bad." :type 'boolean) (defcustom org-return-follows-link nil - "Non-nil means on links RET will follow the link. -Needs to be set before org.el is loaded." + "Non-nil means on links RET will follow the link." :group 'org-link-follow :type 'boolean) @@ -1294,15 +1432,16 @@ Needs to be set before org.el is loaded." :type 'boolean) (defcustom org-mark-ring-length 4 - "Number of different positions to be recorded in the ring + "Number of different positions to be recorded in the ring. Changing this requires a restart of Emacs to work correctly." :group 'org-link-follow :type 'integer) (defcustom org-link-frame-setup '((vm . vm-visit-folder-other-frame) - (gnus . gnus-other-frame) - (file . find-file-other-window)) + (gnus . org-gnus-no-new-news) + (file . find-file-other-window) + (wl . wl-other-frame)) "Setup the frame configuration for following links. When following a link with Emacs, it may often be useful to display this link in another window or frame. This variable can be used to @@ -1318,6 +1457,9 @@ For FILE, use any of `find-file' `find-file-other-window' `find-file-other-frame' +For Wanderlust use any of + `wl' + `wl-other-frame' For the calendar, use the variable `calendar-setup'. For BBDB, it is currently only possible to display the matches in another window." @@ -1337,13 +1479,18 @@ another window." (choice (const find-file) (const find-file-other-window) - (const find-file-other-frame))))) + (const find-file-other-frame))) + (cons (const wl) + (choice + (const wl) + (const wl-other-frame))))) (defcustom org-display-internal-link-with-indirect-buffer nil "Non-nil means use indirect buffer to display infile links. Activating internal links (from one location in a file to another location in the same file) normally just jumps to the location. When the link is -activated with a C-u prefix (or with mouse-3), the link is displayed in +activated with a \\[universal-argument] prefix (or with mouse-3), the link \ +is displayed in another window. When this option is set, the other window actually displays an indirect buffer clone of the current buffer, to avoid any visibility changes to the current buffer." @@ -1368,7 +1515,7 @@ window on that directory." (defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") "Function and arguments to call for following mailto links. -This is a list with the first element being a lisp function, and the +This is a list with the first element being a Lisp function, and the remaining elements being arguments to the function. In string arguments, %a will be replaced by the address, and %s will be replaced by the subject if one was given like in <mailto:arthur@galaxy.org::this subject>." @@ -1395,6 +1542,9 @@ single keystroke rather than having to type \"yes\"." (const :tag "with yes-or-no (safer)" yes-or-no-p) (const :tag "with y-or-n (faster)" y-or-n-p) (const :tag "no confirmation (dangerous)" nil))) +(put 'org-confirm-shell-link-function + 'safe-local-variable + '(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) (defcustom org-confirm-elisp-link-function 'yes-or-no-p "Non-nil means ask for confirmation before executing Emacs Lisp links. @@ -1412,6 +1562,9 @@ single keystroke rather than having to type \"yes\"." (const :tag "with yes-or-no (safer)" yes-or-no-p) (const :tag "with y-or-n (faster)" y-or-n-p) (const :tag "no confirmation (dangerous)" nil))) +(put 'org-confirm-shell-link-function + 'safe-local-variable + '(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) (defconst org-file-apps-defaults-gnu '((remote . emacs) @@ -1463,10 +1616,37 @@ you can use this variable to set the application for a given file extension. The entries in this list are cons cells where the car identifies files and the cdr the corresponding command. Possible values for the file identifier are - \"regex\" Regular expression matched against the file: link. For - backward compatibility, this can also be a string with only - alphanumeric characters, which is then interpreted as an - extension. + \"string\" A string as a file identifier can be interpreted in different + ways, depending on its contents: + + - Alphanumeric characters only: + Match links with this file extension. + Example: (\"pdf\" . \"evince %s\") + to open PDFs with evince. + + - Regular expression: Match links where the + filename matches the regexp. If you want to + use groups here, use shy groups. + + Example: (\"\\.x?html\\'\" . \"firefox %s\") + (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\") + to open *.html and *.xhtml with firefox. + + - Regular expression which contains (non-shy) groups: + Match links where the whole link, including \"::\", and + anything after that, matches the regexp. + In a custom command string, %1, %2, etc. are replaced with + the parts of the link that were matched by the groups. + For backwards compatibility, if a command string is given + that does not use any of the group matches, this case is + handled identically to the second one (i.e. match against + file name only). + In a custom lisp form, you can access the group matches with + (match-string n link). + + Example: (\"\\.pdf::\\(\\d+\\)\\'\" . \"evince -p %1 %s\") + to open [[file:document.pdf::5]] with evince at page 5. + `directory' Matches a directory `remote' Matches a remote file, accessible through tramp or efs. Remote files most likely should be visited through Emacs @@ -1480,7 +1660,7 @@ file identifier are `system' The system command to open files, like `open' on Windows and Mac OS X, and mailcap under GNU/Linux. This is the command that will be selected if you call `C-c C-o' with a double - `C-u C-u' prefix. + \\[universal-argument] \\[universal-argument] prefix. Possible values for the command are: `emacs' The file will be visited by the current Emacs process. @@ -1495,13 +1675,9 @@ Possible values for the command are: does define this command, but you can overrule/replace it here. string A command to be executed by a shell; %s will be replaced - by the path to the file. If the file identifier is a regex, - %n will be replaced by the match of the nth match group. + by the path to the file. sexp A Lisp form which will be evaluated. The file path will - be available in the Lisp variable `file', the link itself - in the Lisp variable `link'. If the file identifier is a regex, - the original match data will be restored, so subexpression - matches are accessible using (match-string n link). + be available in the Lisp variable `file'. For more examples, see the system specific constants `org-file-apps-defaults-macosx' `org-file-apps-defaults-windowsnt' @@ -1523,6 +1699,8 @@ For more examples, see the system specific constants (string :tag "Command") (sexp :tag "Lisp form"))))) + + (defgroup org-refile nil "Options concerning refiling entries in Org-mode." :tag "Org Refile" @@ -1546,10 +1724,8 @@ following situations: (defcustom org-default-notes-file (convert-standard-filename "~/.notes") "Default target for storing notes. -Used by the hooks for remember.el. This can be a string, or nil to mean -the value of `remember-data-file'. -You can set this on a per-template basis with the variable -`org-remember-templates'." +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 :type '(choice @@ -1571,7 +1747,7 @@ outline-path-completion Headlines in the current buffer are offered via (const :tag "Outline-path-completion" outline-path-completion))) (defcustom org-goto-max-level 5 - "Maximum level to be considered when running org-goto with refile interface." + "Maximum target level when running `org-goto' with refile interface." :group 'org-refile :type 'integer) @@ -1640,7 +1816,7 @@ This is list of cons cells. Each cell contains: order in hierarchy, not to the number of stars. You can set the variable `org-refile-target-verify-function' to a function -to verify each headline found by the simple critery above. +to verify each headline found by the simple criteria above. When this variable is nil, all top-level headlines in the current buffer are used, equivalent to the value `((nil . (:level . 1))'." @@ -1672,6 +1848,17 @@ of the subtree." :group 'org-refile :type 'function) +(defcustom org-refile-use-cache nil + "Non-nil means cache refile targets to speed up the process. +The cache for a particular file will be updated automatically when +the buffer has been killed, or when any of the marker used for flagging +refile targets no longer points at a live buffer. +If you have added new entries to a buffer that might themselves be targets, +you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you +find that easier, `C-u C-u C-u C-c C-w'." + :group 'org-refile + :type 'boolean) + (defcustom org-refile-use-outline-path nil "Non-nil means provide refile targets as paths. So a level 3 headline will be available as level1/level2/level3. @@ -1731,9 +1918,8 @@ heading." '( (:tag "Sequence (cycling hits every state)" sequence) (:tag "Type (cycling directly to DONE)" type)) - "The available interpretation symbols for customizing - `org-todo-keywords'. - Interested libraries should add to this list.") + "The available interpretation symbols for customizing `org-todo-keywords'. +Interested libraries should add to this list.") (defcustom org-todo-keywords '((sequence "TODO" "DONE")) "List of TODO entry keyword sequences and their interpretation. @@ -1759,7 +1945,7 @@ 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!)\" +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 @@ -2103,6 +2289,7 @@ The value is an alist, with the car being a symbol indicating the note context, and the cdr is the heading to be used. The heading may also be the empty string. %t in the heading will be replaced by a time stamp. +%T will be an active time stamp instead the default inactive one %s will be replaced by the new TODO state, in double quotes. %S will be replaced by the old TODO state, in double quotes. %u will be replaced by the user name. @@ -2184,10 +2371,19 @@ When nil, the state change notes will be ordered according to time." :group 'org-progress :type 'boolean) +(defcustom org-todo-repeat-to-state nil + "The TODO state to which a repeater should return the repeating task. +By default this is the first task in a TODO sequence, or the previous state +in a TODO_TYP set. But you can specify another task here. +alternatively, set the :REPEAT_TO_STATE: property of the entry." + :group 'org-todo + :type '(choice (const :tag "Head of sequence" nil) + (string :tag "Specific state"))) + (defcustom org-log-repeat 'time "Non-nil means record moving through the DONE state when triggering repeat. An auto-repeating task is immediately switched back to TODO when -marked DONE. If you are not logging state changes (by adding \"@\" +marked DONE. If you are not logging state changes (by adding \"@\" or \"!\" to the TODO keyword definition), or set `org-log-done' to record a closing note, there will be no record of the task moving through DONE. This variable forces taking a note anyway. @@ -2276,12 +2472,12 @@ of N minutes, as given by the second value. When a setting is 0 or 1, insert the time unmodified. Useful rounding numbers should be factors of 60, so for example 5, 10, 15. -When this is larger than 1, you can still force an exact time-stamp by using -a double prefix argument to a time-stamp command like `C-c .' or `C-c !', +When this is larger than 1, you can still force an exact time stamp by using +a double prefix argument to a time stamp command like `C-c .' or `C-c !', and by using a prefix arg to `S-up/down' to specify the exact number of minutes to shift." :group 'org-time - :get '(lambda (var) ; Make sure all entries have 5 elements + :get '(lambda (var) ; Make sure both elements are there (if (integerp (default-value var)) (list (default-value var) 5) (default-value var))) @@ -2324,8 +2520,8 @@ commands, if custom time display is turned on at the time of export." f))) (defcustom org-time-clocksum-format "%d:%02d" - "The format string used when creating CLOCKSUM lines, or when -org-mode generates a time duration." + "The format string used when creating CLOCKSUM lines. +This is also used when org-mode generates a time duration." :group 'org-time :type 'string) @@ -2356,8 +2552,8 @@ Custom commands can set this variable in the options section." "Non-nil means assume future for incomplete date input from user. This affects the following situations: 1. The user gives a month but not a year. - For example, if it is april and you enter \"feb 2\", this will be read - as feb 2, *next* year. \"May 5\", however, will be this year. + For example, if it is April and you enter \"feb 2\", this will be read + as Feb 2, *next* year. \"May 5\", however, will be this year. 2. The user gives a day, but no month. For example, if today is the 15th, and you enter \"3\", Org-mode will read this as the third of *next* month. However, if you enter \"17\", @@ -2607,7 +2803,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 function as a comparator" + "When set, tags are sorted using this function as a comparator." :group 'org-tags :type '(choice (const :tag "No sorting" nil) @@ -2638,7 +2834,7 @@ lined-up with respect to each other." (defcustom org-use-property-inheritance nil "Non-nil means properties apply also for sublevels. -This setting is chiefly used during property searches. Turning it on can +This setting is chiefly used during property searches. Turning it on can cause significant overhead when doing a search, which is why it is not on by default. @@ -2937,32 +3133,49 @@ will be appended." (defvar org-format-latex-header-extra nil) +(defun org-set-packages-alist (var val) + "Set the packages alist and make sure it has 3 elements per entry." + (set var (mapcar (lambda (x) + (if (and (consp x) (= (length x) 2)) + (list (car x) (nth 1 x) t) + x)) + val))) + +(defun org-get-packages-alist (var) + + "Get the packages alist and make sure it has 3 elements per entry." + (mapcar (lambda (x) + (if (and (consp x) (= (length x) 2)) + (list (car x) (nth 1 x) t) + x)) + (default-value var))) + ;; The following variables are defined here because is it also used ;; when formatting latex fragments. Originally it was part of the ;; LaTeX exporter, which is why the name includes "export". (defcustom org-export-latex-default-packages-alist - '(("AUTO" "inputenc") - ("T1" "fontenc") - ("" "fixltx2e") - ("" "graphicx") - ("" "longtable") - ("" "float") - ("" "wrapfig") - ("" "soul") - ("" "t1enc") - ("" "textcomp") - ("" "marvosym") - ("" "wasysym") - ("" "latexsym") - ("" "amssymb") - ("" "hyperref") + '(("AUTO" "inputenc" t) + ("T1" "fontenc" t) + ("" "fixltx2e" nil) + ("" "graphicx" t) + ("" "longtable" nil) + ("" "float" nil) + ("" "wrapfig" nil) + ("" "soul" t) + ("" "t1enc" t) + ("" "textcomp" t) + ("" "marvosym" t) + ("" "wasysym" t) + ("" "latexsym" t) + ("" "amssymb" t) + ("" "hyperref" nil) "\\tolerance=1000" ) "Alist of default packages to be inserted in the header. Change this only if one of the packages here causes an incompatibility with another package you are using. The packages in this list are needed by one part or another of Org-mode -to function properly. +to function properly. - inputenc, fontenc, t1enc: for basic font and character selection - textcomp, marvosymb, wasysym, latexsym, amssym: for various symbols used @@ -2976,31 +3189,42 @@ to function properly. Therefore you should not modify this variable unless you know what you are doing. The one reason to change it anyway is that you might be loading some other package that conflicts with one of the default packages. -Each cell is of the format \( \"options\" \"package\" \)." +Each cell is of the format \( \"options\" \"package\" snippet-flag\). +If SNIPPET-FLAG is t, the package also needs to be included when +compiling LaTeX snippets into images for inclusion into HTML." :group 'org-export-latex + :set 'org-set-packages-alist + :get 'org-get-packages-alist :type '(repeat - (choice - (string :tag "A line of LaTeX") + (choice (list :tag "options/package pair" (string :tag "options") - (string :tag "package"))))) + (string :tag "package") + (boolean :tag "Snippet")) + (string :tag "A line of LaTeX")))) (defcustom org-export-latex-packages-alist nil - "Alist of packages to be inserted in every LaTeX the header. + "Alist of packages to be inserted in every LaTeX header. These will be inserted after `org-export-latex-default-packages-alist'. -Each cell is of the format \( \"options\" \"package\" \). -Make sure that you only lis packages here which: +Each cell is of the format \( \"options\" \"package\" snippet-flag \). +SNIPPET-FLAG, when t, indicates that this package is also needed when +turning LaTeX snippets into images for inclusion into HTML. +Make sure that you only list packages here which: - you want in every file - do not conflict with the default packages in `org-export-latex-default-packages-alist' - do not conflict with the setup in `org-format-latex-header'." :group 'org-export-latex + :set 'org-set-packages-alist + :get 'org-get-packages-alist :type '(repeat - (choice - (string :tag "A line of LaTeX") + (choice (list :tag "options/package pair" (string :tag "options") - (string :tag "package"))))) + (string :tag "package") + (boolean :tag "Snippet")) + (string :tag "A line of LaTeX")))) + (defgroup org-appearance nil "Settings for Org-mode appearance." @@ -3073,8 +3297,25 @@ org-level-* faces." :group 'org-appearance :type 'boolean) +(defcustom org-pretty-entities nil + "Non-nil means show entities as UTF8 characters. +When nil, the \\name form remains in the buffer." + :group 'org-appearance + :type 'boolean) + +(defcustom org-pretty-entities-include-sub-superscripts t + "Non-nil means, pretty entity display includes formatting sub/superscripts." + :group 'org-appearance + :type 'boolean) + (defvar org-emph-re nil - "Regular expression for matching emphasis.") + "Regular expression for matching emphasis. +After a match, the match groups contain these elements: +1 The character before the proper match, or empty at beginning of line +2 The proper match, including the leading and trailing markers +3 The leading marker like * or /, indicating the type of highlighting +4 The text between the emphasis markers, not including the markers +5 The character after the match, empty at the end of a line") (defvar org-verbatim-re nil "Regular expression for matching verbatim text.") (defvar org-emphasis-regexp-components) ; defined just below @@ -3176,6 +3417,7 @@ example *bold*, _underlined_ and /italic/. This variable sets the marker characters, the face to be used by font-lock for highlighting in Org-mode Emacs buffers, and the HTML tags to be used for this. For LaTeX export, see the variable `org-export-latex-emphasis-alist'. +For DocBook export, see the variable `org-export-docbook-emphasis-alist'. Use customize to modify this, or restart Emacs after changing it." :group 'org-appearance :set 'org-set-emph-re @@ -3271,6 +3513,7 @@ Normal means no org-mode-specific context." (declare-function org-indent-mode "org-indent" (&optional arg)) (declare-function parse-time-string "parse-time" (string)) (declare-function org-attach-reveal "org-attach" (&optional if-exists)) +(declare-function org-export-latex-fix-inputenc "org-latex" ()) (defvar remember-data-file) (defvar texmathp-why) (declare-function speedbar-line-directory "speedbar" (&optional depth)) @@ -3287,18 +3530,18 @@ Normal means no org-mode-specific context." ;; by the functions setting up org-mode or checking for table context. (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" - "Detects an org-type or table-type table.") + "Detect an org-type or table-type table.") (defconst org-table-line-regexp "^[ \t]*|" - "Detects an org-type table line.") + "Detect an org-type table line.") (defconst org-table-dataline-regexp "^[ \t]*|[^-]" - "Detects an org-type table line.") + "Detect an org-type table line.") (defconst org-table-hline-regexp "^[ \t]*|-" - "Detects an org-type table hline.") + "Detect an org-type table hline.") (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" - "Detects a table-type table hline.") + "Detect a table-type table hline.") (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") + "Detect the first line outside a table when searching from within it. +This works for both table types.") ;; Autoload the functions in org-table.el that are needed by functions here. @@ -3325,7 +3568,9 @@ outside the table.") 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-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. @@ -3365,7 +3610,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (message "recognizing table.el table...") (table-recognize-table) (message "recognizing table.el table...done"))) - (error "This should not happen...")) + (error "This should not happen")) t) nil) nil)) @@ -3380,21 +3625,22 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (defvar org-table-clean-did-remove-column nil) -(defun org-table-map-tables (function) +(defun org-table-map-tables (function &optional quietly) "Apply FUNCTION to the start of all tables in the buffer." (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (re-search-forward org-table-any-line-regexp nil t) - (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) + (unless quietly + (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))) (beginning-of-line 1) (when (looking-at org-table-line-regexp) (save-excursion (funcall function)) (or (looking-at org-table-line-regexp) (forward-char 1))) (re-search-forward org-table-any-border-regexp nil 1)))) - (message "Mapping tables: done")) + (unless quietly (message "Mapping tables: done"))) ;; Declare and autoload functions from org-exp.el & Co @@ -3448,6 +3694,11 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." '(org-remember-insinuate org-remember-annotation 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))) + ;; Autoload org-clock.el @@ -3814,7 +4065,7 @@ Also put tags into group 4 if tags are present.") "Matches any of the 3 keywords, together with the time stamp.") (make-variable-buffer-local 'org-keyword-time-not-clock-regexp) (defvar org-maybe-keyword-time-regexp nil - "Matches a timestamp, possibly preceeded by a keyword.") + "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.") @@ -3910,7 +4161,9 @@ After a match, the following groups carry important information: ("noptag" org-tag-persistent-alist nil) ("hideblocks" org-hide-block-startup t) ("nohideblocks" org-hide-block-startup nil) - ("beamer" org-startup-with-beamer-mode t)) + ("beamer" org-startup-with-beamer-mode t) + ("entitiespretty" org-pretty-entities t) + ("entitiesplain" org-pretty-entities nil)) "Variable associated with STARTUP options for org-mode. Each element is a list of three items: The startup options as written in the #+STARTUP line, the corresponding variable, and the value to @@ -3933,9 +4186,11 @@ means to push this value onto the list in the variable.") (let ((re (org-make-options-regexp '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" - "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE" "LATEX_CLASS") + "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE" "LATEX_CLASS" + "OPTIONS") "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)")) (splitre "[ \t]+") + (scripts org-use-sub-superscripts) kwds kws0 kwsa key log value cat arch tags const links hw dws tail sep kws1 prio props ftags drawers beamer-p ext-setup-or-nil setup-contents (start 0)) @@ -3950,10 +4205,9 @@ means to push this value onto the list in the variable.") (re-search-forward re nil t))) (setq key (upcase (match-string 1 ext-setup-or-nil)) value (org-match-string-no-properties 2 ext-setup-or-nil)) + (if (stringp value) (setq value (org-trim value))) (cond ((equal key "CATEGORY") - (if (string-match "[ \t]+$" value) - (setq value (replace-match "" t t value))) (setq cat value)) ((member key '("SEQ_TODO" "TODO")) (push (cons 'sequence (org-split-string value splitre)) kwds)) @@ -4004,12 +4258,14 @@ means to push this value onto the list in the variable.") (set (make-local-variable var) (symbol-value var)) (add-to-list var val)))))) ((equal key "ARCHIVE") - (string-match " *$" value) - (setq arch (replace-match "" t t value)) + (setq arch value) (remove-text-properties 0 (length arch) '(face t fontified t) arch)) ((equal key "LATEX_CLASS") (setq beamer-p (equal value "beamer"))) + ((equal key "OPTIONS") + (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value) + (setq scripts (read (match-string 2 value))))) ((equal key "SETUPFILE") (setq setup-contents (org-file-contents (expand-file-name @@ -4022,6 +4278,7 @@ means to push this value onto the list in the variable.") "\n" setup-contents "\n" (substring ext-setup-or-nil start))))) )))) + (org-set-local 'org-use-sub-superscripts scripts) (when cat (org-set-local 'org-category (intern cat)) (push (cons "CATEGORY" cat) props)) @@ -4148,7 +4405,11 @@ means to push this value onto the list in the variable.") org-complex-heading-regexp-format (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(%s\\)" + "\\)\\>\\)?" + "\\(?:[ \t]*\\(\\[#.\\]\\)\\)?" + "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie + "[ \t]*\\(%s\\)" + "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") org-nl-done-regexp (concat "\n\\*+[ \t]+" @@ -4211,10 +4472,10 @@ means to push this value onto the list in the variable.") (not (file-readable-p file))) (if noerror (progn - (message "Cannot read file %s" file) + (message "Cannot read file \"%s\"" file) (ding) (sit-for 2) "") - (error "Cannot read file %s" file)) + (error "Cannot read file \"%s\"" file)) (with-temp-buffer (insert-file-contents file) (buffer-string)))) @@ -4287,7 +4548,7 @@ 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.")) + (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 @@ -4334,7 +4595,7 @@ The following commands are available: ;; we switch another buffer into org-mode. (if (featurep 'xemacs) (when (boundp 'outline-mode-menu-heading) - ;; Assume this is Greg's port, it used easymenu + ;; Assume this is Greg's port, it uses easymenu (easy-menu-remove outline-mode-menu-heading) (easy-menu-remove outline-mode-menu-show) (easy-menu-remove outline-mode-menu-hide)) @@ -4346,9 +4607,9 @@ The following commands are available: (easy-menu-add org-org-menu) (easy-menu-add org-tbl-menu) (org-install-agenda-files-menu) - (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) - (org-add-to-invisibility-spec '(org-cwidth)) - (org-add-to-invisibility-spec '(org-hide-block . t)) + (if org-descriptive-links (add-to-invisibility-spec '(org-link))) + (add-to-invisibility-spec '(org-cwidth)) + (add-to-invisibility-spec '(org-hide-block . t)) (when (featurep 'xemacs) (org-set-local 'line-move-ignore-invisible t)) (org-set-local 'outline-regexp org-outline-regexp) @@ -4371,7 +4632,6 @@ The following commands are available: (org-set-tag-faces 'org-tag-faces org-tag-faces)) ;; Calc embedded (org-set-local 'calc-embedded-open-mode "# ") - (modify-syntax-entry ?# "<") (modify-syntax-entry ?@ "w") (if org-startup-truncated (setq truncate-lines t)) (org-set-local 'font-lock-unfontify-region-function @@ -4386,6 +4646,9 @@ The following commands are available: (org-set-autofill-regexps) (setq indent-line-function 'org-indent-line-function) (org-update-radio-target-regexp) + ;; 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) ;; Make sure dependence stuff works reliably, even for users who set it ;; too late :-( (if org-enforce-todo-dependencies @@ -4400,7 +4663,7 @@ The following commands are available: 'org-block-todo-from-checkboxes)) ;; Comment characters -; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping + (org-set-local 'comment-start "#") (org-set-local 'comment-padding " ") ;; Align options lines @@ -4434,7 +4697,7 @@ The following commands are available: (unless org-inhibit-startup (when org-startup-align-all-tables (let ((bmp (buffer-modified-p))) - (org-table-map-tables 'org-table-align) + (org-table-map-tables 'org-table-align 'quietly) (set-buffer-modified-p bmp))) (when org-startup-indented (require 'org-indent) @@ -4461,10 +4724,8 @@ The following commands are available: ;;;; Font-Lock stuff, including the activators (defvar org-mouse-map (make-sparse-keymap)) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse) +(org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse) +(org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse) (when org-mouse-1-follows-link (org-defkey org-mouse-map [follow-link] 'mouse-face)) (when org-tab-follows-link @@ -4475,7 +4736,7 @@ 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")) + "shell" "elisp" "doi")) (defvar org-link-types-re nil "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil @@ -4499,10 +4760,51 @@ Here is what the match groups contain after a match: 4: [desc] 5: desc") (defvar org-bracket-link-analytic-regexp++ nil - "Like org-bracket-link-analytic-regexp, but include coderef internal type.") + "Like `org-bracket-link-analytic-regexp', but include coderef internal type.") (defvar org-any-link-re nil "Regular expression matching any link.") +(defcustom org-match-sexp-depth 3 + "Number of stacked braces for sub/superscript matching. +This has to be set before loading org.el to be effective." + :group 'org-export-translation ; ??????????????????????????/ + :type 'integer) + +(defun org-create-multibrace-regexp (left right n) + "Create a regular expression which will match a balanced sexp. +Opening delimiter is LEFT, and closing delimiter is RIGHT, both given +as single character strings. +The regexp returned will match the entire expression including the +delimiters. It will also define a single group which contains the +match except for the outermost delimiters. The maximum depth of +stacked delimiters is N. Escaping delimiters is not possible." + (let* ((nothing (concat "[^" left right "]*?")) + (or "\\|") + (re nothing) + (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) + (while (> n 1) + (setq n (1- n) + re (concat re or next) + next (concat "\\(?:" nothing left next right "\\)+" nothing))) + (concat left "\\(" re "\\)" right))) + +(defvar org-match-substring-regexp + (concat + "\\([^\\]\\)\\([_^]\\)\\(" + "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" + "\\|" + "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" + "\\|" + "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") + "The regular expression matching a sub- or superscript.") + +(defvar org-match-substring-with-braces-regexp + (concat + "\\([^\\]\\)\\([_^]\\)\\(" + "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" + "\\)") + "The regular expression matching a sub- or superscript, forcing braces.") + (defun org-make-link-regexps () "Update the link regular expressions. This should be called after the variable `org-link-types' has changed." @@ -4607,7 +4909,7 @@ The time stamps may be either active or inactive.") (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))) (add-text-properties (match-beginning 2) (match-end 2) - '(font-lock-multiline t)) + '(font-lock-multiline t org-emphasis t)) (when org-hide-emphasis-markers (add-text-properties (match-end 4) (match-beginning 5) '(invisible org-link)) @@ -4724,7 +5026,7 @@ will be prompted for." '(font-lock-fontified t face org-block)) t) ((and (match-end 4) (equal dc3 "begin")) - ;; Truely a block + ;; Truly a block (setq block-type (downcase (match-string 5)) quoting (member block-type org-protecting-blocks)) (when (re-search-forward @@ -4766,7 +5068,8 @@ will be prompted for." '(font-lock-fontified t face org-meta-line)) t) ((or (member dc1 '("begin:" "end:" "caption:" "label:" - "orgtbl:" "tblfm:" "tblname:")) + "orgtbl:" "tblfm:" "tblname:" "result:" + "results:" "source:" "srcname:" "call:")) (and (match-end 4) (equal dc3 "attr"))) (add-text-properties beg (match-end 0) @@ -4944,13 +5247,17 @@ will be prompted for." (if org-export-with-TeX-macros (list (concat "\\\\" (regexp-opt - (append (mapcar 'car (append org-entities-user - org-entities)) - (if (boundp 'org-latex-entities) - (mapcar (lambda (x) - (or (car-safe x) x)) - org-latex-entities) - nil)) + (append + + (delq nil + (mapcar 'car-safe + (append org-entities-user + org-entities))) + (if (boundp 'org-latex-entities) + (mapcar (lambda (x) + (or (car-safe x) x)) + org-latex-entities) + nil)) 'words))) ; FIXME )) ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) @@ -4989,7 +5296,7 @@ will be prompted for." rtn))) (defun org-restart-font-lock () - "Restart font-lock-mode, to force refontification." + "Restart `font-lock-mode', to force refontification." (when (and (boundp 'font-lock-mode) font-lock-mode) (font-lock-mode -1) (font-lock-mode 1))) @@ -5034,7 +5341,7 @@ between words." (defun org-outline-level () "Compute the outline level of the heading at point. This function assumes that the cursor is at the beginning of a line matched -by outline-regexp. Otherwise it returns garbage. +by `outline-regexp'. Otherwise it returns garbage. If this is called at a normal headline, the level is the number of stars. Use `org-reduced-level' to remove the effect of `org-odd-levels'. For plain list items, if they are matched by `outline-regexp', this returns @@ -5134,6 +5441,8 @@ For plain list items, if they are matched by `outline-regexp', this returns '(1 'org-archived prepend)) ;; Specials '(org-do-latex-and-special-faces) + '(org-fontify-entities) + '(org-raise-scripts) ;; Code '(org-activate-code (1 'org-code t)) ;; COMMENT @@ -5151,8 +5460,41 @@ For plain list items, if they are matched by `outline-regexp', this returns '(org-font-lock-keywords t nil nil backward-paragraph)) (kill-local-variable 'font-lock-keywords) nil)) +(defun org-toggle-pretty-entities () + "Toggle the composition display of entities as UTF8 characters." + (interactive) + (org-set-local 'org-pretty-entities (not org-pretty-entities)) + (org-restart-font-lock) + (if org-pretty-entities + (message "Entities are displayed as UTF8 characers") + (save-restriction + (widen) + (decompose-region (point-min) (point-max)) + (message "Entities are displayed plain")))) + +(defun org-fontify-entities (limit) + "Find an entity to fontify." + (let (ee) + (when org-pretty-entities + (catch 'match + (while (re-search-forward + "\\\\\\([a-zA-Z][a-zA-Z0-9]*\\)\\($\\|[^[:alnum:]\n]\\)" + limit t) + (if (and (not (org-in-indented-comment-line)) + (setq ee (org-entity-get (match-string 1))) + (= (length (nth 6 ee)) 1)) + (progn + (add-text-properties + (match-beginning 0) (match-end 1) + (list 'font-lock-fontified t)) + (compose-region (match-beginning 0) (match-end 1) + (nth 6 ee) nil) + (backward-char 1) + (throw 'match t)))) + nil)))) + (defun org-fontify-like-in-org-mode (s &optional odd-levels) - "Fontify string S like in Org-mode" + "Fontify string S like in Org-mode." (with-temp-buffer (insert s) (let ((org-odd-levels-only odd-levels)) @@ -5227,6 +5569,7 @@ If KWD is a number, get the corresponding match group." (inhibit-read-only t) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) + (decompose-region beg end) (remove-text-properties beg end (if org-indent-mode @@ -5234,10 +5577,69 @@ If KWD is a number, get the corresponding match group." '(mouse-face t keymap t org-linked-text t invisible t intangible t line-prefix t wrap-prefix t - org-no-flyspell 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-no-flyspell t org-emphasis t))) + (org-remove-font-lock-display-properties beg end))) + +(defconst org-script-display '(((raise -0.3) (height 0.7)) + ((raise 0.3) (height 0.7)) + ((raise -0.5)) + ((raise 0.5))) + "Display properties for showing superscripts and subscripts.") + +(defun org-remove-font-lock-display-properties (beg end) + "Remove specific display properties that have been added by font lock. +The will remove the raise properties that are used to show superscripts +and subscripts." + (let (next prop) + (while (< beg end) + (setq next (next-single-property-change beg 'display nil end) + prop (get-text-property beg 'display)) + (if (member prop org-script-display) + (put-text-property beg next 'display nil)) + (setq beg next)))) + +(defun org-raise-scripts (limit) + "Add raise properties to sub/superscripts." + (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts) + (if (re-search-forward + (if (eq org-use-sub-superscripts t) + org-match-substring-regexp + org-match-substring-with-braces-regexp) + limit t) + (let* ((pos (point)) table-p comment-p + (mpos (match-beginning 3)) + (emph-p (get-text-property mpos 'org-emphasis)) + (link-p (get-text-property mpos 'mouse-face)) + (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) + (goto-char (point-at-bol)) + (setq table-p (org-looking-at-p org-table-dataline-regexp) + comment-p (org-looking-at-p "[ \t]*#")) + (goto-char pos) + ;; FIXME: Should we go back one character here, for a_b^c + ;; (goto-char (1- pos)) ;???????????????????? + (if (or comment-p emph-p link-p keyw-p) + t + (put-text-property (match-beginning 3) (match-end 0) + 'display + (if (equal (char-after (match-beginning 2)) ?^) + (nth (if table-p 3 1) org-script-display) + (nth (if table-p 2 0) org-script-display))) + (add-text-properties (match-beginning 2) (match-end 2) + (list 'invisible t + 'org-dwidth t 'org-dwidth-n 1)) + (if (and (eq (char-after (match-beginning 3)) ?{) + (eq (char-before (match-end 3)) ?})) + (progn + (add-text-properties + (match-beginning 3) (1+ (match-beginning 3)) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)) + (add-text-properties + (1- (match-end 3)) (match-end 3) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))) + t))))) ;;;; Visibility cycling, including org-goto and indirect buffer @@ -5284,7 +5686,7 @@ in special contexts. - When point is at the beginning of an empty headline and the variable `org-cycle-level-after-item/entry-creation' is set, cycle the level of the headline by demoting and promoting it to likely levels. This - speeds up creation document structure by presing TAB once or several + speeds up creation document structure by pressing TAB once or several times right after creating a new headline. - When there is a numeric prefix, go up to a heading with level ARG, do @@ -5462,7 +5864,6 @@ in special contexts. (while (and (not (eobp)) ;; this is like `next-line' (get-char-property (1- (point)) 'invisible)) (goto-char (next-single-char-property-change (point) 'invisible)) -;;;??? (or (bolp) (beginning-of-line 2)))) (and (eolp) (beginning-of-line 2)))) (setq eol (point))) (outline-end-of-heading) (setq eoh (point)) @@ -5524,7 +5925,7 @@ in special contexts. ;;;###autoload (defun org-global-cycle (&optional arg) "Cycle the global visibility. For details see `org-cycle'. -With C-u prefix arg, switch to startup visibility. +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 @@ -5553,7 +5954,7 @@ With a numeric prefix, show all headlines up to that level." (org-set-visibility-according-to-property 'no-cleanup) (org-cycle-hide-archived-subtrees 'all) (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines 'all))) + (org-cycle-show-empty-lines t))) (defun org-set-visibility-according-to-property (&optional no-cleanup) "Switch subtree visibilities according to :VISIBILITY: property." @@ -5637,11 +6038,11 @@ This function is the default value of the hook `org-cycle-hook'." "Remove outline overlays that do not contain non-white stuff." (mapc (lambda (o) - (and (eq 'outline (org-overlay-get o 'invisible)) - (not (string-match "\\S-" (buffer-substring (org-overlay-start o) - (org-overlay-end o)))) - (org-delete-overlay o))) - (org-overlays-at pos))) + (and (eq 'outline (overlay-get o 'invisible)) + (not (string-match "\\S-" (buffer-substring (overlay-start o) + (overlay-end o)))) + (delete-overlay o))) + (overlays-at pos))) (defun org-clean-visibility-after-subtree-move () "Fix visibility issues after moving a subtree." @@ -5794,7 +6195,7 @@ Optional argument N means put the headline into the Nth line of the window." (defun org-outline-overlay-data (&optional use-markers) "Return a list of the locations of all outline overlays. The are overlays with the `invisible' property value `outline'. -The return valus is a list of cons cells, with start and stop +The return values is a list of cons cells, with start and stop positions for each overlay. If USE-MARKERS is set, return the positions as markers." (let (beg end) @@ -5803,15 +6204,15 @@ If USE-MARKERS is set, return the positions as markers." (widen) (delq nil (mapcar (lambda (o) - (when (eq (org-overlay-get o 'invisible) 'outline) - (setq beg (org-overlay-start o) - end (org-overlay-end o)) + (when (eq (overlay-get o 'invisible) 'outline) + (setq beg (overlay-start o) + end (overlay-end o)) (and beg end (> end beg) (if use-markers (cons (move-marker (make-marker) beg) (move-marker (make-marker) end)) (cons beg end))))) - (org-overlays-in (point-min) (point-max)))))))) + (overlays-in (point-min) (point-max)))))))) (defun org-set-outline-overlay-data (data) "Create visibility overlays for all positions in DATA. @@ -5822,8 +6223,8 @@ DATA should have been made by `org-outline-overlay-data'." (widen) (show-all) (mapc (lambda (c) - (setq o (org-make-overlay (car c) (cdr c))) - (org-overlay-put o 'invisible 'outline)) + (setq o (make-overlay (car c) (cdr c))) + (overlay-put o 'invisible 'outline)) data))))) (defmacro org-save-outline-visibility (use-markers &rest body) @@ -5833,6 +6234,7 @@ This means that the buffer may change while running BODY, but it also means that the buffer should stay alive during the operation, because otherwise all these markers will point nowhere." + (declare (indent 1)) `(let ((data (org-outline-overlay-data ,use-markers))) (unwind-protect (progn @@ -5857,9 +6259,8 @@ point nowhere." (make-variable-buffer-local 'org-hide-block-overlays) (defun org-block-map (function &optional start end) - "Call func at the head of all source blocks in the current -buffer. Optional arguments START and END can be used to limit -the range." + "Call FUNCTION at the head of all source blocks in the current buffer. +Optional arguments START and END can be used to limit the range." (let ((start (or start (point-min))) (end (or end (point-max)))) (save-excursion @@ -5882,7 +6283,8 @@ the range." (defun org-show-block-all () "Unfold all blocks in the current buffer." - (mapc 'org-delete-overlay org-hide-block-overlays) + (interactive) + (mapc 'delete-overlay org-hide-block-overlays) (setq org-hide-block-overlays nil)) (defun org-hide-block-toggle-maybe () @@ -5906,30 +6308,30 @@ the range." (end (match-end 0)) ;; end of entire body ov) (if (memq t (mapcar (lambda (overlay) - (eq (org-overlay-get overlay 'invisible) + (eq (overlay-get overlay 'invisible) 'org-hide-block)) - (org-overlays-at start))) + (overlays-at start))) (if (or (not force) (eq force 'off)) (mapc (lambda (ov) (when (member ov org-hide-block-overlays) (setq org-hide-block-overlays (delq ov org-hide-block-overlays))) - (when (eq (org-overlay-get ov 'invisible) + (when (eq (overlay-get ov 'invisible) 'org-hide-block) - (org-delete-overlay ov))) - (org-overlays-at start))) - (setq ov (org-make-overlay start end)) - (org-overlay-put ov 'invisible 'org-hide-block) + (delete-overlay ov))) + (overlays-at start))) + (setq ov (make-overlay start end)) + (overlay-put ov 'invisible 'org-hide-block) ;; make the block accessible to isearch - (org-overlay-put + (overlay-put ov 'isearch-open-invisible (lambda (ov) (when (member ov org-hide-block-overlays) (setq org-hide-block-overlays (delq ov org-hide-block-overlays))) - (when (eq (org-overlay-get ov 'invisible) + (when (eq (overlay-get ov 'invisible) 'org-hide-block) - (org-delete-overlay ov)))) + (delete-overlay ov)))) (push ov org-hide-block-overlays))) (error "Not looking at a source block")))) @@ -6146,10 +6548,12 @@ With 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 `C-u' prefix, or +indirect buffers. However, when you call the command with a \ +\\[universal-argument] prefix, or when `org-indirect-buffer-display' is `new-frame', the last buffer is kept so that you can work with several indirect buffers at the same time. -If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also +If `org-indirect-buffer-display' is `dedicated-frame', the \ +\\[universal-argument] prefix also requests that a new frame be made for the new buffer, so that the dedicated frame is not changed." (interactive "P") @@ -6634,7 +7038,7 @@ After top level, it switches back to sibling level." (funcall fun))))) (defun org-fixup-indentation (diff) - "Change the indentation in the current entry by DIFF + "Change the indentation in the current entry by DIFF. However, if any line in the current entry has no indentation, or if it would end up with no indentation after the change, nothing at all is done." (save-excursion @@ -6672,10 +7076,11 @@ level 5 etc." (end-of-line 1)))))) (defun org-convert-to-oddeven-levels () - "Convert an org-mode file with only odd levels to one with odd and even levels. -This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a -section with an even level, conversion would destroy the structure of the file. An error -is signaled in this case." + "Convert an org-mode file with only odd levels to one with odd/even levels. +This promotes level 3 to level 2, level 5 to level 3 etc. If the +file contains a section with an even level, conversion would +destroy the structure of the file. An error is signaled in this +case." (interactive) (goto-char (point-min)) ;; First check if there are no even levels @@ -7014,18 +7419,22 @@ If yes, remember the marker and the distance to BEG." (if (org-on-heading-p) (backward-char 1)) (point)))))) +(eval-when-compile + (defvar org-property-drawer-re)) + (defun org-clone-subtree-with-time-shift (n &optional shift) "Clone the task (subtree) at point N times. The clones will be inserted as siblings. -In interactive use, the user will be prompted for the number of clones -to be produced, and for a time SHIFT, which may be a repeater as used -in time stamps, for example `+3d'. +In interactive use, the user will be prompted for the number of +clones to be produced, and for a time SHIFT, which may be a +repeater as used in time stamps, for example `+3d'. -When a valid repeater is given and the entry contains any time stamps, -the clones will become a sequence in time, with time stamps in the -subtree shifted for each clone produced. If SHIFT is nil or the -empty string, time stamps will be left alone. +When a valid repeater is given and the entry contains any time +stamps, the clones will become a sequence in time, with time +stamps in the subtree shifted for each clone produced. If SHIFT +is nil or the empty string, time stamps will be left alone. The +ID property of the original subtree is removed. If the original subtree did contain time stamps with a repeater, the following will happen: @@ -7039,7 +7448,7 @@ the following will happen: I this way you can spell out a number of instances of a repeating task, and still retain the repeater to cover future instances of the task." (interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ") - (let (beg end template task + (let (beg end template task idprop shift-n shift-what doshift nmin nmax (n-no-remove -1)) (if (not (and (integerp n) (> n 0))) (error "Invalid number of replications %s" n)) @@ -7056,6 +7465,7 @@ and still retain the repeater to cover future instances of the task." (setq nmin 1 nmax n) (org-back-to-heading t) (setq beg (point)) + (setq idprop (org-entry-get nil "ID")) (org-end-of-subtree t t) (or (bolp) (insert "\n")) (setq end (point)) @@ -7067,12 +7477,18 @@ and still retain the repeater to cover future instances of the task." (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) (goto-char end) (loop for n from nmin to nmax do - (if (not doshift) - (setq task template) - (with-temp-buffer - (insert template) - (org-mode) - (goto-char (point-min)) + ;; prepare clone + (with-temp-buffer + (insert template) + (org-mode) + (goto-char (point-min)) + (and idprop (if org-clone-delete-id + (org-entry-delete nil "ID") + (org-id-get-create t))) + (while (re-search-forward org-property-drawer-re nil t) + (org-remove-empty-drawer-at "PROPERTIES" (point))) + (goto-char (point-min)) + (when doshift (while (re-search-forward org-ts-regexp-both nil t) (org-timestamp-change (* n shift-n) shift-what)) (unless (= n n-no-remove) @@ -7081,8 +7497,8 @@ and still retain the repeater to cover future instances of the task." (save-excursion (goto-char (match-beginning 0)) (if (looking-at "<[^<>\n]+\\( +\\+[0-9]+[dwmy]\\)") - (delete-region (match-beginning 1) (match-end 1)))))) - (setq task (buffer-string)))) + (delete-region (match-beginning 1) (match-end 1))))))) + (setq task (buffer-string))) (insert task)) (goto-char beg))) @@ -7126,7 +7542,7 @@ Sorting can be alphabetically, numerically, by date/time as given by a time stamp, by a property or by priority. The command prompts for the sorting type unless it has been given to the -function through the SORTING-TYPE argument, which needs to a character, +function through the SORTING-TYPE argument, which needs to be a character, \(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the precise meaning of each character: @@ -7419,15 +7835,15 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." "Keymap for the minor `orgstruct-mode'.") (defvar org-local-vars nil - "List of local variables, for use by `orgstruct-mode'") + "List of local variables, for use by `orgstruct-mode'.") ;;;###autoload (define-minor-mode orgstruct-mode - "Toggle the minor more `orgstruct-mode'. -This mode is for using Org-mode structure commands in other modes. -The following key behave as if Org-mode was active, if the cursor -is on a headline, or on a plain list item (both in the definition -of Org-mode). + "Toggle the minor mode `orgstruct-mode'. +This mode is for using Org-mode structure commands in other +modes. The following keys behave as if Org-mode were active, if +the cursor is on a headline, or on a plain list item (both as +defined by Org-mode). M-up Move entry/item up M-down Move entry/item down @@ -7478,7 +7894,7 @@ major mode, for example with \\[normal-mode]." (org-set-local 'orgstruct-is-++ t)))) (defvar orgstruct-is-++ nil - "Is orgstruct-mode in ++ version in the current-buffer?") + "Is `orgstruct-mode' in ++ version in the current-buffer?") (make-variable-buffer-local 'orgstruct-is-++) ;;;###autoload @@ -7720,7 +8136,7 @@ If yes, it should return a non-nil value after a calling `org-store-link-props' with a list of properties and values. Special properties are: -:type The link prefix. like \"http\". This must be given. +:type The link prefix, like \"http\". This must be given. :link The link, like \"http://www.astro.uva.nl/~dominik\". This is obligatory as well. :description Optional default description for the second pair @@ -7806,7 +8222,9 @@ For file links, arg negates `org-context-in-file-links'." (get-text-property (point) 'org-marker)))) (when m (org-with-point-at m - (call-interactively 'org-store-link))))) + (if (interactive-p) + (call-interactively 'org-store-link) + (org-store-link nil)))))) ((eq major-mode 'calendar-mode) (let ((cd (calendar-cursor-to-date))) @@ -8117,6 +8535,12 @@ This is the list that is used before handing over to the browser.") (defun org-fixup-message-id-for-http (s) "Replace special characters in a message id, so it can be used in an http query." + (when (string-match "%" s) + (setq s (mapconcat (lambda (c) + (if (eq c ?%) + "%25" + (char-to-string c))) + s ""))) (while (string-match "<" s) (setq s (replace-match "%3C" t t s))) (while (string-match ">" s) @@ -8284,8 +8708,9 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (t (save-match-data (if (string-match (concat "^" (regexp-quote - (file-name-as-directory - (expand-file-name ".")))) + (expand-file-name + (file-name-as-directory + default-directory)))) (expand-file-name path)) ;; We are linking a file with relative path name. (setq path (substring (expand-file-name path) @@ -8316,7 +8741,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (setq file (read-file-name "File: ")) (let ((pwd (file-name-as-directory (expand-file-name "."))) (pwd1 (file-name-as-directory (abbreviate-file-name - default-directory)))) + (expand-file-name "."))))) (cond ((equal arg '(16)) (setq link (org-make-link @@ -8554,6 +8979,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file. With a double prefix argument, try to open outside of Emacs, in the application the system uses for this file type." (interactive "P") + ;; if in a code block, then open the block's results + (unless (call-interactively #'org-babel-open-src-block-result) (org-load-modules-maybe) (move-marker org-open-link-marker (point)) (setq org-window-config-before-follow-link (current-window-configuration)) @@ -8660,6 +9087,11 @@ application the system uses for this file type." (browse-url (concat type ":" (org-link-escape path org-link-escape-chars-browser)))) + ((string= type "doi") + (browse-url (concat "http://dx.doi.org/" + (org-link-escape + path org-link-escape-chars-browser)))) + ((member type '("message")) (browse-url (concat type ":" path))) @@ -8730,7 +9162,7 @@ application the system uses for this file type." (t (browse-url-at-point))))))) (move-marker org-open-link-marker nil) - (run-hook-with-args 'org-follow-link-hook)) + (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. @@ -8800,10 +9232,10 @@ there is one, offer it as link number zero." (org-add-link-type "file+sys" 'org-open-file-with-system) (org-add-link-type "file+emacs" 'org-open-file-with-emacs) (defun org-open-file-with-system (path) - "Open file at PATH using the system way of opeing it." + "Open file at PATH using the system way of opening it." (org-open-file path 'system)) (defun org-open-file-with-emacs (path) - "Open file at PATH in emacs." + "Open file at PATH in Emacs." (org-open-file path 'emacs)) (defun org-remove-file-link-modifiers () "Remove the file link modifiers in `file+sys:' and `file+emacs:' links." @@ -8829,8 +9261,8 @@ These functions are called in turn with point at the location to which the link should point. A function in the hook should first test if it would like to -handle this file type, for example by checking the major-mode or -the file extension. If it decides not to handle this file, it +handle this file type, for example by checking the `major-mode' +or the file extension. If it decides not to handle this file, it should just return nil to give other functions a chance. If it does handle the file, it must return the search string to be used when following the link. The search string will be part of the @@ -8851,8 +9283,8 @@ buffer with \\[org-insert-link].") Functions added to this hook must accept a single argument, the search string that was part of the file link, the part after the double colon. The function must first check if it would like to -handle this search, for example by checking the major-mode or the -file extension. If it decides not to handle this search, it +handle this search, for example by checking the `major-mode' or +the file extension. If it decides not to handle this search, it should just return nil to give other functions a chance. If it does handle the search, it must return a non-nil value to keep other functions from trying. @@ -9124,20 +9556,23 @@ entry for this file type, and if yes, the corresponding command is launched. If no application is found, Emacs simply visits the file. With optional prefix argument IN-EMACS, Emacs will visit the file. -With a double C-c C-u prefix arg, Org tries to avoid opening in Emacs +With a double \\[universal-argument] \\[universal-argument] \ +prefix arg, Org tries to avoid opening in Emacs and to use an external application to visit the file. -Optional LINE specifies a line to go to, optional SEARCH a string to -search for. If LINE or SEARCH is given, but IN-EMACS is nil, it will -be assumed that org-open-file was called to open a file: link, and the -original link to match against org-file-apps will be reconstructed -from PATH and whichever of LINE or SEARCH is given. - +Optional LINE specifies a line to go to, optional SEARCH a string +to search for. If LINE or SEARCH is given, the file will be +opened in Emacs, unless an entry from org-file-apps that makes +use of groups in a regexp matches. If the file does not exist, an error is thrown." (let* ((file (if (equal path "") buffer-file-name (substitute-in-file-name (expand-file-name path)))) - (apps (append org-file-apps (org-default-apps))) + (file-apps (append org-file-apps (org-default-apps))) + (apps (org-remove-if + 'org-file-apps-entry-match-against-dlink-p file-apps)) + (apps-dlink (org-remove-if-not + 'org-file-apps-entry-match-against-dlink-p file-apps)) (remp (and (assq 'remote apps) (org-file-remote-p file))) (dirp (if remp nil (file-directory-p file))) (file (if (and dirp org-open-directory-means-index-dot-org) @@ -9169,21 +9604,19 @@ 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))) - ;; if we find a match in org-file-apps, store the match - ;; data for later - (let* ((re-list1 (org-apps-regexp-alist apps nil)) - (re-list2 - (if a-m-a-p - (org-apps-regexp-alist apps a-m-a-p) - re-list1)) - (private-match - (assoc-default dlink re-list1 'string-match)) - (general-match - (assoc-default dfile re-list2 'string-match))) - (if private-match + ; first, try matching against apps-dlink + ; if we get a match here, store the match data for later + (let ((match (assoc-default dlink apps-dlink + 'string-match))) + (if match (progn (setq link-match-data (match-data)) - private-match) - general-match)) + match) + (progn (setq in-emacs (or in-emacs line search)) + nil))) ; if we have no match in apps-dlink, + ; always open the file in emacs if line or search + ; is given (for backwards compatibility) + (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) + 'string-match) (cdr (assoc ext apps)) (cdr (assoc t apps)))))) (when (eq cmd 'system) @@ -9213,6 +9646,7 @@ If the file does not exist, an error is thrown." (shell-quote-argument (convert-standard-filename file))) t t cmd))) + ;; Replace "%1", "%2" etc. in command with group matches from regex (save-match-data (let ((match-index 1) @@ -9246,6 +9680,25 @@ If the file does not exist, an error is thrown." (not (equal old-pos (point)))) (org-mark-ring-push old-pos old-buffer)))) +(defun org-file-apps-entry-match-against-dlink-p (entry) + "This function returns non-nil if `entry' uses a regular +expression which should be matched against the whole link by +org-open-file. + +It assumes that is the case when the entry uses a regular +expression which has at least one grouping construct and the +action is either a lisp form or a command string containing +'%1', i.e. using at least one subexpression match as a +parameter." + (let ((selector (car entry)) + (action (cdr entry))) + (if (stringp selector) + (and (> (regexp-opt-depth selector) 0) + (or (and (stringp action) + (string-match "%[0-9]" action)) + (consp action))) + nil))) + (defun org-default-apps () "Return the default applications for this operating system." (cond @@ -9269,8 +9722,7 @@ be opened in Emacs." nil (if (string-match "\\W" (car x)) x - (cons (concat "\\." (car x) "\\(::.*\\)?\\'") - (cdr x))))) + (cons (concat "\\." (car x) "\\'") (cdr x))))) list)) (if add-auto-mode (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) @@ -9321,12 +9773,64 @@ on the system \"/user@host:\"." (defvar org-agenda-new-buffers nil "Buffers created to visit agenda files.") +(defvar org-refile-cache nil + "Cache for refile targets.") + + +(defvar org-refile-markers nil + "All the markers used for caching refile locations.") + +(defun org-refile-marker (pos) + "Get a new refile marker, but only if caching is in use." + (if (not org-refile-use-cache) + pos + (let ((m (make-marker))) + (move-marker m pos) + (push m org-refile-markers) + m))) + +(defun org-refile-cache-clear () + "Clear the refile cache and disable all the markers." + (mapc (lambda (m) (move-marker m nil)) org-refile-markers) + (setq org-refile-markers nil) + (setq org-refile-cache nil) + (message "Refile cache has been cleared")) + +(defun org-refile-cache-check-set (set) + "Check if all the markers in the cache still have live buffers." + (let (marker) + (catch 'exit + (while (and set (setq marker (nth 3 (pop set)))) + ;; if org-refile-use-outline-path is 'file, marker may be nil + (when (and marker (null (marker-buffer marker))) + (message "not found") (sit-for 3) + (throw 'exit nil))) + t))) + +(defun org-refile-cache-put (set &rest identifiers) + "Push the refile targets SET into the cache, under IDENTIFIERS." + (let* ((key (sha1 (prin1-to-string identifiers))) + (entry (assoc key org-refile-cache))) + (if entry + (setcdr entry set) + (push (cons key set) org-refile-cache)))) + +(defun org-refile-cache-get (&rest identifiers) + "Retrieve the cached value for refile targets given by IDENTIFIERS." + (cond + ((not org-refile-cache) nil) + ((not org-refile-use-cache) (org-refile-cache-clear) nil) + (t + (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers)) + org-refile-cache)))) + (and set (org-refile-cache-check-set set) set))))) + (defun org-get-refile-targets (&optional default-buffer) "Produce a table with refile targets." (let ((case-fold-search nil) ;; otherwise org confuses "TODO" as a kw and "Todo" as a word (entries (or org-refile-targets '((nil . (:level . 1))))) - targets txt re files f desc descre fast-path-p level pos0) + targets tgs txt re files f desc descre fast-path-p level pos0) (message "Getting targets...") (with-current-buffer (or default-buffer (current-buffer)) (while (setq entry (pop entries)) @@ -9365,46 +9869,64 @@ on the system \"/user@host:\"." (while (setq f (pop files)) (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)) - (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f)))) - (setq f (and f (expand-file-name f))) - (if (eq org-refile-use-outline-path 'file) - (push (list (file-name-nondirectory f) f nil nil) targets)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward descre nil t) - (goto-char (setq pos0 (point-at-bol))) - (catch 'next - (when org-refile-target-verify-function - (save-match-data - (or (funcall org-refile-target-verify-function) - (throw 'next t)))) - (when (looking-at org-complex-heading-regexp) - (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) - txt (org-link-display-format (match-string 4)) - re (concat "^" (regexp-quote - (buffer-substring (match-beginning 1) - (match-end 4))))) - (if (match-end 5) (setq re (concat re "[ \t]+" - (regexp-quote - (match-string 5))))) - (setq re (concat re "[ \t]*$")) - (when org-refile-use-outline-path - (setq txt (mapconcat 'org-protect-slash - (append - (if (eq org-refile-use-outline-path 'file) - (list (file-name-nondirectory - (buffer-file-name (buffer-base-buffer)))) - (if (eq org-refile-use-outline-path 'full-file-path) - (list (buffer-file-name (buffer-base-buffer))))) - (org-get-outline-path fast-path-p level txt) - (list txt)) - "/"))) - (push (list txt f re (point)) targets))) - (when (= (point) pos0) - ;; verification function has not moved point - (goto-char (point-at-eol)))))))))) + (or + (setq tgs (org-refile-cache-get (buffer-file-name) descre)) + (progn + (if (bufferp f) (setq f (buffer-file-name + (buffer-base-buffer f)))) + (setq f (and f (expand-file-name f))) + (if (eq org-refile-use-outline-path 'file) + (push (list (file-name-nondirectory f) f nil nil) tgs)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward descre nil t) + (goto-char (setq pos0 (point-at-bol))) + (catch 'next + (when org-refile-target-verify-function + (save-match-data + (or (funcall org-refile-target-verify-function) + (throw 'next t)))) + (when (looking-at org-complex-heading-regexp) + (setq level (org-reduced-level + (- (match-end 1) (match-beginning 1))) + txt (org-link-display-format (match-string 4)) + re (concat "^" (regexp-quote + (buffer-substring + (match-beginning 1) + (match-end 4))))) + (if (match-end 5) (setq re (concat + re "[ \t]+" + (regexp-quote + (match-string 5))))) + (setq re (concat re "[ \t]*$")) + (when org-refile-use-outline-path + (setq txt (mapconcat + 'org-protect-slash + (append + (if (eq org-refile-use-outline-path + 'file) + (list (file-name-nondirectory + (buffer-file-name + (buffer-base-buffer)))) + (if (eq org-refile-use-outline-path + 'full-file-path) + (list (buffer-file-name + (buffer-base-buffer))))) + (org-get-outline-path fast-path-p + level txt) + (list txt)) + "/"))) + (push (list txt f re (org-refile-marker (point))) + tgs))) + (when (= (point) pos0) + ;; verification function has not moved point + (goto-char (point-at-eol)))))))) + (when org-refile-use-cache + (org-refile-cache-put tgs (buffer-file-name) descre)) + (setq targets (append tgs targets)) + )))) (message "Getting targets...done") (nreverse targets))) @@ -9417,13 +9939,14 @@ on the system \"/user@host:\"." (defun org-get-outline-path (&optional fastp level heading) "Return the outline path to the current entry, as a list. -The parameters FASTP, LEVEL, and HEADING are for use be a scanner + +The parameters FASTP, LEVEL, and HEADING are for use by a scanner routine which makes outline path derivations for an entire file, -avoiding backtracing." +avoiding backtracing. Refile target collection makes use of that." (if fastp (progn (if (> level 19) - (error "Outline path failure, more than 19 levels.")) + (error "Outline path failure, more than 19 levels")) (loop for i from level upto 19 do (aset org-olpa i nil)) (prog1 @@ -9439,7 +9962,7 @@ avoiding backtracing." rtn))))) (defun org-format-outline-path (path &optional width prefix) - "Format the outlie path PATH for display. + "Format the outline path PATH for display. Width is the maximum number of characters that is available. Prefix is a prefix to be included in the returned string, such as the file name." @@ -9501,6 +10024,7 @@ such as the file name." Note that this is still *before* the stuff will be removed from the *old* location.") +(defvar org-capture-last-stored-marker) (defun org-refile (&optional goto default-buffer rfloc) "Move the entry at point to another heading. The list of target headings is compiled using the information in @@ -9512,119 +10036,130 @@ Depending on `org-reverse-note-order', the new subitem will either be the first or the last subitem. If there is an active region, all entries in that region will be moved. -However, the region must fulfil the requirement that the first heading +However, the region must fulfill the requirement that the first heading is the first one sets the top-level of the moved text - at most siblings below it are allowed. With prefix arg GOTO, the command will only visit the target location, not actually move anything. -With a double prefix `C-u C-u', go to the location where the last refiling +With a double prefix arg \\[universal-argument] \\[universal-argument], \ +go to the location where the last refiling operation has put the subtree. With a prefix argument of `2', refile to the running clock. RFLOC can be a refile location obtained in a different way. -See also `org-refile-use-outline-path' and `org-completion-use-ido'" +See also `org-refile-use-outline-path' and `org-completion-use-ido'. + +If you are using target caching (see `org-refile-use-cache'), +You have to clear the target cache in order to find new targets. +This can be done with a 0 prefix: `C-0 C-c C-w'" (interactive "P") - (let* ((cbuf (current-buffer)) - (regionp (org-region-active-p)) - (region-start (and regionp (region-beginning))) - (region-end (and regionp (region-end))) - (region-length (and regionp (- region-end region-start))) - (filename (buffer-file-name (buffer-base-buffer cbuf))) - pos it nbuf file re level reversed) - (setq last-command nil) - (when regionp - (goto-char region-start) - (or (bolp) (goto-char (point-at-bol))) - (setq region-start (point)) - (unless (org-kill-is-subtree-p - (buffer-substring region-start region-end)) - (error "The region is not a (sequence of) subtree(s)"))) - (if (equal goto '(16)) - (org-refile-goto-last-stored) - (when (or - (and (equal goto 2) - org-clock-hd-marker (marker-buffer org-clock-hd-marker) - (prog1 - (setq it (list (or org-clock-heading "running clock") - (buffer-file-name - (marker-buffer org-clock-hd-marker)) - "" - (marker-position org-clock-hd-marker))) - (setq goto nil))) - (setq it (or rfloc - (save-excursion - (org-refile-get-location - (if goto "Goto: " "Refile to: ") default-buffer - org-refile-allow-creating-parent-nodes))))) - (setq file (nth 1 it) - re (nth 2 it) - pos (nth 3 it)) - (if (and (not goto) - pos - (equal (buffer-file-name) file) - (if regionp - (and (>= pos region-start) - (<= pos region-end)) - (and (>= pos (point)) - (< pos (save-excursion - (org-end-of-subtree t t)))))) - (error "Cannot refile to position inside the tree or region")) - - (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) - (if goto - (progn - (switch-to-buffer nbuf) - (goto-char pos) - (org-show-context 'org-goto)) - (if regionp + (if (member goto '(0 (64))) + (org-refile-cache-clear) + (let* ((cbuf (current-buffer)) + (regionp (org-region-active-p)) + (region-start (and regionp (region-beginning))) + (region-end (and regionp (region-end))) + (region-length (and regionp (- region-end region-start))) + (filename (buffer-file-name (buffer-base-buffer cbuf))) + pos it nbuf file re level reversed) + (setq last-command nil) + (when regionp + (goto-char region-start) + (or (bolp) (goto-char (point-at-bol))) + (setq region-start (point)) + (unless (org-kill-is-subtree-p + (buffer-substring region-start region-end)) + (error "The region is not a (sequence of) subtree(s)"))) + (if (equal goto '(16)) + (org-refile-goto-last-stored) + (when (or + (and (equal goto 2) + org-clock-hd-marker (marker-buffer org-clock-hd-marker) + (prog1 + (setq it (list (or org-clock-heading "running clock") + (buffer-file-name + (marker-buffer org-clock-hd-marker)) + "" + (marker-position org-clock-hd-marker))) + (setq goto nil))) + (setq it (or rfloc + (save-excursion + (org-refile-get-location + (if goto "Goto: " "Refile to: ") default-buffer + org-refile-allow-creating-parent-nodes))))) + (setq file (nth 1 it) + re (nth 2 it) + pos (nth 3 it)) + (if (and (not goto) + pos + (equal (buffer-file-name) file) + (if regionp + (and (>= pos region-start) + (<= pos region-end)) + (and (>= pos (point)) + (< pos (save-excursion + (org-end-of-subtree t t)))))) + (error "Cannot refile to position inside the tree or region")) + + (setq nbuf (or (find-buffer-visiting file) + (find-file-noselect file))) + (if goto (progn - (org-kill-new (buffer-substring region-start region-end)) - (org-save-markers-in-region region-start region-end)) - (org-copy-subtree 1 nil t)) - (with-current-buffer (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) - (setq reversed (org-notes-order-reversed-p)) - (save-excursion - (save-restriction - (widen) - (if pos - (progn - (goto-char pos) - (looking-at outline-regexp) - (setq level (org-get-valid-level (funcall outline-level) 1)) - (goto-char - (if reversed - (or (outline-next-heading) (point-max)) - (or (save-excursion (org-get-next-sibling)) - (org-end-of-subtree t t) - (point-max))))) - (setq level 1) - (if (not reversed) - (goto-char (point-max)) - (goto-char (point-min)) - (or (outline-next-heading) (goto-char (point-max))))) - (if (not (bolp)) (newline)) - (org-paste-subtree level) - (when org-log-refile - (org-add-log-setup 'refile nil nil 'findpos - org-log-refile) - (unless (eq org-log-refile 'note) - (save-excursion (org-add-log-note)))) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-refile-last-stored") - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (run-hooks 'org-after-refile-insert-hook)))) - (if regionp - (delete-region (point) (+ (point) region-length)) - (org-cut-subtree)) - (when (featurep 'org-inlinetask) - (org-inlinetask-remove-END-maybe)) - (setq org-markers-to-move nil) - (message "Refiled to \"%s\"" (car it)))))) - (org-reveal)) + (switch-to-buffer nbuf) + (goto-char pos) + (org-show-context 'org-goto)) + (if regionp + (progn + (org-kill-new (buffer-substring region-start region-end)) + (org-save-markers-in-region region-start region-end)) + (org-copy-subtree 1 nil t)) + (with-current-buffer (setq nbuf (or (find-buffer-visiting file) + (find-file-noselect file))) + (setq reversed (org-notes-order-reversed-p)) + (save-excursion + (save-restriction + (widen) + (if pos + (progn + (goto-char pos) + (looking-at outline-regexp) + (setq level (org-get-valid-level (funcall outline-level) 1)) + (goto-char + (if reversed + (or (outline-next-heading) (point-max)) + (or (save-excursion (org-get-next-sibling)) + (org-end-of-subtree t t) + (point-max))))) + (setq level 1) + (if (not reversed) + (goto-char (point-max)) + (goto-char (point-min)) + (or (outline-next-heading) (goto-char (point-max))))) + (if (not (bolp)) (newline)) + (org-paste-subtree level) + (when org-log-refile + (org-add-log-setup 'refile nil nil 'findpos + org-log-refile) + (unless (eq org-log-refile 'note) + (save-excursion (org-add-log-note)))) + (and org-auto-align-tags (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 + (when (org-bound-and-true-p org-refile-for-capture) + (bookmark-set "org-capture-last-stored-marker") + (move-marker org-capture-last-stored-marker (point))) + (if (fboundp 'deactivate-mark) (deactivate-mark)) + (run-hooks 'org-after-refile-insert-hook)))) + (if regionp + (delete-region (point) (+ (point) region-length)) + (org-cut-subtree)) + (when (featurep 'org-inlinetask) + (org-inlinetask-remove-END-maybe)) + (setq org-markers-to-move nil) + (message "Refiled to \"%s\" in file %s" (car it) file))))))) (defun org-refile-goto-last-stored () "Go to the location where the last refile was stored." @@ -9837,7 +10372,7 @@ blocks in the buffer." (org-update-dblock))) (defun org-update-dblock () - "Update the dynamic block at point + "Update the dynamic block at point. This means to empty the block, parse for parameters and then call the correct writing function." (save-window-excursion @@ -9932,12 +10467,12 @@ This function can be used in a hook." ) "Structure completion elements. This is a list of abbreviation keys and values. The value gets inserted -it you type @samp{.} followed by the key and then the completion key, +if you type `<' followed by the key and then press the completion key, usually `M-TAB'. %file will be replaced by a file name after prompting for the file using completion. 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 +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." :group 'org-completion @@ -10157,15 +10692,13 @@ this is nil.") (defvar org-todo-setup-filter-hook nil "Hook for functions that pre-filter todo specs. - -Each function takes a todo spec and returns either `nil' or the spec +Each function takes a todo spec and returns either nil or the spec transformed into canonical form." ) (defvar org-todo-get-default-hook nil "Hook for functions that get a default item for todo. - Each function takes arguments (NEW-MARK OLD-MARK) and returns either -`nil' or a string to be used for the todo mark." ) +nil or a string to be used for the todo mark." ) (defvar org-agenda-headline-snapshot-before-repeat) @@ -10182,10 +10715,12 @@ So for this example: when the item starts with TODO, it is changed to DONE. When it starts with DONE, the DONE is removed. And when neither TODO nor DONE are present, add TODO at the beginning of the heading. -With C-u prefix arg, use completion to determine the new state. +With \\[universal-argument] prefix arg, use completion to determine the new \ +state. With numeric prefix arg, switch to that state. -With a double C-u prefix, switch to the next set of TODO keywords (nextset). -With a triple C-u prefix, circumvent any state blocking. +With a double \\[universal-argument] prefix, switch to the next set of TODO \ +keywords (nextset). +With a triple \\[universal-argument] prefix, circumvent any state blocking. For calling through lisp, arg is also interpreted in the following way: 'none -> empty state @@ -10213,7 +10748,7 @@ For calling through lisp, arg is also interpreted in the following way: (looking-at " *")) (let* ((match-data (match-data)) (startpos (point-at-bol)) - (logging (save-match-data (org-entry-get nil "LOGGING" t))) + (logging (save-match-data (org-entry-get nil "LOGGING" t t))) (org-log-done org-log-done) (org-log-repeat org-log-repeat) (org-todo-log-states org-todo-log-states) @@ -10429,7 +10964,7 @@ changes. Such blocking occurs when: (let* ((pos (point)) (parent-pos (and (org-up-heading-safe) (point)))) (if (not parent-pos) (throw 'dont-block t)) ; no parent - (when (and (org-entry-get (point) "ORDERED") + (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t)) (throw 'dont-block nil)) ; block, there is an older sibling not done. @@ -10441,7 +10976,7 @@ changes. Such blocking occurs when: (setq pos (point)) (setq parent-pos (and (org-up-heading-safe) (point))) (if (not parent-pos) (throw 'dont-block t)) ; no parent - (when (and (org-entry-get (point) "ORDERED") + (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t)) (throw 'dont-block nil)))))))) ; block, older sibling not done. @@ -10835,12 +11370,17 @@ This function is run automatically after each state change to a DONE state." (org-log-done nil) (org-todo-log-states nil) (nshiftmax 10) (nshift 0) - re type n what ts time) + re type n what ts time to-state) (when repeat (if (eq org-log-repeat t) (setq org-log-repeat 'state)) - (org-todo (if (eq interpret 'type) last-state head)) - (org-entry-put nil "LAST_REPEAT" (format-time-string - (org-time-stamp-format t t))) + (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE") + org-todo-repeat-to-state)) + (unless (and to-state (member to-state org-todo-keywords-1)) + (setq to-state (if (eq interpret 'type) last-state head))) + (org-todo to-state) + (when (or org-log-repeat (org-entry-get nil "CLOCK")) + (org-entry-put nil "LAST_REPEAT" (format-time-string + (org-time-stamp-format t t)))) (when org-log-repeat (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) (memq 'org-add-log-note post-command-hook)) @@ -11004,7 +11544,7 @@ returns nil." (apply 'encode-time (org-parse-time-string time))))) (defun org-get-deadline-time (pom &optional inherit) - "Get the deadine as a time tuple, of a format suitable for + "Get the deadline as a time tuple, of a format suitable for calling org-deadline with, or if there is no scheduling, returns nil." (let ((time (org-entry-get pom "DEADLINE" inherit))) @@ -11122,7 +11662,7 @@ be removed." (end-of-line 1)) (goto-char (point-min)) (widen) - (if (and (looking-at "[ \t]+\n") + (if (and (looking-at "[ \t]*\n") (equal (char-before) ?\n)) (delete-region (1- (point)) (point-at-eol))) ts)))))) @@ -11272,6 +11812,9 @@ EXTRA is additional text that will be inserted into the notes buffer." (cons "%t" (format-time-string (org-time-stamp-format 'long 'inactive) (current-time))) + (cons "%T" (format-time-string + (org-time-stamp-format 'long nil) + (current-time))) (cons "%s" (if org-log-note-state (concat "\"" org-log-note-state "\"") "")) @@ -11326,7 +11869,8 @@ POS may also be a marker." This command can create sparse trees. You first need to select the type of match used to create the tree: -t Show entries with a specific TODO keyword. +t Show all TODO entries. +T Show entries with a specific TODO keyword. m Show entries selected by a tags/property match. p Enter a property name and its value (both with completion on existing names/values) and show entries with that property. @@ -11336,7 +11880,7 @@ b Show deadlines and scheduled items before a date. a Show deadlines and scheduled items after a date." (interactive "P") (let (ans kwd value) - (message "Sparse tree: [/]regexp [t]odo-kwd [m]atch [p]roperty [d]eadlines [b]efore-date [a]fter-date") + (message "Sparse tree: [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty [d]eadlines\n [b]efore-date [a]fter-date") (setq ans (read-char-exclusive)) (cond ((equal ans ?d) @@ -11346,6 +11890,8 @@ a Show deadlines and scheduled items after a date." ((equal ans ?a) (call-interactively 'org-check-after-date)) ((equal ans ?t) + (org-show-todo-tree nil)) + ((equal ans ?T) (org-show-todo-tree '(4))) ((member ans '(?T ?m)) (call-interactively 'org-match-sparse-tree)) @@ -11417,7 +11963,7 @@ that the match should indeed be shown." cnt)) (defun org-show-context (&optional key) - "Make sure point and context and visible. + "Make sure point and context are visible. How much context is shown depends upon the variables `org-show-hierarchy-above', `org-show-following-heading'. and `org-show-siblings'." @@ -11460,7 +12006,8 @@ not t for the search context. With optional argument SIBLINGS, on each level of the hierarchy all siblings are shown. This repairs the tree structure to what it would look like when opened with hierarchical calls to `org-cycle'. -With double optional argument `C-u C-u', go to the parent and show the +With double optional argument \\[universal-argument] \\[universal-argument], \ +go to the parent and show the entire tree." (interactive "P") (run-hooks 'org-reveal-start-hook) @@ -11476,8 +12023,8 @@ entire tree." (defun org-highlight-new-match (beg end) "Highlight from BEG to END and mark the highlight is an occur headline." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face 'secondary-selection) + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face 'secondary-selection) (push ov org-occur-highlights))) (defun org-remove-occur-highlights (&optional beg end noremove) @@ -11486,7 +12033,7 @@ BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) (unless org-inhibit-highlight-removal - (mapc 'org-delete-overlay org-occur-highlights) + (mapc 'delete-overlay org-occur-highlights) (setq org-occur-highlights nil) (setq org-occur-parameters nil) (unless noremove @@ -11989,7 +12536,7 @@ epoch to the beginning of today (00:00)." (delq nil list)) (defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param -(defvar org-tags-overlay (org-make-overlay 1 1)) +(defvar org-tags-overlay (make-overlay 1 1)) (org-detach-overlay org-tags-overlay) (defun org-get-local-tags-at (&optional pos) @@ -12142,6 +12689,16 @@ If DATA is nil or the empty string, any tags will be removed." (if (looking-at ".*?\\([ \t]+\\)$") (delete-region (match-beginning 1) (match-end 1)))))) +(defun org-align-all-tags () + "Align the tags i all headings." + (interactive) + (save-excursion + (or (ignore-errors (org-back-to-heading t)) + (outline-next-heading)) + (if (org-on-heading-p) + (org-set-tags t) + (message "No headings")))) + (defun org-set-tags (&optional arg just-align) "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." @@ -12355,7 +12912,7 @@ Returns the new tags string, or nil to not change the current settings." (if (> (current-column) org-tags-column) " " (make-string (- org-tags-column (current-column)) ?\ )))))) - (org-move-overlay org-tags-overlay ov-start ov-end) + (move-overlay org-tags-overlay ov-start ov-end) (save-window-excursion (if expert (set-buffer (get-buffer-create " *Org tags*")) @@ -12663,7 +13220,7 @@ but in some other way.") "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" "EXPORT_FILE_NAME" "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" - "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" + "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE" "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS") "Some properties that are used by Org-mode for various purposes. Being in this list makes sure that they are offered for completion.") @@ -12753,12 +13310,11 @@ allowed value." (save-excursion (beginning-of-line 1) (when (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)")) - (let ((match (match-data)) ;; Keep match-data for use by calling - (p (point)) ;; procedures. - (range (unless (org-before-first-heading-p) - (org-get-property-block)))) - (prog1 (and range (<= (car range) p) (< p (cdr range))) - (set-match-data match)))))) + (save-match-data ;; Used by calling procedures + (let ((p (point)) + (range (unless (org-before-first-heading-p) + (org-get-property-block)))) + (and range (<= (car range) p) (< p (cdr range)))))))) (defun org-get-property-block (&optional beg end force) "Return the (beg . end) range of the body of the property drawer. @@ -12806,7 +13362,7 @@ 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 value string clocksum) + beg end range props sum-props key key1 value string clocksum) (save-excursion (when (condition-case nil (and (org-mode-p) (org-back-to-heading t)) @@ -12837,23 +13393,35 @@ things up because then unnecessary parsing is avoided." (when (or (not specific) (string= specific "BLOCKED")) (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)) (when (or (not specific) - (member specific org-all-time-keywords) - (member specific '("TIMESTAMP" "TIMESTAMP_IA"))) + (member specific + '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" + "TIMESTAMP" "TIMESTAMP_IA"))) (while (re-search-forward org-maybe-keyword-time-regexp end t) - (setq key (if (match-end 1) (substring (org-match-string-no-properties 1) 0 -1)) + (setq key (if (match-end 1) + (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))))) - (substring (org-match-string-no-properties 3) 1 -1))) - (unless key - (if (= (char-after (match-beginning 3)) ?\[) - (setq key "TIMESTAMP_IA") - (setq key "TIMESTAMP"))) - (when (or (equal key clockstr) (not (assoc key props))) + (buffer-substring + (match-beginning 3) (goto-char + (point-at-eol))))) + (substring (org-match-string-no-properties 3) + 1 -1))) + ;; Get the correct property name from the key. This is + ;; necessary if the user has configured time keywords. + (setq key1 (concat key ":")) + (cond + ((not key) + (setq key + (if (= (char-after (match-beginning 3)) ?\[) + "TIMESTAMP_IA" "TIMESTAMP"))) + ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) + ((equal key1 org-deadline-string) (setq key "DEADLINE")) + ((equal key1 org-closed-string) (setq key "CLOSED")) + ((equal key1 org-clock-string) (setq key "CLOCK"))) + (when (or (equal key "CLOCK") (not (assoc key props))) (push (cons key string) props)))) - ) (when (memq which '(all standard)) @@ -12880,19 +13448,23 @@ things up because then unnecessary parsing is avoided." (push (cons "CATEGORY" value) props)) (append sum-props (nreverse props))))))) -(defun org-entry-get (pom property &optional inherit) +(defun org-entry-get (pom property &optional inherit literal-nil) "Get value of PROPERTY for entry at point-or-marker POM. If INHERIT is non-nil and the entry does not have the property, then also check higher levels of the hierarchy. If INHERIT is the symbol `selective', use inheritance only if the setting in `org-use-property-inheritance' selects PROPERTY for inheritance. If the property is present but empty, the return value is the empty string. -If the property is not present at all, nil is returned." +If the property is not present at all, nil is returned. + +If LITERAL-NIL is set, return the string value \"nil\" as a string, +do not interpret it as the list atom nil. This is used for inheritance +when a \"nil\" value can supersede a non-nil value higher up the hierarchy." (org-with-point-at pom (if (and inherit (if (eq inherit 'selective) (org-property-inherit-p property) t)) - (org-entry-get-with-inheritance property) + (org-entry-get-with-inheritance property literal-nil) (if (member property org-special-properties) ;; We need a special property. Use `org-entry-properties' to ;; retrieve it, but specify the wanted property @@ -12905,7 +13477,9 @@ If the property is not present at all, nil is returned." (cdr range) t)) ;; Found the property, return it. (if (match-end 1) - (org-match-string-no-properties 1) + (if literal-nil + (org-match-string-no-properties 1) + (org-not-nil (org-match-string-no-properties 1))) ""))))))) (defun org-property-or-variable-value (var &optional inherit) @@ -13000,8 +13574,12 @@ no match, the marker will point nowhere. Note that also `org-entry-get' calls this function, if the INHERIT flag is set.") -(defun org-entry-get-with-inheritance (property) - "Get entry property, and search higher levels if not present." +(defun org-entry-get-with-inheritance (property &optional literal-nil) + "Get entry property, and search higher levels if not present. +The search will stop at the first ancestor which has the property defined. +If the value found is \"nil\", return nil to show that the property +should be considered as undefined (this is the meaning of nil here). +However, if LITERAL-NIL is set, return the string value \"nil\" instead." (move-marker org-entry-property-inherited-from nil) (let (tmp) (save-excursion @@ -13009,15 +13587,16 @@ is set.") (widen) (catch 'ex (while t - (when (setq tmp (org-entry-get nil property)) + (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))))) - (or tmp - (cdr (assoc property org-file-properties)) - (cdr (assoc property org-global-properties)) - (cdr (assoc property org-global-properties-fixed)))))) + (setq tmp (or tmp + (cdr (assoc property org-file-properties)) + (cdr (assoc property org-global-properties)) + (cdr (assoc property org-global-properties-fixed)))) + (if literal-nil tmp (org-not-nil tmp))))) (defvar org-property-changed-functions nil "Hook called when the value of a property has changed. @@ -13216,7 +13795,8 @@ in the current file." "In the current entry, delete PROPERTY." (interactive (let* ((completion-ignore-case t) - (prop (org-icompleting-read "Property: " (org-entry-properties nil 'standard)))) + (prop (org-icompleting-read "Property: " + (org-entry-properties nil 'standard)))) (list prop))) (message "Property %s %s" property (if (org-entry-delete nil property) @@ -13330,6 +13910,51 @@ completion." (skip-chars-forward " \t") (run-hook-with-args 'org-property-changed-functions key nval))) +(defun org-find-olp (path &optional this-buffer) + "Return a marker pointing to the entry at outline path OLP. +If anything goes wrong, throw an error. +You can wrap this call to catch the error like this: + + (condition-case msg + (org-mobile-locate-entry (match-string 4)) + (error (nth 1 msg))) + +The return value will then be either a string with the error message, +or a marker if everything is OK. + +If THIS-BUFFER is set, the outline path does not contain a file, +only headings." + (let* ((file (if this-buffer buffer-file-name (pop path))) + (buffer (if this-buffer (current-buffer) (find-file-noselect file))) + (level 1) + (lmin 1) + (lmax 1) + limit re end found pos heading cnt) + (unless buffer (error "File not found :%s" file)) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (setq limit (point-max)) + (goto-char (point-min)) + (while (setq heading (pop path)) + (setq re (format org-complex-heading-regexp-format + (regexp-quote heading))) + (setq cnt 0 pos (point)) + (while (re-search-forward re end t) + (setq level (- (match-end 1) (match-beginning 1))) + (if (and (>= level lmin) (<= level lmax)) + (setq found (match-beginning 0) cnt (1+ cnt)))) + (when (= cnt 0) (error "Heading not found on level %d: %s" + lmax heading)) + (when (> cnt 1) (error "Heading not unique on level %d: %s" + lmax heading)) + (goto-char found) + (setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0))) + (setq end (save-excursion (org-end-of-subtree t t)))) + (when (org-on-heading-p) + (move-marker (make-marker) (point)))))))) + (defun org-find-entry-with-id (ident) "Locate the entry that contains the ID property with exact value IDENT. IDENT can be a string, a symbol or a number, this function will search for @@ -13436,8 +14061,8 @@ So these are more for recording a certain time/date." (interactive "P") (org-time-stamp arg 'inactive)) -(defvar org-date-ovl (org-make-overlay 1 1)) -(org-overlay-put org-date-ovl 'face 'org-warning) +(defvar org-date-ovl (make-overlay 1 1)) +(overlay-put org-date-ovl 'face 'org-warning) (org-detach-overlay org-date-ovl) (defvar org-ans1) ; dynamically scoped parameter @@ -13458,10 +14083,15 @@ The prompt will suggest to enter an ISO date, but you can also enter anything which will at least partially be understood by `parse-time-string'. Unrecognized parts of the date will default to the current day, month, year, hour and minute. If this command is called to replace a timestamp at point, -of to enter the second timestamp of a range, the default time is taken from the -existing stamp. For example, +of to enter the second timestamp of a range, the default time is taken +from the existing stamp. Furthermore, the command prefers the future, +so if you are giving a date where the year is not given, and the day-month +combination is already past in the current year, it will assume you +mean next year. For details, see the manual. A few examples: + 3-2-5 --> 2003-02-05 feb 15 --> currentyear-02-15 + 2/15 --> currentyear-02-15 sep 12 9 --> 2009-09-12 12:45 --> today 12:45 22 sept 0:34 --> currentyear-09-22 0:34 @@ -13514,11 +14144,10 @@ user." (setq def (apply 'encode-time defdecode) defdecode (decode-time def))))) (calendar-frame-setup nil) + (calendar-setup nil) (calendar-move-hook nil) (calendar-view-diary-initially-flag nil) - (view-diary-entries-initially nil) (calendar-view-holidays-initially-flag nil) - (view-calendar-holidays-initially nil) (timestr (format-time-string (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) (prompt (concat (if prompt (concat prompt " ") "") @@ -13539,10 +14168,8 @@ user." (map (copy-keymap calendar-mode-map)) (minibuffer-local-map (copy-keymap minibuffer-local-map))) (org-defkey map (kbd "RET") 'org-calendar-select) - (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1]) - 'org-calendar-select-mouse) - (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2]) - 'org-calendar-select-mouse) + (org-defkey map [mouse-1] 'org-calendar-select-mouse) + (org-defkey map [mouse-2] 'org-calendar-select-mouse) (org-defkey minibuffer-local-map [(meta shift left)] (lambda () (interactive) (org-eval-in-calendar '(calendar-backward-month 1)))) @@ -13585,6 +14212,14 @@ user." (org-defkey minibuffer-local-map "<" (lambda () (interactive) (org-eval-in-calendar '(scroll-calendar-right 1)))) + (org-defkey minibuffer-local-map "\C-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-left-three-months 1)))) + (org-defkey minibuffer-local-map "\M-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-right-three-months 1)))) (run-hooks 'org-read-date-minibuffer-setup-hook) (unwind-protect (progn @@ -13599,7 +14234,7 @@ user." (remove-hook 'post-command-hook 'org-read-date-display) (use-local-map old-map) (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay) + (delete-overlay org-read-date-overlay) (setq org-read-date-overlay nil))))))) (t ; Naked prompt only @@ -13607,7 +14242,7 @@ user." (setq ans (read-string prompt default-input 'org-read-date-history timestr)) (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay) + (delete-overlay org-read-date-overlay) (setq org-read-date-overlay nil))))) (setq final (org-read-date-analyze ans def defdecode)) @@ -13629,7 +14264,7 @@ user." "Display the current date prompt interpretation in the minibuffer." (when org-read-date-display-live (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay)) + (delete-overlay org-read-date-overlay)) (let ((p (point))) (end-of-line 1) (while (not (equal (buffer-substring @@ -13657,11 +14292,11 @@ user." (when org-read-date-analyze-futurep (setq txt (concat txt " (=>F)"))) (setq org-read-date-overlay - (org-make-overlay (1- (point-at-eol)) (point-at-eol))) + (make-overlay (1- (point-at-eol)) (point-at-eol))) (org-overlay-display org-read-date-overlay txt 'secondary-selection)))) (defun org-read-date-analyze (ans def defdecode) - "Analyse the combined answer of the date prompt." + "Analyze the combined answer of the date prompt." ;; FIXME: cleanup and comment (let ((nowdecode (decode-time (current-time))) delta deltan deltaw deltadef year month day @@ -13703,7 +14338,7 @@ user." t nil ans))) ;; Help matching american dates, like 5/30 or 5/30/7 (when (string-match - "^ *\\([0-3]?[0-9]\\)/\\([0-1]?[0-9]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans) + "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans) (setq year (if (match-end 4) (string-to-number (match-string 4 ans)) (progn (setq kill-year t) @@ -13893,7 +14528,7 @@ Also, store the cursor date in variable org-ans2." (let* ((date (calendar-cursor-to-date)) (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) - (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) + (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) (select-window sw) (org-select-frame-set-input-focus sf))) @@ -14187,7 +14822,7 @@ days in order to avoid rounding problems." (defun org-time-string-to-absolute (s &optional daynr prefer show-all) "Convert a time stamp to an absolute day number. -If there is a specifyer for a cyclic time stamp, get the closest date to +If there is a specifier for a cyclic time stamp, get the closest date to DAYNR. PREFER and SHOW-ALL are passed through to `org-closest-date'. the variable date is bound by the calendar when this is called." @@ -14300,7 +14935,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change) (setq dn (string-to-number (match-string 1 change)) dw (cdr (assoc (match-string 2 change) a1))) - (error "Invalid change specifyer: %s" change)) + (error "Invalid change specifier: %s" change)) (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) (cond ((eq dw 'day) @@ -14346,7 +14981,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." (t (if (= cday n1) n1 n2))))))) (defun org-date-to-gregorian (date) - "Turn any specification of DATE into a gregorian date for the calendar." + "Turn any specification of DATE into a Gregorian date for the calendar." (cond ((integerp date) (calendar-gregorian-from-absolute date)) ((and (listp date) (= (length date) 3)) date) ((stringp date) @@ -14378,7 +15013,7 @@ If the cursor is on the year, change the year. If it is on the month or the day, change that. With prefix ARG, change by that many units." (interactive "p") - (org-timestamp-change (prefix-numeric-value arg))) + (org-timestamp-change (prefix-numeric-value arg) nil 'updown)) (defun org-timestamp-down (&optional arg) "Decrease the date item at the cursor by one. @@ -14386,7 +15021,7 @@ If the cursor is on the year, change the year. If it is on the month or the day, change that. With prefix ARG, change by that many units." (interactive "p") - (org-timestamp-change (- (prefix-numeric-value arg)))) + (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown)) (defun org-timestamp-up-day (&optional arg) "Increase the date in the time stamp by one day. @@ -14395,7 +15030,7 @@ With prefix ARG, change that many days." (if (and (not (org-at-timestamp-p t)) (org-on-heading-p)) (org-todo 'up) - (org-timestamp-change (prefix-numeric-value arg) 'day))) + (org-timestamp-change (prefix-numeric-value arg) 'day 'updown))) (defun org-timestamp-down-day (&optional arg) "Decrease the date in the time stamp by one day. @@ -14404,7 +15039,7 @@ With prefix ARG, change that many days." (if (and (not (org-at-timestamp-p t)) (org-on-heading-p)) (org-todo 'down) - (org-timestamp-change (- (prefix-numeric-value arg)) 'day))) + (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown)) (defun org-at-timestamp-p (&optional inactive-ok) "Determine if the cursor is in or at a timestamp." @@ -14449,7 +15084,7 @@ With prefix ARG, change that many days." (message "Timestamp is now %sactive" (if (equal (char-after beg) ?<) "" "in"))))) -(defun org-timestamp-change (n &optional what) +(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', `year', `minute', `second'. If WHAT is not given, the cursor position @@ -14480,8 +15115,10 @@ in the timestamp determines what will be changed." (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) (setq with-hm t)) (setq time0 (org-parse-time-string ts)) - (when (and (eq org-ts-what 'minute) - (eq current-prefix-arg nil)) + (when (and updown + (eq org-ts-what 'minute) + (not current-prefix-arg)) + ;; This looks like s-up and s-down. Change by one rounding step. (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) (when (not (= 0 (setq rem (% (nth 1 time0) dm)))) (setcar (cdr time0) (+ (nth 1 time0) @@ -14578,9 +15215,7 @@ A prefix ARG can be used to force the current date." (let ((tsr org-ts-regexp) diff (calendar-move-hook nil) (calendar-view-holidays-initially-flag nil) - (view-calendar-holidays-initially nil) - (calendar-view-diary-initially-flag nil) - (view-diary-entries-initially nil)) + (calendar-view-diary-initially-flag nil)) (if (or (org-at-timestamp-p) (save-excursion (beginning-of-line 1) @@ -14670,21 +15305,31 @@ changes from another. I believe the procedure must be like this: ;;;; Agenda files ;;;###autoload -(defun org-iswitchb (&optional arg) - "Use `org-icompleting-read' to prompt for an Org buffer to switch to. +(defun org-switchb (&optional arg) + "Switch between Org buffers. With a prefix argument, restrict available to files. -With two prefix arguments, restrict available buffers to agenda files." +With two prefix arguments, restrict available buffers to agenda files. + +Defaults to `iswitchb' for buffer name completion. +Set `org-completion-use-ido' to make it use ido instead." (interactive "P") (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files)) ((equal arg '(16)) (org-buffer-list 'agenda)) - (t (org-buffer-list))))) + (t (org-buffer-list)))) + (org-completion-use-iswitchb org-completion-use-iswitchb) + (org-completion-use-ido org-completion-use-ido)) + (unless (or org-completion-use-ido org-completion-use-iswitchb) + (setq org-completion-use-iswitchb t)) (switch-to-buffer (org-icompleting-read "Org buffer: " - (mapcar 'list (mapcar 'buffer-name blist)) - nil t)))) + (mapcar 'list (mapcar 'buffer-name blist)) + nil t)))) +;;; Define some older names previously used for this functionality +;;;###autoload +(defalias 'org-ido-switchb 'org-switchb) ;;;###autoload -(defalias 'org-ido-switchb 'org-iswitchb) +(defalias 'org-iswitchb 'org-switchb) (defun org-buffer-list (&optional predicate exclude-tmp) "Return a list of Org buffers. @@ -14755,6 +15400,13 @@ used by the agenda files. If ARCHIVE is `ifmode', do this only if (setq files (org-add-archive-files files))) files)) +(defun org-agenda-file-p (&optional file) + "Return non-nil, if FILE is an agenda file. +If FILE is omitted, use the file associated with the current +buffer." + (member (or file (buffer-file-name)) + (org-agenda-files t))) + (defun org-edit-agenda-file-list () "Edit the list of agenda files. Depending on setup, this either uses customize to edit the variable @@ -15068,10 +15720,6 @@ looks only before point, not after." (org-in-regexp "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) -(defun test () - (interactive) - (message "%s" (org-inside-latex-macro-p))) - (defun org-try-cdlatex-tab () "Check if it makes sense to execute `cdlatex-tab', and do it if yes. It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is @@ -15113,7 +15761,7 @@ Revert to the normal definition outside of these fragments." (defun org-remove-latex-fragment-image-overlays () "Remove all overlays with LaTeX fragment images in current buffer." - (mapc 'org-delete-overlay org-latex-fragment-image-overlays) + (mapc 'delete-overlay org-latex-fragment-image-overlays) (setq org-latex-fragment-image-overlays nil)) (defun org-preview-latex-fragment (&optional subtree) @@ -15122,7 +15770,8 @@ If the cursor is in a LaTeX fragment, create the image and overlay it over the source code. If there is no fragment at point, display all fragments in the current text, from one headline to the next. With prefix SUBTREE, display all fragments in the current subtree. With a -double prefix `C-u C-u', or when the cursor is before the first headline, +double prefix arg \\[universal-argument] \\[universal-argument], or when \ +the cursor is before the first headline, display all fragments in the buffer. The images can be removed again with \\[org-ctrl-c-ctrl-c]." (interactive "P") @@ -15168,7 +15817,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) "Regular expressions for matching embedded LaTeX.") -(defun org-format-latex (prefix &optional dir overlays msg at forbuffer) +(defun org-format-latex (prefix &optional dir overlays msg at + forbuffer protect-only) "Replace LaTeX fragments with links to an image, and produce images. Some of the options can be changed using the variable `org-format-latex-options'." @@ -15198,60 +15848,63 @@ Some of the options can be changed using the variable (not (eq (get-char-property (match-beginning n) 'org-overlay-type) 'org-latex-overlay)))) - (setq txt (match-string n) - beg (match-beginning n) end (match-end n) - cnt (1+ cnt)) - (let (print-length print-level) ; make sure full list is printed - (setq hash (sha1 (prin1-to-string - (list org-format-latex-header - org-format-latex-header-extra - org-export-latex-default-packages-alist - org-export-latex-packages-alist - org-format-latex-options - forbuffer txt))) - linkfile (format "%s_%s.png" prefix hash) - movefile (format "%s_%s.png" absprefix hash))) - (setq link (concat block "[[file:" linkfile "]]" block)) - (if msg (message msg cnt)) - (goto-char beg) - (unless checkdir ; make sure the directory exists - (setq checkdir t) - (or (file-directory-p todir) (make-directory todir))) - - (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)) - (if overlays - (progn - (mapc (lambda (o) - (if (eq (org-overlay-get o 'org-overlay-type) - 'org-latex-overlay) - (org-delete-overlay o))) - (org-overlays-in beg end)) - (setq ov (org-make-overlay beg end)) - (org-overlay-put ov 'org-overlay-type 'org-latex-overlay) - (if (featurep 'xemacs) - (progn - (org-overlay-put ov 'invisible t) - (org-overlay-put - ov 'end-glyph - (make-glyph (vector 'png :file movefile)))) - (org-overlay-put - ov 'display - (list 'image :type 'png :file movefile :ascent 'center))) - (push ov org-latex-fragment-image-overlays) - (goto-char end)) - (delete-region beg end) - (insert (org-add-props link - (list 'org-latex-src - (replace-regexp-in-string "\"" "" txt))))))))))) + (if protect-only + (add-text-properties (match-beginning n) (match-end n) + '(org-protected t)) + (setq txt (match-string n) + beg (match-beginning n) end (match-end n) + cnt (1+ cnt)) + (let (print-length print-level) ; make sure full list is printed + (setq hash (sha1 (prin1-to-string + (list org-format-latex-header + org-format-latex-header-extra + org-export-latex-default-packages-alist + org-export-latex-packages-alist + org-format-latex-options + forbuffer txt))) + linkfile (format "%s_%s.png" prefix hash) + movefile (format "%s_%s.png" absprefix hash))) + (setq link (concat block "[[file:" linkfile "]]" block)) + (if msg (message msg cnt)) + (goto-char beg) + (unless checkdir ; make sure the directory exists + (setq checkdir t) + (or (file-directory-p todir) (make-directory todir))) + + (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)) + (if overlays + (progn + (mapc (lambda (o) + (if (eq (overlay-get o 'org-overlay-type) + 'org-latex-overlay) + (delete-overlay o))) + (overlays-in beg end)) + (setq ov (make-overlay beg end)) + (overlay-put ov 'org-overlay-type 'org-latex-overlay) + (if (featurep 'xemacs) + (progn + (overlay-put ov 'invisible t) + (overlay-put + ov 'end-glyph + (make-glyph (vector 'png :file movefile)))) + (overlay-put + ov 'display + (list 'image :type 'png :file movefile :ascent 'center))) + (push ov org-latex-fragment-image-overlays) + (goto-char end)) + (delete-region beg end) + (insert (org-add-props link + (list 'org-latex-src + (replace-regexp-in-string "\"" "" txt)))))))))))) ;; This function borrows from Ganesh Swami's latex2png.el (defun org-create-formula-image (string tofile options buffer) @@ -15280,7 +15933,7 @@ Some of the options can be changed using the variable (insert (org-splice-latex-header org-format-latex-header org-export-latex-default-packages-alist - org-export-latex-packages-alist + org-export-latex-packages-alist t org-format-latex-header-extra)) (insert "\n\\begin{document}\n" string "\n\\end{document}\n") (require 'org-latex) @@ -15314,13 +15967,13 @@ Some of the options can be changed using the variable (delete-file (concat texfilebase e))) pngfile)))) -(defun org-splice-latex-header (tpl def-pkg pkg &optional extra) +(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) "Fill a LaTeX header template TPL. In the template, the following place holders will be recognized: [DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG [NO-DEFAULT-PACKAGES] do not include DEF-PKG - [PACKAGES] \\usepackage statements for PKG + [PACKAGES] \\usepackage statements for PKG [NO-PACKAGES] do not include PKG [EXTRA] the string EXTRA [NO-EXTRA] do not include EXTRA @@ -15329,19 +15982,22 @@ For backward compatibility, if both the positive and the negative place holder is missing, the positive one (without the \"NO-\") will be assumed to be present at the end of the template. DEF-PKG and PKG are assumed to be alists of options/packagename lists. -EXTRA is a string." +EXTRA is a string. +SNIPPETS-P indicates if this is run to create snippet images for HTML." (let (rpl (end "")) (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl) (setq rpl (if (or (match-end 1) (not def-pkg)) - "" (org-latex-packages-to-string def-pkg t)) + "" (org-latex-packages-to-string def-pkg snippets-p t)) tpl (replace-match rpl t t tpl)) - (if def-pkg (setq end (org-latex-packages-to-string def-pkg)))) - + (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) + (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl) (setq rpl (if (or (match-end 1) (not pkg)) - "" (org-latex-packages-to-string pkg t)) + "" (org-latex-packages-to-string pkg snippets-p t)) tpl (replace-match rpl t t tpl)) - (if pkg (setq end (concat end "\n" (org-latex-packages-to-string pkg))))) + (if pkg (setq end + (concat end "\n" + (org-latex-packages-to-string pkg snippets-p))))) (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl) (setq rpl (if (or (match-end 1) (not extra)) @@ -15354,11 +16010,13 @@ EXTRA is a string." (concat tpl "\n" end) tpl))) -(defun org-latex-packages-to-string (pkg &optional newline) +(defun org-latex-packages-to-string (pkg &optional snippets-p newline) "Turn an alist of packages into a string with the \\usepackage macros." (setq pkg (mapconcat (lambda(p) (cond ((stringp p) p) + ((and snippets-p (>= (length p) 3) (not (nth 2 p))) + (format "%% Package %s omitted" (cadr p))) ((equal "" (car p)) (format "\\usepackage{%s}" (cadr p))) (t @@ -15378,6 +16036,80 @@ EXTRA is a string." "Return string to be used as color value for an RGB component." (format "%g" (/ value 65535.0))) +;; Image display + + +(defvar org-inline-image-overlays nil) +(make-variable-buffer-local 'org-inline-image-overlays) + +(defun org-toggle-inline-images (&optional include-linked) + "Toggle the display of inline images. +INCLUDE-LINKED is passed to `org-display-inline-images'." + (interactive "P") + (if org-inline-image-overlays + (progn + (org-remove-inline-images) + (message "Inline image display turned off")) + (org-display-inline-images include-linked) + (if org-inline-image-overlays + (message "%d images displayed inline" + (length org-inline-image-overlays)) + (message "No images to display inline")))) + +(defun org-display-inline-images (&optional include-linked refresh beg end) + "Display inline images. +Normally only links without a description part are inlined, because this +is how it will work for export. When INCLUDE-LINKED is set, also links +with a description part will be inlined. This can be nice for a quick +look at those images, but it does not reflect what exported files will look +like. +When REFRESH is set, refresh existing images between BEG and END. +This will create new image displays only if necessary. +BEG and END default to the buffer boundaries." + (interactive "P") + (unless refresh + (org-remove-inline-images) + (clear-image-cache)) + (save-excursion + (save-restriction + (widen) + (setq beg (or beg (point-min)) end (or end (point-max))) + (goto-char (point-min)) + (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([-+~.:/\\_0-9a-zA-Z ]+" + (substring (org-image-file-name-regexp) 0 -2) + "\\)\\]" (if include-linked "" "\\]"))) + old file ov img) + (while (re-search-forward re end t) + (setq old (get-char-property-and-overlay (match-beginning 1) + 'org-image-overlay)) + (setq file (expand-file-name + (concat (or (match-string 3) "") (match-string 4)))) + (when (file-exists-p file) + (if (and (car-safe old) refresh) + (image-refresh (overlay-get (cdr old) 'display)) + (setq img (create-image file)) + (when img + (setq ov (make-overlay (match-beginning 0) (match-end 0))) + (overlay-put ov 'display img) + (overlay-put ov 'face 'default) + (overlay-put ov 'org-image-overlay t) + (overlay-put ov 'modification-hooks + (list 'org-display-inline-modification-hook)) + (push ov org-inline-image-overlays))))))))) + +(defun org-display-inline-modification-hook (ov after beg end &optional len) + "Remove inline-display overlay if a corresponding region is modified." + (let ((inhibit-modification-hooks t)) + (when (and ov after) + (delete ov org-inline-image-overlays) + (delete-overlay ov)))) + +(defun org-remove-inline-images () + "Remove inline display of images." + (interactive) + (mapc 'delete-overlay org-inline-image-overlays) + (setq org-inline-image-overlays nil)) + ;;;; Key bindings ;; Make `C-c C-x' a prefix key @@ -15419,6 +16151,12 @@ EXTRA is a string." (org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) (org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) +;; Babel keys +(define-key org-mode-map org-babel-key-prefix org-babel-map) +(mapc (lambda (pair) + (define-key org-babel-map (car pair) (cdr pair))) + org-babel-key-bindings) + ;;; Extra keys for tty access. ;; We only set them when really needed because otherwise the ;; menus don't show the simple keys @@ -15476,7 +16214,6 @@ EXTRA is a string." (org-defkey org-mode-map "\C-c\C-s" 'org-schedule) (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) -(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) (org-defkey org-mode-map "\C-c\C-w" 'org-refile) (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved (org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. @@ -15547,6 +16284,8 @@ EXTRA is a string." (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\\" '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) @@ -15639,7 +16378,7 @@ EXTRA is a string." "Show the available speed commands." (interactive) (if (not org-use-speed-commands) - (error "Speed commands are not activated, customize `org-use-speed-commands'.") + (error "Speed commands are not activated, customize `org-use-speed-commands'") (with-output-to-temp-buffer "*Help*" (princ "User-defined Speed commands\n===========================\n") (mapc 'org-print-speed-command org-speed-commands-user) @@ -15832,8 +16571,9 @@ See `org-ctrl-c-ctrl-c-hook' for more information. This hook runs as the first action when TAB is pressed, even before `org-cycle' messes around with the `outline-regexp' to cater for inline tasks and plain list item folding. -If any function in this hook returns t, not other actions like table -field motion visibility cycling will be done.") +If any function in this hook returns t, any other actions that +would have been caused by TAB (such as table field motion or visibility +cycling) will not occur.") (defvar org-tab-after-check-for-table-hook nil "Hook for functions to attach themselves to TAB. @@ -15884,6 +16624,34 @@ See `org-ctrl-c-ctrl-c-hook' for more information.") (defvar org-metareturn-hook nil "Hook for functions attaching themselves to `M-RET'. See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftup-hook nil + "Hook for functions attaching themselves to `S-up'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftup-final-hook nil + "Hook for functions attaching themselves to `S-up'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftdown-hook nil + "Hook for functions attaching themselves to `S-down'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftdown-final-hook nil + "Hook for functions attaching themselves to `S-down'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftleft-hook nil + "Hook for functions attaching themselves to `S-left'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftleft-final-hook nil + "Hook for functions attaching themselves to `S-left'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftright-hook nil + "Hook for functions attaching themselves to `S-right'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftright-final-hook nil + "Hook for functions attaching themselves to `S-right'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") (defun org-modifier-cursor-error () "Throw an error, a modified cursor command was applied in wrong context." @@ -15924,7 +16692,7 @@ See the individual commands for more information." ((run-hook-with-args-until-success 'org-shiftmetaleft-hook)) ((org-at-table-p) (call-interactively 'org-table-delete-column)) ((org-on-heading-p) (call-interactively 'org-promote-subtree)) - ((org-at-item-p) (call-interactively 'org-outdent-item)) + ((org-at-item-p) (call-interactively 'org-outdent-item-tree)) (t (org-modifier-cursor-error)))) (defun org-shiftmetaright () @@ -15937,7 +16705,7 @@ See the individual commands for more information." ((run-hook-with-args-until-success 'org-shiftmetaright-hook)) ((org-at-table-p) (call-interactively 'org-table-insert-column)) ((org-on-heading-p) (call-interactively 'org-demote-subtree)) - ((org-at-item-p) (call-interactively 'org-indent-item)) + ((org-at-item-p) (call-interactively 'org-indent-item-tree)) (t (org-modifier-cursor-error)))) (defun org-shiftmetaup (&optional arg) @@ -15966,6 +16734,10 @@ commands for more information." ((org-at-item-p) (call-interactively 'org-move-item-down)) (t (org-modifier-cursor-error)))) +(defsubst org-hidden-tree-error () + (error + "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>")) + (defun org-metaleft (&optional arg) "Promote heading or move table column to left. Calls `org-do-promote' or `org-table-move-column', depending on context. @@ -15980,12 +16752,14 @@ See the individual commands for more information." (save-excursion (goto-char (region-beginning)) (org-on-heading-p)))) + (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) (call-interactively 'org-do-promote)) ((or (org-at-item-p) (and (org-region-active-p) (save-excursion (goto-char (region-beginning)) (org-at-item-p)))) + (when (org-check-for-hidden 'items) (org-hidden-tree-error)) (call-interactively 'org-outdent-item)) (t (call-interactively 'backward-word)))) @@ -16003,15 +16777,44 @@ See the individual commands for more information." (save-excursion (goto-char (region-beginning)) (org-on-heading-p)))) + (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) (call-interactively 'org-do-demote)) ((or (org-at-item-p) (and (org-region-active-p) (save-excursion (goto-char (region-beginning)) (org-at-item-p)))) + (when (org-check-for-hidden 'items) (org-hidden-tree-error)) (call-interactively 'org-indent-item)) (t (call-interactively 'forward-word)))) +(defun org-check-for-hidden (what) + "Check if there are hidden headlines/items in the current visual line. +WHAT can be either `headlines' or `items'. If the current line is +an outline or item heading and it has a folded subtree below it, +this function returns t, nil otherwise." + (let ((re (cond + ((eq what 'headlines) (concat "^" org-outline-regexp)) + ((eq what 'items) (concat "^" (org-item-re t))) + (t (error "This should not happen")))) + beg end) + (save-excursion + (catch 'exit + (unless (org-region-active-p) + (setq beg (point-at-bol)) + (beginning-of-line 2) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (beginning-of-line 2)) + (setq end (point)) + (goto-char beg) + (goto-char (point-at-eol)) + (setq end (max end (point))) + (while (re-search-forward re end t) + (if (get-char-property (match-beginning 0) 'invisible) + (throw 'exit t)))) + nil)))) + (defun org-metaup (&optional arg) "Move subtree up or move table row up. Calls `org-move-subtree-up' or `org-table-move-row' or @@ -16044,6 +16847,7 @@ Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', depending on context. See the individual commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftup-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'previous-line)) ((org-at-timestamp-p t) @@ -16056,6 +16860,7 @@ depending on context. See the individual commands for more information." ((and (not org-support-shift-select) (org-at-item-p)) (call-interactively 'org-previous-item)) ((org-clocktable-try-shift 'up arg)) + ((run-hook-with-args-until-success 'org-shiftup-final-hook)) (org-support-shift-select (org-call-for-shift-select 'previous-line)) (t (org-shiftselect-error)))) @@ -16066,6 +16871,7 @@ Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' depending on context. See the individual commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftdown-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'next-line)) ((org-at-timestamp-p t) @@ -16078,6 +16884,7 @@ depending on context. See the individual commands for more information." ((and (not org-support-shift-select) (org-at-item-p)) (call-interactively 'org-next-item)) ((org-clocktable-try-shift 'down arg)) + ((run-hook-with-args-until-success 'org-shiftdown-final-hook)) (org-support-shift-select (org-call-for-shift-select 'next-line)) (t (org-shiftselect-error)))) @@ -16093,6 +16900,7 @@ Depending on context, this does one of the following: - on a clocktable definition line, move time block into the future" (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftright-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'forward-char)) ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) @@ -16112,6 +16920,7 @@ Depending on context, this does one of the following: (org-at-property-p)) (call-interactively 'org-property-next-allowed-value)) ((org-clocktable-try-shift 'right arg)) + ((run-hook-with-args-until-success 'org-shiftright-final-hook)) (org-support-shift-select (org-call-for-shift-select 'forward-char)) (t (org-shiftselect-error)))) @@ -16127,6 +16936,7 @@ Depending on context, this does one of the following: - on a clocktable definition line, move time block into the past" (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftleft-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'backward-char)) ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) @@ -16146,6 +16956,7 @@ Depending on context, this does one of the following: (org-at-property-p)) (call-interactively 'org-property-previous-allowed-value)) ((org-clocktable-try-shift 'left arg)) + ((run-hook-with-args-until-success 'org-shiftleft-final-hook)) (org-support-shift-select (org-call-for-shift-select 'backward-char)) (t (org-shiftselect-error)))) @@ -16208,24 +17019,33 @@ See the individual commands for more information." (org-table-paste-rectangle) (org-paste-subtree arg))) -(defun org-edit-special () +(defun org-edit-special (&optional arg) "Call a special editor for the stuff at point. When at a table, call the formula editor with `org-table-edit-formulas'. When at the first line of an src example, call `org-edit-src-code'. When in an #+include line, visit the include file. Otherwise call `ffap' to visit the file at point." (interactive) - (cond - ((org-at-table.el-p) - (org-edit-src-code)) - ((org-at-table-p) - (call-interactively 'org-table-edit-formulas)) + ;; possibly prep session before editing source + (when arg + (let* ((info (org-babel-get-src-block-info)) + (lang (nth 0 info)) + (params (nth 2 info)) + (session (cdr (assoc :session params)))) + (when (and info session) ;; we are in a source-code block with a session + (funcall + (intern (concat "org-babel-prep-session:" lang)) session params)))) + (cond ;; proceed with `org-edit-special' ((save-excursion (beginning-of-line 1) (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*<include\\>.*?file=\"\\)\\([^\"\n>]+\\)")) (find-file (org-trim (match-string 1)))) ((org-edit-src-code)) ((org-edit-fixed-width-region)) + ((org-at-table.el-p) + (org-edit-src-code)) + ((org-at-table-p) + (call-interactively 'org-table-edit-formulas)) (t (call-interactively 'ffap)))) @@ -16269,7 +17089,13 @@ This command does many different things, depending on context: - If the cursor is on a numbered item in a plain list, renumber the ordered list. -- If the cursor is on a checkbox, toggle it." +- If the cursor is on a checkbox, toggle it. + +- If the cursor is on a code block, evaluate it. The variable + `org-confirm-babel-evaluate' can be used to control prompting + before code block evaluation, by default every code block + evaluation requires confirmation. Code block evaluation can be + inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." (interactive "P") (let ((org-enable-table-editor t)) (cond @@ -16304,11 +17130,13 @@ This command does many different things, depending on context: (org-footnote-at-definition-p)) (call-interactively 'org-footnote-action)) ((org-at-item-checkbox-p) - (call-interactively 'org-toggle-checkbox)) + (call-interactively 'org-toggle-checkbox) + (org-list-send-list 'maybe)) ((org-at-item-p) (if arg (call-interactively 'org-toggle-checkbox) - (call-interactively 'org-maybe-renumber-ordered-list))) + (call-interactively 'org-maybe-renumber-ordered-list)) + (org-list-send-list 'maybe)) ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) ;; Dynamic block (beginning-of-line 1) @@ -16343,7 +17171,9 @@ Also updates the keyword regular expressions." "If this is a Note buffer, abort storing the note. Else call `show-branches'." (interactive) (if (not org-finish-function) - (call-interactively 'show-branches) + (progn + (hide-subtree) + (call-interactively 'show-branches)) (let ((org-note-abort t)) (funcall org-finish-function)))) @@ -16638,7 +17468,7 @@ See the individual commands for more information." ["Previous link" org-previous-link t] "--" ["Descriptive Links" - (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) + (progn (add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) :style radio :selected (member '(org-link) buffer-invisibility-spec)] ["Literal Links" @@ -16655,8 +17485,8 @@ See the individual commands for more information." ["Complete Keyword" org-complete (assq :todo-keyword (org-context))] ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))] ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]) - ["Show TODO Tree" org-show-todo-tree t] - ["Global TODO list" org-todo-list t] + ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"] + ["Global TODO list" org-todo-list :active t :keys "C-c a t"] "--" ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies) :selected org-enforce-todo-dependencies :style toggle :active t] @@ -16752,7 +17582,7 @@ See the individual commands for more information." :style toggle :selected (and (boundp 'org-export-with-LaTeX-fragments) org-export-with-LaTeX-fragments)] "--" - ["Template for BEAMER" org-beamer-settings-template t]) + ["Template for BEAMER" org-insert-beamer-options-template t]) "--" ("MobileOrg" ["Push Files and Views" org-mobile-push t] @@ -16885,8 +17715,18 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (dir-org-contrib (ignore-errors (file-name-directory (org-find-library-name "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") + (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)))) (remove-re (concat (if (featurep 'xemacs) @@ -16953,9 +17793,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions." "Display the given MESSAGE as a warning." (if (fboundp 'display-warning) (display-warning 'org message - (if (featurep 'xemacs) - 'warning - :warning)) + (if (featurep 'xemacs) 'warning :warning)) (let ((buf (get-buffer-create "*Org warnings*"))) (with-current-buffer buf (goto-char (point-max)) @@ -16969,6 +17807,13 @@ With prefix arg UNCOMPILED, load the uncompiled versions." "Is point in a line starting with `#'?" (equal (char-after (point-at-bol)) ?#)) +(defun org-in-indented-comment-line () + "Is point in a line starting with `#' after some white space?" + (save-excursion + (save-match-data + (goto-char (point-at-bol)) + (looking-at "[ \t]*#")))) + (defun org-in-verbatim-emphasis () (save-match-data (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~"))))) @@ -17276,11 +18121,11 @@ and :keyword." (mapcar (lambda (x) (if (memq x org-latex-fragment-image-overlays) x)) - (org-overlays-at (point)))))) + (overlays-at (point)))))) (push (list :latex-fragment - (org-overlay-start o) (org-overlay-end o)) clist) + (overlay-start o) (overlay-end o)) clist) (push (list :latex-preview - (org-overlay-start o) (org-overlay-end o)) clist)) + (overlay-start o) (overlay-end o)) clist)) ((org-inside-LaTeX-fragment-p) ;; FIXME: positions wrong. (push (list :latex-fragment (point) (point)) clist))) @@ -17319,7 +18164,7 @@ really on, so that the block visually is on the match." nil)))) (defun org-in-regexps-block-p (start-re end-re) - "Returns t if the current point is between matches of START-RE and END-RE. + "Return t if the current point is between matches of START-RE and END-RE. This will also return to if point is on one of the two matches." (interactive) (let ((p (point))) @@ -17396,6 +18241,33 @@ for the search purpose." (setq list (delete (pop elts) list))) list) +(defun org-count (cl-item cl-seq) + "Count the number of occurrences of ITEM in SEQ. +Taken from `count' in cl-seq.el with all keyword arguments removed." + (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x) + (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) + (while (< cl-start cl-end) + (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start))) + (if (equal cl-item cl-x) (setq cl-count (1+ cl-count))) + (setq cl-start (1+ cl-start))) + cl-count)) + +(defun org-remove-if (predicate seq) + "Remove everything from SEQ that fulfills PREDICATE." + (let (res e) + (while seq + (setq e (pop seq)) + (if (not (funcall predicate e)) (push e res))) + (nreverse res))) + +(defun org-remove-if-not (predicate seq) + "Remove everything from SEQ that does not fulfill PREDICATE." + (let (res e) + (while seq + (setq e (pop seq)) + (if (funcall predicate e) (push e res))) + (nreverse res))) + (defun org-back-over-empty-lines () "Move backwards over whitespace, to the beginning of the first empty line. Returns the number of empty lines passed." @@ -17411,7 +18283,7 @@ Returns the number of empty lines passed." (defun org-point-in-group (point group &optional context) "Check if POINT is in match-group GROUP. If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the -match. If the match group does ot exist or point is not inside it, +match. If the match group does not exist or point is not inside it, return nil." (and (match-beginning group) (>= point (match-beginning group)) @@ -17422,7 +18294,8 @@ return nil." (defun org-switch-to-buffer-other-window (&rest args) "Switch to buffer in a second window on the current frame. -In particular, do not allow pop-up frames." +In particular, do not allow pop-up frames. +Returns the newly created buffer." (let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) (apply 'switch-to-buffer-other-window args))) @@ -17473,17 +18346,27 @@ TABLE is an association list with keys like \"%a\" and string values. The sequences in STRING may contain normal field width and padding information, for example \"%-5s\". Replacements happen in the sequence given by TABLE, so values can contain further %-escapes if they are define later in TABLE." - (let ((case-fold-search nil) - e re rpl) - (while (setq e (pop table)) + (let ((tbl (copy-alist table)) + (case-fold-search nil) + (pchg 0) + e re rpl) + (while (setq e (pop tbl)) (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) + (when (and (cdr e) (string-match re (cdr e))) + (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0))) + (safe "SREF")) + (add-text-properties 0 3 (list 'sref sref) safe) + (setcdr e (replace-match safe t t (cdr e))))) (while (string-match re string) - (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") - (cdr e))) - (setq string (replace-match rpl t t string)))) + (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") + (cdr e))) + (setq string (replace-match rpl t t string)))) + (while (setq pchg (next-property-change pchg string)) + (let ((sref (get-text-property pchg 'sref string))) + (when (and sref (string-match "SREF" string pchg)) + (setq string (replace-match sref t t string))))) string)) - (defun org-sublist (list start end) "Return a section of LIST, from START to END. Counting starts at 1." @@ -17678,7 +18561,7 @@ the functionality can be provided as a fall-back.") (org-set-local 'fill-paragraph-function 'org-fill-paragraph) ;; 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) + (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") @@ -17829,8 +18712,8 @@ beyond the end of the headline." (if (bobp) nil (backward-char 1) - (if (org-invisible-p) - (while (and (not (bobp)) (org-invisible-p)) + (if (org-truely-invisible-p) + (while (and (not (bobp)) (org-truely-invisible-p)) (backward-char 1) (beginning-of-line 1)) (forward-char 1)))) @@ -17926,6 +18809,11 @@ depending on context." ((or (not org-special-ctrl-k) (bolp) (not (org-on-heading-p))) + (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible) + org-ctrl-k-protect-subtree) + (if (or (eq org-ctrl-k-protect-subtree 'error) + (not (y-or-n-p "Kill hidden subtree along with headline? "))) + (error "C-k aborted - would kill hidden subtree"))) (call-interactively 'kill-line)) ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$")) (kill-region (point) (match-beginning 1)) @@ -17953,7 +18841,8 @@ org-yank-adjusted-subtrees *visible* surrounding headings. Any prefix to this command will cause `yank' to be called directly with -no special treatment. In particular, a simple `C-u' prefix will just +no special treatment. In particular, a simple \\[universal-argument] prefix \ +will just plainly yank the text as it is. \[1] The test checks if the first non-white line is a heading @@ -18043,6 +18932,17 @@ interactive command with similar behavior." (outline-invisible-p) (get-char-property (point) 'invisible))) +(defun org-truely-invisible-p () + "Check if point is at a character currently not visible. +This version does not only check the character property, but also +`visible-mode'." + ;; Early versions of noutline don't have `outline-invisible-p'. + (if (org-bound-and-true-p visible-mode) + nil + (if (fboundp 'outline-invisible-p) + (outline-invisible-p) + (get-char-property (point) 'invisible)))) + (defun org-invisible-p2 () "Check if point is at a character currently not visible." (save-excursion @@ -18059,6 +18959,13 @@ interactive command with similar behavior." (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 @@ -18403,11 +19310,11 @@ if no description is present" ;; Speedbar support -(defvar org-speedbar-restriction-lock-overlay (org-make-overlay 1 1) +(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1) "Overlay marking the agenda restriction line in speedbar.") -(org-overlay-put org-speedbar-restriction-lock-overlay +(overlay-put org-speedbar-restriction-lock-overlay 'face 'org-agenda-restriction-lock) -(org-overlay-put org-speedbar-restriction-lock-overlay +(overlay-put org-speedbar-restriction-lock-overlay 'help-echo "Agendas are currently limited to this item.") (org-detach-overlay org-speedbar-restriction-lock-overlay) @@ -18440,8 +19347,8 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (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"))) - (org-move-overlay org-speedbar-restriction-lock-overlay - (point-at-bol) (point-at-eol)) + (move-overlay org-speedbar-restriction-lock-overlay + (point-at-bol) (point-at-eol)) (setq current-prefix-arg nil) (org-agenda-maybe-redo))) @@ -18455,7 +19362,6 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (add-hook 'speedbar-visiting-tag-hook (lambda () (and (org-mode-p) (org-show-context 'org-goto)))))) - ;;; Fixes and Hacks for problems with other packages ;; Make flyspell not check words in links, to not mess up our keymap diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index 00ebbae2814..68d1590e571 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -76,13 +76,12 @@ If the return value is a number, it is used as the timer period." :type 'hook) (defcustom tetris-tty-colors - [nil "blue" "white" "yellow" "magenta" "cyan" "green" "red"] - "Vector of colors of the various shapes in text mode. -Element 0 is ignored." + ["blue" "white" "yellow" "magenta" "cyan" "green" "red"] + "Vector of colors of the various shapes in text mode." :group 'tetris :type (let ((names `("Shape 1" "Shape 2" "Shape 3" "Shape 4" "Shape 5" "Shape 6" "Shape 7")) - (result `(vector (const nil)))) + (result nil)) (while names (add-to-list 'result (cons 'choice @@ -96,9 +95,8 @@ Element 0 is ignored." result)) (defcustom tetris-x-colors - [nil [0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]] - "Vector of colors of the various shapes. -Element 0 is ignored." + [[0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]] + "Vector of colors of the various shapes." :group 'tetris :type 'sexp) @@ -196,51 +194,44 @@ Element 0 is ignored." ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst tetris-shapes - [[[[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]] - [[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[2 2 2 0] [0 2 0 0] [2 0 0 0] [2 2 0 0]] - [[0 0 2 0] [0 2 0 0] [2 2 2 0] [2 0 0 0]] - [[0 0 0 0] [2 2 0 0] [0 0 0 0] [2 0 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[3 3 3 0] [3 3 0 0] [0 0 3 0] [3 0 0 0]] - [[3 0 0 0] [0 3 0 0] [3 3 3 0] [3 0 0 0]] - [[0 0 0 0] [0 3 0 0] [0 0 0 0] [3 3 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[4 4 0 0] [0 4 0 0] [4 4 0 0] [0 4 0 0]] - [[0 4 4 0] [4 4 0 0] [0 4 4 0] [4 4 0 0]] - [[0 0 0 0] [4 0 0 0] [0 0 0 0] [4 0 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[0 5 5 0] [5 0 0 0] [0 5 5 0] [5 0 0 0]] - [[5 5 0 0] [5 5 0 0] [5 5 0 0] [5 5 0 0]] - [[0 0 0 0] [0 5 0 0] [0 0 0 0] [0 5 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[0 6 0 0] [6 0 0 0] [6 6 6 0] [0 6 0 0]] - [[6 6 6 0] [6 6 0 0] [0 6 0 0] [6 6 0 0]] - [[0 0 0 0] [6 0 0 0] [0 0 0 0] [0 6 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[7 7 7 7] [7 0 0 0] [7 7 7 7] [7 0 0 0]] - [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]] - [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]] - [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]]]]) + [[[[0 0] [1 0] [0 1] [1 1]]] + + [[[0 0] [1 0] [2 0] [2 1]] + [[1 -1] [1 0] [1 1] [0 1]] + [[0 -1] [0 0] [1 0] [2 0]] + [[1 -1] [2 -1] [1 0] [1 1]]] + + [[[0 0] [1 0] [2 0] [0 1]] + [[0 -1] [1 -1] [1 0] [1 1]] + [[2 -1] [0 0] [1 0] [2 0]] + [[1 -1] [1 0] [1 1] [2 1]]] + + [[[0 0] [1 0] [1 1] [2 1]] + [[1 0] [0 1] [1 1] [0 2]]] + + [[[1 0] [2 0] [0 1] [1 1]] + [[0 0] [0 1] [1 1] [1 2]]] + + [[[1 0] [0 1] [1 1] [2 1]] + [[1 0] [1 1] [2 1] [1 2]] + [[0 1] [1 1] [2 1] [1 2]] + [[1 0] [0 1] [1 1] [1 2]]] + + [[[0 0] [1 0] [2 0] [3 0]] + [[1 -1] [1 0] [1 1] [1 2]]]] + "Each shape is described by a vector that contains the coordinates of +each one of its four blocks.") ;;the scoring rules were taken from "xtetris". Blocks score differently ;;depending on their rotation (defconst tetris-shape-scores - [ [6 6 6 6] [6 7 6 7] [6 7 6 7] [6 7 6 7] [6 7 6 7] [5 5 6 5] [5 8 5 8]] ) + [[6] [6 7 6 7] [6 7 6 7] [6 7] [6 7] [5 5 6 5] [5 8]] ) (defconst tetris-shape-dimensions [[2 2] [3 2] [3 2] [3 2] [3 2] [3 2] [4 1]]) -(defconst tetris-blank 0) +(defconst tetris-blank 7) (defconst tetris-border 8) @@ -299,7 +290,7 @@ Element 0 is ignored." (aset options c (cond ((= c tetris-blank) tetris-blank-options) - ((and (>= c 1) (<= c 7)) + ((and (>= c 0) (<= c 6)) (append tetris-cell-options `((((glyph color-x) ,(aref tetris-x-colors c)) @@ -320,20 +311,16 @@ Element 0 is ignored." tetris-n-rows nil))) (and (numberp period) period)))) -(defun tetris-get-shape-cell (x y) - (aref (aref (aref (aref tetris-shapes - tetris-shape) - y) - tetris-rot) - x)) +(defun tetris-get-shape-cell (block) + (aref (aref (aref tetris-shapes + tetris-shape) tetris-rot) + block)) (defun tetris-shape-width () - (aref (aref tetris-shape-dimensions tetris-shape) - (% tetris-rot 2))) + (aref (aref tetris-shape-dimensions tetris-shape) 0)) -(defun tetris-shape-height () - (aref (aref tetris-shape-dimensions tetris-shape) - (- 1 (% tetris-rot 2)))) +(defun tetris-shape-rotations () + (length (aref tetris-shapes tetris-shape))) (defun tetris-draw-score () (let ((strings (vector (format "Shapes: %05d" tetris-n-shapes) @@ -365,52 +352,58 @@ Element 0 is ignored." (tetris-update-score))) (defun tetris-draw-next-shape () - (loop for y from 0 to 3 do - (loop for x from 0 to 3 do - (gamegrid-set-cell (+ tetris-next-x x) - (+ tetris-next-y y) - (let ((tetris-shape tetris-next-shape) - (tetris-rot 0)) - (tetris-get-shape-cell x y)))))) + (loop for x from 0 to 3 do + (loop for y from 0 to 3 do + (gamegrid-set-cell (+ tetris-next-x x) + (+ tetris-next-y y) + tetris-blank))) + (loop for i from 0 to 3 do + (let ((tetris-shape tetris-next-shape) + (tetris-rot 0)) + (gamegrid-set-cell (+ tetris-next-x + (aref (tetris-get-shape-cell i) 0)) + (+ tetris-next-y + (aref (tetris-get-shape-cell i) 1)) + tetris-shape)))) (defun tetris-draw-shape () - (loop for y from 0 to (1- (tetris-shape-height)) do - (loop for x from 0 to (1- (tetris-shape-width)) do - (let ((c (tetris-get-shape-cell x y))) - (if (/= c tetris-blank) - (gamegrid-set-cell (+ tetris-top-left-x - tetris-pos-x - x) - (+ tetris-top-left-y - tetris-pos-y - y) - c)))))) + (loop for i from 0 to 3 do + (let ((c (tetris-get-shape-cell i))) + (gamegrid-set-cell (+ tetris-top-left-x + tetris-pos-x + (aref c 0)) + (+ tetris-top-left-y + tetris-pos-y + (aref c 1)) + tetris-shape)))) (defun tetris-erase-shape () - (loop for y from 0 to (1- (tetris-shape-height)) do - (loop for x from 0 to (1- (tetris-shape-width)) do - (let ((c (tetris-get-shape-cell x y)) - (px (+ tetris-top-left-x tetris-pos-x x)) - (py (+ tetris-top-left-y tetris-pos-y y))) - (if (/= c tetris-blank) - (gamegrid-set-cell px py tetris-blank)))))) + (loop for i from 0 to 3 do + (let ((c (tetris-get-shape-cell i))) + (gamegrid-set-cell (+ tetris-top-left-x + tetris-pos-x + (aref c 0)) + (+ tetris-top-left-y + tetris-pos-y + (aref c 1)) + tetris-blank)))) (defun tetris-test-shape () (let ((hit nil)) - (loop for y from 0 to (1- (tetris-shape-height)) do - (loop for x from 0 to (1- (tetris-shape-width)) do - (unless hit - (setq hit - (let* ((c (tetris-get-shape-cell x y)) - (xx (+ tetris-pos-x x)) - (yy (+ tetris-pos-y y)) - (px (+ tetris-top-left-x xx)) - (py (+ tetris-top-left-y yy))) - (and (/= c tetris-blank) - (or (>= xx tetris-width) - (>= yy tetris-height) - (/= (gamegrid-get-cell px py) - tetris-blank)))))))) + (loop for i from 0 to 3 do + (unless hit + (setq hit + (let* ((c (tetris-get-shape-cell i)) + (xx (+ tetris-pos-x + (aref c 0))) + (yy (+ tetris-pos-y + (aref c 1)))) + (or (>= xx tetris-width) + (>= yy tetris-height) + (/= (gamegrid-get-cell + (+ xx tetris-top-left-x) + (+ yy tetris-top-left-y)) + tetris-blank)))))) hit)) (defun tetris-full-row (y) @@ -510,33 +503,30 @@ Drops the shape one square, testing for collision." (defun tetris-move-bottom () "Drop the shape to the bottom of the playing area." (interactive) - (if (not tetris-paused) - (let ((hit nil)) - (tetris-erase-shape) - (while (not hit) - (setq tetris-pos-y (1+ tetris-pos-y)) - (setq hit (tetris-test-shape))) - (setq tetris-pos-y (1- tetris-pos-y)) - (tetris-draw-shape) - (tetris-shape-done)))) + (unless tetris-paused + (let ((hit nil)) + (tetris-erase-shape) + (while (not hit) + (setq tetris-pos-y (1+ tetris-pos-y)) + (setq hit (tetris-test-shape))) + (setq tetris-pos-y (1- tetris-pos-y)) + (tetris-draw-shape) + (tetris-shape-done)))) (defun tetris-move-left () "Move the shape one square to the left." (interactive) - (unless (or (= tetris-pos-x 0) - tetris-paused) + (unless tetris-paused (tetris-erase-shape) (setq tetris-pos-x (1- tetris-pos-x)) (if (tetris-test-shape) - (setq tetris-pos-x (1+ tetris-pos-x))) + (setq tetris-pos-x (1+ tetris-pos-x))) (tetris-draw-shape))) (defun tetris-move-right () "Move the shape one square to the right." (interactive) - (unless (or (= (+ tetris-pos-x (tetris-shape-width)) - tetris-width) - tetris-paused) + (unless tetris-paused (tetris-erase-shape) (setq tetris-pos-x (1+ tetris-pos-x)) (if (tetris-test-shape) @@ -546,23 +536,26 @@ Drops the shape one square, testing for collision." (defun tetris-rotate-prev () "Rotate the shape clockwise." (interactive) - (if (not tetris-paused) - (progn (tetris-erase-shape) - (setq tetris-rot (% (+ 1 tetris-rot) 4)) - (if (tetris-test-shape) - (setq tetris-rot (% (+ 3 tetris-rot) 4))) - (tetris-draw-shape)))) + (unless tetris-paused + (tetris-erase-shape) + (setq tetris-rot (% (+ 1 tetris-rot) + (tetris-shape-rotations))) + (if (tetris-test-shape) + (setq tetris-rot (% (+ 3 tetris-rot) + (tetris-shape-rotations)))) + (tetris-draw-shape))) (defun tetris-rotate-next () "Rotate the shape anticlockwise." (interactive) - (if (not tetris-paused) - (progn + (unless tetris-paused (tetris-erase-shape) - (setq tetris-rot (% (+ 3 tetris-rot) 4)) + (setq tetris-rot (% (+ 3 tetris-rot) + (tetris-shape-rotations))) (if (tetris-test-shape) - (setq tetris-rot (% (+ 1 tetris-rot) 4))) - (tetris-draw-shape)))) + (setq tetris-rot (% (+ 1 tetris-rot) + (tetris-shape-rotations)))) + (tetris-draw-shape))) (defun tetris-end-game () "Terminate the current game." diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 367c301de44..4fa5a8c3920 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -1,7 +1,7 @@ ;;; zone.el --- idle display hacks -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Victor Zandy <zandy@cs.wisc.edu> ;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org> @@ -40,10 +40,6 @@ ;;; Code: -(require 'timer) -(require 'tabify) -(eval-when-compile (require 'cl)) - (defvar zone-timer nil "The timer we use to decide when to zone out, or nil if none.") @@ -210,19 +206,20 @@ If the element is a function or a list of a function and a number, (insert s))) (defun zone-shift-left () - (let (s) + (let ((inhibit-point-motion-hooks t) + s) (while (not (eobp)) (unless (eolp) (setq s (buffer-substring (point) (1+ (point)))) (delete-char 1) (end-of-line) (insert s)) - (forward-char 1)))) + (ignore-errors (forward-char 1))))) (defun zone-shift-right () (goto-char (point-max)) - (end-of-line) - (let (s) + (let ((inhibit-point-motion-hooks t) + s) (while (not (bobp)) (unless (bolp) (setq s (buffer-substring (1- (point)) (point))) @@ -348,15 +345,8 @@ If the element is a function or a list of a function and a number, (let ((np (+ 2 (random 5))) (pm (point-max))) (while (< np pm) - (goto-char np) - (let ((prec (preceding-char)) - (props (text-properties-at (1- (point))))) - (insert (if (zerop (random 2)) - (upcase prec) - (downcase prec))) - (set-text-properties (1- (point)) (point) props)) - (backward-char 2) - (delete-char 1) + (funcall (if (zerop (random 2)) 'upcase-region + 'downcase-region) (1- np) np) (setq np (+ np (1+ (random 5)))))) (goto-char (point-min)) (sit-for 0 2))) @@ -365,13 +355,14 @@ If the element is a function or a list of a function and a number, ;;;; rotating (defun zone-line-specs () - (let (ret) + (let ((ok t) + ret) (save-excursion (goto-char (window-start)) - (while (< (point) (window-end)) + (while (and ok (< (point) (window-end))) (when (looking-at "[\t ]*\\([^\n]+\\)") (setq ret (cons (cons (match-beginning 1) (match-end 1)) ret))) - (forward-line 1))) + (setq ok (zerop (forward-line 1))))) ret)) (defun zone-pgm-rotate (&optional random-style) @@ -404,6 +395,7 @@ If the element is a function or a list of a function and a number, (setq cut 1 paste 2) (setq cut 2 paste 1)) (goto-char (aref ent cut)) + (setq aamt (min aamt (- (point-max) (point)))) (setq txt (buffer-substring (point) (+ (point) aamt))) (delete-char aamt) (goto-char (aref ent paste)) @@ -447,19 +439,19 @@ If the element is a function or a list of a function and a number, (hmm (cond ((string-match "[a-z]" c-string) (upcase c-string)) ((string-match "[A-Z]" c-string) (downcase c-string)) - (t (propertize " " 'display `(space :width ,cw-ceil)))))) - (do ((i 0 (1+ i)) - (wait 0.5 (* wait 0.8))) - ((= i 20)) + (t (propertize " " 'display `(space :width ,cw-ceil))))) + (wait 0.5)) + (dotimes (i 20) (goto-char pos) (delete-char 1) (insert (if (= 0 (% i 2)) hmm c-string)) - (zone-park/sit-for wbeg wait)) + (zone-park/sit-for wbeg (setq wait (* wait 0.8)))) (delete-char -1) (insert c-string))) (defun zone-fill-out-screen (width height) (let ((start (window-start)) - (line (make-string width 32))) + (line (make-string width 32)) + (inhibit-point-motion-hooks t)) (goto-char start) ;; fill out rectangular ws block (while (progn (end-of-line) @@ -473,8 +465,7 @@ If the element is a function or a list of a function and a number, (let ((nl (- height (count-lines (point-min) (point))))) (when (> nl 0) (setq line (concat line "\n")) - (do ((i 0 (1+ i))) - ((= i nl)) + (dotimes (i nl) (insert line)))) (goto-char start) (recenter 0) @@ -487,8 +478,10 @@ If the element is a function or a list of a function and a number, (wait 0.15) newpos fall-p) (while (when (save-excursion - (forward-line 1) - (and (= col (current-column)) + (and (zerop (forward-line 1)) + (progn + (forward-char col) + (= col (current-column))) (setq newpos (point)) (string= spaces (buffer-substring-no-properties newpos (+ newpos cw-ceil))) @@ -587,11 +580,12 @@ If the element is a function or a list of a function and a number, (defun zone-pgm-stress () (goto-char (point-min)) - (let (lines) - (while (< (point) (point-max)) + (let ((ok t) + lines) + (while (and ok (< (point) (point-max))) (let ((p (point))) - (forward-line 1) - (setq lines (cons (buffer-substring p (point)) lines)))) + (setq ok (zerop (forward-line 1)) + lines (cons (buffer-substring p (point)) lines)))) (sit-for 5) (zone-hiding-modeline (let ((msg "Zoning... (zone-pgm-stress)")) @@ -671,7 +665,8 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).") (setq c (point)) (move-to-column 9) (setq col (cons (buffer-substring (point) c) col)) - (end-of-line 0) +; (let ((inhibit-point-motion-hooks t)) + (end-of-line 0);) (forward-char -10)) (let ((life-patterns (vector (if (and col (search-forward "@" max t)) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 10267a6b2dc..02fc3950a34 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -3974,16 +3974,17 @@ command to conveniently insert and align the necessary backslashes." ;; "Invalid search bound (wrong side of point)" ;; error in the subsequent re-search. Maybe ;; another fix would be needed (2007-12-08). - (and (> (- (cdr c-lit-limits) 2) (point)) + (or (<= (- (cdr c-lit-limits) 2) (point)) + (and (search-forward-regexp (concat "\\=[ \t]*\\(" c-current-comment-prefix "\\)") (- (cdr c-lit-limits) 2) t) (not (search-forward-regexp "\\(\\s \\|\\sw\\)" (- (cdr c-lit-limits) 2) 'limit)) - ;; The comment ender IS on its own line. Exclude - ;; this line from the filling. - (set-marker end (c-point 'bol)))) + ;; The comment ender IS on its own line. Exclude + ;; this line from the filling. + (set-marker end (c-point 'bol))))) ;; The comment ender is hanging. Replace all space between it ;; and the last word either by one or two 'x's (when @@ -4000,6 +4001,14 @@ command to conveniently insert and align the necessary backslashes." (goto-char ender-start) (current-column))) (point-rel (- ender-start here)) + (sentence-ends-comment + (save-excursion + (goto-char ender-start) + (and (search-backward-regexp + (c-sentence-end) (c-point 'bol) t) + (goto-char (match-end 0)) + (looking-at "[ \t]*") + (= (match-end 0) ender-start)))) spaces) (save-excursion @@ -4042,7 +4051,9 @@ command to conveniently insert and align the necessary backslashes." (setq spaces (max (min spaces - (if sentence-end-double-space 2 1)) + (if (and sentence-ends-comment + sentence-end-double-space) + 2 1)) 1))) ;; Insert the filler first to keep marks right. (insert-char ?x spaces t) @@ -4252,8 +4263,11 @@ Optional prefix ARG means justify paragraph as well." (let ((fill-paragraph-function ;; Avoid infinite recursion. (if (not (eq fill-paragraph-function 'c-fill-paragraph)) - fill-paragraph-function))) - (c-mask-paragraph t nil 'fill-paragraph arg)) + fill-paragraph-function)) + (start-point (point-marker))) + (c-mask-paragraph + t nil (lambda () (fill-region-as-paragraph (point-min) (point-max) arg))) + (goto-char start-point)) ;; Always return t. This has the effect that if filling isn't done ;; above, it isn't done at all, and it's therefore effectively ;; disabled in normal code. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 7eb0016ff43..e5e108106f1 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1082,7 +1082,7 @@ been put there by c-put-char-property. POINT remains unchanged." (setq place (next-single-property-change place property nil to))) (< place to)) (setq end-place (next-single-property-change place property nil to)) - (put-text-property place end-place property nil) + (remove-text-properties place end-place (cons property nil)) ;; Do we have to do anything with stickiness here? (setq place end-place)))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 1ee3c295fe1..5aa03317491 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1,8 +1,8 @@ ;;; cc-engine.el --- core syntax guessing engine for CC mode ;; Copyright (C) 1985, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998, -;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Authors: 2001- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -4985,7 +4985,8 @@ comment at the start of cc-engine.el for more info." ;; POS (default point) is at a < character. If it is both marked ;; with open/close paren syntax-table property, and has a matching > ;; (also marked) which is after LIM, remove the property both from - ;; the current > and its partner. + ;; the current > and its partner. Return t when this happens, nil + ;; when it doesn't. (save-excursion (if pos (goto-char pos) @@ -4998,13 +4999,15 @@ comment at the start of cc-engine.el for more info." (equal (c-get-char-property (1- (point)) 'syntax-table) c->-as-paren-syntax)) ; should always be true. (c-unmark-<->-as-paren (1- (point))) - (c-unmark-<->-as-paren pos))))) + (c-unmark-<->-as-paren pos)) + t))) (defun c-clear->-pair-props-if-match-before (lim &optional pos) ;; POS (default point) is at a > character. If it is both marked ;; with open/close paren syntax-table property, and has a matching < ;; (also marked) which is before LIM, remove the property both from - ;; the current < and its partner. + ;; the current < and its partner. Return t when this happens, nil + ;; when it doesn't. (save-excursion (if pos (goto-char pos) @@ -5017,7 +5020,12 @@ comment at the start of cc-engine.el for more info." (equal (c-get-char-property (point) 'syntax-table) c-<-as-paren-syntax)) ; should always be true. (c-unmark-<->-as-paren (point)) - (c-unmark-<->-as-paren pos))))) + (c-unmark-<->-as-paren pos)) + t))) + +;; Set by c-common-init in cc-mode.el. +(defvar c-new-BEG) +(defvar c-new-END) (defun c-before-change-check-<>-operators (beg end) ;; Unmark certain pairs of "< .... >" which are currently marked as @@ -5040,25 +5048,39 @@ comment at the start of cc-engine.el for more info." ;; 2010-01-29. (save-excursion (let ((beg-lit-limits (progn (goto-char beg) (c-literal-limits))) - (end-lit-limits (progn (goto-char end) (c-literal-limits)))) + (end-lit-limits (progn (goto-char end) (c-literal-limits))) + new-beg new-end need-new-beg need-new-end) ;; Locate the barrier before the changed region (goto-char (if beg-lit-limits (car beg-lit-limits) beg)) (c-syntactic-skip-backward "^;{}" (max (- beg 2048) (point-min))) + (setq new-beg (point)) ;; Remove the syntax-table properties from each pertinent <...> pair. ;; Firsly, the ones with the < before beg and > after beg. (while (c-search-forward-char-property 'category 'c-<-as-paren-syntax beg) - (c-clear-<-pair-props-if-match-after beg (1- (point)))) + (if (c-clear-<-pair-props-if-match-after beg (1- (point))) + (setq need-new-beg t))) ;; Locate the barrier after END. (goto-char (if end-lit-limits (cdr end-lit-limits) end)) (c-syntactic-re-search-forward "[;{}]" (min (+ end 2048) (point-max)) 'end) + (setq new-end (point)) ;; Remove syntax-table properties from the remaining pertinent <...> ;; pairs, those with a > after end and < before end. (while (c-search-backward-char-property 'category 'c->-as-paren-syntax end) - (c-clear->-pair-props-if-match-before end))))) + (if (c-clear->-pair-props-if-match-before end) + (setq need-new-end t))) + + ;; Extend the fontification region, if needed. + (when need-new-beg + (goto-char new-beg) + (c-forward-syntactic-ws) + (and (< (point) c-new-BEG) (setq c-new-BEG (point)))) + + (when need-new-end + (and (> new-end c-new-END) (setq c-new-END new-end)))))) @@ -5348,6 +5370,9 @@ comment at the start of cc-engine.el for more info." (goto-char safe-pos) t))) +;; cc-mode requires cc-fonts. +(declare-function c-fontify-recorded-types-and-refs "cc-fonts" ()) + (defun c-forward-<>-arglist (all-types) ;; The point is assumed to be at a "<". Try to treat it as the open ;; paren of an angle bracket arglist and move forward to the @@ -5383,6 +5408,7 @@ comment at the start of cc-engine.el for more info." ;; `nconc' doesn't mind that the tail of ;; `c-record-found-types' is t. (nconc c-record-found-types c-record-type-identifiers))) + (if (c-major-mode-is 'java-mode) (c-fontify-recorded-types-and-refs)) t) (goto-char start) @@ -5402,7 +5428,6 @@ comment at the start of cc-engine.el for more info." ;; List that collects the positions after the argument ;; separating ',' in the arglist. arg-start-pos) - ;; If the '<' has paren open syntax then we've marked it as an angle ;; bracket arglist before, so skip to the end. (if (and (not c-parse-and-markup-<>-arglists) @@ -5413,7 +5438,6 @@ comment at the start of cc-engine.el for more info." (if (and (c-go-up-list-forward) (eq (char-before) ?>)) t - ;; Got unmatched paren angle brackets. We don't clear the paren ;; syntax properties and retry, on the basis that it's very ;; unlikely that paren angle brackets become operators by code @@ -5423,70 +5447,51 @@ comment at the start of cc-engine.el for more info." nil)) (forward-char) + (unless (looking-at c-<-op-cont-regexp) - (while (and + (while (and (progn + (c-forward-syntactic-ws) + (let ((orig-record-found-types c-record-found-types)) + (when (or (and c-record-type-identifiers all-types) + (c-major-mode-is 'java-mode)) + ;; All encountered identifiers are types, so set the + ;; promote flag and parse the type. + (progn + (c-forward-syntactic-ws) + (if (looking-at "\\?") + (forward-char) + (when (looking-at c-identifier-start) + (let ((c-promote-possible-types t) + (c-record-found-types t)) + (c-forward-type)))) - (when c-record-type-identifiers - (if all-types - - ;; All encountered identifiers are types, so set the - ;; promote flag and parse the type. - (progn - (c-forward-syntactic-ws) - (when (looking-at c-identifier-start) - (let ((c-promote-possible-types t)) - (c-forward-type)))) - - ;; Check if this arglist argument is a sole type. If - ;; it's known then it's recorded in - ;; `c-record-type-identifiers'. If it only is found - ;; then it's recorded in `c-record-found-types' which we - ;; might roll back if it turns out that this isn't an - ;; angle bracket arglist afterall. - (when (memq (char-before) '(?, ?<)) - (let ((orig-record-found-types c-record-found-types)) - (c-forward-syntactic-ws) - (and (memq (c-forward-type) '(known found)) - (not (looking-at "[,>]")) - ;; A found type was recorded but it's not the - ;; only thing in the arglist argument, so reset - ;; `c-record-found-types'. - (setq c-record-found-types - orig-record-found-types)))))) + (c-forward-syntactic-ws) - (setq pos (point)) - (or (when (eq (char-after) ?>) - ;; Must check for '>' at the very start separately, - ;; since the regexp below has to avoid ">>" without - ;; using \\=. - (forward-char) - t) - - ;; Note: These regexps exploit the match order in \| so - ;; that "<>" is matched by "<" rather than "[^>:-]>". - (c-syntactic-re-search-forward - (if c-restricted-<>-arglists - ;; Stop on ',', '|', '&', '+' and '-' to catch - ;; common binary operators that could be between - ;; two comparison expressions "a<b" and "c>d". - "[<;{},|&+-]\\|\\([^>:-]>\\)" - ;; Otherwise we still stop on ',' to find the - ;; argument start positions. - "[<;{},]\\|\\([^>:-]>\\)") - nil 'move t t 1) - - ;; If the arglist starter has lost its open paren - ;; syntax but not the closer, we won't find the - ;; closer above since we only search in the - ;; balanced sexp. In that case we stop just short - ;; of it so check if the following char is the closer. - (when (eq (char-after) ?>) - (forward-char) - t))) + (when (or (looking-at "extends") + (looking-at "super")) + (forward-word) + (c-forward-syntactic-ws) + (let ((c-promote-possible-types t) + (c-record-found-types t)) + (c-forward-type) + (c-forward-syntactic-ws)))))) + + (setq pos (point)) + + (or + ;; Note: These regexps exploit the match order in \| so + ;; that "<>" is matched by "<" rather than "[^>:-]>". + (c-syntactic-re-search-forward + ;; Stop on ',', '|', '&', '+' and '-' to catch + ;; common binary operators that could be between + ;; two comparison expressions "a<b" and "c>d". + "[<;{},|+&-]\\|[>)]" + nil t t) + t)) - (cond - ((eq (char-before) ?>) + (cond + ((eq (char-before) ?>) ;; Either an operator starting with '>' or the end of ;; the angle bracket arglist. @@ -5508,7 +5513,6 @@ comment at the start of cc-engine.el for more info." ((eq (char-before) ?<) ;; Either an operator starting with '<' or a nested arglist. - (setq pos (point)) (let (id-start id-end subres keyword-match) (if (if (looking-at c-<-op-cont-regexp) @@ -5528,14 +5532,14 @@ comment at the start of cc-engine.el for more info." (when (or (setq keyword-match (looking-at c-opt-<>-sexp-key)) (not (looking-at c-keywords-regexp))) - (setq id-start (point)))) - - (setq subres - (let ((c-record-type-identifiers nil) - (c-record-found-types nil)) - (c-forward-<>-arglist-recur - (and keyword-match - (c-keyword-member + (setq id-start (point)))) + + (setq subres + (let ((c-promote-possible-types t) + (c-record-found-types t)) + (c-forward-<>-arglist-recur + (and keyword-match + (c-keyword-member (c-keyword-sym (match-string 1)) 'c-<>-type-kwds))))) ))) @@ -5556,14 +5560,16 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws) (looking-at c-opt-identifier-concat-key))) (c-record-ref-id (cons id-start id-end)) - (c-record-type-id (cons id-start id-end)))))) - t) - - ((and (eq (char-before) ?,) - (not c-restricted-<>-arglists)) - ;; Just another argument. Record the position. The - ;; type check stuff that made us stop at it is at - ;; the top of the loop. + (c-record-type-id (cons id-start id-end)))))) + t) + + ((and (not c-restricted-<>-arglists) + (or (and (eq (char-before) ?&) + (not (eq (char-after) ?&))) + (eq (char-before) ?,))) + ;; Just another argument. Record the position. The + ;; type check stuff that made us stop at it is at + ;; the top of the loop. (setq arg-start-pos (cons (point) arg-start-pos))) (t @@ -5572,7 +5578,6 @@ comment at the start of cc-engine.el for more info." ;; it's useless to try to find a surrounding arglist ;; if we're nested. (throw 'angle-bracket-arglist-escape nil)))))) - (if res (or c-record-found-types t))))) @@ -5775,9 +5780,8 @@ comment at the start of cc-engine.el for more info." ((and c-recognize-<>-arglists (eq (char-after) ?<)) ;; Maybe an angle bracket arglist. - - (when (let (c-record-type-identifiers - c-record-found-types) + (when (let ((c-record-type-identifiers t) + (c-record-found-types t)) (c-forward-<>-arglist nil)) (c-add-type start (1+ pos)) @@ -5826,6 +5830,9 @@ comment at the start of cc-engine.el for more info." ;; `c-record-type-identifiers' is non-nil. ;; ;; This function might do hidden buffer changes. + (when (looking-at "<") + (c-forward-<>-arglist t) + (c-forward-syntactic-ws)) (let ((start (point)) pos res name-res id-start id-end id-range) @@ -6025,6 +6032,18 @@ comment at the start of cc-engine.el for more info." res)) +(defun c-forward-annotation () + ;; Used for Java code only at the moment. Assumes point is on the + ;; @, moves forward an annotation. returns nil if there is no + ;; annotation at point. + (and (looking-at "@") + (progn (forward-char) t) + (c-forward-type) + (progn (c-forward-syntactic-ws) t) + (if (looking-at "(") + (c-go-list-forward) + t))) + ;; Handling of large scale constructs like statements and declarations. @@ -6194,6 +6213,9 @@ comment at the start of cc-engine.el for more info." (save-rec-type-ids c-record-type-identifiers) (save-rec-ref-ids c-record-ref-identifiers)) + (while (c-forward-annotation) + (c-forward-syntactic-ws)) + ;; Check for a type. Unknown symbols are treated as possible ;; types, but they could also be specifiers disguised through ;; macros like __INLINE__, so we recognize both types and known @@ -6527,13 +6549,14 @@ comment at the start of cc-engine.el for more info." ;; CASE 3 (when (= (point) start) ;; Got a plain list of identifiers. If a colon follows it's - ;; a valid label. Otherwise the last one probably is the - ;; declared identifier and we should back up to the previous - ;; type, providing it isn't a cast. - (if (eq (char-after) ?:) - ;; If we've found a specifier keyword then it's a - ;; declaration regardless. - (throw 'at-decl-or-cast (eq at-decl-or-cast t)) + ;; a valid label. Otherwise the last one probably is the + ;; declared identifier and we should back up to the previous + ;; type, providing it isn't a cast. + (if (and (eq (char-after) ?:) + (not (c-major-mode-is 'java-mode))) + ;; If we've found a specifier keyword then it's a + ;; declaration regardless. + (throw 'at-decl-or-cast (eq at-decl-or-cast t)) (setq backup-if-not-cast t) (throw 'at-decl-or-cast t))) @@ -8494,7 +8517,7 @@ comment at the start of cc-engine.el for more info." ;; ;; This function might do hidden buffer changes. - (let (special-brace-list) + (let (special-brace-list placeholder) (goto-char indent-point) (skip-chars-forward " \t") @@ -8601,6 +8624,22 @@ comment at the start of cc-engine.el for more info." (c-add-stmt-syntax 'func-decl-cont nil t containing-sexp paren-state)) + ;;CASE F: continued statement and the only preceding items are + ;;annotations. + ((and (c-major-mode-is 'java-mode) + (setq placeholder (point)) + (c-beginning-of-statement-1) + (progn + (while (and (c-forward-annotation) + (< (point) placeholder)) + (c-forward-syntactic-ws)) + t) + (prog1 + (>= (point) placeholder) + (goto-char placeholder))) + (c-beginning-of-statement-1 containing-sexp) + (c-add-syntax 'annotation-var-cont (point))) + ;; CASE D: continued statement. (t (c-beginning-of-statement-1 containing-sexp) @@ -8700,7 +8739,6 @@ comment at the start of cc-engine.el for more info." (when (and containing-sexp (eq (char-after containing-sexp) ?\()) (setq c-stmt-delim-chars c-stmt-delim-chars-with-comma)) - ;; cache char before and after indent point, and move point to ;; the most likely position to perform the majority of tests (goto-char indent-point) @@ -9450,23 +9488,36 @@ comment at the start of cc-engine.el for more info." (c-add-syntax 'objc-method-args-cont placeholder)) ;; CASE 5L: we are at the first argument of a template - ;; arglist that begins on the previous line. - ((and c-recognize-<>-arglists - (eq (char-before) ?<) - (setq placeholder (1- (point))) - (not (and c-overloadable-operators-regexp - (c-after-special-operator-id lim)))) - (c-beginning-of-statement-1 (c-safe-position (point) paren-state)) - (c-add-syntax 'template-args-cont (c-point 'boi) placeholder)) - - ;; CASE 5Q: we are at a statement within a macro. - (macro-start - (c-beginning-of-statement-1 containing-sexp) - (c-add-stmt-syntax 'statement nil t containing-sexp paren-state)) - - ;; CASE 5M: we are at a topmost continuation line - (t - (c-beginning-of-statement-1 (c-safe-position (point) paren-state)) + ;; arglist that begins on the previous line. + ((and c-recognize-<>-arglists + (eq (char-before) ?<) + (not (and c-overloadable-operators-regexp + (c-after-special-operator-id lim)))) + (c-beginning-of-statement-1 (c-safe-position (point) paren-state)) + (c-add-syntax 'template-args-cont (c-point 'boi))) + + ;; CASE 5Q: we are at a statement within a macro. + (macro-start + (c-beginning-of-statement-1 containing-sexp) + (c-add-stmt-syntax 'statement nil t containing-sexp paren-state)) + + ;;CASE 5N: We are at a tompmost continuation line and the only + ;;preceding items are annotations. + ((and (c-major-mode-is 'java-mode) + (setq placeholder (point)) + (c-beginning-of-statement-1) + (progn + (while (and (c-forward-annotation)) + (c-forward-syntactic-ws)) + t) + (prog1 + (>= (point) placeholder) + (goto-char placeholder))) + (c-add-syntax 'annotation-top-cont (c-point 'boi))) + + ;; CASE 5M: we are at a topmost continuation line + (t + (c-beginning-of-statement-1 (c-safe-position (point) paren-state)) (when (c-major-mode-is 'objc-mode) (setq placeholder (point)) (while (and (c-forward-objc-directive) @@ -9477,43 +9528,20 @@ comment at the start of cc-engine.el for more info." (c-add-syntax 'topmost-intro-cont (c-point 'boi))) )) - ;; (CASE 6 has been removed.) - ;; CASE 19: line is an expression, not a statement, and is directly - ;; contained by a template delimiter. Most likely, we are in a - ;; template arglist within a statement. This case is based on CASE - ;; 7. At some point in the future, we may wish to create more - ;; syntactic symbols such as `template-intro', - ;; `template-cont-nonempty', etc., and distinguish between them as we - ;; do for `arglist-intro' etc. (2009-12-07). - ((and c-recognize-<>-arglists - (setq containing-< (c-up-list-backward indent-point containing-sexp)) - (eq (char-after containing-<) ?\<)) - (setq placeholder (c-point 'boi containing-<)) - (goto-char containing-sexp) ; Most nested Lbrace/Lparen (but not - ; '<') before indent-point. - (if (>= (point) placeholder) - (progn - (forward-char) - (skip-chars-forward " \t")) - (goto-char placeholder)) - (c-add-stmt-syntax 'template-args-cont (list containing-<) t - (c-most-enclosing-brace c-state-cache (point)) - paren-state)) - + ;; (CASE 6 has been removed.) - ;; CASE 7: line is an expression, not a statement. Most - ;; likely we are either in a function prototype or a function - ;; call argument list, or a template argument list. - ((not (or (and c-special-brace-lists - (save-excursion - (goto-char containing-sexp) - (c-looking-at-special-brace-list))) - (eq (char-after containing-sexp) ?{) - (eq (char-after containing-sexp) ?<))) - (cond + ;; CASE 7: line is an expression, not a statement. Most + ;; likely we are either in a function prototype or a function + ;; call argument list + ((not (or (and c-special-brace-lists + (save-excursion + (goto-char containing-sexp) + (c-looking-at-special-brace-list))) + (eq (char-after containing-sexp) ?{))) + (cond - ;; CASE 7A: we are looking at the arglist closing paren. + ;; CASE 7A: we are looking at the arglist closing paren. ;; C.f. case 7F. ((memq char-after-ip '(?\) ?\])) (goto-char containing-sexp) @@ -9525,12 +9553,34 @@ comment at the start of cc-engine.el for more info." (skip-chars-forward " \t")) (goto-char placeholder)) (c-add-stmt-syntax 'arglist-close (list containing-sexp) t - (c-most-enclosing-brace paren-state (point)) - paren-state)) + (c-most-enclosing-brace paren-state (point)) + paren-state)) - ;; CASE 7B: Looking at the opening brace of an - ;; in-expression block or brace list. C.f. cases 4, 16A - ;; and 17E. + ;; CASE 19: line is an expression, not a statement, and is directly + ;; contained by a template delimiter. Most likely, we are in a + ;; template arglist within a statement. This case is based on CASE + ;; 7. At some point in the future, we may wish to create more + ;; syntactic symbols such as `template-intro', + ;; `template-cont-nonempty', etc., and distinguish between them as we + ;; do for `arglist-intro' etc. (2009-12-07). + ((and c-recognize-<>-arglists + (setq containing-< (c-up-list-backward indent-point containing-sexp)) + (eq (char-after containing-<) ?\<)) + (setq placeholder (c-point 'boi containing-<)) + (goto-char containing-sexp) ; Most nested Lbrace/Lparen (but not + ; '<') before indent-point. + (if (>= (point) placeholder) + (progn + (forward-char) + (skip-chars-forward " \t")) + (goto-char placeholder)) + (c-add-stmt-syntax 'template-args-cont (list containing-<) t + (c-most-enclosing-brace c-state-cache (point)) + paren-state)) + + ;; CASE 7B: Looking at the opening brace of an + ;; in-expression block or brace list. C.f. cases 4, 16A + ;; and 17E. ((and (eq char-after-ip ?{) (progn (setq placeholder (c-inside-bracelist-p (point) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 907c308daca..219eb25368c 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -194,6 +194,10 @@ (unless (face-property-instance oldface 'reverse) (invert-face newface))))) +(defvar c-annotation-face (make-face 'c-annotation-face) + "Face used to highlight annotations in java-mode and other modes that may wish to use it.") +(set-face-foreground 'c-annotation-face "blue") + (eval-and-compile ;; We need the following functions during compilation since they're ;; called when the `c-lang-defconst' initializers are evaluated. @@ -1538,6 +1542,9 @@ higher." '((c-fontify-types-and-refs ((c-promote-possible-types t)) (c-forward-keyword-clause 1) (if (> (point) limit) (goto-char limit)))))))) + + ,@(when (c-major-mode-is 'java-mode) + `((eval . (list "\\<\\(@[a-zA-Z0-9]+\\)\\>" 1 c-annotation-face)))) )) (c-lang-defconst c-matchers-1 diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index d3669f259de..ae0ed1b928a 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -359,7 +359,7 @@ The syntax tables aren't stored directly since they're quite large." (let ((table (make-syntax-table))) (c-populate-syntax-table table) ;; Mode specific syntaxes. - ,(cond ((c-major-mode-is 'objc-mode) + ,(cond ((or (c-major-mode-is 'objc-mode) (c-major-mode-is 'java-mode)) ;; Let '@' be part of symbols in ObjC to cope with ;; its compiler directives as single keyword tokens. ;; This is then necessary since it's assumed that @@ -382,7 +382,7 @@ The syntax tables aren't stored directly since they're quite large." ;; '<' and '>' characters. Therefore this syntax table might go ;; away when CC Mode handles templates correctly everywhere. t nil - c++ `(lambda () + (java c++) `(lambda () (let ((table (funcall ,(c-lang-const c-make-mode-syntax-table)))) (modify-syntax-entry ?< "(>" table) (modify-syntax-entry ?> ")<" table) @@ -425,7 +425,7 @@ the new syntax, as accepted by `modify-syntax-entry'." ;; it as an indentifier character since it's often used in various ;; machine generated identifiers. t '((?_ . "w") (?$ . "w")) - objc (append '((?@ . "w")) + (objc java) (append '((?@ . "w")) (c-lang-const c-identifier-syntax-modifications)) awk '((?_ . "w"))) (c-lang-defvar c-identifier-syntax-modifications @@ -502,9 +502,10 @@ parameters \(point-min), \(point-max) and <buffer size>." (c-lang-defconst c-symbol-start "Regexp that matches the start of a symbol, i.e. any identifier or -keyword. It's unspecified how far it matches. Does not contain a \\| +keyword. It's unspecified how far it matches. Does not contain a \\| operator at the top level." t (concat "[" c-alpha "_]") + java (concat "[" c-alpha "_@]") objc (concat "[" c-alpha "@]") pike (concat "[" c-alpha "_`]")) (c-lang-defvar c-symbol-start (c-lang-const c-symbol-start)) @@ -859,7 +860,7 @@ since CC Mode treats every identifier as an expression." ;; Primary. ,@(c-lang-const c-identifier-ops) - ,@(cond ((c-major-mode-is 'c++-mode) + ,@(cond ((or (c-major-mode-is 'c++-mode) (c-major-mode-is 'java-mode)) `((postfix-if-paren "<" ">"))) ; Templates. ((c-major-mode-is 'pike-mode) `((prefix "global" "predef"))) @@ -1118,6 +1119,7 @@ operators." t "\\`<." (lambda (op) (substring op 1))))) + (c-lang-defvar c-<-op-cont-regexp (c-lang-const c-<-op-cont-regexp)) (c-lang-defconst c->-op-cont-regexp @@ -1127,7 +1129,13 @@ operators." (c-filter-ops (c-lang-const c-all-op-syntax-tokens) t "\\`>." - (lambda (op) (substring op 1))))) + (lambda (op) (substring op 1)))) + java (c-make-keywords-re nil + (c-filter-ops (c-lang-const c-all-op-syntax-tokens) + t + "\\`>[^>]\\|\\`>>[^>]" + (lambda (op) (substring op 1))))) + (c-lang-defvar c->-op-cont-regexp (c-lang-const c->-op-cont-regexp)) (c-lang-defconst c-stmt-delim-chars @@ -1628,7 +1636,7 @@ following identifier as a type; the keyword must also be present on c++ '("class" "struct" "union") objc '("struct" "union" "@interface" "@implementation" "@protocol") - java '("class" "interface") + java '("class" "@interface" "interface") idl '("component" "eventtype" "exception" "home" "interface" "struct" "union" "valuetype" ;; In CORBA PSDL: @@ -1651,7 +1659,7 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds', `c-<>-type-kwds', or `c-<>-arglist-kwds' then the associated clauses will be handled." t '("enum") - (java awk) nil) + (awk) nil) (c-lang-defconst c-brace-list-key ;; Regexp matching the start of declarations where the following @@ -1772,7 +1780,7 @@ will be handled." "bindsTo" "delegatesTo" "implements" "proxy" "storedOn") ;; Note: "const" is not used in Java, but it's still a reserved keyword. java '("abstract" "const" "final" "native" "private" "protected" "public" - "static" "strictfp" "synchronized" "transient" "volatile") + "static" "strictfp" "synchronized" "transient" "volatile" "@[A-Za-z0-9]+") pike '("final" "inline" "local" "nomask" "optional" "private" "protected" "public" "static" "variant")) @@ -1858,7 +1866,11 @@ one of `c-type-list-kwds', `c-ref-list-kwds', (c-lang-defconst c-prefix-spec-kwds-re ;; Adorned regexp of `c-prefix-spec-kwds'. - t (c-make-keywords-re t (c-lang-const c-prefix-spec-kwds))) + t (c-make-keywords-re t (c-lang-const c-prefix-spec-kwds)) + java (replace-regexp-in-string + "\\\\\\[" "[" + (replace-regexp-in-string "\\\\\\+" "+" (c-make-keywords-re t (c-lang-const c-prefix-spec-kwds))))) + (c-lang-defvar c-prefix-spec-kwds-re (c-lang-const c-prefix-spec-kwds-re)) (c-lang-defconst c-specifier-key @@ -1950,7 +1962,7 @@ or variable identifier (that's being defined)." t nil c++ '("operator") objc '("@class") - java '("import" "new" "extends" "implements" "throws") + java '("import" "new" "extends" "super" "implements" "throws") idl '("manages" "native" "primarykey" "supports" ;; In CORBA PSDL: "as" "implements" "of" "scope") @@ -2499,7 +2511,7 @@ more info." ;; in all languages except Java for when a cpp macro definition ;; begins with a declaration. t "\\([\{\}\(\);,]+\\)" - java "\\([\{\}\(;,]+\\)" + java "\\([\{\}\(;,<]+\\)" ;; Match "<" in C++ to get the first argument in a template arglist. ;; In that case there's an additional check in `c-find-decl-spots' ;; that it got open paren syntax. @@ -2759,7 +2771,7 @@ It's undefined whether identifier syntax (see `c-identifier-syntax-table') is in effect or not." t nil (c c++ objc pike) "\\(\\.\\.\\.\\)" - java (concat "\\(\\[" (c-lang-const c-simple-ws) "*\\]\\)")) + java (concat "\\(\\[" (c-lang-const c-simple-ws) "*\\]\\|\\.\\.\\.\\)")) (c-lang-defvar c-opt-type-suffix-key (c-lang-const c-opt-type-suffix-key)) (c-lang-defvar c-known-type-key diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index ed17e6f34e6..d61c8d42457 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1,8 +1,8 @@ ;;; cc-mode.el --- major mode for editing C and similar languages ;; Copyright (C) 1985, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998, -;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Authors: 2003- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -522,7 +522,7 @@ that requires a literal mode spec at compile time." (when (or c-recognize-<>-arglists (c-major-mode-is 'awk-mode) - (c-major-mode-is '(c-mode c++-mode objc-mode))) + (c-major-mode-is '(java-mode c-mode c++-mode objc-mode))) ;; We'll use the syntax-table text property to change the syntax ;; of some chars for this language, so do the necessary setup for ;; that. @@ -616,6 +616,15 @@ that requires a literal mode spec at compile time." (font-lock-mode 0) (font-lock-mode 1))) +;; Buffer local variables defining the region to be fontified by a font lock +;; after-change function. They are set in c-after-change to +;; after-change-function's BEG and END, and may be modified by a +;; `c-before-font-lock-function'. +(defvar c-new-BEG 0) +(make-variable-buffer-local 'c-new-BEG) +(defvar c-new-END 0) +(make-variable-buffer-local 'c-new-END) + (defun c-common-init (&optional mode) "Common initialization for all CC Mode modes. In addition to the work done by `c-basic-common-init' and @@ -640,6 +649,8 @@ compatible with old code; callers should always specify it." ;; Starting a mode is a sort of "change". So call the change functions... (save-restriction (widen) + (setq c-new-BEG (point-min)) + (setq c-new-END (point-max)) (save-excursion (if c-get-state-before-change-functions (mapc (lambda (fn) @@ -660,6 +671,17 @@ compatible with old code; callers should always specify it." (and (cdr rfn) (setq require-final-newline mode-require-final-newline))))) +(defun c-count-cfss (lv-alist) + ;; LV-ALIST is an alist like `file-local-variables-alist'. Count how many + ;; elements with the key `c-file-style' there are in it. + (let ((elt-ptr lv-alist) elt (cownt 0)) + (while elt-ptr + (setq elt (car elt-ptr) + elt-ptr (cdr elt-ptr)) + (when (eq (car elt) 'c-file-style) + (setq cownt (1+ cownt)))) + cownt)) + (defun c-before-hack-hook () "Set the CC Mode style and \"offsets\" when in the buffer's local variables. They are set only when, respectively, the pseudo variables @@ -667,11 +689,24 @@ They are set only when, respectively, the pseudo variables This function is called from the hook `before-hack-local-variables-hook'." (when c-buffer-is-cc-mode - (let ((stile (cdr (assq 'c-file-style file-local-variables-alist))) + (let ((mode-cons (assq 'mode file-local-variables-alist)) + (stile (cdr (assq 'c-file-style file-local-variables-alist))) (offsets (cdr (assq 'c-file-offsets file-local-variables-alist)))) + (when mode-cons + (hack-one-local-variable (car mode-cons) (cdr mode-cons)) + (setq file-local-variables-alist + (delq mode-cons file-local-variables-alist))) (when stile (or (stringp stile) (error "c-file-style is not a string")) - (c-set-style stile)) + (if (boundp 'dir-local-variables-alist) + ;; Determine whether `c-file-style' was set in the file's local + ;; variables or in a .dir-locals.el (a directory setting). + (let ((cfs-in-file-and-dir-count + (c-count-cfss file-local-variables-alist)) + (cfs-in-dir-count (c-count-cfss dir-local-variables-alist))) + (c-set-style stile + (= cfs-in-file-and-dir-count cfs-in-dir-count))) + (c-set-style stile))) (when offsets (mapc (lambda (langentry) @@ -785,15 +820,6 @@ Note that the style variables are always made local to the buffer." ;;; Change hooks, linking with Font Lock. -;; Buffer local variables defining the region to be fontified by a font lock -;; after-change function. They are set in c-after-change to -;; after-change-function's BEG and END, and may be modified by a -;; `c-before-font-lock-function'. -(defvar c-new-BEG 0) -(make-variable-buffer-local 'c-new-BEG) -(defvar c-new-END 0) -(make-variable-buffer-local 'c-new-END) - ;; Buffer local variables recording Beginning/End-of-Macro position before a ;; change, when a macro straddles, respectively, the BEG or END (or both) of ;; the change region. Otherwise these have the values BEG/END. @@ -886,17 +912,19 @@ Note that the style variables are always made local to the buffer." ;; inside a string, comment, or macro. (goto-char c-old-BOM) ; already set to old start of macro or begg. (setq c-new-BEG - (if (setq limits (c-state-literal-at (point))) - (cdr limits) ; go forward out of any string or comment. - (point))) + (min c-new-BEG + (if (setq limits (c-state-literal-at (point))) + (cdr limits) ; go forward out of any string or comment. + (point)))) (goto-char endd) (if (setq limits (c-state-literal-at (point))) (goto-char (car limits))) ; go backward out of any string or comment. (if (c-beginning-of-macro) (c-end-of-macro)) - (setq c-new-END (max (+ (- c-old-EOM old-len) (- endd begg)) - (point))) + (setq c-new-END (max c-new-END + (+ (- c-old-EOM old-len) (- endd begg)) + (point))) ;; Clear all old relevant properties. (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 82015687cb2..f61c2a9fd06 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1056,9 +1056,13 @@ can always override the use of `c-default-style' by making calls to ;; Anchor pos: Boi at the topmost intro line. (knr-argdecl . 0) ;; Anchor pos: At the beginning of the first K&R argdecl. - (topmost-intro . 0) + (topmost-intro . 0) ;; Anchor pos: Bol at the last line of previous construct. (topmost-intro-cont . c-lineup-topmost-intro-cont) + ;;Anchor pos: Bol at the topmost annotation line + (annotation-top-cont . 0) + ;;Anchor pos: Bol at the topmost annotation line + (annotation-var-cont . +) ;; Anchor pos: Boi at the topmost intro line. (member-init-intro . +) ;; Anchor pos: Boi at the func decl arglist open. @@ -1285,12 +1289,16 @@ Here is the current list of valid syntactic element symbols: between them; in C++ and Java, throws declarations and other things can appear in this context. knr-argdecl-intro -- First line of a K&R C argument declaration. - knr-argdecl -- Subsequent lines in a K&R C argument declaration. - topmost-intro -- The first line in a topmost construct definition. - topmost-intro-cont -- Topmost definition continuation lines. - member-init-intro -- First line in a member initialization list. - member-init-cont -- Subsequent member initialization list lines. - inher-intro -- First line of a multiple inheritance list. + knr-argdecl -- Subsequent lines in a K&R C argument declaration. + topmost-intro -- The first line in a topmost construct definition. + topmost-intro-cont -- Topmost definition continuation lines. + annotation-top-cont -- Topmost definition continuation line where only + annotations are on previous lines. + annotation-var-cont -- A continuation of a C (or like) statement where + only annotations are on previous lines. + member-init-intro -- First line in a member initialization list. + member-init-cont -- Subsequent member initialization list lines. + inher-intro -- First line of a multiple inheritance list. inher-cont -- Subsequent multiple inheritance lines. block-open -- Statement block open brace. block-close -- Statement block close brace. @@ -1376,7 +1384,7 @@ Here is the current list of valid syntactic element symbols: '(defun-block-intro block-open block-close statement statement-cont statement-block-intro statement-case-intro statement-case-open substatement substatement-open substatement-label case-label label - do-while-closure else-clause catch-clause inlambda)) + do-while-closure else-clause catch-clause inlambda annotation-var-cont)) (defcustom c-style-variables-are-local-p t "*Whether style variables should be buffer local by default. @@ -1577,7 +1585,7 @@ names).")) :group 'c) (defcustom java-font-lock-extra-types - (list (concat "[" c-upper "]\\sw*[" c-lower "]\\sw*")) + (list (concat "[" c-upper "]\\sw*[" c-lower "]\\sw")) (c-make-font-lock-extra-types-blurb "Java" "java-mode" (concat "For example, a value of (\"[" c-upper "]\\\\sw*[" c-lower "]\\\\sw*\") means capitalized words are treated as type names (the requirement for a diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 7000b4bbc8a..a909006e0c0 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -47,7 +47,7 @@ ;; using the same *compilation* buffer. this necessitates re-parsing markers. ;; FILE-STRUCTURE is a list of -;; ((FILENAME . DIRECTORY) FORMATS (LINE LOC ...) ...) +;; ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...) ;; FILENAME is a string parsed from an error message. DIRECTORY is a string ;; obtained by following directory change messages. DIRECTORY will be nil for @@ -196,6 +196,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\ \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4)) + (cucumber + "\\(?:^cucumber\\(?: -p [^[:space:]]+\\)?\\|#\\)\ +\\(?: \\)\\([^\(].*\\):\\([1-9][0-9]*\\)" 1 2) + (edg-1 "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)" 1 2 nil (3 . 4)) @@ -223,6 +227,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\ \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) + (ruby + "^[\t ]*\\(?:from \\)?\ +\\([^\(\n][^[:space:]\n]*\\):\\([1-9][0-9]*\\)\\(:in `.*'\\)?.*$" 1 2) + (java "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1)) @@ -325,6 +333,9 @@ during global destruction\\.$\\)" 1 2) "\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil nil) + (ruby-Test::Unit + "[\t ]*\\[\\([^\(].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:$" 1 2) + (rxp "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\ \\([0-9]+\\) of file://\\(.+\\)" @@ -2083,7 +2094,7 @@ and overlay is highlighted between MK and END-MK." pre-existing (let ((display-buffer-reuse-frames t) (pop-up-windows t)) - ;; Pop up a window. + ;; Pop up a window. (display-buffer (marker-buffer msg))))) (highlight-regexp (with-current-buffer (marker-buffer msg) ;; also do this while we change buffer diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index 1e5f1f506b3..2558456bc07 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -628,7 +628,9 @@ routine.") (defun delphi-token-at (p) ;; Returns the token from parsing text at point p. (when (and (<= (point-min) p) (<= p (point-max))) - (cond ((delphi-literal-token-at p)) + (cond ((delphi-char-token-at p ?\n 'newline)) + + ((delphi-literal-token-at p)) ((delphi-space-token-at p)) @@ -638,7 +640,6 @@ routine.") ((delphi-char-token-at p ?\) 'close-group)) ((delphi-char-token-at p ?\[ 'open-group)) ((delphi-char-token-at p ?\] 'close-group)) - ((delphi-char-token-at p ?\n 'newline)) ((delphi-char-token-at p ?\; 'semicolon)) ((delphi-char-token-at p ?. 'dot)) ((delphi-char-token-at p ?, 'comma)) @@ -888,7 +889,24 @@ non-delphi buffer. Set to nil in a delphi buffer. To override, just do: (setq token (delphi-block-start token))) ;; Regular block start found. - ((delphi-is token-kind delphi-block-statements) (throw 'done token)) + ((delphi-is token-kind delphi-block-statements) + (throw 'done + ;; As a special case, when a "case" block appears + ;; within a record declaration (to denote a variant + ;; part), the record declaration should be considered + ;; the enclosing block. + (if (eq 'case token-kind) + (let ((enclosing-token + (delphi-block-start token + 'stop-on-class))) + (if + (eq 'record + (delphi-token-kind enclosing-token)) + (if stop-on-class + enclosing-token + (delphi-previous-token enclosing-token)) + token)) + token))) ;; A class/record start also begins a block. ((delphi-composite-type-start token last-token) @@ -1058,6 +1076,7 @@ non-delphi buffer. Set to nil in a delphi buffer. To override, just do: (token-kind nil) (from-kind (delphi-token-kind from-token)) (last-colon nil) + (last-of nil) (last-token nil)) (catch 'done (while token @@ -1101,9 +1120,17 @@ non-delphi buffer. Set to nil in a delphi buffer. To override, just do: ;; Ignore whitespace. ((delphi-is token-kind delphi-whitespace)) - ;; Remember any ':' we encounter, since that affects how we indent to - ;; a case statement. - ((eq 'colon token-kind) (setq last-colon token)) + ;; Remember any "of" we encounter, since that affects how we + ;; indent to a case statement within a record declaration + ;; (i.e. a variant part). + ((eq 'of token-kind) + (setq last-of token)) + + ;; Remember any ':' we encounter (until we reach an "of"), + ;; since that affects how we indent to case statements in + ;; general. + ((eq 'colon token-kind) + (unless last-of (setq last-colon token))) ;; A case statement delimits a previous statement. We indent labels ;; specially. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 4f0fcd77ab5..2018a71574e 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -40,6 +40,7 @@ If you set this variable, do not also set `tags-table-list'. Use the `etags' program to make a tags table file.") ;; Make M-x set-variable tags-file-name like M-x visit-tags-table. ;;;###autoload (put 'tags-file-name 'variable-interactive (purecopy "fVisit tags table: ")) +;;;###autoload (put 'tags-file-name 'safe-local-variable 'stringp) (defgroup etags nil "Tags tables." :group 'tools) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index e4cc32b972c..5b98ff427c3 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -795,7 +795,10 @@ detailed description of this mode. (gdb-input ;; Needs GDB 6.4 onwards (list (concat "-inferior-tty-set " - (process-tty-name (get-process "gdb-inferior"))) + (or + ;; The process can run on a remote host. + (process-get (get-process "gdb-inferior") 'remote-tty) + (process-tty-name (get-process "gdb-inferior")))) 'ignore)) (if (eq window-system 'w32) (gdb-input (list "-gdb-set new-console off" 'ignore))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index da38a086782..d20a14682c7 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -145,7 +145,7 @@ Used to grey out relevant toolbar icons.") (gud-call "suspend")) ((eq gud-minor-mode 'gdbmi) (gud-call (gdb-gud-context-command "-exec-interrupt"))) - (t + (t (comint-interrupt-subjob))))) (easy-mmode-defmap gud-menu-map @@ -2513,7 +2513,7 @@ comint mode, which see." (setq w (cdr w))) (if w (setcar w - (if (file-remote-p default-directory) + (if (file-remote-p file) ;; Tramp has already been loaded if we are here. (setq file (tramp-file-name-localname (tramp-dissect-file-name file))) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 402893c5946..1d042c99451 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -1602,7 +1602,7 @@ Capitalize system variables - action only `(lambda () (interactive) (self-insert-command 1) - ,@(if (listp cmd) cmd (list cmd)))))) + ,(if (listp cmd) cmd (list cmd)))))) ;; Set action and key bindings. ;; See description of the function `idlwave-action-and-binding'. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 6bd8fbc2442..d6feca4d8a0 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -474,8 +474,7 @@ for preventing Firefox from stealing the keyboard focus." (defcustom js-js-tmpdir "~/.emacs.d/js/js" "Temporary directory used by `js-mode' to communicate with Mozilla. -This directory must be readable and writable by both Mozilla and -Emacs." +This directory must be readable and writable by both Mozilla and Emacs." :type 'directory :group 'js) @@ -499,11 +498,11 @@ getting timeout messages." (define-key keymap [(meta ?.)] #'js-find-symbol) (easy-menu-define nil keymap "Javascript Menu" '("Javascript" - ["Select new Mozilla context…" js-set-js-context + ["Select New Mozilla Context..." js-set-js-context (fboundp #'inferior-moz-process)] - ["Evaluate expression in Mozilla context…" js-eval + ["Evaluate Expression in Mozilla Context..." js-eval (fboundp #'inferior-moz-process)] - ["Send current function to Mozilla…" js-eval-defun + ["Send Current Function to Mozilla..." js-eval-defun (fboundp #'inferior-moz-process)])) keymap) "Keymap for `js-mode'.") @@ -3269,7 +3268,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." ;;; Main Function ;;;###autoload -(define-derived-mode js-mode nil "js" +(define-derived-mode js-mode prog-mode "js" "Major mode for editing JavaScript. Key bindings: diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 7a1aa3e70f4..15664c8e56d 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -768,7 +768,7 @@ The function must satisfy this calling convention: ;;; ------------------------------------------------------------ ;;;###autoload -(define-derived-mode makefile-mode nil "Makefile" +(define-derived-mode makefile-mode prog-mode "Makefile" "Major mode for editing standard Makefiles. If you are editing a file for a different make, try one of the diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index 12f561c6814..5287eff1347 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -4,7 +4,7 @@ ;; Free Software Foundation, Inc. ;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> -;; Author: John Eaton <jwe@bevo.che.wisc.edu> +;; Author: John Eaton <jwe@octave.org> ;; Maintainer: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> ;; Keywords: languages @@ -92,7 +92,7 @@ All Octave abbrevs start with a grave accent (`)." (defvar octave-comment-char ?# "Character to start an Octave comment.") (defvar octave-comment-start - (string octave-comment-char ?\ ) + (string octave-comment-char ?\s) "String to insert to start a new Octave in-line comment.") (defvar octave-comment-start-skip "\\s<+\\s-*" "Regexp to match the start of an Octave comment up to its body.") @@ -194,15 +194,11 @@ parenthetical grouping.") (define-key map ";" 'octave-electric-semi) (define-key map " " 'octave-electric-space) (define-key map "\n" 'octave-reindent-then-newline-and-indent) - (define-key map "\e;" 'octave-indent-for-comment) (define-key map "\e\n" 'octave-indent-new-comment-line) - (define-key map "\e\t" 'octave-complete-symbol) (define-key map "\M-\C-a" 'octave-beginning-of-defun) (define-key map "\M-\C-e" 'octave-end-of-defun) (define-key map "\M-\C-h" 'octave-mark-defun) (define-key map "\M-\C-q" 'octave-indent-defun) - (define-key map "\C-c;" 'octave-comment-region) - (define-key map "\C-c:" 'octave-uncomment-region) (define-key map "\C-c\C-b" 'octave-submit-bug-report) (define-key map "\C-c\C-p" 'octave-previous-code-line) (define-key map "\C-c\C-n" 'octave-next-code-line) @@ -267,14 +263,14 @@ parenthetical grouping.") ["Kill Process" octave-kill-process t]) "-" ["Indent Line" indent-according-to-mode t] - ["Complete Symbol" octave-complete-symbol t] + ["Complete Symbol" completion-at-point t] "-" ["Toggle Abbrev Mode" abbrev-mode t] ["Toggle Auto-Fill Mode" auto-fill-mode t] "-" ["Submit Bug Report" octave-submit-bug-report t] "-" - ["Describe Octave Mode" octave-describe-major-mode t] + ["Describe Octave Mode" describe-mode t] ["Lookup Octave Index" octave-help t]) "Menu for Octave mode.") @@ -298,8 +294,16 @@ parenthetical grouping.") (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?. "w" table) (modify-syntax-entry ?_ "w" table) - (modify-syntax-entry ?\% "<" table) - (modify-syntax-entry ?\# "<" table) + ;; The "b" flag only applies to the second letter of the comstart + ;; and the first letter of the comend, i.e. the "4b" below is ineffective. + ;; If we try to put `b' on the single-line comments, we get a similar + ;; problem where the % and # chars appear as first chars of the 2-char + ;; comend, so the multi-line ender is also turned into style-b. + ;; So we need the new "c" comment style. + (modify-syntax-entry ?\% "< 13" table) + (modify-syntax-entry ?\# "< 13" table) + (modify-syntax-entry ?\{ "(} 2c" table) + (modify-syntax-entry ?\} "){ 4c" table) (modify-syntax-entry ?\n ">" table) table) "Syntax table in use in `octave-mode' buffers.") @@ -402,7 +406,7 @@ Non-nil means always go to the next Octave code line after sending." ;;;###autoload -(defun octave-mode () +(define-derived-mode octave-mode prog-mode "Octave" "Major mode for editing Octave code. This mode makes it easier to write Octave code by helping with @@ -485,52 +489,39 @@ an Octave mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducible test case and send the message." - (interactive) - (kill-all-local-variables) - - (use-local-map octave-mode-map) - (setq major-mode 'octave-mode) - (setq mode-name "Octave") (setq local-abbrev-table octave-abbrev-table) - (set-syntax-table octave-mode-syntax-table) - - (make-local-variable 'indent-line-function) - (setq indent-line-function 'octave-indent-line) - - (make-local-variable 'comment-start) - (setq comment-start octave-comment-start) - (make-local-variable 'comment-end) - (setq comment-end "") - (make-local-variable 'comment-column) - (setq comment-column 32) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "\\s<+\\s-*") - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'octave-comment-indent) - - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments t) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "\\s-*$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) - (make-local-variable 'fill-paragraph-function) - (setq fill-paragraph-function 'octave-fill-paragraph) - (make-local-variable 'adaptive-fill-regexp) - (setq adaptive-fill-regexp nil) - (make-local-variable 'fill-column) - (setq fill-column 72) - (make-local-variable 'normal-auto-fill-function) - (setq normal-auto-fill-function 'octave-auto-fill) - - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(octave-font-lock-keywords nil nil)) - - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression octave-mode-imenu-generic-expression - imenu-case-fold-search nil) + + (set (make-local-variable 'indent-line-function) 'octave-indent-line) + + (set (make-local-variable 'comment-start) octave-comment-start) + (set (make-local-variable 'comment-end) "") + ;; Don't set it here: it's not really a property of the language, + ;; just a personal preference of the author. + ;; (set (make-local-variable 'comment-column) 32) + (set (make-local-variable 'comment-start-skip) "\\s<+\\s-*") + (set (make-local-variable 'comment-add) 1) + + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'paragraph-start) + (concat "\\s-*$\\|" page-delimiter)) + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'paragraph-ignore-fill-prefix) t) + (set (make-local-variable 'fill-paragraph-function) 'octave-fill-paragraph) + ;; FIXME: Why disable it? + ;; (set (make-local-variable 'adaptive-fill-regexp) nil) + ;; Again, this is not a property of the language, don't set it here. + ;; (set (make-local-variable 'fill-column) 72) + (set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill) + + (set (make-local-variable 'font-lock-defaults) + '(octave-font-lock-keywords nil nil)) + + (set (make-local-variable 'imenu-generic-expression) + octave-mode-imenu-generic-expression) + (set (make-local-variable 'imenu-case-fold-search) nil) + + (add-hook 'completion-at-point-functions + 'octave-completion-at-point-function nil t) (octave-add-octave-menu) (octave-initialize-completions) @@ -543,25 +534,22 @@ Look up symbol in the function, operator and variable indices of the info files. (call-interactively 'info-lookup-symbol))) ;;; Miscellaneous useful functions -(defun octave-describe-major-mode () - "Describe the current major mode." - (interactive) - (describe-function major-mode)) (defsubst octave-in-comment-p () "Return t if point is inside an Octave comment." - (interactive) (save-excursion + ;; FIXME: use syntax-ppss? (nth 4 (parse-partial-sexp (line-beginning-position) (point))))) (defsubst octave-in-string-p () "Return t if point is inside an Octave string." - (interactive) (save-excursion + ;; FIXME: use syntax-ppss? (nth 3 (parse-partial-sexp (line-beginning-position) (point))))) (defsubst octave-not-in-string-or-comment-p () "Return t if point is not inside an Octave string or comment." + ;; FIXME: Use syntax-ppss? (let ((pps (parse-partial-sexp (line-beginning-position) (point)))) (not (or (nth 3 pps) (nth 4 pps))))) @@ -620,23 +608,9 @@ the end keyword." (delete-horizontal-space) (insert (concat " " octave-continuation-string)))) -;;; Comments -(defun octave-comment-region (beg end &optional arg) - "Comment or uncomment each line in the region as Octave code. -See `comment-region'." - (interactive "r\nP") - (let ((comment-start (char-to-string octave-comment-char))) - (comment-region beg end arg))) - -(defun octave-uncomment-region (beg end &optional arg) - "Uncomment each line in the region as Octave code." - (interactive "r\nP") - (or arg (setq arg 1)) - (octave-comment-region beg end (- arg))) - ;;; Indentation -(defun calculate-octave-indent () +(defun octave-indent-calculate () "Return appropriate indentation for current line as Octave code. Returns an integer (the column to indent to) unless the line is a comment line with fixed goal golumn. In that case, returns a list whose @@ -722,36 +696,13 @@ level." (beginning-of-line) (and (bobp) (looking-at "\\s-*#!")))) -(defun octave-comment-indent () - (if (or (looking-at "\\s<\\s<\\s<") - (octave-before-magic-comment-p)) - 0 - (if (looking-at "\\s<\\s<") - (calculate-octave-indent) - (skip-syntax-backward " ") - (max (if (bolp) 0 (+ 1 (current-column))) - comment-column)))) - -(defun octave-indent-for-comment () - "Maybe insert and indent an Octave comment. -If there is no comment already on this line, create a code-level comment -\(started by two comment characters) if the line is empty, or an in-line -comment (started by one comment character) otherwise. -Point is left after the start of the comment which is properly aligned." - (interactive) - (beginning-of-line) - (if (looking-at "^\\s-*$") - (insert octave-block-comment-start) - (indent-for-comment)) - (indent-according-to-mode)) - (defun octave-indent-line (&optional arg) "Indent current line as Octave code. With optional ARG, use this as offset unless this line is a comment with fixed goal column." (interactive) (or arg (setq arg 0)) - (let ((icol (calculate-octave-indent)) + (let ((icol (octave-indent-calculate)) (relpos (- (current-column) (current-indentation)))) (if (listp icol) (setq icol (car icol)) @@ -1166,7 +1117,7 @@ otherwise." (beginning-of-line) (point))) (cfc (current-fill-column)) - (ind (calculate-octave-indent)) + (ind (octave-indent-calculate)) comment-prefix) (save-restriction (goto-char beg) @@ -1237,20 +1188,24 @@ otherwise." (if octave-completion-alist () (setq octave-completion-alist - (mapcar '(lambda (var) (cons var var)) - (append octave-reserved-words - octave-text-functions - octave-variables))))) + (append octave-reserved-words + octave-text-functions + octave-variables)))) + +(defun octave-completion-at-point-function () + "Find the text to complete and the corresponding table." + (let* ((beg (save-excursion (backward-sexp 1) (point))) + (end (if (< beg (point)) + (save-excursion (goto-char beg) (forward-sexp 1) (point)) + (point)))) + (list beg end octave-completion-alist))) (defun octave-complete-symbol () "Perform completion on Octave symbol preceding point. Compare that symbol against Octave's reserved words and builtin variables." (interactive) - (let* ((end (point)) - (beg (save-excursion (backward-sexp 1) (point)))) - (completion-in-region beg end octave-completion-alist))) - + (apply 'completion-in-region (octave-completion-at-point-function))) ;;; Electric characters && friends (defun octave-reindent-then-newline-and-indent () @@ -1324,42 +1279,27 @@ Note that all Octave mode abbrevs start with a grave accent." (list-abbrevs)) (setq unread-command-events (list c)))))) -(defun octave-insert-defun (name args vals) +(define-skeleton octave-insert-defun "Insert an Octave function skeleton. Prompt for the function's name, arguments and return values (to be entered without parens)." - (interactive - (list - (read-from-minibuffer "Function name: " - (substring (buffer-name) 0 -2)) - (read-from-minibuffer "Arguments: ") - (read-from-minibuffer "Return values: "))) - (let ((string (format "%s %s (%s)" - (cond - ((string-equal vals "") - vals) - ((string-match "[ ,]" vals) - (concat " [" vals "] =")) - (t - (concat " " vals " ="))) - name - args)) - (prefix octave-block-comment-start)) - (if (not (bobp)) (newline)) - (insert "function" string) - (indent-according-to-mode) - (newline 2) - (insert prefix "usage: " string) - (reindent-then-newline-and-indent) - (insert prefix) - (reindent-then-newline-and-indent) - (insert prefix) - (indent-according-to-mode) - (save-excursion - (newline 2) - (insert "endfunction") - (indent-according-to-mode)))) - + (let* ((defname (substring (buffer-name) 0 -2)) + (name (read-string (format "Function name (default %s): " defname) + nil nil defname)) + (args (read-string "Arguments: ")) + (vals (read-string "Return values: "))) + (format "%s%s (%s)" + (cond + ((string-equal vals "") vals) + ((string-match "[ ,]" vals) (concat "[" vals "] = ")) + (t (concat vals " = "))) + name + args)) + \n "function " > str \n \n + octave-block-comment-start "usage: " str \n + octave-block-comment-start \n octave-block-comment-start + \n _ \n + "endfunction" > \n) ;;; Menu (defun octave-add-octave-menu () diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 7b235bc3b68..387a0cb6e00 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -39,6 +39,7 @@ (defconst ps-mode-version "1.1h, 16 Jun 2005") (defconst ps-mode-maintainer-address "Peter Kleiweg <p.c.j.kleiweg@rug.nl>") +(require 'comint) (require 'easymenu) ;; Define core `PostScript' group. @@ -431,12 +432,11 @@ If nil, use `temporary-file-directory'." (unless ps-run-mode-map (setq ps-run-mode-map (make-sparse-keymap)) + (set-keymap-parent ps-run-mode-map comint-mode-map) (define-key ps-run-mode-map "\C-c\C-q" 'ps-run-quit) (define-key ps-run-mode-map "\C-c\C-k" 'ps-run-kill) (define-key ps-run-mode-map "\C-c\C-e" 'ps-run-goto-error) - (define-key ps-run-mode-map [mouse-2] 'ps-run-mouse-goto-error) - (define-key ps-run-mode-map "\r" 'ps-run-newline) - (define-key ps-run-mode-map [return] 'ps-run-newline)) + (define-key ps-run-mode-map [mouse-2] 'ps-run-mouse-goto-error)) ;; Syntax table. @@ -718,12 +718,9 @@ defines the beginning of a group. These tokens are: { [ <<" (blink-matching-open)) (defun ps-mode-other-newline () - "Perform newline in `*ps run*' buffer." + "Perform newline in `*ps-run*' buffer." (interactive) - (let ((buf (current-buffer))) - (set-buffer "*ps run*") - (ps-run-newline) - (set-buffer buf))) + (ps-run-send-string "")) ;; Print PostScript. @@ -980,7 +977,7 @@ plus the usually uncoded characters inserted on positions 1 through 28." ;; Interactive PostScript interpreter. -(define-derived-mode ps-run-mode fundamental-mode "Interactive PS" +(define-derived-mode ps-run-mode comint-mode "Interactive PS" "Major mode in interactive PostScript window. This mode is invoked from `ps-mode' and should not be called directly. @@ -1014,20 +1011,23 @@ This mode is invoked from `ps-mode' and should not be called directly. (setq init-file (ps-run-make-tmp-filename)) (write-region (concat ps-run-init "\n") 0 init-file) (setq init-file (list init-file))) - (pop-to-buffer "*ps run*") + (pop-to-buffer "*ps-run*") (ps-run-mode) (when (process-status "ps-run") (delete-process "ps-run")) (erase-buffer) (setq command (append command init-file)) (insert (mapconcat 'identity command " ") "\n") - (apply 'start-process "ps-run" "*ps run*" command) + (apply 'make-comint "ps-run" (car command) nil (cdr command)) + (with-current-buffer "*ps-run*" + (use-local-map ps-run-mode-map) + (setq comint-prompt-regexp ps-run-prompt)) (select-window oldwin))) (defun ps-run-quit () "Quit interactive PostScript." (interactive) - (ps-run-send-string "quit" t) + (ps-run-send-string "quit") (ps-run-cleanup)) (defun ps-run-kill () @@ -1039,9 +1039,9 @@ This mode is invoked from `ps-mode' and should not be called directly. (defun ps-run-clear () "Clear/reset PostScript graphics." (interactive) - (ps-run-send-string "showpage" t) + (ps-run-send-string "showpage") (sit-for 1) - (ps-run-send-string "" t)) + (ps-run-send-string "")) (defun ps-run-buffer () "Send buffer to PostScript interpreter." @@ -1056,7 +1056,7 @@ This mode is invoked from `ps-mode' and should not be called directly. (let ((f (ps-run-make-tmp-filename))) (set-marker ps-run-mark begin) (write-region begin end f) - (ps-run-send-string (format "(%s) run" f) t))) + (ps-run-send-string (format "(%s) run" f)))) (defun ps-run-boundingbox () "View BoundingBox." @@ -1104,17 +1104,15 @@ grestore " x1 y1 x2 y1 x2 y2 x1 y2) 0 f) - (ps-run-send-string (format "(%s) run" f) t) + (ps-run-send-string (format "(%s) run" f)) (set-buffer buf))) -(defun ps-run-send-string (string &optional echo) +(defun ps-run-send-string (string) (let ((oldwin (selected-window))) - (pop-to-buffer "*ps run*") - (goto-char (point-max)) - (when echo - (insert string "\n")) - (set-marker (process-mark (get-process "ps-run")) (point)) - (process-send-string "ps-run" (concat string "\n")) + (pop-to-buffer "*ps-run*") + (comint-goto-process-mark) + (insert string) + (comint-send-input) (select-window oldwin))) (defun ps-run-make-tmp-filename () @@ -1140,18 +1138,6 @@ grestore (mouse-set-point event) (ps-run-goto-error)) -(defun ps-run-newline () - "Process newline in PostScript interpreter window." - (interactive) - (end-of-line) - (insert "\n") - (forward-line -1) - (when (looking-at ps-run-prompt) - (goto-char (match-end 0))) - (looking-at ".*") - (goto-char (1+ (match-end 0))) - (ps-run-send-string (buffer-substring (match-beginning 0) (match-end 0)))) - (defun ps-run-goto-error () "Jump to buffer position read as integer at point. Use line numbers if `ps-run-error-line-numbers' is not nil" diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 4e0f326e2d4..2b09e346331 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -93,7 +93,7 @@ (defvar python-font-lock-keywords `(,(rx symbol-start - ;; From v 2.5 reference, keywords. + ;; From v 2.7 reference, keywords. ;; def and class dealt with separately below (or "and" "as" "assert" "break" "continue" "del" "elif" "else" "except" "exec" "finally" "for" "from" "global" "if" @@ -102,7 +102,7 @@ ;; Not real keywords, but close enough to be fontified as such "self" "True" "False") symbol-end) - (,(rx symbol-start "None" symbol-end) ; see Keywords in 2.5 manual + (,(rx symbol-start "None" symbol-end) ; see Keywords in 2.7 manual . font-lock-constant-face) ;; Definitions (,(rx symbol-start (group "class") (1+ space) (group (1+ (or word ?_)))) @@ -117,7 +117,7 @@ (0+ "." (1+ (or word ?_))))) (1 font-lock-type-face)) ;; Built-ins. (The next three blocks are from - ;; `__builtin__.__dict__.keys()' in Python 2.5.1.) These patterns + ;; `__builtin__.__dict__.keys()' in Python 2.7) These patterns ;; are debateable, but they at least help to spot possible ;; shadowing of builtins. (,(rx symbol-start (or @@ -135,7 +135,9 @@ "SystemExit" "TabError" "TypeError" "UnboundLocalError" "UnicodeDecodeError" "UnicodeEncodeError" "UnicodeError" "UnicodeTranslateError" "UnicodeWarning" "UserWarning" - "ValueError" "Warning" "ZeroDivisionError") symbol-end) + "ValueError" "Warning" "ZeroDivisionError" + ;; Python 2.7 + "BufferError" "BytesWarning" "WindowsError") symbol-end) . font-lock-type-face) (,(rx (or line-start (not (any ". \t"))) (* (any " \t")) symbol-start (group (or @@ -152,12 +154,16 @@ "range" "raw_input" "reduce" "reload" "repr" "reversed" "round" "set" "setattr" "slice" "sorted" "staticmethod" "str" "sum" "super" "tuple" "type" "unichr" "unicode" "vars" - "xrange" "zip")) symbol-end) + "xrange" "zip" + ;; Python 2.7. + "bin" "bytearray" "bytes" "format" "memoryview" "next" "print" + )) symbol-end) (1 font-lock-builtin-face)) (,(rx symbol-start (or ;; other built-ins "True" "False" "None" "Ellipsis" - "_" "__debug__" "__doc__" "__import__" "__name__") symbol-end) + "_" "__debug__" "__doc__" "__import__" "__name__" "__package__") + symbol-end) . font-lock-builtin-face))) (defconst python-font-lock-syntactic-keywords diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 59d85e60eef..a75c5b01bb8 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -166,7 +166,6 @@ This should only be called after matching against `ruby-here-doc-end-re'." (define-key map (kbd "M-C-n") 'ruby-end-of-block) (define-key map (kbd "M-C-h") 'ruby-mark-defun) (define-key map (kbd "M-C-q") 'ruby-indent-exp) - (define-key map (kbd "TAB") 'ruby-indent-line) (define-key map (kbd "C-M-h") 'backward-kill-word) (define-key map (kbd "C-j") 'reindent-then-newline-and-indent) (define-key map (kbd "C-m") 'newline) @@ -1390,6 +1389,8 @@ The variable `ruby-indent-level' controls the amount of indentation. (setq major-mode 'ruby-mode) (ruby-mode-variables) + (set (make-local-variable 'indent-line-function) + 'ruby-indent-line) (set (make-local-variable 'imenu-create-index-function) 'ruby-imenu-create-index) (set (make-local-variable 'add-log-current-defun-function) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index ce8a34220e4..da143db5ffb 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -107,7 +107,7 @@ ;; Special characters (modify-syntax-entry ?, "' " st) (modify-syntax-entry ?@ "' " st) - (modify-syntax-entry ?# "' 14b" st) + (modify-syntax-entry ?# "' 14" st) (modify-syntax-entry ?\\ "\\ " st) st)) diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index 3f842903b0d..f8d1a6aca97 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -330,7 +330,7 @@ for SIMULA mode to function correctly." (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu))) ;;;###autoload -(define-derived-mode simula-mode nil "Simula" +(define-derived-mode simula-mode prog-mode "Simula" "Major mode for editing SIMULA code. \\{simula-mode-map} Variables controlling indentation style: diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index e4df102f542..e44504688f2 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -5,7 +5,7 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Michael Mauger <mmaug@yahoo.com> -;; Version: 2.1 +;; Version: 2.5 ;; Keywords: comm languages processes ;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode @@ -152,11 +152,7 @@ ;; (defcustom my-sql-xyz-login-params '(user password server database) ;; "Login parameters to needed to connect to XyzDB." -;; :type '(repeat (choice -;; (const user) -;; (const password) -;; (const server) -;; (const database))) +;; :type 'sql-login-params ;; :group 'SQL) ;; ;; (sql-set-product-feature 'xyz @@ -170,7 +166,7 @@ ;; (sql-set-product-feature 'xyz ;; :sqli-options 'my-sql-xyz-options)) -;; (defun my-sql-connect-xyz (product options) +;; (defun my-sql-comint-xyz (product options) ;; "Connect ti XyzDB in a comint buffer." ;; ;; ;; Do something with `sql-user', `sql-password', @@ -184,10 +180,10 @@ ;; (setq params (append (list "-P" sql-password) params))) ;; (if (not (string= "" sql-user)) ;; (setq params (append (list "-U" sql-user) params))) -;; (sql-connect product params))) +;; (sql-comint product params))) ;; ;; (sql-set-product-feature 'xyz -;; :sqli-connect-func 'my-sql-connect-xyz) +;; :sqli-comint-func 'my-sql-comint-xyz) ;; 6) Define a convienence function to invoke the SQL interpreter. @@ -236,7 +232,7 @@ (require 'regexp-opt)) (require 'custom) (eval-when-compile ;; needed in Emacs 19, 20 - (setq max-specpdl-size 2000)) + (setq max-specpdl-size (max max-specpdl-size 2000))) (defvar font-lock-keyword-face) (defvar font-lock-set-defaults) @@ -255,8 +251,8 @@ (defcustom sql-user "" "Default username." :type 'string - :group 'SQL) -(put 'sql-user 'safe-local-variable 'stringp) + :group 'SQL + :safe 'stringp) (defcustom sql-password "" "Default password. @@ -264,32 +260,68 @@ Storing your password in a textfile such as ~/.emacs could be dangerous. Customizing your password will store it in your ~/.emacs file." :type 'string - :group 'SQL) -(put 'sql-password 'risky-local-variable t) + :group 'SQL + :risky t) (defcustom sql-database "" "Default database." :type 'string - :group 'SQL) -(put 'sql-database 'safe-local-variable 'stringp) + :group 'SQL + :safe 'stringp) (defcustom sql-server "" "Default server or host." :type 'string - :group 'SQL) -(put 'sql-server 'safe-local-variable 'stringp) + :group 'SQL + :safe 'stringp) (defcustom sql-port nil "Default server or host." + :version "24.1" :type 'number - :group 'SQL) -(put 'sql-port 'safe-local-variable 'numberp) + :group 'SQL + :safe 'numberp) + +;; Login parameter type + +(define-widget 'sql-login-params 'lazy + "Widget definition of the login parameters list" + :tag "Login Parameters" + :type '(repeat (choice + (const user) + (const password) + (choice :tag "server" + (const server) + (list :tag "file" + (const :format "" server) + (const :format "" :file) + regexp) + (list :tag "completion" + (const :format "" server) + (const :format "" :completion) + (restricted-sexp + :match-alternatives (listp symbolp)))) + (choice :tag "database" + (const database) + (list :tag "file" + (const :format "" database) + (const :format "" :file) + regexp) + (list :tag "completion" + (const :format "" database) + (const :format "" :completion) + (restricted-sexp + :match-alternatives (listp symbolp)))) + (const port)))) ;; SQL Product support (defvar sql-interactive-product nil "Product under `sql-interactive-mode'.") +(defvar sql-connection nil + "Connection name if interactive session started by `sql-connect'.") + (defvar sql-product-alist '((ansi :name "ANSI" @@ -301,9 +333,10 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-db2-program :sqli-options sql-db2-options :sqli-login sql-db2-login-params - :sqli-connect-func sql-connect-db2 + :sqli-comint-func sql-comint-db2 :prompt-regexp "^db2 => " :prompt-length 7 + :prompt-cont-regexp "^db2 (cont\.) => " :input-filter sql-escape-newlines-filter) (informix @@ -312,7 +345,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-informix-program :sqli-options sql-informix-options :sqli-login sql-informix-login-params - :sqli-connect-func sql-connect-informix + :sqli-comint-func sql-comint-informix :prompt-regexp "^> " :prompt-length 2 :syntax-alist ((?{ . "<") (?} . ">"))) @@ -323,9 +356,10 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-ingres-program :sqli-options sql-ingres-options :sqli-login sql-ingres-login-params - :sqli-connect-func sql-connect-ingres + :sqli-comint-func sql-comint-ingres :prompt-regexp "^\* " - :prompt-length 2) + :prompt-length 2 + :prompt-cont-regexp "^\* ") (interbase :name "Interbase" @@ -333,7 +367,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-interbase-program :sqli-options sql-interbase-options :sqli-login sql-interbase-login-params - :sqli-connect-func sql-connect-interbase + :sqli-comint-func sql-comint-interbase :prompt-regexp "^SQL> " :prompt-length 5) @@ -343,7 +377,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-linter-program :sqli-options sql-linter-options :sqli-login sql-linter-login-params - :sqli-connect-func sql-connect-linter + :sqli-comint-func sql-comint-linter :prompt-regexp "^SQL>" :prompt-length 4) @@ -353,7 +387,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-ms-program :sqli-options sql-ms-options :sqli-login sql-ms-login-params - :sqli-connect-func sql-connect-ms + :sqli-comint-func sql-comint-ms :prompt-regexp "^[0-9]*>" :prompt-length 5 :syntax-alist ((?@ . "w")) @@ -366,9 +400,10 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-mysql-program :sqli-options sql-mysql-options :sqli-login sql-mysql-login-params - :sqli-connect-func sql-connect-mysql + :sqli-comint-func sql-comint-mysql :prompt-regexp "^mysql> " :prompt-length 6 + :prompt-cont-regexp "^ -> " :input-filter sql-remove-tabs-filter) (oracle @@ -377,9 +412,10 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-oracle-program :sqli-options sql-oracle-options :sqli-login sql-oracle-login-params - :sqli-connect-func sql-connect-oracle + :sqli-comint-func sql-comint-oracle :prompt-regexp "^SQL> " :prompt-length 5 + :prompt-cont-regexp "^\\s-*\\d+> " :syntax-alist ((?$ . "w") (?# . "w")) :terminator ("\\(^/\\|;\\)" . "/") :input-filter sql-placeholders-filter) @@ -391,9 +427,10 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-postgres-program :sqli-options sql-postgres-options :sqli-login sql-postgres-login-params - :sqli-connect-func sql-connect-postgres - :prompt-regexp "^.*[#>] *" + :sqli-comint-func sql-comint-postgres + :prompt-regexp "^.*=[#>] " :prompt-length 5 + :prompt-cont-regexp "^.*-[#>] " :input-filter sql-remove-tabs-filter :terminator ("\\(^[\\]g\\|;\\)" . ";")) @@ -403,7 +440,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-solid-program :sqli-options sql-solid-options :sqli-login sql-solid-login-params - :sqli-connect-func sql-connect-solid + :sqli-comint-func sql-comint-solid :prompt-regexp "^" :prompt-length 0) @@ -414,9 +451,11 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-sqlite-program :sqli-options sql-sqlite-options :sqli-login sql-sqlite-login-params - :sqli-connect-func sql-connect-sqlite + :sqli-comint-func sql-comint-sqlite :prompt-regexp "^sqlite> " - :prompt-length 8) + :prompt-length 8 + :prompt-cont-regexp "^ ...> " + :terminator ";") (sybase :name "Sybase" @@ -424,7 +463,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-program sql-sybase-program :sqli-options sql-sybase-options :sqli-login sql-sybase-login-params - :sqli-connect-func sql-connect-sybase + :sqli-comint-func sql-comint-sybase :prompt-regexp "^SQL> " :prompt-length 5 :syntax-alist ((?@ . "w")) @@ -463,7 +502,7 @@ may be any one of the following: database and server) needed to connect to the database. - :sqli-connect-func name of a function which accepts no + :sqli-comint-func name of a function which accepts no parameters that will use the values of `sql-user', `sql-password', `sql-database' and `sql-server' to open a @@ -477,6 +516,10 @@ may be any one of the following: :prompt-length length of the prompt on the line. + :prompt-cont-regexp regular expression string that matches + the continuation prompt issued by the + product interpreter. + :input-filter function which can filter strings sent to the command interpreter. It is also used by the `sql-send-string', @@ -484,7 +527,8 @@ may be any one of the following: and `sql-send-buffer' functions. The function is passed the string sent to the command interpreter and must return the - filtered string. + filtered string. May also be a list of + such functions. :terminator the terminator to be sent after a `sql-send-string', `sql-send-region', @@ -508,6 +552,55 @@ settings.") '(:font-lock :sqli-program :sqli-options :sqli-login)) ;;;###autoload +(defcustom sql-connection-alist nil + "An alist of connection parameters for interacting with a SQL + product. + +Each element of the alist is as follows: + + \(CONNECTION \(SQL-VARIABLE VALUE) ...) + +Where CONNECTION is a symbol identifying the connection, SQL-VARIABLE +is the symbol name of a SQL mode variable, and VALUE is the value to +be assigned to the variable. + +The most common SQL-VARIABLE settings associated with a connection +are: + + `sql-product' + `sql-user' + `sql-password' + `sql-port' + `sql-server' + `sql-database' + +If a SQL-VARIABLE is part of the connection, it will not be +prompted for during login." + + :type `(alist :key-type (string :tag "Connection") + :value-type + (set + (group (const :tag "Product" sql-product) + (choice + ,@(mapcar (lambda (prod-info) + `(const :tag + ,(or (plist-get (cdr prod-info) :name) + (capitalize (symbol-name (car prod-info)))) + (quote ,(car prod-info)))) + sql-product-alist))) + (group (const :tag "Username" sql-user) string) + (group (const :tag "Password" sql-password) string) + (group (const :tag "Server" sql-server) string) + (group (const :tag "Database" sql-database) string) + (group (const :tag "Port" sql-port) integer) + (repeat :inline t + (list :tab "Other" + (symbol :tag " Variable Symbol") + (sexp :tag "Value Expression"))))) + :version "24.1" + :group 'SQL) + +;;;###autoload (defcustom sql-product 'ansi "Select the SQL database product used so that buffers can be highlighted properly when you open them." @@ -518,11 +611,8 @@ highlighted properly when you open them." (capitalize (symbol-name (car prod-info)))) ,(car prod-info))) sql-product-alist)) - :group 'SQL) -(put 'sql-product 'safe-local-variable 'symbolp) - -(defvar sql-interactive-product nil - "Product under `sql-interactive-mode'.") + :group 'SQL + :safe 'symbolp) ;; misc customization of sql.el behaviour @@ -677,11 +767,7 @@ You will find the file in your Orant\\bin directory." (defcustom sql-oracle-login-params '(user password database) "List of login parameters needed to connect to Oracle." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -702,7 +788,7 @@ to be safe: ;; Customization for SQLite -(defcustom sql-sqlite-program "sqlite" +(defcustom sql-sqlite-program "sqlite3" "Command to start SQLite. Starts `sql-interactive-mode' after doing some setup." @@ -715,13 +801,9 @@ Starts `sql-interactive-mode' after doing some setup." :version "20.8" :group 'SQL) -(defcustom sql-sqlite-login-params '(database) +(defcustom sql-sqlite-login-params '((database :file ".*\\.db")) "List of login parameters needed to connect to SQLite." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -744,12 +826,7 @@ on Windows: \"-C\" \"-t\" \"-f\" \"-n\"." (defcustom sql-mysql-login-params '(user password database server) "List of login parameters needed to connect to MySql." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database) - (const port))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -764,11 +841,7 @@ Starts `sql-interactive-mode' after doing some setup." (defcustom sql-solid-login-params '(user password server) "List of login parameters needed to connect to Solid." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -790,11 +863,7 @@ Some versions of isql might require the -n option in order to work." (defcustom sql-sybase-login-params '(server user password database) "List of login parameters needed to connect to Sybase." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -809,11 +878,7 @@ Starts `sql-interactive-mode' after doing some setup." (defcustom sql-informix-login-params '(database) "List of login parameters needed to connect to Informix." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -828,11 +893,7 @@ Starts `sql-interactive-mode' after doing some setup." (defcustom sql-ingres-login-params '(database) "List of login parameters needed to connect to Ingres." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -854,11 +915,7 @@ Starts `sql-interactive-mode' after doing some setup." (defcustom sql-ms-login-params '(user password server database) "List of login parameters needed to connect to Microsoft." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -885,11 +942,7 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list." (defcustom sql-postgres-login-params '(user database server) "List of login parameters needed to connect to Postgres." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -910,11 +963,7 @@ Starts `sql-interactive-mode' after doing some setup." (defcustom sql-interbase-login-params '(user password database) "List of login parameters needed to connect to Interbase." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -935,11 +984,7 @@ Starts `sql-interactive-mode' after doing some setup." (defcustom sql-db2-login-params nil "List of login parameters needed to connect to DB2." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -960,11 +1005,7 @@ Starts `sql-interactive-mode' after doing some setup." (defcustom sql-linter-login-params '(user password database server) "Login parameters to needed to connect to Linter." - :type '(repeat (choice - (const user) - (const password) - (const server) - (const database))) + :type 'sql-login-params :version "24.1" :group 'SQL) @@ -1005,6 +1046,9 @@ You can change `sql-prompt-regexp' on `sql-interactive-mode-hook'.") You can change `sql-prompt-length' on `sql-interactive-mode-hook'.") +(defvar sql-prompt-cont-regexp nil + "Prompt pattern of statement continuation prompts.") + (defvar sql-alternate-buffer-name nil "Buffer-local string used to possibly rename the SQLi buffer. @@ -1056,8 +1100,17 @@ Based on `comint-mode-map'.") (get-buffer-process sql-buffer))] ["Send String" sql-send-string (and (buffer-live-p sql-buffer) (get-buffer-process sql-buffer))] - ["--" nil nil] - ["Start SQLi session" sql-product-interactive (sql-get-product-feature sql-product :sqli-connect-func)] + "--" + ["Start SQLi session" sql-product-interactive + :visible (not sql-connection-alist) + :enable (sql-get-product-feature sql-product :sqli-comint-func)] + ("Start..." + :visible sql-connection-alist + :filter sql-connection-menu-filter + "--" + ["New SQLi Session" sql-product-interactive (sql-get-product-feature sql-product :sqli-comint-func)]) + ["--" + :visible sql-connection-alist] ["Show SQLi buffer" sql-show-sqli-buffer t] ["Set SQLi buffer" sql-set-sqli-buffer t] ["Pop to SQLi buffer after send" @@ -1085,7 +1138,8 @@ Based on `comint-mode-map'.") sql-interactive-mode-menu sql-interactive-mode-map "Menu for `sql-interactive-mode'." '("SQL" - ["Rename Buffer" sql-rename-buffer t])) + ["Rename Buffer" sql-rename-buffer t] + ["Save Connection" sql-save-connection (not sql-connection)])) ;; Abbreviations -- if you want more of them, define them in your ;; ~/.emacs file. Abbrevs have to be enabled in your ~/.emacs, too. @@ -1922,7 +1976,51 @@ regular expressions are created during compilation by calling the function `regexp-opt'. Therefore, take a look at the source before you define your own `sql-mode-mysql-font-lock-keywords'.") -(defvar sql-mode-sqlite-font-lock-keywords nil +(defvar sql-mode-sqlite-font-lock-keywords + (eval-when-compile + (list + ;; SQLite Keyword + (sql-font-lock-keywords-builder 'font-lock-keyword-face nil +"abort" "action" "add" "after" "all" "alter" "analyze" "and" "as" +"asc" "attach" "autoincrement" "before" "begin" "between" "by" +"cascade" "case" "cast" "check" "collate" "column" "commit" "conflict" +"constraint" "create" "cross" "database" "default" "deferrable" +"deferred" "delete" "desc" "detach" "distinct" "drop" "each" "else" +"end" "escape" "except" "exclusive" "exists" "explain" "fail" "for" +"foreign" "from" "full" "glob" "group" "having" "if" "ignore" +"immediate" "in" "index" "indexed" "initially" "inner" "insert" +"instead" "intersect" "into" "is" "isnull" "join" "key" "left" "like" +"limit" "match" "natural" "no" "not" "notnull" "null" "of" "offset" +"on" "or" "order" "outer" "plan" "pragma" "primary" "query" "raise" +"references" "regexp" "reindex" "release" "rename" "replace" +"restrict" "right" "rollback" "row" "savepoint" "select" "set" "table" +"temp" "temporary" "then" "to" "transaction" "trigger" "union" +"unique" "update" "using" "vacuum" "values" "view" "virtual" "when" +"where" +) + ;; SQLite Data types + (sql-font-lock-keywords-builder 'font-lock-type-face nil +"int" "integer" "tinyint" "smallint" "mediumint" "bigint" "unsigned" +"big" "int2" "int8" "character" "varchar" "varying" "nchar" "native" +"nvarchar" "text" "clob" "blob" "real" "double" "precision" "float" +"numeric" "number" "decimal" "boolean" "date" "datetime" +) + ;; SQLite Functions + (sql-font-lock-keywords-builder 'font-lock-builtin-face nil +;; Core functions +"abs" "changes" "coalesce" "glob" "ifnull" "hex" "last_insert_rowid" +"length" "like" "load_extension" "lower" "ltrim" "max" "min" "nullif" +"quote" "random" "randomblob" "replace" "round" "rtrim" "soundex" +"sqlite_compileoption_get" "sqlite_compileoption_used" +"sqlite_source_id" "sqlite_version" "substr" "total_changes" "trim" +"typeof" "upper" "zeroblob" +;; Date/time functions +"time" "julianday" "strftime" +"current_date" "current_time" "current_timestamp" +;; Aggregate functions +"avg" "count" "group_concat" "max" "min" "sum" "total" +))) + "SQLite SQL keywords used by font-lock. This variable is used by `sql-mode' and `sql-interactive-mode'. The @@ -1969,7 +2067,7 @@ configuration." ;; Each product is represented by a radio ;; button with it's display name. `[,display - (lambda () (interactive) (sql-set-product ',product)) + (sql-set-product ',product) :style radio :selected (eq sql-product ',product)] ;; Maintain the product list in @@ -2016,13 +2114,17 @@ argument must be a plist keyword accepted by (setcdr p (plist-put (cdr p) feature newvalue))) (message "`%s' is not a known product; use `sql-add-product' to add it first." product)))) -(defun sql-get-product-feature (product feature &optional fallback) +(defun sql-get-product-feature (product feature &optional fallback not-indirect) "Lookup FEATURE associated with a SQL PRODUCT. If the FEATURE is nil for PRODUCT, and FALLBACK is specified, then the FEATURE associated with the FALLBACK product is returned. +If the FEATURE is in the list `sql-indirect-features', and the +NOT-INDIRECT parameter is not set, then the value of the symbol +stored in the connect alist is returned. + See `sql-product-alist' for a list of products and supported features." (let* ((p (assoc product sql-product-alist)) (v (plist-get (cdr p) feature))) @@ -2036,10 +2138,12 @@ See `sql-product-alist' for a list of products and supported features." (if (and (member feature sql-indirect-features) + (not not-indirect) (symbolp v)) (symbol-value v) v)) - (message "`%s' is not a known product; use `sql-add-product' to add it first." product)))) + (message "`%s' is not a known product; use `sql-add-product' to add it first." product) + nil))) (defun sql-product-font-lock (keywords-only imenu) "Configure font-lock and imenu with product-specific settings. @@ -2126,6 +2230,19 @@ adds a fontification pattern to fontify identifiers ending in (append old-val keywords) (append keywords old-val)))))) +(defun sql-for-each-login (login-params body) + "Iterates through login parameters and returns a list of results." + + (delq nil + (mapcar + (lambda (param) + (let ((token (or (and (listp param) (car param)) param)) + (type (or (and (listp param) (nth 1 param)) nil)) + (arg (or (and (listp param) (nth 2 param)) nil))) + + (funcall body token type arg))) + login-params))) + ;;; Functions to switch highlighting @@ -2287,6 +2404,38 @@ appended to the SQLi buffer without disturbing your SQL buffer." "Read a password using PROMPT. Optional DEFAULT is password to start with." (read-passwd prompt nil default)) +(defun sql-get-login-ext (prompt last-value history-var type arg) + "Prompt user with extended login parameters. + +If TYPE is nil, then the user is simply prompted for a string +value. + +If TYPE is `:file', then the user is prompted for a file +name that must match the regexp pattern specified in the ARG +argument. + +If TYPE is `:completion', then the user is prompted for a string +specified by ARG. (ARG is used as the PREDICATE argument to +`completing-read'.)" + (cond + ((eq type nil) + (read-from-minibuffer prompt last-value nil nil history-var)) + + ((eq type :file) + (let ((use-dialog-box nil)) + (expand-file-name + (read-file-name prompt + (file-name-directory last-value) nil t + (file-name-nondirectory last-value) + (if arg + `(lambda (f) + (string-match (concat "\\<" ,arg "\\>") + (file-name-nondirectory f))) + nil))))) + + ((eq type :completion) + (completing-read prompt arg nil t last-value history-var)))) + (defun sql-get-login (&rest what) "Get username, password and database from the user. @@ -2304,32 +2453,48 @@ symbol `password', for the server if it contains the symbol `database'. The members of WHAT are processed in the order in which they are provided. +The tokens for `database' and `server' may also be lists to +control or limit the values that can be supplied. These can be +of the form: + + \(database :file \".+\\\\.EXT\") + \(database :completion FUNCTION) + +The `server' token supports the same forms. + In order to ask the user for username, password and database, call the function like this: (sql-get-login 'user 'password 'database)." (interactive) - (while what - (cond - ((eq (car what) 'user) ; user - (setq sql-user - (read-from-minibuffer "User: " sql-user nil nil - 'sql-user-history))) - ((eq (car what) 'password) ; password - (setq sql-password - (sql-read-passwd "Password: " sql-password))) - - ((eq (car what) 'server) ; server - (setq sql-server - (read-from-minibuffer "Server: " sql-server nil nil - 'sql-server-history))) - ((eq (car what) 'port) ; port - (setq sql-port - (read-from-minibuffer "Port: " sql-port nil nil - 'sql-port-history))) - ((eq (car what) 'database) ; database - (setq sql-database - (read-from-minibuffer "Database: " sql-database nil nil - 'sql-database-history)))) - (setq what (cdr what)))) + (mapcar + (lambda (w) + (let ((token (or (and (listp w) (car w)) w)) + (type (or (and (listp w) (nth 1 w)) nil)) + (arg (or (and (listp w) (nth 2 w)) nil))) + + (cond + ((eq token 'user) ; user + (setq sql-user + (read-from-minibuffer "User: " sql-user nil nil + 'sql-user-history))) + + ((eq token 'password) ; password + (setq sql-password + (sql-read-passwd "Password: " sql-password))) + + ((eq token 'server) ; server + (setq sql-server + (sql-get-login-ext "Server: " sql-server + 'sql-server-history type arg))) + + ((eq token 'database) ; database + (setq sql-database + (sql-get-login-ext "Database: " sql-database + 'sql-database-history type arg))) + + ((eq token 'port) ; port + (setq sql-port + (read-number "Port: " sql-port)))))) + what)) (defun sql-find-sqli-buffer () "Returns the current default SQLi buffer or nil. @@ -2419,17 +2584,70 @@ variable `sql-buffer'. See `sql-help' on how to create such a buffer." "Return a string that can be used to rename a SQLi buffer. This is used to set `sql-alternate-buffer-name' within -`sql-interactive-mode'." - (concat (if (string= "" sql-user) - (if (string= "" (user-login-name)) - () - (concat (user-login-name) "/")) - (concat sql-user "/")) - (if (string= "" sql-database) - (if (string= "" sql-server) - (system-name) - sql-server) - sql-database))) +`sql-interactive-mode'. + +If the session was started with `sql-connect' then the alternate +name would be the name of the connection. + +Otherwise, it uses the parameters identified by the :sqlilogin +parameter. + +If all else fails, the alternate name would be the user and +server/database name." + + (let ((name "")) + + ;; Build a name using the :sqli-login setting + (setq name + (apply 'concat + (cdr + (apply 'append nil + (sql-for-each-login + (sql-get-product-feature sql-product :sqli-login) + (lambda (token type arg) + (cond + ((eq token 'user) + (unless (string= "" sql-user) + (list "/" sql-user))) + ((eq token 'port) + (unless (= 0 sql-port) + (list ":" sql-port))) + ((eq token 'server) + (unless (string= "" sql-server) + (list "." + (if (eq type :file) + (file-name-nondirectory sql-server) + sql-server)))) + ((eq token 'database) + (when (string= "" sql-database) + (list "@" + (if (eq type :file) + (file-name-nondirectory sql-database) + sql-database)))) + + ((eq token 'password) nil) + (t nil)))))))) + + ;; If there's a connection, use it and the name thus far + (if sql-connection + (format "<%s>%s" sql-connection (or name "")) + + ;; If there is no name, try to create something meaningful + (if (string= "" (or name "")) + (concat + (if (string= "" sql-user) + (if (string= "" (user-login-name)) + () + (concat (user-login-name) "/")) + (concat sql-user "/")) + (if (string= "" sql-database) + (if (string= "" sql-server) + (system-name) + sql-server) + sql-database)) + + ;; Use the name we've got + name)))) (defun sql-rename-buffer () "Rename a SQLi buffer." @@ -2507,14 +2725,73 @@ Every newline in STRING will be preceded with a space and a backslash." ;;; Input sender for SQLi buffers +(defvar sql-output-newline-count 0 + "Number of newlines in the input string. + +Allows the suppression of continuation prompts.") + +(defvar sql-output-by-send nil + "Non-nil if the command in the input was generated by `sql-send-string'.") + (defun sql-input-sender (proc string) "Send STRING to PROC after applying filters." (let* ((product (with-current-buffer (process-buffer proc) sql-product)) (filter (sql-get-product-feature product :input-filter))) + ;; Apply filter(s) + (cond + ((not filter) + nil) + ((functionp filter) + (setq string (funcall filter string))) + ((listp filter) + (mapc (lambda (f) (setq string (funcall f string))) filter)) + (t nil)) + + ;; Count how many newlines in the string + (setq sql-output-newline-count 0) + (mapc (lambda (ch) + (when (eq ch ?\n) + (setq sql-output-newline-count (1+ sql-output-newline-count)))) + string) + ;; Send the string - (comint-simple-send proc (if filter (funcall filter string) string)))) + (comint-simple-send proc string))) + +;;; Strip out continuation prompts + +(defun sql-interactive-remove-continuation-prompt (oline) + "Strip out continuation prompts out of the OLINE. + +Added to the `comint-preoutput-filter-functions' hook in a SQL +interactive buffer. If `sql-outut-newline-count' is greater than +zero, then an output line matching the continuation prompt is filtered +out. If the count is one, then the prompt is replaced with a newline +to force the output from the query to appear on a new line." + (if (and sql-prompt-cont-regexp + sql-output-newline-count + (numberp sql-output-newline-count) + (>= sql-output-newline-count 1)) + (progn + (while (and oline + sql-output-newline-count + (> sql-output-newline-count 0) + (string-match sql-prompt-cont-regexp oline)) + + (setq oline + (replace-match (if (and + (= 1 sql-output-newline-count) + sql-output-by-send) + "\n" "") + nil nil oline) + sql-output-newline-count + (1- sql-output-newline-count))) + (if (= sql-output-newline-count 0) + (setq sql-output-newline-count nil)) + (setq sql-output-by-send nil)) + (setq sql-output-newline-count nil)) + oline) ;;; Sending the region to the SQLi buffer. @@ -2522,26 +2799,20 @@ Every newline in STRING will be preceded with a space and a backslash." "Send the string STR to the SQL process." (interactive "sSQL Text: ") - (let (comint-input-sender-no-newline proc) + (let ((comint-input-sender-no-newline nil) + (s (replace-regexp-in-string "[[:space:]\n\r]+\\'" "" str))) (if (buffer-live-p sql-buffer) (progn ;; Ignore the hoping around... (save-excursion - ;; Get the process - (setq proc (get-buffer-process sql-buffer)) - ;; Set product context (with-current-buffer sql-buffer - ;; Send the string - (sql-input-sender proc str) - - ;; Send a newline if there wasn't one on the end of the string - (unless (string-equal "\n" (substring str (1- (length str)))) - (comint-send-string proc "\n")) + ;; Send the string (trim the trailing whitespace) + (sql-input-sender (get-buffer-process sql-buffer) s) ;; Send a command terminator if we must (if sql-send-terminator - (sql-send-magic-terminator sql-buffer str sql-send-terminator)) + (sql-send-magic-terminator sql-buffer s sql-send-terminator)) (message "Sent string to buffer %s." (buffer-name sql-buffer)))) @@ -2576,7 +2847,7 @@ Every newline in STRING will be preceded with a space and a backslash." (defun sql-send-magic-terminator (buf str terminator) "Send TERMINATOR to buffer BUF if its not present in STR." - (let (pat term) + (let (comint-input-sender-no-newline pat term) ;; If flag is merely on(t), get product-specific terminator (if (eq terminator t) (setq terminator (sql-get-product-feature sql-product :terminator))) @@ -2597,8 +2868,13 @@ Every newline in STRING will be preceded with a space and a backslash." ;; Check to see if the pattern is present in the str already sent (unless (and pat term - (string-match (concat pat "\n?\\'") str)) - (comint-send-string buf (concat term "\n"))))) + (string-match (concat pat "\\'") str)) + (comint-simple-send (get-buffer-process buf) term) + (setq sql-output-newline-count + (if sql-output-newline-count + (1+ sql-output-newline-count) + 1))) + (setq sql-output-by-send t))) (defun sql-remove-tabs-filter (str) "Replace tab characters with spaces." @@ -2788,6 +3064,8 @@ you entered, right above the output it created. (setq abbrev-all-caps 1) ;; Exiting the process will call sql-stop. (set-process-sentinel (get-buffer-process sql-buffer) 'sql-stop) + ;; Save the connection name + (make-local-variable 'sql-connection) ;; Create a usefull name for renaming this buffer later. (make-local-variable 'sql-alternate-buffer-name) (setq sql-alternate-buffer-name (sql-make-alternate-buffer-name)) @@ -2796,13 +3074,22 @@ you entered, right above the output it created. (sql-get-product-feature sql-product :prompt-regexp)) (set (make-local-variable 'sql-prompt-length) (sql-get-product-feature sql-product :prompt-length)) + (set (make-local-variable 'sql-prompt-cont-regexp) + (sql-get-product-feature sql-product :prompt-cont-regexp)) + (make-local-variable 'sql-output-newline-count) + (make-local-variable 'sql-output-by-send) + (add-hook 'comint-preoutput-filter-functions + 'sql-interactive-remove-continuation-prompt nil t) (make-local-variable 'sql-input-ring-separator) (make-local-variable 'sql-input-ring-file-name) - (setq comint-process-echoes t) ;; Run the mode hook (along with comint's hooks). (run-mode-hooks 'sql-interactive-mode-hook) ;; Set comint based on user overrides. - (setq comint-prompt-regexp sql-prompt-regexp) + (setq comint-prompt-regexp + (if sql-prompt-cont-regexp + (concat "\\(" sql-prompt-regexp + "\\|" sql-prompt-cont-regexp "\\)") + sql-prompt-regexp)) (setq left-margin sql-prompt-length) ;; Install input sender (set (make-local-variable 'comint-input-sender) 'sql-input-sender) @@ -2831,6 +3118,133 @@ Sentinels will always get the two parameters PROCESS and EVENT." +;;; Connection handling + +;;;###autoload +(defun sql-connect (connection) + "Connect to an interactive session using CONNECTION settings. + +See `sql-connection-alist' to see how to define connections and +their settings. + +The user will not be prompted for any login parameters if a value +is specified in the connection settings." + + ;; Prompt for the connection from those defined in the alist + (interactive + (if sql-connection-alist + (list + (let ((completion-ignore-case t)) + (completing-read "Connection: " + (mapcar (lambda (c) (car c)) + sql-connection-alist) + nil t nil nil '(())))) + nil)) + + ;; Are there connections defined + (if sql-connection-alist + ;; Was one selected + (when connection + ;; Get connection settings + (let ((connect-set (assoc connection sql-connection-alist))) + ;; Settings are defined + (if connect-set + ;; Set the desired parameters + (eval `(let* + (,@(cdr connect-set) + ;; :sqli-login params variable + (param-var (sql-get-product-feature sql-product + :sqli-login nil t)) + ;; :sqli-login params value + (login-params (sql-get-product-feature sql-product + :sqli-login)) + ;; which params are in the connection + (set-params (mapcar + (lambda (v) + (cond + ((eq (car v) 'sql-user) 'user) + ((eq (car v) 'sql-password) 'password) + ((eq (car v) 'sql-server) 'server) + ((eq (car v) 'sql-database) 'database) + ((eq (car v) 'sql-port) 'port) + (t (car v)))) + (cdr connect-set))) + ;; the remaining params (w/o the connection params) + (rem-params (sql-for-each-login + login-params + (lambda (token type arg) + (unless (member token set-params) + (if (or type arg) + (list token type arg) + token))))) + ;; Remember the connection + (sql-connection connection)) + + ;; Set the remaining parameters and start the + ;; interactive session + (eval `(let ((,param-var ',rem-params)) + (sql-product-interactive sql-product))))) + (message "SQL Connection <%s> does not exist" connection) + nil))) + (message "No SQL Connections defined") + nil)) + +(defun sql-save-connection (name) + "Captures the connection information of the current SQLi session. + +The information is appended to `sql-connection-alist' and +optionally is saved to the user's init file." + + (interactive "sNew connection name: ") + + (if sql-connection + (message "This session was started by a connection; it's already been saved.") + + (let ((login (sql-get-product-feature sql-product :sqli-login)) + (alist sql-connection-alist) + connect) + + ;; Remove the existing connection if the user says so + (when (and (assoc name alist) + (yes-or-no-p (format "Replace connection definition <%s>? " name))) + (setq alist (assq-delete-all name alist))) + + ;; Add the new connection if it doesn't exist + (if (assoc name alist) + (message "Connection <%s> already exists" name) + (setq connect + (append (list name) + (sql-for-each-login + `(product ,@login) + (lambda (token type arg) + (cond + ((eq token 'product) `(sql-product ',sql-product)) + ((eq token 'user) `(sql-user ,sql-user)) + ((eq token 'database) `(sql-database ,sql-database)) + ((eq token 'server) `(sql-server ,sql-server)) + ((eq token 'port) `(sql-port ,sql-port))))))) + + (setq alist (append alist (list connect))) + + ;; confirm whether we want to save the connections + (if (yes-or-no-p "Save the connections for future sessions? ") + (customize-save-variable 'sql-connection-alist alist) + (customize-set-variable 'sql-connection-alist alist)))))) + +(defun sql-connection-menu-filter (tail) + "Generates menu entries for using each connection." + (append + (mapcar + (lambda (conn) + (vector + (format "Connection <%s>" (car conn)) + (list 'sql-connect (car conn)) + t)) + sql-connection-alist) + tail)) + + + ;;; Entry functions for different SQL interpreters. ;;;###autoload @@ -2851,66 +3265,67 @@ If buffer exists and a process is running, just switch to buffer `*SQL*'. sql-product-alist) nil 'require-match (or (and sql-product (symbol-name sql-product)) "ansi")))) - ((symbolp product) product) ; Product specified + ((and product ; Product specified + (symbolp product)) product) (t sql-product))) ; Default to sql-product - (when (sql-get-product-feature product :sqli-connect-func) - (if (and sql-buffer - (buffer-live-p sql-buffer) - (comint-check-proc sql-buffer)) - (pop-to-buffer sql-buffer) - - ;; Is the current buffer in sql-mode and - ;; there is a buffer local setting of sql-buffer - (let* ((start-buffer - (and (derived-mode-p 'sql-mode) - (current-buffer))) - (start-sql-buffer - (and start-buffer - (let (found) - (dolist (var (buffer-local-variables)) - (and (consp var) - (eq (car var) 'sql-buffer) - (buffer-live-p (cdr var)) - (get-buffer-process (cdr var)) - (setq found (cdr var)))) - found))) - new-sqli-buffer) - - ;; Get credentials. - (apply 'sql-get-login (sql-get-product-feature product :sqli-login)) - - ;; Connect to database. - (message "Login...") - (funcall (sql-get-product-feature product :sqli-connect-func) - product - (sql-get-product-feature product :sqli-options)) - - ;; Set SQLi mode. - (setq sql-interactive-product product - new-sqli-buffer (current-buffer) - sql-buffer new-sqli-buffer) - (sql-interactive-mode) - - ;; Set `sql-buffer' in the start buffer - (when (and start-buffer (not start-sql-buffer)) - (with-current-buffer start-buffer - (setq sql-buffer new-sqli-buffer))) - - ;; All done. - (message "Login...done") - (pop-to-buffer sql-buffer))))) - -(defun sql-connect (product params) - "Set up a comint buffer to connect to the SQL processor. + (if product + (when (sql-get-product-feature product :sqli-comint-func) + (if (and sql-buffer + (buffer-live-p sql-buffer) + (comint-check-proc sql-buffer)) + (pop-to-buffer sql-buffer) + + ;; Is the current buffer in sql-mode and + ;; there is a buffer local setting of sql-buffer + (let* ((start-buffer + (and (derived-mode-p 'sql-mode) + (current-buffer))) + (start-sql-buffer + (and start-buffer + (let (found) + (dolist (var (buffer-local-variables)) + (and (consp var) + (eq (car var) 'sql-buffer) + (buffer-live-p (cdr var)) + (get-buffer-process (cdr var)) + (setq found (cdr var)))) + found))) + new-sqli-buffer) + + ;; Get credentials. + (apply 'sql-get-login (sql-get-product-feature product :sqli-login)) + + ;; Connect to database. + (message "Login...") + (funcall (sql-get-product-feature product :sqli-comint-func) + product + (sql-get-product-feature product :sqli-options)) + + ;; Set SQLi mode. + (setq sql-interactive-product product + new-sqli-buffer (current-buffer) + sql-buffer new-sqli-buffer) + (sql-interactive-mode) + + ;; Set `sql-buffer' in the start buffer + (when (and start-buffer (not start-sql-buffer)) + (with-current-buffer start-buffer + (setq sql-buffer new-sqli-buffer))) + + ;; All done. + (message "Login...done") + (pop-to-buffer sql-buffer)))) + (message "No default SQL product defined. Set `sql-product'."))) + +(defun sql-comint (product params) + "Set up a comint buffer to run the SQL processor. PRODUCT is the SQL product. PARAMS is a list of strings which are passed as command line arguments." (let ((program (sql-get-product-feature product :sqli-program))) (set-buffer - (if params - (apply 'make-comint "SQL" program nil params) - (make-comint "SQL" program nil))))) + (apply 'make-comint "SQL" program nil params)))) ;;;###autoload (defun sql-oracle () @@ -2939,7 +3354,7 @@ The default comes from `process-coding-system-alist' and (interactive) (sql-product-interactive 'oracle)) -(defun sql-connect-oracle (product options) +(defun sql-comint-oracle (product options) "Create comint buffer and connect to Oracle." ;; Produce user/password@database construct. Password without user ;; is meaningless; database without user/password is meaningless, @@ -2955,7 +3370,7 @@ The default comes from `process-coding-system-alist' and (if parameter (setq parameter (nconc (list parameter) options)) (setq parameter options)) - (sql-connect product parameter))) + (sql-comint product parameter))) @@ -2986,7 +3401,7 @@ The default comes from `process-coding-system-alist' and (interactive) (sql-product-interactive 'sybase)) -(defun sql-connect-sybase (product options) +(defun sql-comint-sybase (product options) "Create comint buffer and connect to Sybase." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -2999,7 +3414,7 @@ The default comes from `process-coding-system-alist' and (setq params (append (list "-P" sql-password) params))) (if (not (string= "" sql-user)) (setq params (append (list "-U" sql-user) params))) - (sql-connect product params))) + (sql-comint product params))) @@ -3028,7 +3443,7 @@ The default comes from `process-coding-system-alist' and (interactive) (sql-product-interactive 'informix)) -(defun sql-connect-informix (product options) +(defun sql-comint-informix (product options) "Create comint buffer and connect to Informix." ;; username and password are ignored. (let ((db (if (string= "" sql-database) @@ -3036,7 +3451,7 @@ The default comes from `process-coding-system-alist' and (if (string= "" sql-server) sql-database (concat sql-database "@" sql-server))))) - (sql-connect product (append `(,db "-") options)))) + (sql-comint product (append `(,db "-") options)))) @@ -3069,15 +3484,16 @@ The default comes from `process-coding-system-alist' and (interactive) (sql-product-interactive 'sqlite)) -(defun sql-connect-sqlite (product options) +(defun sql-comint-sqlite (product options) "Create comint buffer and connect to SQLite." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. (let ((params)) (if (not (string= "" sql-database)) - (setq params (append (list sql-database) params))) + (setq params (append (list (expand-file-name sql-database)) + params))) (setq params (append options params)) - (sql-connect product params))) + (sql-comint product params))) @@ -3110,7 +3526,7 @@ The default comes from `process-coding-system-alist' and (interactive) (sql-product-interactive 'mysql)) -(defun sql-connect-mysql (product options) +(defun sql-comint-mysql (product options) "Create comint buffer and connect to MySQL." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -3119,14 +3535,14 @@ The default comes from `process-coding-system-alist' and (setq params (append (list sql-database) params))) (if (not (string= "" sql-server)) (setq params (append (list (concat "--host=" sql-server)) params))) - (if (not (and sql-port (numberp sql-port))) + (if (and sql-port (numberp sql-port)) (setq params (append (list (concat "--port=" (number-to-string sql-port))) params))) (if (not (string= "" sql-password)) (setq params (append (list (concat "--password=" sql-password)) params))) (if (not (string= "" sql-user)) (setq params (append (list (concat "--user=" sql-user)) params))) (setq params (append options params)) - (sql-connect product params))) + (sql-comint product params))) @@ -3156,7 +3572,7 @@ The default comes from `process-coding-system-alist' and (interactive) (sql-product-interactive 'solid)) -(defun sql-connect-solid (product options) +(defun sql-comint-solid (product options) "Create comint buffer and connect to Solid." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -3167,7 +3583,7 @@ The default comes from `process-coding-system-alist' and (setq params (append (list sql-user sql-password) params))) (if (not (string= "" sql-server)) (setq params (append (list sql-server) params))) - (sql-connect product params))) + (sql-comint product params))) @@ -3196,10 +3612,10 @@ The default comes from `process-coding-system-alist' and (interactive) (sql-product-interactive 'ingres)) -(defun sql-connect-ingres (product options) +(defun sql-comint-ingres (product options) "Create comint buffer and connect to Ingres." ;; username and password are ignored. - (sql-connect product + (sql-comint product (append (if (string= "" sql-database) nil (list sql-database)) @@ -3234,7 +3650,7 @@ The default comes from `process-coding-system-alist' and (interactive) (sql-product-interactive 'ms)) -(defun sql-connect-ms (product options) +(defun sql-comint-ms (product options) "Create comint buffer and connect to Microsoft SQL Server." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -3254,7 +3670,7 @@ The default comes from `process-coding-system-alist' and ;; If -P is passed to ISQL as the last argument without a ;; password, it's considered null. (setq params (append params (list "-P"))))) - (sql-connect product params))) + (sql-comint product params))) @@ -3290,7 +3706,7 @@ Try to set `comint-output-filter-functions' like this: (interactive) (sql-product-interactive 'postgres)) -(defun sql-connect-postgres (product options) +(defun sql-comint-postgres (product options) "Create comint buffer and connect to Postgres." ;; username and password are ignored. Mark Stosberg suggest to add ;; the database at the end. Jason Beegan suggest using --pset and @@ -3304,7 +3720,7 @@ Try to set `comint-output-filter-functions' like this: (setq params (append (list "-h" sql-server) params))) (if (not (string= "" sql-user)) (setq params (append (list "-U" sql-user) params))) - (sql-connect product params))) + (sql-comint product params))) @@ -3334,7 +3750,7 @@ The default comes from `process-coding-system-alist' and (interactive) (sql-product-interactive 'interbase)) -(defun sql-connect-interbase (product options) +(defun sql-comint-interbase (product options) "Create comint buffer and connect to Interbase." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -3345,7 +3761,7 @@ The default comes from `process-coding-system-alist' and (setq params (append (list "-p" sql-password) params))) (if (not (string= "" sql-database)) (setq params (cons sql-database params))) ; add to the front! - (sql-connect product params))) + (sql-comint product params))) @@ -3379,11 +3795,11 @@ The default comes from `process-coding-system-alist' and (interactive) (sql-product-interactive 'db2)) -(defun sql-connect-db2 (product options) +(defun sql-comint-db2 (product options) "Create comint buffer and connect to DB2." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (sql-connect product options) + (sql-comint product options) ) ;; ;; Properly escape newlines when DB2 is interactive. ;; (setq comint-input-sender 'sql-escape-newlines-and-send)) @@ -3415,7 +3831,7 @@ input. See `sql-interactive-mode'. (interactive) (sql-product-interactive 'linter)) -(defun sql-connect-linter (product options) +(defun sql-comint-linter (product options) "Create comint buffer and connect to Linter." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -3430,7 +3846,7 @@ input. See `sql-interactive-mode'. (if (string= "" sql-database) (setenv "LINTER_MBX" nil) (setenv "LINTER_MBX" sql-database)) - (sql-connect product params) + (sql-comint product params) (setenv "LINTER_MBX" old-mbx))) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 58b8be8c7ba..29096a23046 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -545,7 +545,7 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'." ;; ;;;###autoload -(define-derived-mode tcl-mode nil "Tcl" +(define-derived-mode tcl-mode prog-mode "Tcl" "Major mode for editing Tcl code. Expression and list commands understand all Tcl brackets. Tab indents for Tcl code. diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 6a72c161429..469786e04dd 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -145,7 +145,9 @@ Zero means compute the Imenu menu regardless of size." local-map ,which-func-keymap face which-func ;;mouse-face highlight ; currently not evaluated :-( - help-echo "mouse-1: go to beginning, mouse-2: toggle rest visibility, mouse-3: go to end") + help-echo "mouse-1: go to beginning\n\ +mouse-2: toggle rest visibility\n\ +mouse-3: go to end") "]") "Format for displaying the function in the mode line." :group 'which-func diff --git a/lisp/replace.el b/lisp/replace.el index d73692ccc20..01d971f76eb 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1979,7 +1979,9 @@ make, or the user didn't cancel the call." (let ((isearch-string string) (isearch-regexp regexp) (search-whitespace-regexp nil) - (isearch-case-fold-search case-fold)) + (isearch-case-fold-search case-fold) + (isearch-forward t) + (isearch-error nil)) ;; Set isearch-word to nil because word-replace is regexp-based, ;; so `isearch-search-fun' should not use `word-search-forward'. (if (and isearch-word isearch-regexp) (setq isearch-word nil)) diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index e3895efac8a..1c809bbd7e0 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -550,21 +550,36 @@ This variable is expected to be made buffer-local by modes.") Call `ruler-mode-ruler-function' to compute the ruler value.") ;;;###autoload +(defvar ruler-mode nil + "Non-nil if Ruler mode is enabled. +Use the command `ruler-mode' to change this variable.") +(make-variable-buffer-local 'ruler-mode) + +(defun ruler--save-header-line-format () + "Install the header line format for Ruler mode. +Unless Ruler mode is already enabled, save the old header line +format first." + (when (and (not ruler-mode) + (local-variable-p 'header-line-format) + (not (local-variable-p 'ruler-mode-header-line-format-old))) + (set (make-local-variable 'ruler-mode-header-line-format-old) + header-line-format)) + (setq header-line-format ruler-mode-header-line-format)) + +;;;###autoload (define-minor-mode ruler-mode - "Display a ruler in the header line if ARG > 0." + "Toggle Ruler mode. +In Ruler mode, Emacs displays a ruler in the header line." nil nil ruler-mode-map :group 'ruler-mode + :variable (ruler-mode + . (lambda (enable) + (when enable + (ruler--save-header-line-format)) + (setq ruler-mode enable))) (if ruler-mode - (progn - ;; When `ruler-mode' is on save previous header line format - ;; and install the ruler header line format. - (when (and (local-variable-p 'header-line-format) - (not (local-variable-p 'ruler-mode-header-line-format-old))) - (set (make-local-variable 'ruler-mode-header-line-format-old) - header-line-format)) - (setq header-line-format ruler-mode-header-line-format) - (add-hook 'post-command-hook 'force-mode-line-update nil t)) + (add-hook 'post-command-hook 'force-mode-line-update nil t) ;; When `ruler-mode' is off restore previous header line format if ;; the current one is the ruler header line format. (when (eq header-line-format ruler-mode-header-line-format) diff --git a/lisp/server.el b/lisp/server.el index 1ac2fb5b361..b2cb829adf7 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -563,9 +563,9 @@ server or call `M-x server-force-delete' to forcibly disconnect it.") :coding 'raw-text-unix ;; The other args depend on the kind of socket used. (if server-use-tcp - (list :family nil + (list :family 'ipv4 ;; We're not ready for IPv6 yet :service t - :host (or server-host 'local) + :host (or server-host "127.0.0.1") ;; See bug#6781 :plist '(:authenticated nil)) (list :family 'local :service server-file @@ -577,7 +577,7 @@ server or call `M-x server-force-delete' to forcibly disconnect it.") (loop ;; The auth key is a 64-byte string of random chars in the ;; range `!'..`~'. - for i below 64 + repeat 64 collect (+ 33 (random 94)) into auth finally return (concat auth)))) (process-put server-process :auth-key auth-key) diff --git a/lisp/simple.el b/lisp/simple.el index 08ed329a9b8..5a2c9e70ad6 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -844,6 +844,78 @@ Don't use this command in Lisp programs! (overlay-recenter (point)) (recenter -3)))) +(defcustom delete-active-region t + "Whether single-char deletion commands delete an active region. +This has an effect only if Transient Mark mode is enabled, and +affects `delete-forward-char' and `delete-backward-char', though +not `delete-char'. + +If the value is the symbol `kill', the active region is killed +instead of deleted." + :type '(choice (const :tag "Delete active region" t) + (const :tag "Kill active region" kill) + (const :tag "Do ordinary deletion" nil)) + :group 'editing + :version "24.1") + +(defun delete-backward-char (n &optional killflag) + "Delete the previous N characters (following if N is negative). +If Transient Mark mode is enabled, the mark is active, and N is 1, +delete the text in the region and deactivate the mark instead. +To disable this, set `delete-active-region' to nil. + +Optional second arg KILLFLAG, if non-nil, means to kill (save in +kill ring) instead of delete. Interactively, N is the prefix +arg, and KILLFLAG is set if N is explicitly specified. + +In Overwrite mode, single character backward deletion may replace +tabs with spaces so as to back over columns, unless point is at +the end of the line." + (interactive "p\nP") + (unless (integerp n) + (signal 'wrong-type-argument (list 'integerp n))) + (cond ((and (use-region-p) + delete-active-region + (= n 1)) + ;; If a region is active, kill or delete it. + (if (eq delete-active-region 'kill) + (kill-region (region-beginning) (region-end)) + (delete-region (region-beginning) (region-end)))) + ;; In Overwrite mode, maybe untabify while deleting + ((null (or (null overwrite-mode) + (<= n 0) + (memq (char-before) '(?\t ?\n)) + (eobp) + (eq (char-after) ?\n))) + (let* ((ocol (current-column)) + (val (delete-char (- n) killflag))) + (save-excursion + (insert-char ?\s (- ocol (current-column)) nil)))) + ;; Otherwise, do simple deletion. + (t (delete-char (- n) killflag)))) + +(defun delete-forward-char (n &optional killflag) + "Delete the following N characters (previous if N is negative). +If Transient Mark mode is enabled, the mark is active, and N is 1, +delete the text in the region and deactivate the mark instead. +To disable this, set `delete-active-region' to nil. + +Optional second arg KILLFLAG non-nil means to kill (save in kill +ring) instead of delete. Interactively, N is the prefix arg, and +KILLFLAG is set if N was explicitly specified." + (interactive "p\nP") + (unless (integerp n) + (signal 'wrong-type-argument (list 'integerp n))) + (cond ((and (use-region-p) + delete-active-region + (= n 1)) + ;; If a region is active, kill or delete it. + (if (eq delete-active-region 'kill) + (kill-region (region-beginning) (region-end)) + (delete-region (region-beginning) (region-end)))) + ;; Otherwise, do simple deletion. + (t (delete-char n killflag)))) + (defun mark-whole-buffer () "Put point at beginning and mark at end of buffer. You probably should not use this function in Lisp programs; @@ -3594,29 +3666,30 @@ a mistake; see the documentation of `set-mark'." (marker-position (mark-marker)) (signal 'mark-inactive nil))) -(defcustom select-active-regions nil - "If non-nil, an active region automatically becomes the window selection." - :type 'boolean - :group 'killing - :version "23.1") - (declare-function x-selection-owner-p "xselect.c" (&optional selection)) -;; Many places set mark-active directly, and several of them failed to also -;; run deactivate-mark-hook. This shorthand should simplify. (defsubst deactivate-mark (&optional force) "Deactivate the mark by setting `mark-active' to nil. Unless FORCE is non-nil, this function does nothing if Transient Mark mode is disabled. This function also runs `deactivate-mark-hook'." (when (or transient-mark-mode force) - ;; Copy the latest region into the primary selection, if desired. - (and select-active-regions - mark-active - (display-selections-p) - (x-selection-owner-p 'PRIMARY) - (x-set-selection 'PRIMARY (buffer-substring-no-properties - (region-beginning) (region-end)))) + (when (and (if (eq select-active-regions 'only) + (eq (car-safe transient-mark-mode) 'only) + select-active-regions) + (region-active-p) + (display-selections-p)) + ;; The var `saved-region-selection', if non-nil, is the text in + ;; the region prior to the last command modifying the buffer. + ;; Set the selection to that, or to the current region. + (cond (saved-region-selection + (x-set-selection 'PRIMARY saved-region-selection) + (setq saved-region-selection nil)) + ((/= (region-beginning) (region-end)) + (x-set-selection 'PRIMARY + (buffer-substring-no-properties + (region-beginning) + (region-end)))))) (if (and (null force) (or (eq transient-mark-mode 'lambda) (and (eq (car-safe transient-mark-mode) 'only) @@ -3634,10 +3707,7 @@ This function also runs `deactivate-mark-hook'." (when (mark t) (setq mark-active t) (unless transient-mark-mode - (setq transient-mark-mode 'lambda)) - (when (and select-active-regions - (display-selections-p)) - (x-set-selection 'PRIMARY (current-buffer))))) + (setq transient-mark-mode 'lambda)))) (defun set-mark (pos) "Set this buffer's mark to POS. Don't use this function! @@ -3660,9 +3730,6 @@ store it in a Lisp variable. Example: (progn (setq mark-active t) (run-hooks 'activate-mark-hook) - (when (and select-active-regions - (display-selections-p)) - (x-set-selection 'PRIMARY (current-buffer))) (set-marker (mark-marker) pos (current-buffer))) ;; Normally we never clear mark-active except in Transient Mark mode. ;; But when we actually clear out the mark value too, we must @@ -3688,10 +3755,9 @@ point otherwise." This is used by commands that act specially on the region under Transient Mark mode. -The return value is t provided Transient Mark mode is enabled and -the mark is active; and, when `use-empty-active-region' is -non-nil, provided the region is empty. Otherwise, the return -value is nil. +The return value is t if Transient Mark mode is enabled and the +mark is active; furthermore, if `use-empty-active-region' is nil, +the region must not be empty. Otherwise, the return value is nil. For some commands, it may be appropriate to ignore the value of `use-empty-active-region'; in that case, use `region-active-p'." @@ -3877,7 +3943,8 @@ Does not set point. Does nothing if mark ring is empty." (setq mark-ring (cdr mark-ring))) (deactivate-mark)) -(defalias 'exchange-dot-and-mark 'exchange-point-and-mark) +(define-obsolete-function-alias + 'exchange-dot-and-mark 'exchange-point-and-mark "23.3") (defun exchange-point-and-mark (&optional arg) "Put the mark where point is now, and point where the mark is now. This command works even when the mark is not active, @@ -3935,8 +4002,8 @@ deactivate it, and restore the variable `transient-mark-mode' to its earlier value." (cond ((and shift-select-mode this-command-keys-shift-translated) (unless (and mark-active - (eq (car-safe transient-mark-mode) 'only)) - (setq transient-mark-mode + (eq (car-safe transient-mark-mode) 'only)) + (setq transient-mark-mode (cons 'only (unless (eq transient-mark-mode 'lambda) transient-mark-mode))) @@ -5499,7 +5566,10 @@ it skips the contents of comments that end before point." During execution of Lisp code, this character causes a quit directly. At top-level, as an editor command, this simply beeps." (interactive) - (deactivate-mark) + ;; Avoid adding the region to the window selection. + (setq saved-region-selection nil) + (let (select-active-regions) + (deactivate-mark)) (if (fboundp 'kmacro-keyboard-quit) (kmacro-keyboard-quit)) (setq defining-kbd-macro nil) @@ -5698,7 +5768,7 @@ Each action has the form (FUNCTION . ARGS)." The default mail mode is now Message mode. You have the following Mail mode variable%s customized: \n %s\n\nTo use Mail mode, set `mail-user-agent' to sendmail-user-agent. -To disable this warning, set `compose-mail-check-user-agent' to nil." +To disable this warning, set `compose-mail-user-agent-warnings' to nil." (if (> (length warn-vars) 1) "s" "") (mapconcat 'symbol-name warn-vars " ")))))) @@ -6450,6 +6520,7 @@ call `normal-erase-is-backspace-mode' (which see) instead." (if (if (eq normal-erase-is-backspace 'maybe) (and (not noninteractive) (or (memq system-type '(ms-dos windows-nt)) + (memq window-system '(ns)) (and (memq window-system '(x)) (fboundp 'x-backspace-delete-keys-p) (x-backspace-delete-keys-p)) diff --git a/lisp/startup.el b/lisp/startup.el index 87f1a00bd54..76e11491c0c 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -878,10 +878,33 @@ opening the first frame (e.g. open a connection to an X server).") (run-hooks 'before-init-hook) - ;; Under X Window, this creates the X frame and deletes the terminal frame. + ;; Under X, this creates the X frame and deletes the terminal frame. (unless (daemonp) + ;; Enable or disable the tool-bar and menu-bar. + ;; While we're at it, set `no-blinking-cursor' too. + (cond + ((or noninteractive emacs-basic-display) + (setq menu-bar-mode nil + tool-bar-mode nil + no-blinking-cursor t)) + ;; Check X resources if available. + ((memq initial-window-system '(x w32 ns)) + (let ((no-vals '("no" "off" "false" "0"))) + (if (member (x-get-resource "menuBar" "MenuBar") no-vals) + (setq menu-bar-mode nil)) + (if (member (x-get-resource "toolBar" "ToolBar") no-vals) + (setq tool-bar-mode nil)) + (if (member (x-get-resource "cursorBlink" "CursorBlink") + no-vals) + (setq no-blinking-cursor t))))) (frame-initialize)) + (when (fboundp 'x-create-frame) + ;; Set up the tool-bar (even in tty frames, since Emacs might open a + ;; graphical frame later). + (unless noninteractive + (tool-bar-setup))) + ;; Turn off blinking cursor if so specified in X resources. This is here ;; only because all other settings of no-blinking-cursor are here. (unless (or noninteractive @@ -891,25 +914,6 @@ opening the first frame (e.g. open a connection to an X server).") '("off" "false"))))) (setq no-blinking-cursor t)) - ;; If frame was created with a menu bar, set menu-bar-mode on. - (unless (or noninteractive - emacs-basic-display - (and (memq initial-window-system '(x w32)) - (<= (frame-parameter nil 'menu-bar-lines) 0))) - (menu-bar-mode 1)) - - (unless (or noninteractive (not (fboundp 'tool-bar-mode))) - ;; Set up the tool-bar. Do this even in tty frames, so that there - ;; is a tool-bar if Emacs later opens a graphical frame. - (if (or emacs-basic-display - (and (numberp (frame-parameter nil 'tool-bar-lines)) - (<= (frame-parameter nil 'tool-bar-lines) 0))) - ;; On a graphical display with the toolbar disabled via X - ;; resources, set up the toolbar without enabling it. - (tool-bar-setup) - ;; Otherwise, enable tool-bar-mode. - (tool-bar-mode 1))) - ;; Re-evaluate predefined variables whose initial value depends on ;; the runtime context. (mapc 'custom-reevaluate-setting @@ -1166,6 +1170,9 @@ the `--debug-init' option to view a complete error backtrace." (eq face-ignored-fonts old-face-ignored-fonts)) (clear-face-cache))) + ;; Load ELPA packages. + (and user-init-file package-enable-at-startup (package-initialize)) + (setq after-init-time (current-time)) (run-hooks 'after-init-hook) diff --git a/lisp/subr.el b/lisp/subr.el index 16ba45f1c74..9fb737fd038 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1874,12 +1874,11 @@ any other non-digit terminates the character code and is then used as input.")) ;; Note: `read-char' does it using the `ascii-character' property. ;; We should try and use read-key instead. (let ((translation (lookup-key local-function-key-map (vector char)))) - (if (arrayp translation) - (setq translated (aref translation 0)))) - (setq translated - (if (integerp char) - (char-resolve-modifiers char) - char)) + (setq translated (if (arrayp translation) + (aref translation 0) + char))) + (if (integerp translated) + (setq translated (char-resolve-modifiers translated))) (cond ((null translated)) ((not (integerp translated)) (setq unread-command-events (list char) diff --git a/lisp/term.el b/lisp/term.el index ea6c48a2b2a..d5e0d149ae5 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -502,8 +502,8 @@ This is a good thing to set in mode hooks.") (defvar term-delimiter-argument-list () "List of characters to recognize as separate arguments in input. Strings comprising a character in this list will separate the arguments -surrounding them, and also be regarded as arguments in their own right (unlike -whitespace). See `term-arguments'. +surrounding them, and also be regarded as arguments in their own right +\(unlike whitespace). See `term-arguments'. Defaults to the empty list. For shells, a good value is (?\\| ?& ?< ?> ?\\( ?\\) ?\\;). @@ -1516,7 +1516,7 @@ if [ $1 = .. ]; then shift; fi; exec \"$@\"" ;; term-replace-by-expanded-history-before-point Workhorse function. (defun term-read-input-ring (&optional silent) - "Sets the buffer's `term-input-ring' from a history file. + "Set the buffer's `term-input-ring' from a history file. The name of the file is given by the variable `term-input-ring-file-name'. The history ring is of size `term-input-ring-size', regardless of file size. If `term-input-ring-file-name' is nil this function does nothing. @@ -1564,7 +1564,7 @@ See also `term-input-ignoredups' and `term-write-input-ring'." term-input-ring-index nil))))) (defun term-write-input-ring () - "Writes the buffer's `term-input-ring' to a history file. + "Write the buffer's `term-input-ring' to a history file. The name of the file is given by the variable `term-input-ring-file-name'. The original contents of the file are lost if `term-input-ring' is not empty. If `term-input-ring-file-name' is nil this function does nothing. @@ -1996,12 +1996,12 @@ Argument 0 is the command name." "Send input to process. After the process output mark, sends all text from the process mark to point as input to the process. Before the process output mark, calls value -of variable term-get-old-input to retrieve old input, copies it to the +of variable `term-get-old-input' to retrieve old input, copies it to the process mark, and sends it. A terminal newline is also inserted into the buffer and sent to the process. The list of function names contained in the value of `term-input-filter-functions' is called on the input before sending it. The input is entered into the input history ring, if the value of variable -term-input-filter returns non-nil when called on the input. +`term-input-filter' returns non-nil when called on the input. Any history reference may be expanded depending on the value of the variable `term-input-autoexpand'. The list of function names contained in the value @@ -2137,7 +2137,7 @@ set the hook `term-input-sender'." (term-send-string proc "\n")) (defun term-bol (arg) - "Goes to the beginning of line, then skips past the prompt, if any. + "Go to the beginning of line, then skip past the prompt, if any. If a prefix argument is given (\\[universal-argument]), then no prompt skip -- go straight to column 0. @@ -3760,7 +3760,7 @@ all pending output has been dealt with.")) (goto-char saved-point)))) (defun term-erase-in-display (kind) - "Erases (that is blanks out) part of the window. + "Erase (that is blank out) part of the window. If KIND is 0, erase from (point) to (point-max); if KIND is 1, erase from home to point; else erase from home to point-max." (term-handle-deferred-scroll) @@ -4166,7 +4166,7 @@ Typing SPC flushes the help buffer." ;; I need a make-term that doesn't surround with *s -mm (defun term-ansi-make-term (name program &optional startfile &rest switches) -"Make a term process NAME in a buffer, running PROGRAM. + "Make a term process NAME in a buffer, running PROGRAM. The name of the buffer is NAME. If there is already a running process in that buffer, it is not restarted. Optional third arg STARTFILE is the name of a file to send the contents of to @@ -4267,7 +4267,7 @@ returns nil, which is recognized by `serial-process-configure' for special serial ports that cannot be configured.") (defun serial-supported-or-barf () - "Signal an error if serial processes are not supported" + "Signal an error if serial processes are not supported." (unless (fboundp 'make-serial-process) (error "Serial processes are not supported on this system"))) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index a53d0346d94..f73b3d7e67e 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -186,14 +186,11 @@ The properties returned may include `top', `left', `height', and `width'." ;;;; Keyboard mapping. -;; These tell read-char how to convert these special chars to ASCII. -(put 'S-tab 'ascii-character (logior 16 ?\t)) - (defvar ns-alternatives-map (let ((map (make-sparse-keymap))) ;; Map certain keypad keys into ASCII characters ;; that people usually expect. - (define-key map [S-tab] [25]) + (define-key map [S-tab] [backtab]) (define-key map [M-backspace] [?\M-\d]) (define-key map [M-delete] [?\M-\d]) (define-key map [M-tab] [?\M-\t]) @@ -208,6 +205,7 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [?\s-,] 'customize) (define-key global-map [?\s-'] 'next-multiframe-window) (define-key global-map [?\s-`] 'other-frame) +(define-key global-map [?\s-~] 'ns-prev-frame) (define-key global-map [?\s--] 'center-line) (define-key global-map [?\s-:] 'ispell) (define-key global-map [?\s-\;] 'ispell-next) diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index 017c976ed51..24561fe835f 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -45,7 +45,7 @@ "Toggle 132/80 column mode for vt100s. With positive argument, switch to 132-column mode. With negative argument, switch to 80-column mode." - :global t :initial-value (= (frame-width) 132) + :global t :init-value (= (frame-width) 132) (send-string-to-terminal (if vt100-wide-mode "\e[?3h" "\e[?3l")) (set-frame-width terminal-frame (if vt100-wide-mode 132 80))) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 3208ece9c09..65ba534de42 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1219,35 +1219,27 @@ This is the actual text stored in the X cut buffer.") "Max number of characters to put in the cut buffer. It is said that overlarge strings are slow to put into the cut buffer.") -(defcustom x-select-enable-clipboard nil +(defcustom x-select-enable-clipboard t "Non-nil means cutting and pasting uses the clipboard. -This is in addition to, but in preference to, the primary selection. - -On MS-Windows, this is non-nil by default, since Windows does not -support other types of selections. \(The primary selection that is -set by Emacs is not accessible to other programs on Windows.\)" +This is in addition to, but in preference to, the primary selection." :type 'boolean - :group 'killing) + :group 'killing + :version "24.1") -(defcustom x-select-enable-primary t +(defcustom x-select-enable-primary nil "Non-nil means cutting and pasting uses the primary selection." :type 'boolean - :group 'killing) + :group 'killing + :version "24.1") (defun x-select-text (text &optional push) "Select TEXT, a string, according to the window system. - -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. - -On Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. - -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." +If `x-select-enable-clipboard' is non-nil, copy TEXT to the +clipboard. If `x-select-enable-primary' is non-nil, put TEXT in +the primary selection. For backward compatibility with older X +applications, this function also sets the value of X cut buffer +0, and, if the optional argument PUSH is non-nil, rotates the cut +buffers." ;; With multi-tty, this function may be called from a tty frame. (when (eq (framep (selected-frame)) 'x) ;; Don't send the cut buffer too much text. @@ -1560,12 +1552,12 @@ The value nil is the same as this list: ;; Enable CLIPBOARD copy/paste through menu bar commands. (menu-bar-enable-clipboard) - ;; Override Paste so it looks at CLIPBOARD first. - (define-key menu-bar-edit-menu [paste] - (append '(menu-item "Paste" x-clipboard-yank - :enable (not buffer-read-only) - :help "Paste (yank) text most recently cut/copied") - nil)) + ;; ;; Override Paste so it looks at CLIPBOARD first. + ;; (define-key menu-bar-edit-menu [paste] + ;; (append '(menu-item "Paste" x-clipboard-yank + ;; :enable (not buffer-read-only) + ;; :help "Paste (yank) text most recently cut/copied") + ;; nil)) (setq x-initialized t)) diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 605f3f8c101..a9eb45939b2 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -1289,18 +1289,16 @@ otherwise it is made canonical." (skip-chars-backward " ")) (setq ncols (- fc endcol)) ;; Ncols is number of additional space chars needed - (if (and (> ncols 0) (> nspaces 0) (not eop)) - (progn - (setq curr-fracspace (+ ncols (/ (1+ nspaces) 2)) - count nspaces) - (while (> count 0) - (skip-chars-forward " ") - (insert-and-inherit - (make-string (/ curr-fracspace nspaces) ?\s)) - (search-forward " " nil t) - (setq count (1- count) - curr-fracspace - (+ (% curr-fracspace nspaces) ncols))))))) + (when (and (> ncols 0) (> nspaces 0) (not eop)) + (setq curr-fracspace (+ ncols (/ nspaces 2)) + count nspaces) + (while (> count 0) + (skip-chars-forward " ") + (insert-char ?\s (/ curr-fracspace nspaces) t) + (search-forward " " nil t) + (setq count (1- count) + curr-fracspace + (+ (% curr-fracspace nspaces) ncols)))))) (t (error "Unknown justification value")))) (goto-char pos) (move-marker pos nil))) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index e5727f41e93..e8a92b101ef 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1817,7 +1817,9 @@ misspelled words backwards." (throw 'exit t))))))) (save-excursion (goto-char pos) - (ispell-word)) + (ispell-word) + (setq flyspell-word-cache-word nil) ;; Force flyspell-word re-check + (flyspell-word)) (error "No word to correct before point")))) ;;*---------------------------------------------------------------------*/ diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 94eb721e4cf..ad591eb0e7f 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -357,21 +357,21 @@ Must be greater than 1." :group 'ispell) (defcustom ispell-alternate-dictionary - (cond ((file-exists-p "/usr/dict/web2") "/usr/dict/web2") - ((file-exists-p "/usr/share/dict/web2") "/usr/share/dict/web2") - ((file-exists-p "/usr/dict/words") "/usr/dict/words") - ((file-exists-p "/usr/lib/dict/words") "/usr/lib/dict/words") - ((file-exists-p "/usr/share/dict/words") "/usr/share/dict/words") - ((file-exists-p "/usr/share/lib/dict/words") + (cond ((file-readable-p "/usr/dict/web2") "/usr/dict/web2") + ((file-readable-p "/usr/share/dict/web2") "/usr/share/dict/web2") + ((file-readable-p "/usr/dict/words") "/usr/dict/words") + ((file-readable-p "/usr/lib/dict/words") "/usr/lib/dict/words") + ((file-readable-p "/usr/share/dict/words") "/usr/share/dict/words") + ((file-readable-p "/usr/share/lib/dict/words") "/usr/share/lib/dict/words") - ((file-exists-p "/sys/dict") "/sys/dict") - (t "/usr/dict/words")) - "*Alternate dictionary for spelling help." + ((file-readable-p "/sys/dict") "/sys/dict")) + "*Alternate plain word-list dictionary for spelling help." :type '(choice file (const :tag "None" nil)) :group 'ispell) -(defcustom ispell-complete-word-dict ispell-alternate-dictionary - "*Dictionary used for word completion." +(defcustom ispell-complete-word-dict nil + "*Plain word-list dictionary used for word completion if +different from `ispell-alternate-dictionary'." :type '(choice file (const :tag "None" nil)) :group 'ispell) @@ -660,8 +660,8 @@ re-start Emacs." "[^A-Za-z\241\243\246\254\257\261\263\266\274\277\306\312\321\323\346\352\361\363]" "[.]" nil nil nil iso-8859-2) ("portugues" ; Portuguese mode - "[a-zA-Z\301\302\311\323\340\341\342\351\352\355\363\343\372]" - "[^a-zA-Z\301\302\311\323\340\341\342\351\352\355\363\343\372]" + "[a-zA-Z\301\302\307\311\323\340\341\342\351\352\355\363\343\347\372]" + "[^a-zA-Z\301\302\307\311\323\340\341\342\351\352\355\363\343\347\372]" "[']" t ("-C") "~latin1" iso-8859-1) ("russian" ; Russian.aff (KOI8-R charset) "[\341\342\367\347\344\345\263\366\372\351\352\353\354\355\356\357\360\362\363\364\365\346\350\343\376\373\375\370\371\377\374\340\361\301\302\327\307\304\305\243\326\332\311\312\313\314\315\316\317\320\322\323\324\325\306\310\303\336\333\335\330\331\337\334\300\321]" @@ -982,8 +982,8 @@ Assumes that value contains no whitespace." ;; This returns nil if the data file does not exist. ;; Can someone please explain the return value format when the ;; file does exist -- rms? - (let* ((lang ;; Strip out region, variant, etc. - (and (string-match "^[[:alpha:]]+" dict-name) + (let* ((lang ;; Strip out variant, etc. + (and (string-match "^[[:alpha:]_]+" dict-name) (match-string 0 dict-name))) (data-file (concat (or ispell-aspell-data-dir @@ -2049,10 +2049,11 @@ Global `ispell-quit' set to start location to continue spell session." (erase-buffer) (setq count ?0 skipped 0 - mode-line-format + mode-line-format ;; setup the *Choices* buffer with valid data. (concat "-- %b -- word: " new-word - " -- dict: " - ispell-alternate-dictionary) + " -- word-list: " + (or ispell-complete-word-dict + ispell-alternate-dictionary)) miss (lookup-words new-word) choices miss line ispell-choices-win-default-height) @@ -2267,11 +2268,20 @@ Otherwise the variable `ispell-grep-command' contains the command used to search for the words (usually egrep). Optional second argument contains the dictionary to use; the default is -`ispell-alternate-dictionary'." +`ispell-alternate-dictionary', overriden by `ispell-complete-word-dict' +if defined." ;; We don't use the filter for this function, rather the result is written ;; into a buffer. Hence there is no need to save the filter values. (if (null lookup-dict) - (setq lookup-dict ispell-alternate-dictionary)) + (setq lookup-dict (or ispell-complete-word-dict + ispell-alternate-dictionary))) + + (if lookup-dict + (unless (file-readable-p lookup-dict) + (error "lookup-words error: Unreadable or missing plain word-list %s." + lookup-dict)) + (error (concat "lookup-words error: No plain word-list found at system default " + "locations. Customize `ispell-alternate-dictionary' to set yours."))) (let* ((process-connection-type ispell-use-ptys-p) (wild-p (string-match "\\*" word)) @@ -2622,7 +2632,7 @@ Keeps argument list for future ispell invocations for no async support." ;; Restart check for personal dictionary is done in ;; `ispell-internal-change-dictionary', called from `ispell-buffer-local-dict' (or (or ispell-local-pdict ispell-personal-dictionary) - (equal ispell-process-directory default-directory))) + (equal ispell-process-directory (expand-file-name default-directory)))) (setq ispell-filter nil ispell-filter-continue nil) ;; may need to restart to select new personal dictionary. (ispell-kill-ispell t) @@ -2638,13 +2648,13 @@ Keeps argument list for future ispell invocations for no async support." (if (window-minibuffer-p) (if (fboundp 'minibuffer-selected-window) ;; Assign ispell process to parent buffer - (setq ispell-process-directory default-directory + (setq ispell-process-directory (expand-file-name default-directory) ispell-process-buffer-name (window-buffer (minibuffer-selected-window))) ;; Force `ispell-process-directory' to $HOME and use a dummy name (setq ispell-process-directory (expand-file-name "~/") ispell-process-buffer-name " * Minibuffer-has-spellcheck-enabled")) ;; Not in a minibuffer - (setq ispell-process-directory default-directory + (setq ispell-process-directory (expand-file-name default-directory) ispell-process-buffer-name (buffer-name))) (if ispell-async-processp (set-process-filter ispell-process 'ispell-filter)) @@ -3342,7 +3352,8 @@ Standard ispell choices are then available." (lookup-words (concat (and interior-frag "*") word (if (or interior-frag (null ispell-look-p)) "*")) - ispell-complete-word-dict))) + (or ispell-complete-word-dict + ispell-alternate-dictionary)))) (cond ((eq possibilities t) (message "No word to complete")) ((null possibilities) diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index b735b446b81..577287c60bc 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -1,8 +1,8 @@ ;;; texinfmt.el --- format Texinfo files into Info files -;; Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, -;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, +;; 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: Robert J. Chassell <bug-texinfo@gnu.org> ;; Keywords: maint, tex, docs @@ -224,7 +224,7 @@ converted to Info is stored in a temporary buffer." (save-restriction (widen) (goto-char (point-min)) - (let ((search-end (save-excursion (forward-line 100) (point)))) + (let ((search-end (line-beginning-position 101))) (if (or ;; Either copy header text. (and @@ -285,7 +285,7 @@ converted to Info is stored in a temporary buffer." (let ((filename (concat input-directory (texinfo-parse-line-arg)))) (re-search-backward "^@include") - (delete-region (point) (save-excursion (forward-line 1) (point))) + (delete-region (point) (line-beginning-position 2)) (message "Reading included file: %s" filename) (save-excursion (save-restriction @@ -323,8 +323,7 @@ converted to Info is stored in a temporary buffer." ;; Insert Info region title text. (goto-char (point-min)) - (if (search-forward - "@setfilename" (save-excursion (forward-line 100) (point)) t) + (if (search-forward "@setfilename" (line-beginning-position 101) t) (progn (setq texinfo-command-end (point)) (beginning-of-line) @@ -772,13 +771,13 @@ commands." ((eq type '@raisesections) (setq level (1+ level)) (delete-region - (point) (save-excursion (forward-line 1) (point)))) + (point) (line-beginning-position 2))) ;; 2. Decrement level ((eq type '@lowersections) (setq level (1- level)) (delete-region - (point) (save-excursion (forward-line 1) (point)))) + (point) (line-beginning-position 2))) ;; Now handle structuring commands ((cond @@ -1505,9 +1504,7 @@ The node is constructed automatically." (progn (goto-char node-name-beginning) ; skip over node command (skip-chars-forward " \t") ; and over spaces (point)) - (if (search-forward - "," - (save-excursion (end-of-line) (point)) t) ; bound search + (if (search-forward "," (line-end-position) t) ; bound search (1- (point)) (end-of-line) (point)))))) (texinfo-discard-command) ; remove or insert whitespace, as needed @@ -1692,7 +1689,7 @@ Used by @refill indenting command to avoid indenting within lists, etc.") (put 'itemize 'texinfo-item 'texinfo-itemize-item) (defun texinfo-itemize-item () ;; (texinfo-discard-line) ; Did not handle text on same line as @item. - (delete-region (1+ (point)) (save-excursion (beginning-of-line) (point))) + (delete-region (1+ (point)) (line-beginning-position)) (if (looking-at "[ \t]*[^ \t\n]+") ;; Text on same line as @item command. (insert "\b " (nth 1 (car texinfo-stack)) " \n") @@ -2132,10 +2129,10 @@ This command is executed when texinfmt sees @item inside @multitable." (narrow-to-region start end) ;; Remove whitespace before and after entry. (skip-chars-forward " ") - (delete-region (point) (save-excursion (beginning-of-line) (point))) + (delete-region (point) (line-beginning-position)) (goto-char (point-max)) (skip-chars-backward " ") - (delete-region (point) (save-excursion (end-of-line) (point))) + (delete-region (point) (line-end-position)) ;; Temporarily set texinfo-stack to nil so texinfo-format-scan ;; does not see an unterminated @multitable. (let (texinfo-stack) ; nil @@ -2409,16 +2406,14 @@ Use only the FILENAME arg; for Info, ignore the other arguments to @image." (let ((start (1- (point))) args) (skip-chars-forward " ") - (save-excursion (end-of-line) (setq texinfo-command-end (point))) + (setq texinfo-command-end (line-end-position)) (if (not (looking-at "\\([^=]+\\)=\\(.*\\)")) (error "Invalid alias command") (push (cons (match-string-no-properties 1) (match-string-no-properties 2)) texinfo-alias-list) - (texinfo-discard-command)) - ) - ) + (texinfo-discard-command)))) ;;; @var, @code and the like @@ -2455,7 +2450,7 @@ Use only the FILENAME arg; for Info, ignore the other arguments to @image." "Insert ` ... ' around arg unless inside a table; in that case, no quotes." ;; `looking-at-backward' not available in v. 18.57, 20.2 (if (not (search-backward "" ; searched-for character is a control-H - (save-excursion (beginning-of-line) (point)) + (line-beginning-position) t)) (insert "`" (texinfo-parse-arg-discard) "'") (insert (texinfo-parse-arg-discard))) @@ -2840,8 +2835,7 @@ Default is to leave paragraph indentation as is." (defun texinfo-noindent () (save-excursion (forward-paragraph 1) - (if (search-backward "@refill" - (save-excursion (forward-line -1) (point)) t) + (if (search-backward "@refill" (line-beginning-position 0) t) () ; leave @noindent command so @refill command knows not to indent ;; else (texinfo-discard-line)))) diff --git a/lisp/time.el b/lisp/time.el index c11f399ae71..d512faefee0 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -87,7 +87,7 @@ The value can be one of: ;;;###autoload (defcustom display-time-day-and-date nil "\ -*Non-nil means \\[display-time] should display day and date as well as time." +Non-nil means \\[display-time] should display day and date as well as time." :type 'boolean :group 'display-time) @@ -182,7 +182,7 @@ LABEL is a string to display as the label of that TIMEZONE's time." :version "23.1") (defcustom display-time-world-buffer-name "*wclock*" - "Name of the wclock buffer." + "Name of the world clock buffer." :group 'display-time :type 'string :version "23.1") @@ -203,7 +203,7 @@ LABEL is a string to display as the label of that TIMEZONE's time." (let ((map (make-sparse-keymap))) (define-key map "q" 'kill-this-buffer) map) - "Keymap of Display Time World mode") + "Keymap of Display Time World mode.") ;;;###autoload (defun display-time () @@ -490,15 +490,10 @@ This runs the normal hook `display-time-hook' after each update." 'display-time-event-handler))) -(defun display-time-world-mode () +(define-derived-mode display-time-world-mode nil "World clock" "Major mode for buffer that displays times in various time zones. See `display-time-world'." - (interactive) - (kill-all-local-variables) - (setq - major-mode 'display-time-world-mode - mode-name "World clock") - (use-local-map display-time-world-mode-map)) + (setq show-trailing-whitespace nil)) (defun display-time-world-display (alist) "Replace current buffer text with times in various zones, based on ALIST." @@ -506,24 +501,22 @@ See `display-time-world'." (buffer-undo-list t)) (erase-buffer) (let ((max-width 0) - (result ())) + (result ()) + fmt) (unwind-protect (dolist (zone alist) (let* ((label (cadr zone)) (width (string-width label))) (set-time-zone-rule (car zone)) - (setq result - (append result - (list - label width - (format-time-string display-time-world-time-format)))) + (push (cons label + (format-time-string display-time-world-time-format)) + result) (when (> width max-width) (setq max-width width)))) (set-time-zone-rule nil)) - (while result - (insert (pop result) - (make-string (1+ (- max-width (pop result))) ?\s) - (pop result) "\n"))) + (setq fmt (concat "%-" (int-to-string max-width) "s %s\n")) + (dolist (timedata (nreverse result)) + (insert (format fmt (car timedata) (cdr timedata))))) (delete-char -1))) ;;;###autoload diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index a05d05daeb9..4b83b07754d 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -48,21 +48,23 @@ With numeric ARG, display the tool bar if and only if ARG is positive. See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for conveniently adding tool bar items." - :init-value nil + :init-value t :global t :group 'mouse :group 'frames - (if tool-bar-mode - (progn - ;; Make one tool-bar-line for any - including non-graphical - - ;; terminal, see Bug#1754. If this causes problems, we should - ;; handle the problem in `modify-frame-parameters' or do not - ;; call `modify-all-frames-parameters' when toggling the tool - ;; bar off either. - (modify-all-frames-parameters (list (cons 'tool-bar-lines 1))) - (if (= 1 (length (default-value 'tool-bar-map))) ; not yet setup - (tool-bar-setup))) - (modify-all-frames-parameters (list (cons 'tool-bar-lines 0))))) + (let ((val (if tool-bar-mode 1 0))) + (dolist (frame (frame-list)) + (set-frame-parameter frame 'tool-bar-lines val)) + ;; If the user has given `default-frame-alist' a `tool-bar-lines' + ;; parameter, replace it. + (if (assq 'tool-bar-lines default-frame-alist) + (setq default-frame-alist + (cons (cons 'tool-bar-lines val) + (assq-delete-all 'tool-bar-lines + default-frame-alist))))) + (and tool-bar-mode + (= 1 (length (default-value 'tool-bar-map))) ; not yet setup + (tool-bar-setup))) ;;;###autoload ;; Used in the Show/Hide menu, to have the toggle reflect the current frame. @@ -74,17 +76,6 @@ See `tool-bar-mode' for more information." (tool-bar-mode (if (> (frame-parameter nil 'tool-bar-lines) 0) 0 1)) (tool-bar-mode arg))) -;;;###autoload -;; We want to pretend the toolbar by standard is on, as this will make -;; customize consider disabling the toolbar a customization, and save -;; that. We could do this for real by setting :init-value above, but -;; that would turn on the toolbar in MS Windows where it is currently -;; useless, and it would overwrite disabling the tool bar from X -;; resources. If anyone want to implement this in a cleaner way, -;; please do so. -;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-21. -(put 'tool-bar-mode 'standard-value '(t)) - (defvar tool-bar-map (make-sparse-keymap) "Keymap for the tool bar. Define this locally to override the global tool bar.") diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 0ac315ac6dc..15dfe86a8df 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -252,7 +252,7 @@ LEFT and RIGHT are the elements to compare." ;; * INSERTING AND DELETING ;; C-u 8 * to insert ********. (delete-backward-char "\d") - (delete-char [?\C-d]) + (delete-forward-char [?\C-d]) (backward-kill-word [?\M-\d]) (kill-word [?\M-d]) (kill-line [?\C-k]) @@ -829,6 +829,8 @@ Run the Viper tutorial? ")) (if old-tut-file (progn (insert-file-contents (tutorial--saved-file)) + (let ((enable-local-variables :safe)) + (hack-local-variables)) (goto-char (point-min)) (setq old-tut-point (string-to-number @@ -844,6 +846,8 @@ Run the Viper tutorial? ")) (goto-char tutorial--point-before-chkeys) (setq tutorial--point-before-chkeys (point-marker))) (insert-file-contents (expand-file-name filename tutorial-directory)) + (let ((enable-local-variables :safe)) + (hack-local-variables)) (forward-line) (setq tutorial--point-before-chkeys (point-marker))) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index f61c8d2566d..e3f76e72e37 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,28 @@ +2010-07-27 Michael Albinus <michael.albinus@gmx.de> + + * url-http (url-http-parse-headers): Disable file name handlers at + all (not only Tramp). (Bug#6717) + +2010-07-27 Michael Albinus <michael.albinus@gmx.de> + + * url-http (url-http-parse-headers): Disable Tramp. (Bug#6717) + +2010-07-01 Mark A. Hershberger <mah@everybody.org> + + * url-http.el (url-http-create-request): Add a CRLF on the end so + that POSTs with content to https urls work. See + <https://bugs.launchpad.net/mediawiki-el/+bug/540759> + +2010-06-22 Mark A. Hershberger <mah@everybody.org> + + * url-parse.el (url-user-for-url, url-password-for-url): + Convenience functions that get usernames and passwords for urls + from auth-source functions. + +2010-06-12 Štěpán Němec <stepnem@gmail.com> (tiny change) + + * url-vars.el (url-privacy-level): Fix doc typo. (Bug#6406) + 2010-05-19 Stefan Monnier <monnier@iro.umontreal.ca> * url-util.el (url-unhex-string): Don't accidentally decode as latin-1. @@ -204,7 +229,7 @@ 2008-03-09 Magnus Henoch <mange@freemail.hu> * url-http.el (url-http-chunked-encoding-after-change-function): - Remove superfluous CRLF at end of file. (bug #42) + Remove superfluous CRLF at end of file. (Bug #42) 2008-03-02 Andreas Schwab <schwab@suse.de> @@ -790,7 +815,7 @@ (url-http-parse-headers): Use it. (url-http-handle-authentication): Use subst-char-in-string. -2005-11-16 Juergen Hoetzel <emacs@hoetzel.info> (tiny change) +2005-11-16 Jürgen Hötzel <emacs@hoetzel.info> (tiny change) * url-handlers.el (url-insert-file-contents): Use the charset info provided by the HTTP server, if any. diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 9f988beaf0a..bd0a3de98a5 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -339,7 +339,7 @@ request.") ;; End request "\r\n" ;; Any data - url-http-data)) + url-http-data "\r\n")) "")) (url-http-debug "Request is: \n%s" request) request)) @@ -486,7 +486,11 @@ should be shown to the user." (class nil) (success nil) ;; other status symbols: jewelry and luxury cars - (status-symbol (cadr (assq url-http-response-status url-http-codes)))) + (status-symbol (cadr (assq url-http-response-status url-http-codes))) + ;; The filename part of a URL could be in remote file syntax, + ;; see Bug#6717 for an example. We disable file name + ;; handlers, therefore. + (file-name-handler-alist nil)) (setq class (/ url-http-response-status 100)) (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status) (url-http-handle-cookies) diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index e68e0791558..20432dcf7e5 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -25,6 +25,7 @@ ;;; Code: (require 'url-vars) +(require 'auth-source) (eval-when-compile (require 'cl)) (autoload 'url-scheme-get-property "url-methods") @@ -174,6 +175,25 @@ TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS." (url-parse-make-urlobj prot user pass host port file refs attr full))))))) +(defmacro url-bit-for-url (method lookfor url) + `(let* ((urlobj (url-generic-parse-url url)) + (bit (funcall ,method urlobj)) + (methods (list 'url-recreate-url + 'url-host))) + (while (and (not bit) (> (length methods) 0)) + (setq bit + (auth-source-user-or-password + ,lookfor (funcall (pop methods) urlobj) (url-type urlobj)))) + bit)) + +(defun url-user-for-url (url) + "Attempt to use .authinfo to find a user for this URL." + (url-bit-for-url 'url-user "login" url)) + +(defun url-password-for-url (url) + "Attempt to use .authinfo to find a password for this URL." + (url-bit-for-url 'url-password "password" url)) + (provide 'url-parse) ;; arch-tag: f338325f-71ab-4bee-93cc-78fb9a03d403 diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 1b9fd7b76cc..65622a06e02 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -128,7 +128,7 @@ email -- the email address os -- the operating system info lastloc -- the last location agent -- do not send the User-Agent string -cookie -- never accept HTTP cookies +cookies -- never accept HTTP cookies Samples: diff --git a/lisp/compare-w.el b/lisp/vc/compare-w.el index 866c6e3e4f8..6e2ab7327de 100644 --- a/lisp/compare-w.el +++ b/lisp/vc/compare-w.el @@ -4,7 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF -;; Keywords: convenience files +;; Keywords: convenience files vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index adc5a2a0455..cec4fb24616 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -97,6 +97,9 @@ when editing big diffs)." :options '(diff-delete-empty-files diff-make-unified) :group 'diff-mode) +(defvar diff-vc-backend nil + "The VC backend that created the current Diff buffer, if any.") + (defvar diff-outline-regexp "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)") @@ -138,6 +141,7 @@ when editing big diffs)." ;; Standard M-r is useful, so don't change M-r or M-R. ;;("r" . diff-restrict-view) ;;("R" . diff-reverse-direction) + ("g" . revert-buffer) ("q" . quit-window)) "Basic keymap for `diff-mode', bound to various prefix keys.") diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index d21d40d50f2..c95fe54d04a 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -315,8 +315,8 @@ use; you may override this using the second optional arg MODE." vc-annotate-display-mode)))) ;;;###autoload -(defun vc-annotate (file rev &optional display-mode buf move-point-to) - "Display the edit history of the current file using colors. +(defun vc-annotate (file rev &optional display-mode buf move-point-to vc-bk) + "Display the edit history of the current FILE using colors. This command creates a buffer that shows, for each line of the current file, when it was last edited and by whom. Additionally, colors are @@ -326,7 +326,7 @@ default, the time scale stretches back one year into the past; everything that is older than that is shown in blue. With a prefix argument, this command asks two questions in the -minibuffer. First, you may enter a revision number; then the buffer +minibuffer. First, you may enter a revision number REV; then the buffer displays and annotates that revision instead of the working revision \(type RET in the minibuffer to leave that default unchanged). Then, you are prompted for the time span in days which the color range @@ -336,6 +336,8 @@ age, and everything that is older than that is shown in blue. If MOVE-POINT-TO is given, move the point to that line. +If VC-BK is given used that VC backend. + Customization variables: `vc-annotate-menu-elements' customizes the menu elements of the @@ -348,9 +350,9 @@ mode-specific menu. `vc-annotate-color-map' and (list buffer-file-name (let ((def (vc-working-revision buffer-file-name))) (if (null current-prefix-arg) def - (read-string + (vc-read-revision (format "Annotate from revision (default %s): " def) - nil nil def))) + (list buffer-file-name) nil def))) (if (null current-prefix-arg) vc-annotate-display-mode (float (string-to-number @@ -376,7 +378,7 @@ mode-specific menu. `vc-annotate-color-map' and ;; In case it had to be uniquified. (setq temp-buffer-name (buffer-name)))) (with-output-to-temp-buffer temp-buffer-name - (let ((backend (vc-backend file)) + (let ((backend (or vc-bk (vc-backend file))) (coding-system-for-read buffer-file-coding-system)) (vc-call-backend backend 'annotate-command file (get-buffer temp-buffer-name) rev) @@ -462,7 +464,7 @@ Return a cons (REV . FILENAME)." (if (not rev-at-line) (message "Cannot extract revision number from the current line") (switch-to-buffer-other-window - (vc-find-revision (cdr rev-at-line) (car rev-at-line))))))) + (vc-find-revision (cdr rev-at-line) (car rev-at-line) vc-annotate-backend)))))) (defun vc-annotate-revision-previous-to-line () "Visit the annotation of the revision before the revision at line." @@ -527,7 +529,7 @@ the file in question, search for the log entry required and move point ." (message "Cannot extract revision number from the current line") (setq prev-rev (vc-call-backend vc-annotate-backend 'previous-revision - fname rev)) + (if filediff fname nil) rev)) (if (not prev-rev) (message "Cannot diff from any revision prior to %s" rev) (save-window-excursion @@ -597,7 +599,8 @@ describes a revision number, so warp to that revision." ;; place the point in the line. (min oldline (progn (goto-char (point-max)) (forward-line -1) - (line-number-at-pos)))))))) + (line-number-at-pos))) + vc-annotate-backend))))) (defun vc-annotate-compcar (threshold a-list) "Test successive cons cells of A-LIST against THRESHOLD. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 161013fbae0..9cacef2f71b 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -412,22 +412,24 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." (setq entry (car entries)) (setq node (ewoc-next vc-ewoc node))) (t - (ewoc-enter-before vc-ewoc node - (apply 'vc-dir-create-fileinfo entry)) + (unless noinsert + (ewoc-enter-before vc-ewoc node + (apply 'vc-dir-create-fileinfo entry))) (setq entries (cdr entries)) (setq entry (car entries)))))) (t - ;; We might need to insert a directory node if the - ;; previous node was in a different directory. - (let* ((rd (file-relative-name entrydir)) - (prev-node (ewoc-prev vc-ewoc node)) - (prev-dir (vc-dir-node-directory prev-node))) - (unless (string-equal entrydir prev-dir) - (ewoc-enter-before - vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir)))) - ;; Now insert the node itself. - (ewoc-enter-before vc-ewoc node - (apply 'vc-dir-create-fileinfo entry)) + (unless noinsert + ;; We might need to insert a directory node if the + ;; previous node was in a different directory. + (let* ((rd (file-relative-name entrydir)) + (prev-node (ewoc-prev vc-ewoc node)) + (prev-dir (vc-dir-node-directory prev-node))) + (unless (string-equal entrydir prev-dir) + (ewoc-enter-before + vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir)))) + ;; Now insert the node itself. + (ewoc-enter-before vc-ewoc node + (apply 'vc-dir-create-fileinfo entry))) (setq entries (cdr entries) entry (car entries)))))) ;; We're past the last node, all remaining entries go to the end. (unless (or node noinsert) @@ -902,10 +904,12 @@ If it is a file, return the corresponding cons for the file itself." (vc-dir-resync-directory-files file) (ewoc-set-hf vc-ewoc (vc-dir-headers vc-dir-backend default-directory) "")) - (let ((state (vc-dir-recompute-file-state file ddir))) + (let* ((complete-state (vc-dir-recompute-file-state file ddir)) + (state (cadr complete-state))) (vc-dir-update - (list state) - status-buf (eq (cadr state) 'up-to-date)))))))))) + (list complete-state) + status-buf (or (not state) + (eq state 'up-to-date))))))))))) ;; Remove out-of-date entries from vc-dir-buffers. (dolist (b drop) (setq vc-dir-buffers (delq b vc-dir-buffers))))) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 6129b21c324..cccccbdfd02 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -563,13 +563,18 @@ or an empty string if none." (let* (process-file-side-effects (coding-system-for-read 'binary) (coding-system-for-write 'binary) - (fullname (substring - (vc-git--run-command-string - file "ls-files" "-z" "--full-name" "--") - 0 -1))) + (fullname + (let ((fn (vc-git--run-command-string + file "ls-files" "-z" "--full-name" "--"))) + ;; ls-files does not return anything when looking for a + ;; revision of a file that has been renamed or removed. + (if (string= fn "") + (file-relative-name file (vc-git-root default-directory)) + (substring fn 0 -1))))) (vc-git-command buffer 0 - (concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob"))) + nil + "cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname)))) (defun vc-git-checkout (file &optional editable rev) (vc-git-command nil 0 file "checkout" (or rev "HEAD"))) @@ -723,7 +728,7 @@ or BRANCH^ (where \"^\" can be repeated)." (defun vc-git-annotate-command (file buf &optional rev) (let ((name (file-relative-name file))) - (vc-git-command buf 'async name "blame" "--date=iso" "-C" "-C" rev))) + (vc-git-command buf 'async nil "blame" "--date=iso" "-C" "-C" rev "--" name))) (declare-function vc-annotate-convert-time "vc-annotate" (time)) @@ -740,8 +745,12 @@ or BRANCH^ (where \"^\" can be repeated)." (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?") (let ((revision (match-string-no-properties 1))) (if (match-beginning 2) - (cons revision (expand-file-name (match-string-no-properties 3) - (vc-git-root default-directory))) + (let ((fname (match-string-no-properties 3))) + ;; Remove trailing whitespace from the file name. + (when (string-match " +\\'" fname) + (setq fname (substring fname 0 (match-beginning 0)))) + (cons revision + (expand-file-name fname (vc-git-root default-directory)))) revision))))) ;;; TAG SYSTEM @@ -765,11 +774,10 @@ or BRANCH^ (where \"^\" can be repeated)." (defun vc-git-previous-revision (file rev) "Git-specific version of `vc-previous-revision'." (if file - (let* ((default-directory (file-name-directory (expand-file-name file))) - (file (file-name-nondirectory file)) + (let* ((fname (file-relative-name file)) (prev-rev (with-temp-buffer (and - (vc-git--out-ok "rev-list" "-2" rev "--" file) + (vc-git--out-ok "rev-list" "-2" rev "--" fname) (goto-char (point-max)) (bolp) (zerop (forward-line -1)) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index cd43d425af1..889a60c278e 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -170,7 +170,7 @@ want to force an empty list of arguments, use t." (?? . unregistered) ;; This is what vc-svn-parse-status does. (?~ . edited))) - (re (if remote "^\\(.\\)...... \\([ *]\\) +\\(?:[-0-9]+\\)? \\(.*\\)$" + (re (if remote "^\\(.\\)......? \\([ *]\\) +\\(?:[-0-9]+\\)? \\(.*\\)$" ;; Subexp 2 is a dummy in this case, so the numbers match. "^\\(.\\)....\\(.\\) \\(.*\\)$")) result) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 0d6584fb343..20e56bbd42f 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -913,6 +913,16 @@ Within directories, only files already under version control are noticed." (nreverse flattened))) (defvar vc-dir-backend) +(defvar log-view-vc-backend) +(defvar diff-vc-backend) + +(defun vc-deduce-backend () + (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) + ((derived-mode-p 'log-view-mode) log-view-vc-backend) + ((derived-mode-p 'diff-mode) diff-vc-backend) + ((derived-mode-p 'dired-mode) + (vc-responsible-backend default-directory)) + (vc-mode (vc-backend buffer-file-name)))) (declare-function vc-dir-current-file "vc-dir" ()) (declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files)) @@ -1427,6 +1437,16 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." ;; (vc-call-backend ',(vc-backend f) ;; 'diff (list ',f) ',rev1 ',rev2)))))) +(defvar vc-coding-system-inherit-eol t + "When non-nil, inherit the EOL format for reading Diff output from the file. + +Used in `vc-coding-system-for-diff' to determine the EOL format to use +for reading Diff output for a file. If non-nil, the EOL format is +inherited from the file itself. +Set this variable to nil if your Diff tool might use a different +EOL. Then Emacs will auto-detect the EOL format in Diff output, which +gives better results.") ;; Cf. bug#4451. + (defun vc-coding-system-for-diff (file) "Return the coding system for reading diff output for FILE." (or coding-system-for-read @@ -1434,7 +1454,12 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." ;; use the buffer's coding system (let ((buf (find-buffer-visiting file))) (when buf (with-current-buffer buf - buffer-file-coding-system))) + (if vc-coding-system-inherit-eol + buffer-file-coding-system + ;; Don't inherit the EOL part of the coding-system, + ;; because some Diff tools may choose to use + ;; a different one. bug#4451. + (coding-system-base buffer-file-coding-system))))) ;; otherwise, try to find one based on the file name (car (find-operation-coding-system 'insert-file-contents file)) ;; and a final fallback @@ -1547,6 +1572,10 @@ returns t if the buffer had changes, nil otherwise." (message "%s" (cdr messages)) nil) (diff-mode) + (set (make-local-variable 'diff-vc-backend) (car vc-fileset)) + (set (make-local-variable 'revert-buffer-function) + `(lambda (ignore-auto noconfirm) + (vc-diff-internal ,async ',vc-fileset ,rev1 ,rev2 ,verbose))) ;; Make the *vc-diff* buffer read only, the diff-mode key ;; bindings are nicer for read only buffers. pcl-cvs does the ;; same thing. @@ -1653,10 +1682,7 @@ saving the buffer." ;; that's not what we want here, we want the diff for the VC root dir. (call-interactively 'vc-version-diff) (when buffer-file-name (vc-buffer-sync not-urgent)) - (let ((backend - (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) - ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory)) - (vc-mode (vc-backend buffer-file-name)))) + (let ((backend (vc-deduce-backend)) rootdir working-revision) (unless backend (error "Buffer is not version controlled")) @@ -1689,8 +1715,9 @@ If `F.~REV~' already exists, use it instead of checking it out again." rev))) (switch-to-buffer-other-window (vc-find-revision file revision)))) -(defun vc-find-revision (file revision) - "Read REVISION of FILE into a buffer and return the buffer." +(defun vc-find-revision (file revision &optional backend) + "Read REVISION of FILE into a buffer and return the buffer. +Use BACKEND as the VC backend if specified." (let ((automatic-backup (vc-version-backup-file-name file revision)) (filebuf (or (get-file-buffer file) (current-buffer))) (filename (vc-version-backup-file-name file revision 'manual))) @@ -1708,7 +1735,9 @@ If `F.~REV~' already exists, use it instead of checking it out again." ;; Change buffer to get local value of ;; vc-checkout-switches. (with-current-buffer filebuf - (vc-call find-revision file revision outbuf)))) + (if backend + (vc-call-backend backend 'find-revision file revision outbuf) + (vc-call find-revision file revision outbuf))))) (setq failed nil)) (when (and failed (file-exists-p filename)) (delete-file filename)))) @@ -1953,7 +1982,6 @@ If it contains `directory' then if the fileset contains a directory show a short If it contains `file' then show short logs for files. Not all VC backends support short logs!") -(defvar log-view-vc-backend) (defvar log-view-vc-fileset) (defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return) @@ -2102,10 +2130,7 @@ When called interactively with a prefix argument, prompt for LIMIT." (list lim))) (t (list (when (> vc-log-show-limit 0) vc-log-show-limit))))) - (let ((backend - (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) - ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory)) - (vc-mode (vc-backend buffer-file-name)))) + (let ((backend (vc-deduce-backend)) rootdir working-revision) (unless backend (error "Buffer is not version controlled")) @@ -2117,10 +2142,7 @@ When called interactively with a prefix argument, prompt for LIMIT." (defun vc-log-incoming (&optional remote-location) "Show a log of changes that will be received with a pull operation from REMOTE-LOCATION." (interactive "sRemote location (empty for default): ") - (let ((backend - (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) - ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory)) - (vc-mode (vc-backend buffer-file-name)))) + (let ((backend (vc-deduce-backend)) rootdir working-revision) (unless backend (error "Buffer is not version controlled")) @@ -2130,10 +2152,7 @@ When called interactively with a prefix argument, prompt for LIMIT." (defun vc-log-outgoing (&optional remote-location) "Show a log of changes that will be sent with a push operation to REMOTE-LOCATION." (interactive "sRemote location (empty for default): ") - (let ((backend - (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) - ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory)) - (vc-mode (vc-backend buffer-file-name)))) + (let ((backend (vc-deduce-backend)) rootdir working-revision) (unless backend (error "Buffer is not version controlled")) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 0b97b184d22..78fe793b174 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -254,7 +254,7 @@ You should set this to t when using a non-system shell.\n\n")))) ;; (expand-file-name ".." exec-directory))))) (defun w32-convert-standard-filename (filename) - "Convert a standard file's name to something suitable for the MS-Windows. + "Convert a standard file's name to something suitable for MS-Windows. This means to guarantee valid names and perhaps to canonicalize certain patterns. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 5e67c07957e..dfeb6371f5e 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1156,14 +1156,17 @@ the field." (if field (narrow-to-region (line-beginning-position) (line-end-position))))) +;; This used to say: +;; "When not inside a field, move to the previous button or field." +;; but AFAICS, it has always just thrown an error. (defun widget-complete () "Complete content of editable field from point. -When not inside a field, move to the previous button or field." +When not inside a field, signal an error." (interactive) (let ((field (widget-field-find (point)))) - (when field - (widget-apply field :complete)) - (error "Not in an editable field"))) + (if field + (widget-apply field :complete) + (error "Not in an editable field")))) ;;; Setting up the buffer. diff --git a/lisp/woman.el b/lisp/woman.el index 3efe15d5f7d..291ebcee740 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -4521,7 +4521,8 @@ logging the message." nil) ; for woman-file-readable-p etc. ;;; Bookmark Woman support. -(declare-function bookmark-make-record-default "bookmark" (&optional pos-only)) +(declare-function bookmark-make-record-default + "bookmark" (&optional no-file no-context posn)) (declare-function bookmark-prop-get "bookmark" (bookmark prop)) (declare-function bookmark-default-handler "bookmark" (bmk)) (declare-function bookmark-get-bookmark-record "bookmark" (bmk)) @@ -4532,7 +4533,7 @@ logging the message." (defun woman-bookmark-make-record () "Make a bookmark entry for a Woman buffer." `(,(Man-default-bookmark-title) - ,@(bookmark-make-record-default 'point-only) + ,@(bookmark-make-record-default 'no-file) (location . ,(concat "woman " woman-last-file-name)) ;; Use the same form as man's bookmarks, as much as possible. (man-args . ,woman-last-file-name) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 328eb569c6f..6d38fd043fe 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -1,9 +1,9 @@ -;;; x-dnd.el --- drag and drop support for X. +;;; x-dnd.el --- drag and drop support for X -*- coding: utf-8 -*- ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;; Free Software Foundation, Inc. -;; Author: Jan Dj,Ad(Brv <jan.h.d@swipnet.se> +;; Author: Jan Djärv <jan.h.d@swipnet.se> ;; Maintainer: FSF ;; Keywords: window, drag, drop diff --git a/lisp/xml.el b/lisp/xml.el index 20b595fd2d7..8e8981ac439 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -321,18 +321,20 @@ If PARSE-NS is non-nil, then QNAMES are expanded." (progn (forward-char -1) (setq result (xml-parse-tag parse-dtd parse-ns)) - (if (and xml result (not xml-sub-parser)) - ;; translation of rule [1] of XML specifications - (error "XML: (Not Well-Formed) Only one root tag allowed") - (cond - ((null result)) - ((and (listp (car result)) - parse-dtd) - (setq dtd (car result)) - (if (cdr result) ; possible leading comment - (add-to-list 'xml (cdr result)))) - (t - (add-to-list 'xml result))))) + (cond + ((null result) + ;; Not looking at an xml start tag. + (forward-char 1)) + ((and xml (not xml-sub-parser)) + ;; Translation of rule [1] of XML specifications + (error "XML: (Not Well-Formed) Only one root tag allowed")) + ((and (listp (car result)) + parse-dtd) + (setq dtd (car result)) + (if (cdr result) ; possible leading comment + (add-to-list 'xml (cdr result)))) + (t + (add-to-list 'xml result)))) (goto-char (point-max)))) (if parse-dtd (cons dtd (nreverse xml)) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 2d38c6e827c..f802103fbd7 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -122,8 +122,8 @@ ;; read xterm sequences above ascii 127 (#x7f) (defun xterm-mouse-event-read () (let ((c (read-char))) - (if (< c 0) - (+ c #x8000000 128) + (if (> c #x3FFF80) + (+ 128 (- c #x3FFF80)) c))) (defun xterm-mouse-truncate-wrap (f) |