summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorDaniel Colascione <dancol@dancol.org>2012-10-07 14:31:58 -0800
committerDaniel Colascione <dancol@dancol.org>2012-10-07 14:31:58 -0800
commit36a305a723c63fd345be65c536c52fe9765c14be (patch)
treefb89d9e103552863214c60297a65320917109357 /lisp
parent2ab329f3b5d52a39f0a45c3d9c129f1c19560142 (diff)
parent795b1482a9e314cda32d62ac2988f573d359366e (diff)
downloademacs-36a305a723c63fd345be65c536c52fe9765c14be.tar.gz
Merge from trunk
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog1381
-rw-r--r--lisp/ChangeLog.102
-rw-r--r--lisp/ChangeLog.154
-rw-r--r--lisp/ChangeLog.82
-rw-r--r--lisp/ChangeLog.94
-rw-r--r--lisp/allout.el13
-rw-r--r--lisp/ansi-color.el4
-rw-r--r--lisp/arc-mode.el86
-rw-r--r--lisp/avoid.el1
-rw-r--r--lisp/bindings.el3
-rw-r--r--lisp/bookmark.el76
-rw-r--r--lisp/bs.el2
-rw-r--r--lisp/buff-menu.el6
-rw-r--r--lisp/calc/calc-aent.el3
-rw-r--r--lisp/calc/calc-map.el20
-rw-r--r--lisp/calc/calc-store.el3
-rw-r--r--lisp/calc/calc.el46
-rw-r--r--lisp/calendar/cal-menu.el9
-rw-r--r--lisp/calendar/cal-tex.el83
-rw-r--r--lisp/calendar/cal-x.el12
-rw-r--r--lisp/calendar/calendar.el97
-rw-r--r--lisp/calendar/diary-lib.el8
-rw-r--r--lisp/calendar/icalendar.el9
-rw-r--r--lisp/calendar/timeclock.el3
-rw-r--r--lisp/cedet/ChangeLog530
-rw-r--r--lisp/cedet/cedet-cscope.el2
-rw-r--r--lisp/cedet/cedet-global.el2
-rw-r--r--lisp/cedet/cedet-idutils.el5
-rw-r--r--lisp/cedet/cedet.el21
-rw-r--r--lisp/cedet/data-debug.el53
-rw-r--r--lisp/cedet/ede.el211
-rw-r--r--lisp/cedet/ede/auto.el198
-rw-r--r--lisp/cedet/ede/autoconf-edit.el50
-rw-r--r--lisp/cedet/ede/base.el7
-rw-r--r--lisp/cedet/ede/cpp-root.el40
-rw-r--r--lisp/cedet/ede/dired.el2
-rw-r--r--lisp/cedet/ede/emacs.el52
-rw-r--r--lisp/cedet/ede/files.el26
-rw-r--r--lisp/cedet/ede/generic.el80
-rw-r--r--lisp/cedet/ede/linux.el95
-rw-r--r--lisp/cedet/ede/makefile-edit.el3
-rw-r--r--lisp/cedet/ede/pmake.el13
-rw-r--r--lisp/cedet/ede/proj-comp.el21
-rw-r--r--lisp/cedet/ede/proj-elisp.el92
-rw-r--r--lisp/cedet/ede/proj.el87
-rw-r--r--lisp/cedet/ede/project-am.el2
-rw-r--r--lisp/cedet/ede/util.el2
-rw-r--r--lisp/cedet/inversion.el62
-rw-r--r--lisp/cedet/semantic.el70
-rw-r--r--lisp/cedet/semantic/analyze/debug.el2
-rw-r--r--lisp/cedet/semantic/analyze/fcn.el22
-rw-r--r--lisp/cedet/semantic/analyze/refs.el19
-rw-r--r--lisp/cedet/semantic/bovine/c-by.el31
-rw-r--r--lisp/cedet/semantic/bovine/c.el515
-rw-r--r--lisp/cedet/semantic/bovine/el.el4
-rw-r--r--lisp/cedet/semantic/bovine/gcc.el52
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el506
-rw-r--r--lisp/cedet/semantic/bovine/make-by.el10
-rw-r--r--lisp/cedet/semantic/bovine/make.el1
-rw-r--r--lisp/cedet/semantic/bovine/scm-by.el12
-rw-r--r--lisp/cedet/semantic/bovine/scm.el5
-rw-r--r--lisp/cedet/semantic/complete.el338
-rw-r--r--lisp/cedet/semantic/db-el.el55
-rw-r--r--lisp/cedet/semantic/db-file.el7
-rw-r--r--lisp/cedet/semantic/db-find.el15
-rw-r--r--lisp/cedet/semantic/db-global.el41
-rw-r--r--lisp/cedet/semantic/db-typecache.el11
-rw-r--r--lisp/cedet/semantic/db.el57
-rw-r--r--lisp/cedet/semantic/debug.el4
-rw-r--r--lisp/cedet/semantic/decorate/include.el126
-rw-r--r--lisp/cedet/semantic/decorate/mode.el2
-rw-r--r--lisp/cedet/semantic/doc.el5
-rw-r--r--lisp/cedet/semantic/ede-grammar.el119
-rw-r--r--lisp/cedet/semantic/find.el14
-rw-r--r--lisp/cedet/semantic/fw.el195
-rw-r--r--lisp/cedet/semantic/grammar-wy.el66
-rw-r--r--lisp/cedet/semantic/grammar.el53
-rw-r--r--lisp/cedet/semantic/ia.el44
-rw-r--r--lisp/cedet/semantic/idle.el78
-rw-r--r--lisp/cedet/semantic/java.el26
-rw-r--r--lisp/cedet/semantic/lex-spp.el46
-rw-r--r--lisp/cedet/semantic/lex.el40
-rw-r--r--lisp/cedet/semantic/mru-bookmark.el1
-rw-r--r--lisp/cedet/semantic/scope.el13
-rw-r--r--lisp/cedet/semantic/symref.el10
-rw-r--r--lisp/cedet/semantic/symref/filter.el21
-rw-r--r--lisp/cedet/semantic/symref/list.el1
-rw-r--r--lisp/cedet/semantic/tag-ls.el268
-rw-r--r--lisp/cedet/semantic/tag-write.el6
-rw-r--r--lisp/cedet/semantic/tag.el110
-rw-r--r--lisp/cedet/semantic/texi.el6
-rw-r--r--lisp/cedet/semantic/util.el1
-rw-r--r--lisp/cedet/semantic/wisent/comp.el15
-rw-r--r--lisp/cedet/semantic/wisent/grammar.el526
-rw-r--r--lisp/cedet/semantic/wisent/java-tags.el28
-rw-r--r--lisp/cedet/semantic/wisent/javascript.el52
-rw-r--r--lisp/cedet/semantic/wisent/javat-wy.elbin19144 -> 19301 bytes
-rw-r--r--lisp/cedet/semantic/wisent/js-wy.el47
-rw-r--r--lisp/cedet/semantic/wisent/python-wy.el83
-rw-r--r--lisp/cedet/semantic/wisent/python.el341
-rw-r--r--lisp/cedet/srecode.el2
-rw-r--r--lisp/cedet/srecode/compile.el13
-rw-r--r--lisp/cedet/srecode/cpp.el55
-rw-r--r--lisp/cedet/srecode/dictionary.el43
-rw-r--r--lisp/cedet/srecode/find.el45
-rw-r--r--lisp/cedet/srecode/getset.el8
-rw-r--r--lisp/cedet/srecode/insert.el179
-rw-r--r--lisp/cedet/srecode/java.el20
-rw-r--r--lisp/cedet/srecode/map.el2
-rw-r--r--lisp/cedet/srecode/mode.el20
-rw-r--r--lisp/cedet/srecode/semantic.el6
-rw-r--r--lisp/cedet/srecode/srt-mode.el8
-rw-r--r--lisp/cedet/srecode/srt-wy.el64
-rw-r--r--lisp/cedet/srecode/table.el59
-rw-r--r--lisp/color.el152
-rw-r--r--lisp/comint.el19
-rw-r--r--lisp/cus-edit.el14
-rw-r--r--lisp/cus-start.el13
-rw-r--r--lisp/custom.el113
-rw-r--r--lisp/desktop.el3
-rw-r--r--lisp/dired-aux.el101
-rw-r--r--lisp/dired-x.el17
-rw-r--r--lisp/dired.el82
-rw-r--r--lisp/doc-view.el230
-rw-r--r--lisp/ehelp.el4
-rw-r--r--lisp/emacs-lisp/autoload.el2
-rw-r--r--lisp/emacs-lisp/byte-run.el4
-rw-r--r--lisp/emacs-lisp/bytecomp.el34
-rw-r--r--lisp/emacs-lisp/cl-extra.el1
-rw-r--r--lisp/emacs-lisp/cl-lib.el1
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el11
-rw-r--r--lisp/emacs-lisp/cl-macs.el6
-rw-r--r--lisp/emacs-lisp/cl-seq.el1
-rw-r--r--lisp/emacs-lisp/cl.el2
-rw-r--r--lisp/emacs-lisp/debug.el14
-rw-r--r--lisp/emacs-lisp/derived.el2
-rw-r--r--lisp/emacs-lisp/easy-mmode.el17
-rw-r--r--lisp/emacs-lisp/edebug.el7
-rw-r--r--lisp/emacs-lisp/eieio-base.el177
-rw-r--r--lisp/emacs-lisp/eieio-custom.el16
-rw-r--r--lisp/emacs-lisp/eieio-datadebug.el7
-rw-r--r--lisp/emacs-lisp/eieio-opt.el139
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el18
-rw-r--r--lisp/emacs-lisp/eieio.el74
-rw-r--r--lisp/emacs-lisp/ert-x.el22
-rw-r--r--lisp/emacs-lisp/ert.el22
-rw-r--r--lisp/emacs-lisp/gv.el13
-rw-r--r--lisp/emacs-lisp/macroexp.el57
-rw-r--r--lisp/emacs-lisp/package-x.el10
-rw-r--r--lisp/emacs-lisp/package.el10
-rw-r--r--lisp/emacs-lisp/pcase.el14
-rw-r--r--lisp/emacs-lisp/shadow.el8
-rw-r--r--lisp/emacs-lisp/tabulated-list.el6
-rw-r--r--lisp/emacs-lisp/testcover.el24
-rw-r--r--lisp/emacs-lisp/timer.el22
-rw-r--r--lisp/emacs-lock.el2
-rw-r--r--lisp/emulation/crisp.el6
-rw-r--r--lisp/epa.el2
-rw-r--r--lisp/epg.el8
-rw-r--r--lisp/erc/ChangeLog38
-rw-r--r--lisp/erc/erc-autoaway.el1
-rw-r--r--lisp/erc/erc-backend.el3
-rw-r--r--lisp/erc/erc-button.el4
-rw-r--r--lisp/erc/erc-capab.el4
-rw-r--r--lisp/erc/erc-compat.el1
-rw-r--r--lisp/erc/erc-dcc.el2
-rw-r--r--lisp/erc/erc-desktop-notifications.el (renamed from lisp/erc/erc-notifications.el)9
-rw-r--r--lisp/erc/erc-ezbounce.el1
-rw-r--r--lisp/erc/erc-fill.el1
-rw-r--r--lisp/erc/erc-goodies.el1
-rw-r--r--lisp/erc/erc-ibuffer.el1
-rw-r--r--lisp/erc/erc-identd.el1
-rw-r--r--lisp/erc/erc-imenu.el1
-rw-r--r--lisp/erc/erc-join.el1
-rw-r--r--lisp/erc/erc-lang.el2
-rw-r--r--lisp/erc/erc-list.el1
-rw-r--r--lisp/erc/erc-log.el11
-rw-r--r--lisp/erc/erc-match.el1
-rw-r--r--lisp/erc/erc-menu.el1
-rw-r--r--lisp/erc/erc-netsplit.el1
-rw-r--r--lisp/erc/erc-networks.el1
-rw-r--r--lisp/erc/erc-notify.el1
-rw-r--r--lisp/erc/erc-page.el2
-rw-r--r--lisp/erc/erc-pcomplete.el1
-rw-r--r--lisp/erc/erc-replace.el2
-rw-r--r--lisp/erc/erc-ring.el1
-rw-r--r--lisp/erc/erc-services.el2
-rw-r--r--lisp/erc/erc-sound.el2
-rw-r--r--lisp/erc/erc-speedbar.el1
-rw-r--r--lisp/erc/erc-spelling.el1
-rw-r--r--lisp/erc/erc-stamp.el6
-rw-r--r--lisp/erc/erc-track.el1
-rw-r--r--lisp/erc/erc-truncate.el1
-rw-r--r--lisp/erc/erc-xdcc.el1
-rw-r--r--lisp/erc/erc.el7
-rw-r--r--lisp/eshell/em-term.el5
-rw-r--r--lisp/eshell/esh-cmd.el7
-rw-r--r--lisp/eshell/esh-mode.el6
-rw-r--r--lisp/eshell/esh-util.el4
-rw-r--r--lisp/eshell/eshell.el6
-rw-r--r--lisp/facemenu.el13
-rw-r--r--lisp/faces.el3
-rw-r--r--lisp/files.el8
-rw-r--r--lisp/font-lock.el4
-rw-r--r--lisp/generic-x.el6
-rw-r--r--lisp/gnus/ChangeLog25
-rw-r--r--lisp/gnus/ChangeLog.22
-rw-r--r--lisp/gnus/gnus-art.el11
-rw-r--r--lisp/gnus/gnus-msg.el2
-rw-r--r--lisp/gnus/gnus-notifications.el1
-rw-r--r--lisp/gnus/gnus-sync.el4
-rw-r--r--lisp/gnus/message.el8
-rw-r--r--lisp/gnus/mml.el68
-rw-r--r--lisp/help-fns.el15
-rw-r--r--lisp/help-macro.el4
-rw-r--r--lisp/help.el53
-rw-r--r--lisp/hi-lock.el12
-rw-r--r--lisp/hippie-exp.el10
-rw-r--r--lisp/htmlfontify.el2
-rw-r--r--lisp/ibuf-ext.el14
-rw-r--r--lisp/ibuffer.el4
-rw-r--r--lisp/ido.el27
-rw-r--r--lisp/image-mode.el18
-rw-r--r--lisp/image.el2
-rw-r--r--lisp/imenu.el9
-rw-r--r--lisp/international/characters.el8
-rw-r--r--lisp/international/latin1-disp.el4
-rw-r--r--lisp/international/mule-cmds.el2
-rw-r--r--lisp/international/mule-conf.el3
-rw-r--r--lisp/international/mule-diag.el2
-rw-r--r--lisp/international/mule-util.el36
-rw-r--r--lisp/international/mule.el16
-rw-r--r--lisp/international/uni-bidi.el2
-rw-r--r--lisp/international/uni-category.el2
-rw-r--r--lisp/international/uni-name.elbin162303 -> 162318 bytes
-rw-r--r--lisp/international/uni-numeric.elbin4592 -> 4609 bytes
-rw-r--r--lisp/isearch.el4
-rw-r--r--lisp/iswitchb.el54
-rw-r--r--lisp/json.el8
-rw-r--r--lisp/ldefs-boot.el1340
-rw-r--r--lisp/linum.el5
-rw-r--r--lisp/mail/emacsbug.el18
-rw-r--r--lisp/mail/mailalias.el2
-rw-r--r--lisp/mail/rmail.el11
-rw-r--r--lisp/mail/rmailedit.el2
-rw-r--r--lisp/mail/rmailmm.el48
-rw-r--r--lisp/mail/sendmail.el4
-rw-r--r--lisp/mail/supercite.el22
-rw-r--r--lisp/menu-bar.el11
-rw-r--r--lisp/mh-e/ChangeLog.12
-rw-r--r--lisp/minibuf-eldef.el55
-rw-r--r--lisp/minibuffer.el3
-rw-r--r--lisp/mouse.el6
-rw-r--r--lisp/net/eudcb-bbdb.el24
-rw-r--r--lisp/net/newst-backend.el2
-rw-r--r--lisp/net/newst-treeview.el4
-rw-r--r--lisp/net/snmp-mode.el4
-rw-r--r--lisp/net/tramp.el1
-rw-r--r--lisp/newcomment.el4
-rw-r--r--lisp/org/ChangeLog3018
-rw-r--r--lisp/org/ob-C.el42
-rw-r--r--lisp/org/ob-R.el91
-rw-r--r--lisp/org/ob-asymptote.el4
-rw-r--r--lisp/org/ob-awk.el9
-rw-r--r--lisp/org/ob-calc.el10
-rw-r--r--lisp/org/ob-clojure.el2
-rw-r--r--lisp/org/ob-comint.el76
-rw-r--r--lisp/org/ob-css.el2
-rw-r--r--lisp/org/ob-ditaa.el19
-rw-r--r--lisp/org/ob-dot.el3
-rw-r--r--lisp/org/ob-emacs-lisp.el12
-rw-r--r--lisp/org/ob-eval.el4
-rw-r--r--lisp/org/ob-exp.el160
-rw-r--r--lisp/org/ob-fortran.el76
-rw-r--r--lisp/org/ob-gnuplot.el79
-rw-r--r--lisp/org/ob-haskell.el4
-rw-r--r--lisp/org/ob-io.el122
-rw-r--r--lisp/org/ob-js.el6
-rw-r--r--lisp/org/ob-latex.el2
-rw-r--r--lisp/org/ob-ledger.el4
-rw-r--r--lisp/org/ob-lilypond.el130
-rw-r--r--lisp/org/ob-lisp.el6
-rw-r--r--lisp/org/ob-lob.el69
-rw-r--r--lisp/org/ob-maxima.el36
-rw-r--r--lisp/org/ob-mscgen.el6
-rw-r--r--lisp/org/ob-ocaml.el14
-rw-r--r--lisp/org/ob-octave.el16
-rw-r--r--lisp/org/ob-org.el2
-rw-r--r--lisp/org/ob-perl.el12
-rw-r--r--lisp/org/ob-picolisp.el6
-rw-r--r--lisp/org/ob-plantuml.el2
-rw-r--r--lisp/org/ob-python.el59
-rw-r--r--lisp/org/ob-ref.el211
-rw-r--r--lisp/org/ob-ruby.el12
-rw-r--r--lisp/org/ob-scala.el120
-rw-r--r--lisp/org/ob-screen.el12
-rw-r--r--lisp/org/ob-sh.el59
-rw-r--r--lisp/org/ob-sql.el34
-rw-r--r--lisp/org/ob-sqlite.el24
-rw-r--r--lisp/org/ob-table.el2
-rw-r--r--lisp/org/ob-tangle.el328
-rw-r--r--lisp/org/ob.el1030
-rw-r--r--lisp/org/org-agenda.el3622
-rw-r--r--lisp/org/org-archive.el46
-rw-r--r--lisp/org/org-ascii.el104
-rw-r--r--lisp/org/org-attach.el30
-rw-r--r--lisp/org/org-bbdb.el58
-rw-r--r--lisp/org/org-beamer.el23
-rw-r--r--lisp/org/org-bibtex.el279
-rw-r--r--lisp/org/org-capture.el500
-rw-r--r--lisp/org/org-clock.el939
-rw-r--r--lisp/org/org-colview.el159
-rw-r--r--lisp/org/org-compat.el49
-rw-r--r--lisp/org/org-crypt.el21
-rw-r--r--lisp/org/org-ctags.el49
-rw-r--r--lisp/org/org-datetree.el85
-rw-r--r--lisp/org/org-docbook.el22
-rw-r--r--lisp/org/org-element.el4356
-rw-r--r--lisp/org/org-entities.el56
-rw-r--r--lisp/org/org-eshell.el20
-rw-r--r--lisp/org/org-exp-blocks.el238
-rw-r--r--lisp/org/org-exp.el427
-rw-r--r--lisp/org/org-faces.el61
-rw-r--r--lisp/org/org-feed.el124
-rw-r--r--lisp/org/org-footnote.el32
-rw-r--r--lisp/org/org-freemind.el112
-rw-r--r--lisp/org/org-gnus.el25
-rw-r--r--lisp/org/org-habit.el6
-rw-r--r--lisp/org/org-html.el695
-rw-r--r--lisp/org/org-icalendar.el81
-rw-r--r--lisp/org/org-id.el63
-rw-r--r--lisp/org/org-indent.el142
-rw-r--r--lisp/org/org-info.el6
-rw-r--r--lisp/org/org-inlinetask.el164
-rw-r--r--lisp/org/org-irc.el78
-rw-r--r--lisp/org/org-jsinfo.el186
-rw-r--r--lisp/org/org-latex.el587
-rw-r--r--lisp/org/org-list.el235
-rw-r--r--lisp/org/org-lparse.el107
-rw-r--r--lisp/org/org-mac-message.el94
-rw-r--r--lisp/org/org-macs.el65
-rw-r--r--lisp/org/org-mew.el3
-rw-r--r--lisp/org/org-mhe.el26
-rw-r--r--lisp/org/org-mobile.el258
-rw-r--r--lisp/org/org-mouse.el714
-rw-r--r--lisp/org/org-odt.el242
-rw-r--r--lisp/org/org-pcomplete.el109
-rw-r--r--lisp/org/org-plot.el116
-rw-r--r--lisp/org/org-protocol.el104
-rw-r--r--lisp/org/org-publish.el144
-rw-r--r--lisp/org/org-remember.el86
-rw-r--r--lisp/org/org-rmail.el15
-rw-r--r--lisp/org/org-special-blocks.el12
-rw-r--r--lisp/org/org-src.el123
-rw-r--r--lisp/org/org-table.el371
-rw-r--r--lisp/org/org-taskjuggler.el82
-rw-r--r--lisp/org/org-timer.el156
-rw-r--r--lisp/org/org-version.el27
-rw-r--r--lisp/org/org-vm.el89
-rw-r--r--lisp/org/org-wl.el12
-rw-r--r--lisp/org/org-xoxo.el2
-rw-r--r--lisp/org/org.el4373
-rw-r--r--lisp/password-cache.el3
-rw-r--r--lisp/pcmpl-gnu.el3
-rw-r--r--lisp/pcomplete.el12
-rw-r--r--lisp/proced.el297
-rw-r--r--lisp/profiler.el729
-rw-r--r--lisp/progmodes/ada-mode.el4
-rw-r--r--lisp/progmodes/bug-reference.el1
-rw-r--r--lisp/progmodes/compile.el75
-rw-r--r--lisp/progmodes/cwarn.el8
-rw-r--r--lisp/progmodes/flymake.el3
-rw-r--r--lisp/progmodes/grep.el4
-rw-r--r--lisp/progmodes/hideif.el19
-rw-r--r--lisp/progmodes/idlw-shell.el2
-rw-r--r--lisp/progmodes/idlwave.el10
-rw-r--r--lisp/progmodes/inf-lisp.el13
-rw-r--r--lisp/progmodes/prolog.el2
-rw-r--r--lisp/progmodes/ps-mode.el4
-rw-r--r--lisp/progmodes/python.el442
-rw-r--r--lisp/progmodes/ruby-mode.el48
-rw-r--r--lisp/progmodes/sh-script.el7
-rw-r--r--lisp/progmodes/tcl.el4
-rw-r--r--lisp/progmodes/vera-mode.el6
-rw-r--r--lisp/progmodes/verilog-mode.el707
-rw-r--r--lisp/progmodes/vhdl-mode.el4
-rw-r--r--lisp/progmodes/which-func.el4
-rw-r--r--lisp/register.el2
-rw-r--r--lisp/repeat.el6
-rw-r--r--lisp/replace.el193
-rw-r--r--lisp/savehist.el2
-rw-r--r--lisp/server.el25
-rw-r--r--lisp/simple.el70
-rw-r--r--lisp/startup.el9
-rw-r--r--lisp/strokes.el5
-rw-r--r--lisp/subr.el88
-rw-r--r--lisp/tar-mode.el9
-rw-r--r--lisp/term.el8
-rw-r--r--lisp/term/ns-win.el18
-rw-r--r--lisp/textmodes/bibtex.el32
-rw-r--r--lisp/textmodes/reftex-auc.el29
-rw-r--r--lisp/textmodes/reftex-cite.el171
-rw-r--r--lisp/textmodes/reftex-dcr.el16
-rw-r--r--lisp/textmodes/reftex-global.el7
-rw-r--r--lisp/textmodes/reftex-index.el25
-rw-r--r--lisp/textmodes/reftex-parse.el17
-rw-r--r--lisp/textmodes/reftex-ref.el130
-rw-r--r--lisp/textmodes/reftex-sel.el55
-rw-r--r--lisp/textmodes/reftex-toc.el18
-rw-r--r--lisp/textmodes/reftex-vars.el221
-rw-r--r--lisp/textmodes/reftex.el655
-rw-r--r--lisp/textmodes/rst.el733
-rw-r--r--lisp/textmodes/sgml-mode.el5
-rw-r--r--lisp/textmodes/table.el454
-rw-r--r--lisp/textmodes/tex-mode.el7
-rw-r--r--lisp/textmodes/text-mode.el23
-rw-r--r--lisp/tutorial.el15
-rw-r--r--lisp/type-break.el147
-rw-r--r--lisp/url/ChangeLog26
-rw-r--r--lisp/url/url-handlers.el31
-rw-r--r--lisp/url/url-http.el17
-rw-r--r--lisp/url/url-parse.el2
-rw-r--r--lisp/url/url-util.el8
-rw-r--r--lisp/vc/add-log.el12
-rw-r--r--lisp/vc/diff-mode.el24
-rw-r--r--lisp/vc/diff.el3
-rw-r--r--lisp/vc/ediff-init.el6
-rw-r--r--lisp/vc/ediff-util.el4
-rw-r--r--lisp/vc/ediff-wind.el4
-rw-r--r--lisp/vc/emerge.el12
-rw-r--r--lisp/vc/log-edit.el78
-rw-r--r--lisp/vc/pcvs-defs.el14
-rw-r--r--lisp/vc/pcvs-info.el4
-rw-r--r--lisp/vc/pcvs.el25
-rw-r--r--lisp/vc/smerge-mode.el2
-rw-r--r--lisp/vc/vc-bzr.el14
-rw-r--r--lisp/vc/vc-git.el48
-rw-r--r--lisp/vc/vc-hooks.el23
-rw-r--r--lisp/vc/vc-rcs.el3
-rw-r--r--lisp/vc/vc-sccs.el12
-rw-r--r--lisp/vc/vc.el54
-rw-r--r--lisp/view.el2
-rw-r--r--lisp/window.el501
-rw-r--r--lisp/winner.el82
444 files changed, 31975 insertions, 13449 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d56e0e88f91..b0f896aa086 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,1364 @@
+2012-10-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (read-passwd-map): Don't use `defconst' (bug#12597).
+ (read-passwd): Remove a few more potential sources of leaks.
+
+2012-10-07 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (inferior-python-mode)
+ (python-shell-make-comint): Fix initialization of local
+ variables copied from parent buffer.
+
+2012-10-07 Jan Djärv <jan.h.d@swipnet.se>
+
+ * term/ns-win.el (ns-read-file-name): Update declaration to match
+ nsfns.m.
+ (ns-respond-to-change-font): Change fontsize separatly so we are sure
+ it is set when font is acted upon.
+
+2012-10-07 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Enhancements to indentation.
+ * progmodes/python.el (python-indent-context): Give priority to
+ inside-string context. Make comments indentation markers.
+ (python-indent-region): Do not mess with strings, unless it's the
+ enclosing set of quotes.
+
+2012-10-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * window.el (internal--before-save-selected-window)
+ (internal--after-save-selected-window): New functions extracted from
+ save-selected-window. Make sure we return the `alist' we construct.
+ (save-selected-window): Use them.
+
+ * textmodes/tex-mode.el (tex-recenter-output-buffer):
+ Use with-selected-window.
+
+ * emacs-lisp/autoload.el (make-autoload): Add `cl-defmacro' to the
+ forms that define macros (bug#12593).
+
+2012-10-07 Kenichi Handa <handa@gnu.org>
+
+ * international/mule-conf.el (compound-text-with-extensions):
+ Add :mime-charset property as x-ctext.
+
+2012-10-07 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el (rst-new-adornment-down, rst-indent-field)
+ (rst-indent-literal-normal, rst-indent-literal-minimized)
+ (rst-indent-comment): Correct :version tag.
+ (rst-official-cvs-rev): Correct version string.
+
+2012-10-07 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailmm.el (rmail-mime-process-multipart):
+ Do not confuse a multipart message with an epilogue
+ with a "truncated" one; fixes 2011-06-27 change. (Bug#10101)
+
+2012-10-07 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Fix shell output retrieval and comint-prompt-regexp init.
+ * progmodes/python.el (inferior-python-mode):
+ (python-shell-make-comint): Fix initialization of
+ comint-prompt-regexp from copied file local variables.
+ (python-shell-fetched-lines): Remove var.
+ (python-shell-output-filter-in-progress): Rename from
+ python-shell-fetch-lines-in-progress.
+ (python-shell-output-filter-buffer): Rename from
+ python-shell-fetch-lines-string.
+ (python-shell-fetch-lines-filter): Delete function.
+ (python-shell-output-filter): New function.
+ (python-shell-send-string-no-output): Use them.
+
+2012-10-07 Glenn Morris <rgm@gnu.org>
+
+ * hi-lock.el (hi-lock-process-phrase):
+ Try to make it less fragile. (Bug#7161)
+
+ * hi-lock.el (hi-lock-face-phrase-buffer): Doc fix.
+
+2012-10-06 Glenn Morris <rgm@gnu.org>
+
+ * ehelp.el (electric-help-mode): Use help-mode rather than
+ non-existent mode `help'.
+ (electric-help-map): Use button-buffer-map. (Bug#10917)
+
+ * textmodes/reftex-vars.el (reftex-create-bibtex-header)
+ (reftex-create-bibtex-footer): Fix custom types.
+
+ * progmodes/sh-script.el (sh-indent-after-continuation):
+ Add explicit :group.
+
+ * textmodes/rst.el (rst-preferred-decorations)
+ (rst-shift-basic-offset): Clarify obsolescence versions.
+
+ * profiler.el (profiler): Add missing group :version tag.
+ * avoid.el (mouse-avoidance-banish-position):
+ * proced.el (proced-renice-command):
+ * calc/calc.el (calc-ensure-consistent-units):
+ * calendar/icalendar.el (icalendar-import-format-uid):
+ * net/tramp.el (tramp-save-ad-hoc-proxies):
+ * progmodes/bug-reference.el (bug-reference-bug-regexp):
+ * progmodes/flymake.el (flymake-error-bitmap)
+ (flymake-warning-bitmap, flymake-fringe-indicator-position):
+ * progmodes/sh-script.el (sh-indent-after-continuation):
+ * progmodes/verilog-mode.el (verilog-auto-template-warn-unused)
+ (verilog-before-save-font-hook, verilog-after-save-font-hook):
+ * progmodes/vhdl-mode.el (vhdl-makefile-default-targets)
+ (vhdl-array-index-record-field-in-sensitivity-list)
+ (vhdl-indent-comment-like-next-code-line):
+ * textmodes/reftex-vars.el (reftex-ref-style-alist)
+ (reftex-ref-macro-prompt, reftex-ref-style-default-list)
+ (reftex-cite-key-separator, reftex-create-bibtex-header)
+ (reftex-create-bibtex-footer):
+ * textmodes/rst.el (rst-new-adornment-down, rst-indent-field)
+ (rst-indent-literal-normal, rst-indent-literal-minimized)
+ (rst-indent-comment): Add missing custom :version tags.
+
+ * calendar/timeclock.el (timeclock-modeline-display):
+ Add missing obsolete alias for renamed user option.
+
+ * strokes.el (strokes-modeline-string):
+ * emulation/crisp.el (crisp-mode-modeline-string):
+ * eshell/esh-mode.el (eshell-status-in-modeline):
+ Aliases to defcustoms must come before the defcustom.
+
+ * calendar/cal-tex.el (cal-tex-diary, cal-tex-cursor-week)
+ (cal-tex-cursor-week2, cal-tex-cursor-week-iso)
+ (cal-tex-cursor-week-monday): Doc fixes.
+ (cal-tex-cursor-week2-summary): Doc fix.
+ Rename from cal-tex-cursor-week-at-a-glance.
+
+ * calendar/cal-menu.el (cal-menu-context-mouse-menu):
+ Tweak week descriptions. Add cal-tex-cursor-week2-summary.
+
+ * calendar/calendar.el (calendar-mode-map):
+ Add cal-tex-cursor-week2-summary.
+
+2012-10-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Improve docstring.
+
+ * subr.el (read-passwd-map): New var.
+ (read-passwd): Use `read-string' again.
+ * minibuffer.el (delete-minibuffer-contents): Make it interactive.
+
+2012-10-06 Jambunathan K <kjambunathan@gmail.com>
+
+ * register.el (append-to-register, prepend-to-register):
+ Deactivate mark, as does `copy-to-register' (bug#12389).
+
+2012-10-06 Chong Yidong <cyd@gnu.org>
+
+ * files.el (auto-mode-alist): Add .by and .wy (Semantic grammars).
+
+2012-10-06 Ikumi Keita <ikumi@ikumi.que.jp> (tiny change)
+
+ * international/characters.el: Fix simple mistake ((car chars) ->
+ elt), delete duplicated code.
+
+2012-10-06 Glenn Morris <rgm@gnu.org>
+
+ * subr.el (read-passwd): Allow C-u to erase entry. (Bug#12570)
+
+2012-10-06 Julian Scheid <julians37@gmail.com> (tiny change)
+
+ * color.el (color-hsl-to-rgb): Fix incorrect results for
+ small and large hue values. (Bug#12559)
+
+2012-10-05 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Enhancements to docstring formatting when filling paragraphs.
+ * progmodes/python.el (python-fill-docstring-style): Rename from
+ python-fill-string-style. Added new style.
+ (python-fill-string): Use new style. Better checks for
+ docstrings.
+
+2012-10-05 Glenn Morris <rgm@gnu.org>
+
+ * net/newst-treeview.el (newsticker-group-move-feed): Doc fix.
+
+ * color.el (color-name-to-rgb, color-rgb-to-hex)
+ (color-hue-to-rgb, color-hsl-to-rgb, color-rgb-to-hsv)
+ (color-rgb-to-hsl, color-srgb-to-xyz, color-saturate-hsl)
+ (color-desaturate-hsl, color-desaturate-name, color-lighten-hsl)
+ (color-lighten-name, color-darken-hsl, color-darken-name): Doc fixes.
+
+ * emacs-lisp/timer.el (with-timeout): Add missing progn. (Bug#12577)
+
+2012-10-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * ido.el (ido-directory-too-big-p): Pass dir through file-truename
+ to get the correct size across symlinks.
+
+ * ido.el (ido-buffer-disable-smart-matches): Fix typo in docstring.
+
+2012-10-04 Juri Linkov <juri@jurta.org>
+
+ * replace.el (query-replace-interactive): Declare obsolete.
+ (query-replace-read-from): Add the last incremental search string
+ to the list of default values accessible via M-n.
+ (map-query-replace-regexp): Use `read-regexp'.
+ (query-replace, query-replace-regexp, query-replace-regexp-eval)
+ (map-query-replace-regexp, replace-string, replace-regexp):
+ Fix docstrings to replace mentions of `query-replace-interactive'
+ with alternatives. (Bug#12526)
+
+2012-10-04 Juri Linkov <juri@jurta.org>
+
+ * dired.el (dired-shrink-to-fit): Declare obsolete. (Bug#1806)
+ (dired-pop-to-buffer): Declare obsolete.
+ (dired-mark-pop-up): Doc fix.
+
+2012-10-04 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Allow user to set docstring style for fill-paragraph.
+ * progmodes/python.el
+ (python-fill-comment-function, python-fill-string-function)
+ (python-fill-decorator-function, python-fill-paren-function):
+ Remove :safe for defcustoms.
+ (python-fill-string-style): New defcustom
+ (python-fill-paragraph-function): Enhance context detection.
+ (python-fill-string): Honor python-fill-string-style settings.
+
+2012-10-04 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/edebug.el (edebug-pop-to-buffer): Select window
+ after setting its buffer (Bug#10805).
+
+2012-10-03 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Fix cornercase for string syntax.
+ * progmodes/python.el (python-syntax-propertize-function):
+ Simplify and enhance the regexp for unescaped quotes. Now it also
+ matches quotes in weird situations like the single quote in
+ "something\"'".
+ (python-syntax-stringify): Simplify num-quotes detecting code.
+
+2012-10-03 Glenn Morris <rgm@gnu.org>
+
+ * help-macro.el (three-step-help):
+ Revert 2012-09-29 change. (Bug#12567)
+
+2012-10-03 Martin Rudalics <rudalics@gmx.at>
+
+ * menu-bar.el (kill-this-buffer): Don't do anything when
+ `menu-frame' is not alive or visible (Bug#8184).
+
+ * emacs-lisp/debug.el (debug): When quitting the debugger window
+ restore current buffer (Bug#12502).
+
+2012-10-02 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/hideif.el (hif-lookup, hif-defined):
+ Handle semantic-c-takeover-hideif.
+
+2012-10-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Change sampling interval units from ms to ns.
+ * profiler.el (profiler-sampling-interval): Change units
+ from ms to ns, multiplying the default by 1000000 so that
+ it remains 1 ms.
+ (profiler-report-cpu-line-format): Give enough room for
+ the maximum counters on 64-bit hosts.
+ (profiler-report-render-calltree-1): Call them "CPU samples",
+ not "Time (ms)", since they are not milliseconds now (and
+ never really were).
+
+2012-10-02 Sergio Durigan Junior <sergiodj@riseup.net> (tiny change)
+
+ * net/eudcb-bbdb.el (eudc-bbdb-format-record-as-result):
+ Fix querying BBDB for entries without a last name (Bug#11580).
+
+2012-10-02 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/eieio.el: Restore Version header.
+
+2012-10-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/diff-mode.el (diff--auto-refine-data): New var.
+ (diff-hunk): Use it to delay refinement.
+ (diff-mode): Remove overlays when we turn off font-lock.
+
+ * textmodes/table.el: Use lexical-binding, dolist, define-minor-mode.
+ (table-initialize-table-fixed-width-mode)
+ (table-set-table-fixed-width-mode): Remove functions.
+ (table-command-list): Move initialization into declaration.
+ (table--tweak-menu-for-xemacs): Move defun outside mapcar.
+ (table-with-cache-buffer): Use `declare'.
+ (table-span-cell): Simplify via CSE.
+ (table-fixed-width-mode): Use define-minor-mode.
+ (table-call-interactively, table-funcall, table-apply): Remove.
+ (table-function): New function, to replace them.
+
+ * bookmark.el (bookmark-search-pattern): Remove var.
+ (bookmark-read-search-input): Remove function.
+ (bookmark-bmenu-search): Reimplement using a minibuffer.
+
+ * faces.el (modeline): Remove obsolete face name.
+
+ * vc/add-log.el (add-log-buffer-file-name-function): Demote to defvar
+ and give a non-nil default value.
+ (add-change-log-entry): Simplify accordingly.
+
+2012-10-01 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-git.el (vc-git-log-edit-toggle-signoff): New function.
+ (vc-git-log-edit-toggle-amend): New function.
+ (vc-git-log-edit-toggle-signoff): New function.
+ (vc-git-log-edit-mode): New major mode.
+ (vc-git-log-edit-mode-map): Keymap for it.
+ (vc-git-checkin): Handle "Amend" and "Sign-Off" headers.
+
+ * vc/log-edit.el (log-edit-font-lock-keywords): Allow hyphens in
+ header names.
+ (log-edit-toggle-header): New function.
+ (log-edit-extract-headers): Accept function values in HEADERS alist.
+
+2012-10-01 David Engster <deng@randomsample.de>
+
+ * emacs-lisp/eieio-opt.el (eieio-describe-class): Add filename
+ from symbol property and change message to be more consistent with
+ Emacs proper.
+ (eieio-describe-generic): Add filename for each implementation.
+ Fix indices for generic and normal methods.
+ (eieio-method-def, eieio-class-def): New buttons.
+ (eieio-help-find-method-definition)
+ (eieio-help-find-class-definition): New functions.
+ (eieio-help-mode-augmentation-maybee): Add buttons to filenames of
+ class, constructor and method definitions.
+
+ * emacs-lisp/eieio.el (eieiomt-add, eieio-defclass): Save file
+ information in symbol property.
+ (scoped-class): Remove.
+ (eieio-slot-name-index, call-next-method): Check if it is bound.
+
+2012-10-01 Leo P. White <lpw25@cam.ac.uk>
+
+ * emacs-lisp/eieio-custom.el (eieio-custom-mode-map): New option.
+ (eieio-custom-mode): New major mode.
+ (eieio-customize-object): Use it.
+
+2012-10-01 Eric Ludlam <zappo@gnu.org>
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-read): New input args
+ specifying the expected class, and whether subclassing is allowed.
+ (eieio-persistent-convert-list-to-object):
+ (eieio-persistent-validate/fix-slot-value)
+ (eieio-persistent-slot-type-is-class-p): New functions.
+ (eieio-named::slot-missing): Doc fix.
+
+ * emacs-lisp/eieio-datadebug.el (data-debug/eieio-insert-slots):
+ Stop using unused publd variable.
+
+ * emacs-lisp/eieio-speedbar.el (eieio-speedbar-handle-click):
+ (eieio-speedbar-description, eieio-speedbar-derive-line-path)
+ (eieio-speedbar-object-buttonname, eieio-speedbar-make-tag-line)
+ (eieio-speedbar-handle-click): Do not specify a class for the
+ method. Fixes method invocation order problems with EDE.
+
+2012-10-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compiler-abbreviate-file): New function.
+ (byte-compile-warning-prefix, byte-compile-file): Use it (bug#12508).
+
+2012-10-01 Karl Fogel <kfogel@red-bean.com>
+
+ * bookmark.el (bookmark-version-control): Give tags in the
+ :type choices (Bug#12309), and improve doc string.
+ (bookmark-write-file): Bind `print-circle' to `t' to allow
+ circular custom bookmark types. (Bug#12503)
+
+2012-10-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Revert the FOLLOW-SYMLINKS change for file-attributes.
+ * files.el (remote-file-name-inhibit-cache, after-find-file):
+ * time.el (display-time-file-nonempty-p): Undo last change.
+
+ * profiler.el (profiler-sampling-interval): Change default back to 1.
+ See Stefan Monnier in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00863.html>.
+
+2012-10-01 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Shell output catching a la gud-gdb.
+ * progmodes/python.el (python-shell-fetch-lines-in-progress)
+ (python-shell-fetch-lines-string, python-shell-fetched-lines):
+ New Vars.
+ (python-shell-fetch-lines-filter): New function.
+ (python-shell-send-string-no-output): Use them.
+
+2012-09-30 Tomohiro Matsuyama <tomo@cx4a.org>
+
+ * profiler.el (profiler-sampling-interval): Rename from
+ profiler-sample-interval.
+ (profiler-sampling-interval): Default to 10.
+ (profiler-find-profile): New command (was profiler-find-log).
+ (profiler-find-profile-other-window): New command.
+ (profiler-find-profile-other-frame): New command.
+ (profiler-profile): Introduce API-level data structure.
+
+2012-09-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ file-attributes has a new optional arg FOLLOW-SYMLINKS.
+ * files.el (remote-file-name-inhibit-cache):
+ * time.el (display-time-file-nonempty-p): Use it.
+ * files.el (after-find-file): Don't chase links before calling
+ file-exists-p, as file-exists-p already does the right thing.
+
+2012-09-30 Ralf Angeli <angeli@caeruleus.net>
+
+ Merge from standalone RefTeX repository.
+
+ The following ChangeLog entries are shortened versions of the
+ original ones with file paths adapted. A not so strongly edited
+ version of the original ChangeLog can be found in the commit log.
+
+ * textmodes/reftex-auc.el: Move `provide' call to bottom of file.
+ (reftex-arg-cite): Use `reftex-cite-key-separator'.
+ Correctly handle new value type returned by `reftex-citation'.
+
+ * textmodes/reftex-cite.el (reftex-create-bibtex-file): Make sure
+ that entries with whitespace at various places are found.
+ Doc fix. Include entries that are cross-referenced from cited entries.
+ Include @String definitions in the resulting bib file. Add header
+ and footer defined in `reftex-create-bibtex-header' and
+ `reftex-create-bibtex-footer'.
+ (reftex-do-citation): Make it possible again to insert
+ non-existent entries. Save match data when asking for optional
+ arguments. Return all keys, not just the first one.
+ (reftex-all-used-citation-keys): Fix regexp to correctly extract
+ all citations in the same line.
+ (reftex-parse-bibtex-entry): Accept additional optional argument
+ `raw' and keep quotes or braces if it is non-nil. Match fields
+ containing hyphens besides word constituents.
+ (reftex-get-string-refs): New function.
+ (reftex-extract-bib-entries): Check if BibTeX file changed on disk
+ and ask if it should be reread in case it did.
+ (reftex-pop-to-bibtex-entry)
+ (reftex-extract-bib-entries-from-thebibliography): Match \bibitem
+ entries with spaces or tabs in front of arguments.
+ (reftex-pop-to-bibtex-entry, reftex-extract-bib-entries)
+ (reftex-parse-bibtex-entry, reftex-create-bibtex-file):
+ Match entries containing numbers and symbol constituents.
+ (reftex-do-citation, reftex-figure-out-cite-format):
+ Use `reftex-cite-key-separator'.
+
+ * textmodes/reftex-dcr.el: Move provide statement to end of file.
+ (reftex-mouse-view-crossref): Explain why point is set.
+
+ * textmodes/reftex-global.el: Whitespace changes.
+
+ * textmodes/reftex-index.el: Move provide statement to end of
+ file.
+ (reftex-index-selection-or-word): Use `reftex-region-active-p'.
+ (reftex-index-visit-phrases-buffer): Set marker when visiting
+ buffer. This allows for returning from the phrases file to the
+ file one was just editing instead of the file where the last
+ phrases was added from.
+ (reftex-index-phrases-syntax-table): New variable. Give ?\"
+ punctuation syntax as it usually is not used as string quote in
+ TeX-related modes and may occur unmatched. The change also
+ prevents fontification of quoted content.
+ (reftex-index-phrases-mode): Use it.
+
+ * textmodes/reftex-parse.el (reftex-parse-from-file):
+ Move backward one char if a `\' was matched after a section macro.
+ (reftex-parse-from-file): Use beginning of match instead of end as
+ bound.
+
+ * textmodes/reftex-ref.el: Adapt creation of
+ `reftex-<package>-<macro>' functions to new structure of
+ `reftex-ref-style-alist'.
+ (reftex-reference): Use `reftex-ref-style-list' function.
+ Adapt to new structure of `reftex-ref-style-alist'. Prompt for a
+ reference macro if `reftex-ref-macro-prompt' is non-nil.
+ (reftex-reference): Pass refstyle to `reftex-format-special'.
+ Determine reference macro by looking at
+ `reftex-ref-style-default-list' and `reftex-ref-style-alist'.
+ Use only one special format function.
+ (reftex-varioref-vref, reftex-fancyref-fref)
+ (reftex-fancyref-Fref): Remove definitions. The functions are now
+ generated from `reftex-ref-style-alist'.
+ (reftex-format-vref, reftex-format-Fref, reftex-format-fref):
+ Remove.
+ (reftex-format-special): New function.
+
+ * textmodes/reftex-sel.el
+ (reftex-select-cycle-ref-style-internal): Adapt to new structure
+ of `reftex-ref-style-alist'. Remove code for testing macro type.
+ (reftex-select-toggle-varioref)
+ (reftex-select-toggle-fancyref): Remove.
+ (reftex-select-cycle-ref-style-internal)
+ (reftex-select-cycle-ref-style-forward)
+ (reftex-select-cycle-ref-style-backward): New functions.
+ (reftex-select-label-map): Use `v' and `V' for general cycling
+ through reference styles. Add `p' for switching between number
+ and page reference types.
+
+ * textmodes/reftex-toc.el (reftex-re-enlarge):
+ Call `enlarge-window' only if there is something to do because in Emacs
+ the horizontal version throws an error even if the parameter is 0.
+
+ * textmodes/reftex-vars.el (reftex-label-alist): Doc fix.
+ (reftex-plug-into-AUCTeX): Doc fix.
+ (reftex-vref-is-default, reftex-fref-is-default): Adapt doc
+ string. Adapt to new name.
+ (reftex-ref-style-alist): Change structure so that it is not
+ possible to use multiple different package names within a style.
+ Remove the symbols for symbols for macro type distinction.
+ Add characters for macro selection.
+ (reftex-ref-macro-prompt, reftex-create-bibtex-header)
+ (reftex-create-bibtex-footer): New variables.
+ (reftex-format-ref-function): Mention third argument of special
+ format function.
+ (reftex-ref-style-alist, reftex-ref-style-default-list):
+ New variables.
+ (reftex-vref-is-default, reftex-fref-is-default): Adapt doc string
+ to new implementation. Mark as obsolete. Add compatibility code
+ for honoring the variable values in case they are set.
+ (reftex-cite-format-builtin, reftex-bibliography-commands):
+ Add support for ConTeXt.
+ (reftex-format-ref-function, reftex-format-cite-function):
+ Fix custom type.
+ (reftex-cite-key-separator): New variable.
+
+ * textmodes/reftex.el (reftex-syntax-table-for-bib)
+ (reftex-mode): Do not derive `reftex-syntax-table-for-bib' from
+ `reftex-syntax-table' because parens have to retain their paren
+ syntax in order for parsing of BibTeX entries like @book(...) to
+ work.
+ (reftex-in-comment): Do not error out if `comment-start-skip' is
+ not set. Deal correctly with escaped comment characters.
+ (reftex-tie-multifile-symbols): Add doc string.
+ Initialize `reftex-ref-style-list'.
+ (reftex-untie-multifile-symbols): Add doc string.
+ (reftex-add-index-macros): Doc fix.
+ (reftex-ref-style-activate, reftex-ref-style-toggle)
+ (reftex-ref-style-list): New functions.
+ (reftex-mode-menu): Use them. Adapt to new structure of
+ `reftex-ref-style-alist'.
+ (reftex-select-with-char): Kill the RefTeX Select buffer when
+ done.
+ (reftex-remove-if): New function.
+ (reftex-erase-all-selection-and-index-buffers)
+ (reftex-mode-menu): Reference styles are now computed from
+ `reftex-ref-style-alist'. Fix typo.
+ (reftex-report-bug): New function.
+ (reftex-uniquify, reftex-uniquify-by-car): Replace O(n^2)
+ algorithms with O(n log n). Introduce optional argument SORT (not
+ yet used).
+
+2012-09-30 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Enhancements for triple-quote string syntax.
+ * progmodes/python.el (python-syntax-propertize-function):
+ Match both quote cases in one regexp.
+ (python-syntax-stringify): Handle matches properly.
+
+2012-09-30 Juri Linkov <juri@jurta.org>
+
+ * arc-mode.el (archive-summarize): Let-bind `buffer-file-truename'
+ to nil around the call to `insert' to prevent
+ directory time modification by lock_file. (Bug#2295)
+ * tar-mode.el (tar-summarize-buffer): Idem.
+
+2012-09-30 Juri Linkov <juri@jurta.org>
+
+ * facemenu.el (list-colors-sort): Add option "Luminance".
+ (list-colors-sort-key): Implement it.
+
+ * vc/diff-mode.el (diff-refine-removed):
+ * vc/ediff-init.el (ediff-fine-diff-A):
+ * vc/smerge-mode.el (smerge-refined-removed):
+ Change background color "#ffaaaa" to "#ffbbbb". (Bug#10181)
+
+2012-09-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * term/ns-win.el (x-file-dialog): New function.
+
+2012-09-30 Juanma Barranquero <lekktu@gmail.com>
+
+ * ido.el (ido-max-directory-size): Default to nil; the current
+ default is small for POSIX systems, and impractical on Windows 7
+ now that lstat returns directory sizes for NTFS.
+
+2012-09-30 Martin Rudalics <rudalics@gmx.at>
+
+ In buffer display functions handle window-height/window-width
+ alist entries. Suggested by Juri Linkov as fix for Bug#1806.
+ * window.el (window--display-buffer): New argument ALIST.
+ Obey window-height and window-width alist entries.
+ (window--try-to-split-window): New argument ALIST.
+ Bind window-combination-limit to t when the window's size shall be
+ changed and window-combination-limit equals `window-size'.
+ (display-buffer-in-atom-window)
+ (display-buffer-in-major-side-window)
+ (display-buffer-in-side-window, display-buffer-same-window)
+ (display-buffer-reuse-window, display-buffer-pop-up-frame)
+ (display-buffer-pop-up-window, display-buffer-below-selected)
+ (display-buffer-at-bottom, display-buffer-in-previous-window)
+ (display-buffer-use-some-window): Adjust all callers of
+ window--display-buffer and window--try-to-split-window.
+ (fit-frame-to-buffer): New option.
+ (fit-window-to-buffer): Can resize frames if fit-frame-to-buffer
+ is non-nil.
+ (display-buffer-in-major-side-window): Evaluate window-height /
+ window-width alist entries.
+
+ * help.el (temp-buffer-resize-frames)
+ (temp-buffer-resize-regexps): Remove options.
+ (temp-buffer-resize-mode): Adjust doc-string.
+ (resize-temp-buffer-window): Don't consult
+ temp-buffer-resize-regexps. Use fit-frame-to-buffer instead of
+ temp-buffer-resize-frames.
+
+ * dired.el (dired-mark-pop-up):
+ Call display-buffer-below-selected with a fit-window-to-buffer alist
+ entry.
+
+2012-09-30 Chong Yidong <cyd@gnu.org>
+
+ * server.el (server-host): Document the security implications.
+ (server-auth-key): Doc fix.
+
+ * startup.el (initial-buffer-choice): Doc fix.
+
+ * minibuffer.el (minibuffer-local-filename-syntax): Doc fix.
+
+ * simple.el (delete-trailing-whitespace): Avoid an unnecessary
+ restriction change.
+
+ * bindings.el (goto-map): Bind M-g TAB to move-to-column.
+
+ * help-fns.el (help-fns--obsolete): Fix last change.
+
+2012-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * winner.el (winner-mode-map): Obey winner-dont-bind-my-keys here.
+ (minor-mode-map-alist): Remove redundant code.
+
+ * vc/pcvs.el (cvs-cleanup-collection): Keep entries that are currently
+ visited in a buffer.
+ (cvs-insert-visited-file): New function.
+ (find-file-hook): Use it.
+
+ * vc/pcvs-info.el (cvs-fileinfo-pp): Don't use non-existent faces.
+
+ * vc/log-edit.el (log-edit-font-lock-keywords): Ignore case to
+ chose face.
+ (log-edit-empty-buffer-p): Don't require a space after a header.
+
+ * vc/ediff-util.el (ediff-diff-at-point): Don't assume point-min==1.
+
+ * tutorial.el (help-with-tutorial): Use minibuffer-with-setup-hook.
+
+ * textmodes/text-mode.el (paragraph-indent-minor-mode): Make it
+ a proper minor-mode.
+
+ * textmodes/tex-mode.el (tex-mode-map): Don't bind paren keys.
+
+2012-09-29 Glenn Morris <rgm@gnu.org>
+
+ * winner.el (winner-mode): Remove variable (let define-minor-mode
+ handle it).
+ (winner-dont-bind-my-keys, winner-boring-buffers, winner-mode-hook):
+ Doc fixes.
+ (winner-mode-leave-hook): Rename to winner-mode-off-hook.
+ (winner-mode): Use define-minor-mode.
+
+ * vc/vc-sccs.el (vc-sccs-registered): Use the progn trick to get
+ the full definition in loaddefs, rather than duplicating it.
+
+ * help-macro.el (three-step-help): No need to autoload defcustom.
+
+ * progmodes/inf-lisp.el (inferior-lisp-filter-regexp)
+ (inferior-lisp-program, inferior-lisp-load-command)
+ (inferior-lisp-prompt, inferior-lisp-mode-hook):
+ No need to autoload defcustoms.
+
+ * hippie-exp.el (hippie-expand-try-functions-list)
+ (hippie-expand-verbose, hippie-expand-dabbrev-skip-space)
+ (hippie-expand-dabbrev-as-symbol, hippie-expand-no-restriction)
+ (hippie-expand-max-buffers, hippie-expand-ignore-buffers)
+ (hippie-expand-only-buffers): No need to autoload defcustoms.
+ * progmodes/vhdl-mode.el (vhdl-line-expand):
+ Explicitly load hippie-exp, so it does not get autoloaded
+ while hippie-expand-try-functions-list is let-bound.
+
+2012-09-28 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl.el (flet): Fix case of obsolescence message.
+
+ * emacs-lisp/bytecomp.el (byte-compile-cl-file-p):
+ Only "cl.el" counts as cl these days.
+
+2012-09-28 Juri Linkov <juri@jurta.org>
+
+ Display archive errors in the echo area instead of inserting
+ to the file buffer.
+
+ * arc-mode.el (archive-extract-by-stdout): Change arg STDERR-FILE
+ to STDERR-TEST that can be a regexp matching a successful output.
+ Create a temporary file and redirect stderr to it. Search for
+ STDERR-TEST in the stderr output and display it in the echo area
+ if no match is found.
+ (archive-extract-by-file): New function like
+ `archive-extract-by-stdout' but extracting archives to files
+ and looking for successful matches in stdout. Function body is
+ mostly copied from `archive-rar-extract'.
+ (archive-rar-extract): Use `archive-extract-by-file'.
+ (archive-7z-extract): Use `archive-extract-by-stdout'. (Bug#10347)
+
+2012-09-28 Leo Liu <sdl.web@gmail.com>
+
+ * pcomplete.el (pcomplete-show-completions):
+ Use minibuffer-message to make pcomplete usable in minibuffer.
+
+ * ido.el (ido-set-matches-1): Fix 2012-09-11 change.
+
+2012-09-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * type-break.el: Use lexical-binding.
+ (type-break-mode): Use define-minor-mode.
+
+ * emacs-lisp/pcase.el (pcase--mark-used): New.
+ (pcase--u1): Use it (bug#12512).
+
+ * custom.el (load-theme): Set buffer-file-name so the load is recorded
+ in load-history with the right file name.
+
+2012-09-28 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el (doc-view-current-cache-doc-pdf): New function.
+ (doc-view-doc->txt, doc-view-convert-current-doc): Use it.
+ (doc-view-get-bounding-box): Make bounding box slicing work for
+ ODF and DVI documents.
+
+2012-09-28 Glenn Morris <rgm@gnu.org>
+
+ * type-break.el (type-break-mode, type-break-interval)
+ (type-break-good-rest-interval, type-break-keystroke-threshold):
+ No need to autoload.
+ (type-break-good-rest-interval, type-break-keystroke-threshold):
+ Add :set-after.
+
+2012-09-28 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/verilog-mode.el (verilog-auto-inst-interfaced-ports):
+ Add :version tag.
+
+2012-09-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * json.el (json-encode-char): Codes 127-160 aren't "ASCII printable".
+
+2012-09-27 Glenn Morris <rgm@gnu.org>
+
+ * faces.el (x-display-name): Declare (for without-x builds).
+
+ * linum.el (linum-format): Don't autoload it. Improve :type.
+
+ * progmodes/tcl.el: Don't require outline when compiling.
+ (outline-regexp, outline-level): Declare.
+ * textmodes/sgml-mode.el: Don't require outline when compiling.
+ (outline-regexp, outline-heading-end-regexp, outline-level): Declare.
+
+ * term.el (term-ansi-reset):
+ Try setting term-ansi-face-already-done to nil. (Bug#11785)
+
+ * vc/vc.el (vc-next-action): Only gripe about committing read-only
+ files for RCS and SCCS. (Bug#9781)
+
+2012-09-27 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/verilog-mode.el (verilog-mode-release-emacs): Fix last
+ change; value should be t.
+
+2012-09-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * image-mode.el: Use lexical-binding.
+ (image-mode-winprops): Use t to stand for the window of
+ a buffer that's not displayed.
+ * doc-view.el (doc-view-new-window-function): Handle the new
+ t in winprops.
+ (doc-view-enlarge): Make it a real nop if the size is not changed.
+ (doc-view-display): Handle the case where the buffer is not (yet?)
+ displayed in any window.
+ (doc-view-saved-settings): New var.
+ (doc-view-mode): Use it.
+ (doc-view-fallback-mode): Set it.
+
+ * minibuf-eldef.el: Make it possible to replace (default ...) with [...].
+ Set lexical-binding.
+ (minibuffer-eldef-shorten-default): New var.
+ (minibuffer-default-in-prompt-regexps): Use it for new default.
+ (minibuf-eldef-setup-minibuffer): Add replacement functionality.
+
+2012-09-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * international/uni-bidi.el:
+ * international/uni-category.el:
+ * international/uni-name.el:
+ * international/uni-numeric.el: Regenerate.
+
+2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * profiler.el: New file.
+
+2012-09-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/testcover.el (testcover-after): Add gv-expander.
+ (testcover-reinstrument): Simplify with CSE.
+
+2012-09-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * window.el (temp-buffer-window-setup): Fix typo in docstring.
+
+2012-09-25 Wilson Snyder <wsnyder@wsnyder.org>
+
+ * verilog-mode.el (verilog-auto-ascii-enum, verilog-auto-inout)
+ (verilog-auto-input, verilog-auto-insert-lisp)
+ (verilog-auto-output, verilog-auto-output-every, verilog-auto-reg)
+ (verilog-auto-reg-input, verilog-auto-tieoff, verilog-auto-undef)
+ (verilog-auto-unused, verilog-auto-wire)
+ (verilog-forward-or-insert-line): Fix AUTOs with no trailing
+ newline. Reported by Andrew Jones.
+ (verilog-auto-inst) Support expanding $clog2 in AUTOINST.
+ Reported by Brad Dobbie.
+ (verilog-batch-delete-trailing-whitespace):
+ Create verilog-batch-delete-trailing-whitespace.
+ Reported by Brad Dobbie.
+ (verilog-auto-inout-param): Support AUTOINOUTPARAM for copying
+ parameters from another module. Reported by Dan Katz.
+ (verilog-auto, verilog-auto-assign-modport)
+ (verilog-auto-inout-modport): Add AUTOASSIGNMODPORT and
+ AUTOINOUTMODPORT for UVM interface module shell generation.
+ Reported by Brad Dobbie.
+ (verilog-auto-inst-interfaced-ports): Make default nil, as more
+ standard behavior.
+ (verilog-auto): Fix AUTO parameters with parenthesis arguments.
+ Reported by Matt Martin.
+
+2012-09-25 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--resize-child-windows): When resizing child
+ windows proportionally, process them in reverse order to
+ preserve the "when splitting a window the new one gets the odd
+ line" behavior.
+ (window--resize-root-window-vertically): When resizing the
+ minibuffer window try to affect only windows at the bottom of the
+ frame. (Bug#12419)
+
+2012-09-25 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (declare): Doc fix.
+
+ * help-fns.el (help-fns--obsolete): Handle macros properly.
+
+2012-09-25 Chong Yidong <cyd@gnu.org>
+
+ * bookmark.el (bookmark-jump-noselect): Use a declare form to mark
+ this function obsolete.
+
+ * calendar/cal-x.el (calendar-two-frame-setup)
+ (calendar-only-one-frame-setup, calendar-one-frame-setup):
+ * calendar/calendar.el (american-calendar, european-calendar)
+ (calendar-for-loop):
+ * comint.el (comint-dynamic-simple-complete)
+ (comint-dynamic-complete-as-filename, comint-unquote-filename):
+ * desktop.el (desktop-load-default):
+ * dired-x.el (dired-omit-here-always)
+ (dired-hack-local-variables, dired-default-directory):
+ * emacs-lisp/derived.el (derived-mode-class):
+ * emacs-lisp/timer.el (timer-set-time-with-usecs):
+ * emacs-lock.el (toggle-emacs-lock):
+ * epa.el (epa-display-verify-result):
+ * epg.el (epg-sign-keys, epg-start-sign-keys)
+ (epg-passphrase-callback-function):
+ * eshell/esh-util.el (eshell-for):
+ * eshell/eshell.el (eshell-remove-from-window-buffer-names)
+ (eshell-add-to-window-buffer-names):
+ * files.el (locate-file-completion):
+ * imenu.el (imenu-example--create-c-index)
+ (imenu-example--create-lisp-index)
+ (imenu-example--lisp-extract-index-name)
+ (imenu-example--name-and-position):
+ * international/mule-cmds.el (princ-list):
+ * international/mule-diag.el (decode-codepage-char):
+ * international/mule-util.el (detect-coding-with-priority):
+ * iswitchb.el (iswitchb-read-buffer):
+ * mail/mailalias.el (mail-complete):
+ * mail/sendmail.el (mail-sent-via):
+ * mouse.el (mouse-popup-menubar-stuff, mouse-popup-menubar)
+ (mouse-major-mode-menu):
+ * password-cache.el (password-read-and-add):
+ * pcomplete.el (pcomplete-parse-comint-arguments):
+ * progmodes/sh-script.el (sh-maybe-here-document):
+ * replace.el (query-replace-regexp-eval):
+ * savehist.el (savehist-load):
+ * simple.el (choose-completion-delete-max-match):
+ * term.el (term-dynamic-simple-complete):
+ * vc/ediff-init.el (ediff-check-version):
+ * vc/ediff-wind.el (ediff-choose-window-setup-function-automatically):
+ * vc/vc.el (vc-diff-switches-list):
+ * view.el (view-return-to-alist-update): Likewise.
+
+ * subr.el (eval-next-after-load, makehash, insert-string)
+ (assoc-ignore-representation, assoc-ignore-case): Use declare to
+ mark obsolete.
+ (mode-line-inverse-video): Variable deleted.
+
+ * international/mule-util.el (string-to-sequence): Remove.
+
+ * calendar/calendar.el (calendar-version):
+ * calendar/icalendar.el (icalendar-extract-ical-from-buffer)
+ (icalendar-convert-diary-to-ical):
+ * cus-edit.el (custom-mode):
+ * ansi-color.el (ansi-color-unfontify-region):
+ * international/latin1-disp.el (latin1-char-displayable-p):
+ * progmodes/cwarn.el (turn-on-cwarn-mode):
+ * progmodes/which-func.el (which-func-update-1):
+ Use define-obsolete-function-alias.
+
+ * net/newst-backend.el (newsticker-cache-filename):
+ * net/newst-treeview.el (newsticker-groups-filename):
+ Fix incorrect obsolescence declaration.
+
+ * allout.el (allout-passphrase-hint-string): Likewise.
+ (allout-init): Use a declare form to mark obsolete.
+
+ * emacs-lisp/byte-run.el (make-obsolete): Doc fix; emphasize that
+ this applies to functions.
+
+ * iswitchb.el (iswitchb-read-buffer): Move code of
+ iswitchb-define-mode-map here, and delete that obsolete function.
+
+ * net/snmp-mode.el (snmp-font-lock-keywords-3): Don't use obsolete
+ font-lock-reference-face.
+
+2012-09-25 Glenn Morris <rgm@gnu.org>
+
+ * buff-menu.el (Buffer-menu-name-width, Buffer-menu-size-width):
+ Doc fixes.
+
+ * eshell/em-term.el (eshell-term-name):
+ Default to term-term-name. (Bug#12485)
+
+2012-09-24 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-shell-send-buffer): Better handling
+ of "if __name__ == '__main__':" conditionals when sending the buffer.
+
+2012-09-24 Glenn Morris <rgm@gnu.org>
+
+ * eshell/esh-cmd.el (eshell-find-alias-function):
+ Tighten up file-name regexp. (Bug#12499)
+
+2012-09-24 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Enhancements for triple-quote string syntax.
+ * progmodes/python.el (python-quote-syntax): Remove.
+ (python-syntax-propertize-function): New value.
+ (python-syntax-count-quotes, python-syntax-stringify):
+ New functions.
+
+2012-09-24 Chong Yidong <cyd@gnu.org>
+
+ * mail/supercite.el (sc-version): Remove obsolete function.
+ (sc-describe): Don't mark as obsolete, since it is bound.
+ (sc-submit-bug-report): Remove.
+
+ * vc/log-edit.el (cvs-changelog-full-paragraphs)
+ (cvs-commit-buffer-require-final-newline): Remove.
+ (log-edit-require-final-newline)
+ (log-edit-changelog-full-paragraphs): Default to t.
+
+ * vc/pcvs-defs.el (cvs-diff-buffer-name, cvs-diff-ignore-marks)
+ * vc/vc-hooks.el (vc-ignore-vc-files, vc-master-templates)
+ * vc/vc.el (vc-checkout-carefully): Likewise.
+
+ * vc/emerge.el (emerge-mode): Make it an obsolete alias.
+ (emerge-version): Remove.
+
+ * progmodes/compile.el (compile-internal): Remove.
+ (compilation-parse-errors-function): Fix typo.
+
+ * international/mule.el (set-char-table-default): Remove.
+ (set-coding-priority, make-coding-system, generic-char-p)
+ (charset-list, charset-bytes, charset-id): Use declare to mark
+ functions as obsolete.
+
+ * vc/pcvs-defs.el (cvs-buffer-name-alist)
+ (cvs-invert-ignore-marks): Remove references to obsolete vars.
+ * vc/vc-hooks.el (vc-default-registered): Don't use
+ vc-master-templates.
+
+ * font-lock.el (font-lock-reference-face):
+ Use define-obsolete-variable-alias.
+
+ * generic-x.el (rul-generic-mode): Use font-lock-constant-face.
+ * calendar/calendar.el (calendar-font-lock-keywords):
+ * calendar/diary-lib.el (diary-font-lock-keywords)
+ (diary-fancy-font-lock-keywords):
+ * textmodes/reftex-sel.el (reftex-insert-docstruct):
+ * textmodes/reftex-index.el (reftex-insert-index):
+ * textmodes/reftex-cite.el (reftex-format-bib-entry):
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ * progmodes/ps-mode.el (ps-mode-font-lock-keywords-1):
+ * progmodes/prolog.el (prolog-font-lock-keywords):
+ * progmodes/idlwave.el (idlwave-idl-keywords):
+ * progmodes/ada-mode.el (ada-font-lock-keywords):
+ * net/snmp-mode.el (snmp-font-lock-keywords-3): Likewise.
+
+2012-09-24 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug): Include `lsb_release -d'.
+
+2012-09-23 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-indent-line): More consistent cursor
+ movement behavior.
+
+2012-09-23 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Fix compiler warning.
+
+2012-09-23 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-autokey-transcriptions):
+ Transcribe also LaTeX hyphenation.
+ (bibtex-reformat): Bug fix. Do not quote twice the elements of
+ bibtex-reformat-previous-options.
+
+2012-09-23 Roland Winkler <winkler@gnu.org>
+
+ * proced.el (proced-renice-command): New variable.
+ (proced-marked-processes): New function.
+ (proced-with-processes-buffer): New macro.
+ (proced-send-signal): Use them.
+ (proced-renice): New command bound to r.
+
+2012-09-23 Roland Winkler <winkler@gnu.org>
+
+ * ibuf-ext.el (ibuffer-switch-to-saved-filter-groups): If list
+ ibuffer-saved-filter-groups has one element, shortcut the call of
+ completing-read. (Bug#12331)
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * bindings.el (mode-line-toggle-read-only):
+ * bs.el (bs-toggle-readonly):
+ * buff-menu.el (Buffer-menu-toggle-read-only):
+ * dired.el (dired-toggle-read-only):
+ * ibuffer.el (ibuffer-do-toggle-read-only): Use read-only-mode.
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * image.el (image-type-available-p): Adapt to init-image-library
+ argument changes.
+
+2012-09-22 Juri Linkov <juri@jurta.org>
+
+ * dired.el (dired-mode-map): Add [remap read-only-mode] for
+ `dired-toggle-read-only'. (Bug#12462)
+
+2012-09-22 Martin Rudalics <rudalics@gmx.at>
+
+ * subr.el (temp-output-buffer-show): New function.
+ (with-output-to-temp-buffer): Call temp-output-buffer-show
+ instead of internal-temp-output-buffer-show.
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * files.el (ctl-x-map): Bind C-x C-q to read-only-mode
+ (Bug#12462).
+
+ * repeat.el (repeat): Doc fix (Bug#12348).
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix
+ (Bug#10909).
+
+ * simple.el (shell-command-on-region): Doc fix.
+ (read-only-mode): Doc fix.
+
+2012-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ * emacs-lisp/timer.el (run-with-idle-timer)
+ (timer-activate-when-idle): Warn against reinvoking an idle timer
+ from within its own timer action. (Bug#12447)
+
+2012-09-22 Martin Rudalics <rudalics@gmx.at>
+
+ * cus-start.el (window-combination-limit): Add new optional
+ values.
+ * window.el (temp-buffer-window-show)
+ (window--try-to-split-window): Handle new values of
+ window-combination-limit (Bug#1806).
+ (split-window): Test window-combination-limit for t instead of
+ non-nil.
+ (display-buffer-at-bottom): New buffer display action function.
+ * help.el (temp-buffer-resize-regexps): New option.
+ (temp-buffer-resize-mode): Rewrite doc-string.
+ (resize-temp-buffer-window): Obey temp-buffer-resize-regexps.
+ Don't resize reused window. Suggested by Glenn Morris.
+
+2012-09-22 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Revamp section title faces.
+ (rst-official-version)
+ (rst-package-emacs-version-alist): Sync with official version
+ V1.4.0.
+ (rst-faces-defaults, rst-set-level-default)
+ (rst-level-face-max, rst-level-face-base-color)
+ (rst-level-face-base-light, rst-level-face-format-light)
+ (rst-level-face-step-light, rst-define-level-faces): Obsolete.
+ (rst-adornment-faces-alist): Match new setup.
+ (rst-level-1, rst-level-2, rst-level-3, rst-level-4)
+ (rst-level-5, rst-level-6): New faces.
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (undo): Handle indirect buffers (Bug#8207).
+
+2012-09-21 Leo Liu <sdl.web@gmail.com>
+
+ IDO: Disable match re-ordering for buffer switching.
+ * ido.el (ido-buffer-disable-smart-matches): New variable.
+ (ido-set-matches-1): Use it. (Bug#2042)
+
+2012-09-21 Jose Marino <marinoj@nso.edu> (tiny change)
+
+ * progmodes/idlw-shell.el (idlwave-shell-complete-filename):
+ Fix 2011-05-17 change. (Bug#12418)
+
+2012-09-21 Leo Liu <sdl.web@gmail.com>
+
+ * subr.el (ignore-errors): Mention with-demoted-errors in doc-string.
+
+2012-09-21 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/shadow.el (load-path-shadows-font-lock-keywords):
+ Be more robust about locating simple.el.
+
+2012-09-21 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug): Trap load-path-shadows errors.
+
+2012-09-21 Joel Bion <jpbion@westvi.com> (tiny change)
+
+ * pcmpl-gnu.el (pcmpl-gnu-tarfile-regexp): Add tar.xz. (Bug#12382)
+
+2012-09-20 Juri Linkov <juri@jurta.org>
+
+ * replace.el (query-replace-read-from): Use `read-regexp' instead
+ of `read-from-minibuffer' when `regexp-flag' is non-nil.
+ (occur-read-primary-args): Use `read-regexp' instead of
+ `read-string'.
+ (multi-occur-in-matching-buffers): Use `read-regexp' instead of
+ `read-from-minibuffer'.
+ * isearch.el (isearch-occur): Use `read-regexp' instead of
+ `read-string'.
+ * dired.el (dired-read-regexp): Use `read-regexp' instead of
+ `read-from-minibuffer'.
+ * progmodes/grep.el (grep-read-regexp): Use `read-regexp' instead
+ of `read-string'. (Bug#7567)
+
+ * replace.el (read-regexp): Rename DEFAULT-VALUE arg to DEFAULTS
+ and allow accepting a list of strings prepended to a list of
+ standard default values. Doc fix. (Bug#12321)
+
+ * replace.el (read-regexp): Add HISTORY arg. (Bug#7567)
+
+ * replace.el (read-regexp): Don't add ": " when PROMPT already
+ ends with a colon and space. (Bug#12321)
+
+2012-09-20 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el (doc-view-display): Better fix for the cl-assertion
+ error.
+
+2012-09-20 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Integrate support for `imenu' and `which-function'.
+ Fixes feature request bug#11711.
+ (rst-mode): Create `imenu-create-index-function'.
+ (rst-get-stripped-line): Delete after refactoring.
+ (rst-section-tree, rst-section-tree-rec)
+ (rst-section-tree-point): Refactor and document properly.
+ (rst-imenu-find-adornments-for-position)
+ (rst-imenu-convert-cell, rst-imenu-create-index):
+ New function.
+
+2012-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp--obsolete-warning): New function.
+ (macroexp--expand-all): Use it.
+ (macroexp--funcall-and-return): Remove by folding it into its sole
+ caller (macroexp--warn-and-return).
+ * emacs-lisp/bytecomp.el (byte-compile-warn-obsolete):
+ Use macroexp--obsolete-warning.
+
+ * calc/calc.el: Fix last change by removing the whole chunk, since it
+ was only needed back when Calc was not bundled.
+
+2012-09-20 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/debug.el (debug): Restore assignment to
+ debugger-old-buffer removed on 2012-09-08.
+
+2012-09-20 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-diff): Remove (require 'diff) since
+ `diff-latest-backup-file' is now autoloaded.
+
+2012-09-20 Chong Yidong <cyd@gnu.org>
+
+ * vc/diff.el (diff-latest-backup-file): Autoload.
+
+2012-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * calc/calc.el: Remove redundant autoload shape check.
+ (sel-mode): Don't defvar.
+ (calc-get-stack-element): Add `sel-mode' arg instead.
+ (calc-top, calc-top-list): Pass it this additional argument.
+ * calc/calc-store.el (calc-store-map):
+ * calc/calc-map.el (calc-apply, calc-reduce, calc-map)
+ (calc-map-equation, calc-outer-product, calc-inner-product):
+ * calc/calc-aent.el (calc-alg-entry): Don't bind sel-mode.
+
+ * emacs-lisp/macroexp.el (macroexp--expand-all): Fix last change.
+
+2012-09-19 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-diff): Add (require 'diff) because
+ `diff-latest-backup-file' is not autoloaded.
+ (dired-do-chxxx, dired-do-chmod): Set `no-error-if-not-filep' arg
+ of `dired-get-filename' to t to not report error when there is
+ no default file on the current line.
+
+2012-09-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp--funcall-if-compiled): Rename from
+ macroexp--eval-if-compile.
+ (macroexp--funcall-and-return, macroexp--warn-and-return): New funs.
+ (macroexp--expand-all): Use them (bug#12371).
+
+ * doc-view.el (doc-view-guess-paper-size)
+ (doc-view-scale-bounding-box): Fix unbound `caddr'.
+
+2012-09-19 Tassilo Horn <tsdh@gnu.org>
+
+ New feature: set optimal slice from BoundingBox information.
+ * doc-view.el (doc-view-mode-map): Add keybinding.
+ (doc-view-menu): Add menu entry.
+ (doc-view-set-slice): Adapt docstring.
+ (doc-view-get-bounding-box, doc-view-guess-paper-size)
+ (doc-view-scale-bounding-box)
+ (doc-view-set-slice-from-bounding-box): New functions.
+ (doc-view-paper-sizes): New defvar.
+
+2012-09-19 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/macroexp.el (byte-compile-warn-obsolete)
+ (byte-compile-log-warning): Autoload. (Bug#12371)
+
+ * calendar/calendar.el (calendar-american-month-header)
+ (calendar-european-month-header, calendar-iso-month-header)
+ (calendar-month-header): New options.
+ (calendar-set-date-style): Set calendar-month-header. Redraw calendar.
+ (calendar-generate-month): Use calendar-month-header. (Bug#9510)
+
+2012-09-19 Jan Djärv <jan.h.d@swipnet.se>
+
+ * startup.el (command-line-ns-option-alist): Add -g and --geometry.
+
+2012-09-18 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-diff): Restore original functionality of
+ getting the default value, but keep new feature of using the
+ latest existing backup file (`diff-latest-backup-file').
+
+2012-09-18 Juri Linkov <juri@jurta.org>
+
+ * dired.el (dired-mark): If the region is active in Transient Mark
+ mode, mark all files in the active region. Doc fix.
+ (dired-unmark, dired-flag-file-deletion, dired-unmark-backward):
+ Doc fix. (Bug#10624)
+
+2012-09-18 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-do-chxxx, dired-do-chmod): Default file
+ attributes for M-n are pulled from the file at point.
+ (dired-do-chgrp, dired-do-chown, dired-do-touch): Doc fix.
+ Suggested by Drew Adams. (Bug#10624)
+
+2012-09-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-brace-to-do-end): Don't add extra
+ whitespace after "end".
+ (ruby-do-end-to-brace): Collapse block to one line if it fits
+ within fill-column.
+
+2012-09-18 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/debug.el (debugger-bury-or-kill): Fix customization
+ value.
+ (debug): Don't remove debugger window when debugger is expected
+ to be back.
+
+2012-09-18 Chong Yidong <cyd@gnu.org>
+
+ * custom.el (defface): Doc fix.
+
+ * cus-edit.el (custom-unlispify-remove-prefixes): Add warning.
+
+2012-09-18 Martin Blais <blais@furius.ca> (tiny change)
+
+ * progmodes/compile.el (compilation-start): Use compilation-always-kill
+ to initialize query-on-exit; then test that instead (bug#12288).
+
+2012-09-17 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Add support for `testcover'.
+ (rst-defcustom-testcover, rst-testcover-add-compose)
+ (rst-testcover-add-1value): New functions.
+ (rst-portable-mark-active-p): Replace by `use-region-p'.
+ (rst-update-section, rst-classify-adornment)
+ (rst-find-title-line): Mark `1value' forms.
+ (rst-classify-adornment): Remove superfluous form.
+ (rst-update-section, rst-get-adornments-around)
+ (rst-adornment-complete-p, rst-get-next-adornment)
+ (rst-adjust, rst-promote-region)
+ (rst-display-adornments-hierarchy, rst-straighten-adornments)
+ (rst-find-pfx-in-region, rst-section-tree-rec)
+ (rst-section-tree-point, rst-toc-insert, rst-toc-insert-node)
+ (rst-toc-node, rst-toc, rst-forward-section)
+ (rst-iterate-leftmost-paragraphs)
+ (rst-iterate-leftmost-paragraphs-2, rst-enumerate-region)
+ (rst-bullet-list-region)
+ (rst-convert-bullets-to-enumeration, rst-font-lock-keywords)
+ (rst-compile-find-conf, rst-compile)
+ (rst-repeat-last-character): Fix style.
+
+2012-09-17 Chong Yidong <cyd@gnu.org>
+
+ * comint.el (comint--complete-file-name-data): Don't add a space
+ if the status is `sole'; that adds a gratuitous space in the
+ completion-cycling case (Bug#12092).
+
+ * pcomplete.el (pcomplete-completions-at-point): Likewise.
+
2012-09-17 Richard Stallman <rms@gnu.org>
+ * mail/rmailmm.el (rmail-mime-toggle-raw): Do rmail-mime-insert
+ only in the mime-shown mode, not in raw mode.
+ (rmail-mime): Toggle off mime by displaying the message without
+ mime processing. (Bug#12305)
+
+ * mail/rmail.el (rmail-retry-failure):
+ Turn off mime processing first. (Bug#12037)
+
* epa-mail.el (epa-mail-encrypt): Fix bug when a name has no key.
2012-09-17 Chong Yidong <cyd@gnu.org>
@@ -59,8 +1418,8 @@
(display-buffer-function): Mark as obsolete.
* progmodes/compile.el (compilation-parse-errors): Accept list
- values similar to font-lock-keywords (Bug#12136). Suggested by
- Oleksandr Manzyuk.
+ values similar to font-lock-keywords (Bug#12136).
+ Suggested by Oleksandr Manzyuk.
(compilation-error-regexp-alist): Doc fix.
2012-09-15 Glenn Morris <rgm@gnu.org>
@@ -356,12 +1715,12 @@
2012-09-08 Jambunathan K <kjambunathan@gmail.com>
* register.el (register): New group.
- (register-separator): New user option.
+ (separator-register): New user option.
(increment-register): Route it to `append-to-register', if
register contains text. Implication is that `C-x r +' can now be
used for appending to a text register (bug#12217).
(append-to-register, prepend-to-register): Add separator based on
- `register-separator.
+ `separator-register'.
2012-09-08 Alan Mackenzie <acm@muc.de>
@@ -1663,7 +3022,7 @@
:local as the address.
(list-processes): Doc fix.
-2012-08-04 Michal Nazarewicz <mina86@mina86.com> (tiny change)
+2012-08-04 Michal Nazarewicz <mina86@mina86.com>
* lisp/mpc.el: Support password in host argument.
(mpc--proc-connect): Parse and use new password element.
@@ -1797,7 +3156,7 @@
2012-07-30 Stefan Merten <smerten@oekonux.de>
- * rst.el: Silence `checkdoc-ispell'.
+ * textmodes/rst.el: Silence `checkdoc-ispell'.
(rst-cvs-header, rst-svn-rev, rst-svn-timestamp)
(rst-official-version, rst-official-cvs-rev)
(rst-package-emacs-version-alist): Update to upstream V1.3.1.
@@ -1892,8 +3251,9 @@
* register.el (copy-to-register, copy-rectangle-to-register):
Deactivate the mark, and use indicate-copied-region (Bug#10056).
- (append-to-register, prepend-to-register):
- Call 2012-07-29 Juri Linkov <juri@jurta.org>
+ (append-to-register, prepend-to-register): Call indicate-copied-region.
+
+2012-07-29 Juri Linkov <juri@jurta.org>
* simple.el (async-shell-command-buffer): New defcustom.
(shell-command): Use it. (Bug#4719)
@@ -7182,7 +8542,8 @@
2012-03-18 Leo Liu <sdl.web@gmail.com>
- * net/rcirc.el (rcirc-cmd-quit): Allow quiting all servers with prefix.
+ * net/rcirc.el (rcirc-cmd-quit): Allow quitting all servers with
+ prefix.
2012-03-17 Eli Zaretskii <eliz@gnu.org>
@@ -9189,7 +10550,7 @@
Declare as obsolete.
(ns-get-pasteboard, ns-paste-secondary):
Use ns-get-selection-internal.
- (ns-set-pasteboard, ns-copy-including-secondary):
+ (ns-set-pasteboard, ns-copy-including-secondary):
Use ns-store-selection-internal.
2011-12-17 Chong Yidong <cyd@gnu.org>
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index d94d72d0f3c..c9085827f7b 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -5492,7 +5492,7 @@
2003-02-14 Dave Love <fx@gnu.org>
- * international/code-pages.el: Undo `Trailing whitepace deleted.'
+ * international/code-pages.el: Undo `Trailing whitespace deleted.'
damage.
(cp1125, mik): Nullify mime-charset.
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 65a7baf44c4..83657a98bfd 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -10962,7 +10962,7 @@
* Version 23.2 released.
-2010-05-07 Deniz Dogan <deniz.a.m.dogan@gmail.com> (tiny change)
+2010-05-07 Deniz Dogan <deniz.a.m.dogan@gmail.com>
Stefan Monnier <monnier@iro.umontreal.ca>
Highlight vendor specific properties.
@@ -15541,7 +15541,7 @@
* window.el (move-to-window-line-last-op): Remove.
(move-to-window-line-top-bottom): Reuse recenter-last-op instead.
-2009-11-23 Deniz Dogan <deniz.a.m.dogan@gmail.com> (tiny change)
+2009-11-23 Deniz Dogan <deniz.a.m.dogan@gmail.com>
Make M-r mirror the new cycling behavior of C-l.
* window.el (move-to-window-line-last-op): New var.
diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8
index 0380fb117db..db5c2f84511 100644
--- a/lisp/ChangeLog.8
+++ b/lisp/ChangeLog.8
@@ -2372,7 +2372,7 @@
(sh-mode-map): Added new bindings.
(sh-mode): Updated mode doc-string for new commands, added
make-local-variable calls, initialize mode-specific variables.
- (sh-indent-line): Renamed to sh-basic-indent-line; sh-indent-line
+ (sh-indent-line): Renamed to sh-basic-indent-line; sh-indent-line
is now a different function.
(sh-header-marker): Changed docstring.
(sh-set-shell): Initialize mode-specific variables.
diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9
index 5c01f872994..5c71fb860ec 100644
--- a/lisp/ChangeLog.9
+++ b/lisp/ChangeLog.9
@@ -569,7 +569,7 @@
Don't bind mouse events or tab/backtab.
(help-function, help-variable, help-face, help-coding-system)
(help-input-method, help-character-set, help-back, help-info)
- (help-customize-variable, help-function-def, help-variable-def):
+ (help-customize-variable, help-function-def, help-variable-def):
New button types.
(help-button-action): New function.
(describe-function-1): Pass help button-types to
@@ -20671,7 +20671,7 @@
* term/tty-colors.el (tty-defined-color-alist): Renamed from
tty-color-alist.
(tty-color-alist, tty-modify-color-alist): New functions.
- (tty-color-define, tty-color-clear, tty-color-approximate)
+ (tty-color-define, tty-color-clear, tty-color-approximate)
(tty-color-translate, tty-color-by-index, tty-color-desc): Accept an
optional parameter FRAME.
diff --git a/lisp/allout.el b/lisp/allout.el
index acf0b7d75b6..04de853ebe0 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -1522,8 +1522,8 @@ The verifier string is retained as an Emacs file variable, as well as in
the Emacs buffer state, if file variable adjustments are enabled. See
`allout-enable-file-variable-adjustment' for details about that.")
(make-variable-buffer-local 'allout-passphrase-verifier-string)
-(make-obsolete 'allout-passphrase-verifier-string
- 'allout-passphrase-verifier-string "23.3")
+(make-obsolete-variable 'allout-passphrase-verifier-string
+ 'allout-passphrase-verifier-string "23.3")
;;;###autoload
(put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp)
;;;_ = allout-passphrase-hint-string
@@ -1538,8 +1538,8 @@ state, if file variable adjustments are enabled. See
`allout-enable-file-variable-adjustment' for details about that.")
(make-variable-buffer-local 'allout-passphrase-hint-string)
(setq-default allout-passphrase-hint-string "")
-(make-obsolete 'allout-passphrase-hint-string
- 'allout-passphrase-hint-string "23.3")
+(make-obsolete-variable 'allout-passphrase-hint-string
+ 'allout-passphrase-hint-string "23.3")
;;;###autoload
(put 'allout-passphrase-hint-string 'safe-local-variable 'stringp)
;;;_ = allout-after-save-decrypt
@@ -1688,11 +1688,10 @@ from what it did before, for backwards compatibility.
MODE is the activation mode - see `allout-auto-activation' for
valid values."
-
+ (declare (obsolete allout-auto-activation "23.3"))
(custom-set-variables (list 'allout-auto-activation (format "%s" mode)))
(format "%s" mode))
-(make-obsolete 'allout-init
- "customize 'allout-auto-activation' instead." "23.3")
+
;;;_ > allout-setup-menubar ()
(defun allout-setup-menubar ()
"Populate the current buffer's menubar with `allout-mode' stuff."
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 8305aaf1199..047b4b944b9 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -230,8 +230,8 @@ This is a good function to put in `comint-output-filter-functions'."
(t
(ansi-color-apply-on-region start-marker end-marker)))))
-(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region)
-(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1")
+(define-obsolete-function-alias 'ansi-color-unfontify-region
+ 'font-lock-default-unfontify-region "24.1")
;; Working with strings
(defvar ansi-color-context nil
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index c776a3f8b5c..c04cd8dcf9d 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -787,7 +787,8 @@ is visible (and the real data of the buffer is hidden).
Optional argument SHUT-UP, if non-nil, means don't print messages
when parsing the archive."
(widen)
- (let ((inhibit-read-only t))
+ (let ((buffer-file-truename nil) ; avoid changing dir mtime by lock_file
+ (inhibit-read-only t))
(setq archive-proper-file-start (copy-marker (point-min) t))
(set (make-local-variable 'change-major-mode-hook) 'archive-desummarize)
(or shut-up
@@ -1117,13 +1118,54 @@ using `make-temp-file', and the generated name is returned."
(archive-delete-local tmpfile)
success))
-(defun archive-extract-by-stdout (archive name command &optional stderr-file)
- (apply 'call-process
- (car command)
- nil
- (if stderr-file (list t stderr-file) t)
- nil
- (append (cdr command) (list archive name))))
+(defun archive-extract-by-stdout (archive name command &optional stderr-test)
+ (let ((stderr-file (make-temp-file "arc-stderr")))
+ (unwind-protect
+ (prog1
+ (apply 'call-process
+ (car command)
+ nil
+ (if stderr-file (list t stderr-file) t)
+ nil
+ (append (cdr command) (list archive name)))
+ (with-temp-buffer
+ (insert-file-contents stderr-file)
+ (goto-char (point-min))
+ (when (if (stringp stderr-test)
+ (not (re-search-forward stderr-test nil t))
+ (> (buffer-size) 0))
+ (message "%s" (buffer-string)))))
+ (if (file-exists-p stderr-file)
+ (delete-file stderr-file)))))
+
+(defun archive-extract-by-file (archive name command &optional stdout-test)
+ (let ((dest (make-temp-file "arc-dir" 'dir))
+ (stdout-file (make-temp-file "arc-stdout")))
+ (unwind-protect
+ (prog1
+ (apply 'call-process
+ (car command)
+ nil
+ `(:file ,stdout-file)
+ nil
+ (append (cdr command) (list archive name dest)))
+ (with-temp-buffer
+ (insert-file-contents stdout-file)
+ (goto-char (point-min))
+ (when (if (stringp stdout-test)
+ (not (re-search-forward stdout-test nil t))
+ (> (buffer-size) 0))
+ (message "%s" (buffer-string))))
+ (if (file-exists-p (expand-file-name name dest))
+ (insert-file-contents-literally (expand-file-name name dest))))
+ (if (file-exists-p stdout-file)
+ (delete-file stdout-file))
+ (if (file-exists-p (expand-file-name name dest))
+ (delete-file (expand-file-name name dest)))
+ (while (file-name-directory name)
+ (setq name (directory-file-name (file-name-directory name)))
+ (delete-directory (expand-file-name name dest)))
+ (delete-directory dest))))
(defun archive-extract-other-window ()
"In archive mode, find this member in another window."
@@ -2006,17 +2048,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
;; The code below assumes the name is relative and may do undesirable
;; things otherwise.
(error "Can't extract files with non-relative names")
- (let ((dest (make-temp-file "arc-rar" 'dir)))
- (unwind-protect
- (progn
- (call-process "unrar-free" nil nil nil
- "--extract" archive name dest)
- (insert-file-contents-literally (expand-file-name name dest)))
- (delete-file (expand-file-name name dest))
- (while (file-name-directory name)
- (setq name (directory-file-name (file-name-directory name)))
- (delete-directory (expand-file-name name dest)))
- (delete-directory dest)))))
+ (archive-extract-by-file archive name '("unrar-free" "--extract") "All OK")))
;;; Section: Rar self-extracting .exe archives.
@@ -2099,17 +2131,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(apply 'vector files))))
(defun archive-7z-extract (archive name)
- (let ((tmpfile (make-temp-file "7z-stderr")))
- ;; 7z doesn't provide a `quiet' option to suppress non-essential
- ;; stderr messages. So redirect stderr to a temp file and display it
- ;; in the echo area when it contains error messages.
- (prog1 (archive-extract-by-stdout
- archive name archive-7z-extract tmpfile)
- (with-temp-buffer
- (insert-file-contents tmpfile)
- (unless (search-forward "Everything is Ok" nil t)
- (message "%s" (buffer-string)))
- (delete-file tmpfile)))))
+ ;; 7z doesn't provide a `quiet' option to suppress non-essential
+ ;; stderr messages. So redirect stderr to a temp file and display it
+ ;; in the echo area when it contains no message indicating success.
+ (archive-extract-by-stdout
+ archive name archive-7z-extract "Everything is Ok"))
(defun archive-7z-write-file-member (archive descr)
(archive-*-write-file-member
diff --git a/lisp/avoid.el b/lisp/avoid.el
index 2fa6ef39e70..7f4b78bf5e0 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -128,6 +128,7 @@ SIDE-POS: Distance from right or left edge of frame or window.
TOP-OR-BOTTOM: banish the mouse to top or bottom of frame or window.
TOP-OR-BOTTOM-POS: Distance from top or bottom edge of frame or window."
:group 'avoid
+ :version "24.3"
:type '(alist :key-type symbol :value-type symbol)
:options '(frame-or-window side (side-pos integer)
top-or-bottom (top-or-bottom-pos integer)))
diff --git a/lisp/bindings.el b/lisp/bindings.el
index c20a7f30eea..b4f9d29fe52 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -40,7 +40,7 @@ corresponding to the mode line clicked."
(interactive "e")
(save-selected-window
(select-window (posn-window (event-start event)))
- (call-interactively 'toggle-read-only)))
+ (read-only-mode 'toggle)))
(defun mode-line-toggle-modified (event)
"Toggle the buffer-modified flag from the mode-line."
@@ -898,6 +898,7 @@ if `inhibit-field-text-motion' is non-nil."
(define-key goto-map "\M-n" 'next-error)
(define-key goto-map "p" 'previous-error)
(define-key goto-map "\M-p" 'previous-error)
+(define-key goto-map "\t" 'move-to-column)
(defvar search-map (make-sparse-keymap)
"Keymap for search related commands.")
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 31bbc13acf9..838e5a5ec00 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -99,12 +99,14 @@ To specify the file in which to save them, modify the variable
(defcustom bookmark-version-control 'nospecial
"Whether or not to make numbered backups of the bookmark file.
-It can have four values: t, nil, `never', and `nospecial'.
+It can have four values: t, nil, `never', or `nospecial'.
The first three have the same meaning that they do for the
-variable `version-control', and the final value `nospecial' means just
-use the value of `version-control'."
- :type '(choice (const nil) (const never) (const nospecial)
- (other t))
+variable `version-control'; the value `nospecial' (the default) means
+just use the value of `version-control'."
+ :type '(choice (const :tag "If existing" nil)
+ (const :tag "Never" never)
+ (const :tag "Use value of option `version-control'" nospecial)
+ (other :tag "Always" t))
:group 'bookmark)
@@ -1048,12 +1050,11 @@ The return value has the form (BUFFER . POINT).
Note: this function is deprecated and is present for Emacs 22
compatibility only."
+ (declare (obsolete bookmark-handle-bookmark "23.1"))
(save-excursion
(bookmark-handle-bookmark bookmark)
(cons (current-buffer) (point))))
-(make-obsolete 'bookmark-jump-noselect 'bookmark-handle-bookmark "23.1")
-
(defun bookmark-handle-bookmark (bookmark-name-or-record)
"Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler'
if it has none. This changes current buffer and point and returns nil,
@@ -1358,7 +1359,12 @@ for a file, defaulting to the file defined by variable
(goto-char (point-min))
(delete-region (point-min) (point-max))
(let ((print-length nil)
- (print-level nil))
+ (print-level nil)
+ ;; See bug #12503 for why we bind `print-circle'. Users
+ ;; can define their own bookmark types, which can result in
+ ;; arbitrary Lisp objects being stored in bookmark records,
+ ;; and some users create objects containing circularities.
+ (print-circle t))
(bookmark-insert-file-format-version-stamp)
(insert "(")
;; Rather than a single call to `pp' we make one per bookmark.
@@ -2004,32 +2010,6 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
;;; Bookmark-bmenu search
-;; Store keyboard input for incremental search.
-(defvar bookmark-search-pattern)
-
-(defun bookmark-read-search-input ()
- "Read each keyboard input and add it to `bookmark-search-pattern'."
- (let ((prompt (propertize "Pattern: " 'face 'minibuffer-prompt))
- ;; (inhibit-quit t) ; inhibit-quit is evil. Use it with extreme care!
- (tmp-list ()))
- (while
- (let ((char (read-key (concat prompt bookmark-search-pattern))))
- (pcase char
- ((or ?\e ?\r) nil) ; RET or ESC break the search loop.
- (?\C-g (setq bookmark-quit-flag t) nil)
- (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL
- (_
- (if (characterp char)
- (push char tmp-list)
- (setq unread-command-events
- (nconc (mapcar 'identity
- (this-single-command-raw-keys))
- unread-command-events))
- nil))))
- (setq bookmark-search-pattern
- (apply 'string (reverse tmp-list))))))
-
-
(defun bookmark-bmenu-filter-alist-by-regexp (regexp)
"Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list."
(let ((bookmark-alist
@@ -2044,19 +2024,23 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
"Incremental search of bookmarks, hiding the non-matches as we go."
(interactive)
(let ((bmk (bookmark-bmenu-bookmark))
- (bookmark-search-pattern "")
- (timer (run-with-idle-timer
- bookmark-search-delay 'repeat
- #'(lambda ()
- (bookmark-bmenu-filter-alist-by-regexp
- bookmark-search-pattern)))))
+ (timer nil))
(unwind-protect
- (bookmark-read-search-input)
- (cancel-timer timer)
- (message nil)
- (when bookmark-quit-flag ; C-g hit restore menu list.
- (bookmark-bmenu-list) (bookmark-bmenu-goto-bookmark bmk))
- (setq bookmark-quit-flag nil))))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq timer (run-with-idle-timer
+ bookmark-search-delay 'repeat
+ #'(lambda (buf)
+ (with-current-buffer buf
+ (bookmark-bmenu-filter-alist-by-regexp
+ (minibuffer-contents))))
+ (current-buffer))))
+ (read-string "Pattern: ")
+ (when timer (cancel-timer timer) (setq timer nil)))
+ (when timer ;; Signalled an error or a `quit'.
+ (cancel-timer timer)
+ (bookmark-bmenu-list)
+ (bookmark-bmenu-goto-bookmark bmk)))))
(defun bookmark-bmenu-goto-bookmark (name)
"Move point to bookmark with name NAME."
diff --git a/lisp/bs.el b/lisp/bs.el
index 09aefee416e..a84c951acfe 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -962,7 +962,7 @@ Default is `bs--current-sort-function'."
Uses function `toggle-read-only'."
(interactive)
(with-current-buffer (bs--current-buffer)
- (call-interactively 'toggle-read-only))
+ (read-only-mode 'toggle))
(bs--update-current-line))
(defun bs-clear-modified ()
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 589b6ebc47a..6ab6e548ab5 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -64,13 +64,13 @@ minus `Buffer-menu-size-width'. This use is deprecated."
"24.3")
(defcustom Buffer-menu-name-width 19
- "Width of buffer size column in the Buffer Menu."
+ "Width of buffer name column in the Buffer Menu."
:type 'number
:group 'Buffer-menu
:version "24.3")
(defcustom Buffer-menu-size-width 7
- "Width of buffer name column in the Buffer Menu."
+ "Width of buffer size column in the Buffer Menu."
:type 'number
:group 'Buffer-menu
:version "24.3")
@@ -520,7 +520,7 @@ This behaves like invoking \\[toggle-read-only] in that buffer."
(interactive)
(let ((read-only
(with-current-buffer (Buffer-menu-buffer t)
- (call-interactively 'toggle-read-only)
+ (read-only-mode 'toggle)
buffer-read-only)))
(tabulated-list-set-col 1 (if read-only "%" " ") t)))
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 4b91a8c2002..4cca7fb7e7f 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -286,8 +286,7 @@ The value t means abort and give an error message.")
;;;###autoload
(defun calc-alg-entry (&optional initial prompt)
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(calc-plain-entry t)
diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el
index 2519e960e0e..9276e1a7832 100644
--- a/lisp/calc/calc-map.el
+++ b/lisp/calc/calc-map.el
@@ -32,8 +32,7 @@
(defun calc-apply (&optional oper)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(oper (or oper (calc-get-operator "Apply"
@@ -53,11 +52,10 @@
(defun calc-reduce (&optional oper accum)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (nest (calc-is-hyperbolic))
+ (let* ((nest (calc-is-hyperbolic))
(rev (calc-is-inverse))
(nargs (if (and nest (not rev)) 2 1))
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(calc-mapping-dir (and (not accum) (not nest) ""))
@@ -99,8 +97,7 @@
(defun calc-map (&optional oper)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(calc-mapping-dir "")
@@ -120,8 +117,7 @@
(defun calc-map-equation (&optional oper)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(oper (or oper (calc-get-operator "Map-equation")))
@@ -152,8 +148,7 @@
(defun calc-outer-product (&optional oper)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(oper (or oper (calc-get-operator "Outer" 2))))
@@ -170,8 +165,7 @@
(defun calc-inner-product (&optional mul-oper add-oper)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(mul-oper (or mul-oper (calc-get-operator "Inner (Mult)" 2)))
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index 80d355ed5fa..64df10a40ca 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -235,8 +235,7 @@
(defun calc-store-map (&optional oper var)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(oper (or oper (calc-get-operator "Store Mapping")))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 17f0998d30b..f1643b10a76 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -423,6 +423,7 @@ in normal mode."
"If non-nil, make sure new units are consistent with current units
when converting units."
:group 'calc
+ :version "24.3"
:type 'boolean)
(defcustom calc-undo-length
@@ -912,35 +913,6 @@ Used by `calc-user-invocation'.")
(defvar calc-embedded-mode-hook nil
"Hook run when starting embedded mode.")
-;; Set up the autoloading linkage.
-(let ((name (and (fboundp 'calc-dispatch)
- (autoloadp (symbol-function 'calc-dispatch))
- (nth 1 (symbol-function 'calc-dispatch))))
- (p load-path))
-
- ;; If Calc files exist on the load-path, we're all set.
- (while (and p (not (file-exists-p
- (expand-file-name "calc-misc.elc" (car p)))))
- (setq p (cdr p)))
- (or p
-
- ;; If Calc is autoloaded using a path name, look there for Calc files.
- ;; This works for both relative ("calc/calc.elc") and absolute paths.
- (and name (file-name-directory name)
- (let ((p2 load-path)
- (name2 (concat (file-name-directory name)
- "calc-misc.elc")))
- (while (and p2 (not (file-exists-p
- (expand-file-name name2 (car p2)))))
- (setq p2 (cdr p2)))
- (when p2
- (setq load-path (nconc load-path
- (list
- (directory-file-name
- (file-name-directory
- (expand-file-name
- name (car p2))))))))))))
-
;; The following modes use specially-formatted data.
(put 'calc-mode 'mode-class 'special)
(put 'calc-trail-mode 'mode-class 'special)
@@ -1353,12 +1325,12 @@ Notations: 3.14e6 3.14 * 10^6
\\{calc-mode-map}
"
(interactive)
- (mapc (function
+ (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!?
(lambda (v) (set-default v (symbol-value v)))) calc-local-var-list)
(kill-all-local-variables)
(use-local-map (if (eq calc-algebraic-mode 'total)
(progn (require 'calc-ext) calc-alg-map) calc-mode-map))
- (mapc (function (lambda (v) (make-local-variable v))) calc-local-var-list)
+ (mapc #'make-local-variable calc-local-var-list)
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
@@ -1395,7 +1367,7 @@ Notations: 3.14e6 3.14 * 10^6
(if calc-buffer-list (setq calc-stack (copy-sequence calc-stack)))
(add-to-list 'calc-buffer-list (current-buffer) t))
-(defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks
+(defvar calc-check-defines 'calc-check-defines) ; Suitable for run-hooks.
(defun calc-check-defines ()
(if (symbol-plist 'calc-define)
(let ((plist (copy-sequence (symbol-plist 'calc-define))))
@@ -1943,8 +1915,7 @@ See calc-keypad for details."
(delete-region (point) (point-max))))
(calc-set-command-flag 'renum-stack))))))
-(defvar sel-mode)
-(defun calc-get-stack-element (x)
+(defun calc-get-stack-element (x &optional sel-mode)
(cond ((eq sel-mode 'entry)
x)
((eq sel-mode 'sel)
@@ -1961,9 +1932,9 @@ See calc-keypad for details."
(defun calc-top (&optional n sel-mode)
(or n (setq n 1))
(calc-check-stack n)
- (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack)))
+ (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack) sel-mode))
-(defun calc-top-n (&optional n sel-mode) ; in case precision has changed
+(defun calc-top-n (&optional n sel-mode) ; In case precision has changed.
(math-check-complete (calc-normalize (calc-top n sel-mode))))
(defun calc-top-list (&optional n m sel-mode)
@@ -1974,7 +1945,8 @@ See calc-keypad for details."
(let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1)
calc-stack))))
(setcdr (nthcdr (1- n) top) nil)
- (nreverse (mapcar 'calc-get-stack-element top)))))
+ (nreverse
+ (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top)))))
(defun calc-top-list-n (&optional n m sel-mode)
(mapcar 'math-check-complete
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index d4546125f3e..52c82b661e8 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -237,10 +237,11 @@ is non-nil."
;; These did not work if called without calendar window selected.
("Prepare LaTeX buffer"
["Daily (1 page)" cal-tex-cursor-day]
- ["Weekly (1 page)" cal-tex-cursor-week]
- ["Weekly (2 pages)" cal-tex-cursor-week2]
- ["Weekly (other style; 1 page)" cal-tex-cursor-week-iso]
- ["Weekly (yet another style; 1 page)" cal-tex-cursor-week-monday]
+ ["Weekly (1 page, with hours)" cal-tex-cursor-week]
+ ["Weekly (2 pages, with hours)" cal-tex-cursor-week2]
+ ["Weekly (1 page, no hours)" cal-tex-cursor-week-iso]
+ ["Weekly (1 page, with hours, different style)" cal-tex-cursor-week-monday]
+ ["Weekly (2 pages, no hours)" cal-tex-cursor-week2-summary]
["Monthly" cal-tex-cursor-month]
["Monthly (landscape)" cal-tex-cursor-month-landscape]
["Yearly" cal-tex-cursor-year]
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index 9c01ab40c0c..e4c2765940a 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -37,6 +37,7 @@
;; cal-tex-cursor-month
;; cal-tex-cursor-week
;; cal-tex-cursor-week2
+;; cal-tex-cursor-week2-summary
;; cal-tex-cursor-week-iso
;; cal-tex-cursor-week-monday
;; cal-tex-cursor-filofax-2week
@@ -82,8 +83,6 @@ Setting this to nil may speed up calendar generation."
(defcustom cal-tex-diary nil
"Non-nil means diary entries are printed in LaTeX calendars that support it.
-At present, this only affects the monthly, filofax, and iso-week
-calendars (i.e. not the yearly, plain weekly, or daily calendars).
Setting this to nil may speed up calendar generation."
:type 'boolean
:group 'calendar-tex)
@@ -717,11 +716,15 @@ this is only an upper bound."
;; TODO respect cal-tex-daily-start,end (see cal-tex-week-hours).
;;;###cal-autoload
(defun cal-tex-cursor-week (&optional n event)
- "Make a LaTeX calendar buffer for a two-page one-week calendar.
-It applies to the week that point is in. The optional prefix
-argument N specifies number of weeks (default 1). The calendar
-shows holidays if `cal-tex-holidays' is non-nil (note that diary
-entries are not shown). The calendar shows the hours 8-12am, 1-5pm."
+ "Make a one page LaTeX calendar for one week, showing hours of the day.
+There are two columns; with 8-12am in the first and 1-5pm in the second.
+It shows holidays if `cal-tex-holidays' is non-nil.
+It does not show diary entries.
+
+The optional prefix argument N specifies a number of weeks (default 1).
+
+By default, the calendar is for the week at point; the optional
+argument EVENT specifies a different buffer position."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
@@ -768,12 +771,15 @@ entries are not shown). The calendar shows the hours 8-12am, 1-5pm."
;; TODO respect cal-tex-daily-start,end (see cal-tex-week-hours).
;;;###cal-autoload
(defun cal-tex-cursor-week2 (&optional n event)
- "Make a LaTeX calendar buffer for a two-page one-week calendar.
-It applies to the week that point is in. Optional prefix
-argument N specifies number of weeks (default 1). The calendar
-shows holidays if `cal-tex-holidays' is non-nil (note that diary
-entries are not shown). The calendar shows the hours 8-12am, 1-5pm.
-Optional EVENT indicates a buffer position to use instead of point."
+ "Make a two page LaTeX calendar for one week, showing hours of the day.
+There are two columns; with 8-12am in the first and 1-5pm in the second.
+It shows holidays if `cal-tex-holidays' is non-nil.
+It does not show diary entries.
+
+The optional prefix argument N specifies a number of weeks (default 1).
+
+By default, the calendar is for the week at point; the optional
+argument EVENT specifies a different buffer position."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
@@ -848,12 +854,15 @@ Optional EVENT indicates a buffer position to use instead of point."
;;;###cal-autoload
(defun cal-tex-cursor-week-iso (&optional n event)
- "Make a LaTeX calendar buffer for a one page ISO-style weekly calendar.
-Optional prefix argument N specifies number of weeks (default 1).
-The calendar shows holiday and diary entries if
-`cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil.
-It does not show hours of the day. Optional EVENT indicates a buffer
-position to use instead of point."
+ "Make a one page LaTeX calendar for one week, in the ISO-style.
+It does not show hours of the day.
+It shows holidays if `cal-tex-holidays' is non-nil.
+It shows diary entries if `cal-tex-diary' is non-nil.
+
+The optional prefix argument N specifies a number of weeks (default 1).
+
+By default, the calendar is for the week at point; the optional
+argument EVENT specifies a different buffer position."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
@@ -976,13 +985,16 @@ shown are hard-coded to 8-12, 13-17."
;; TODO respect cal-tex-daily-start,end (see cal-tex-weekly4-box).
;;;###cal-autoload
(defun cal-tex-cursor-week-monday (&optional n event)
- "Make a LaTeX calendar buffer for a two-page one-week calendar.
-It applies to the week that point is in, and starts on Monday.
-Optional prefix argument N specifies number of weeks (default 1).
-The calendar shows holidays if `cal-tex-holidays' is
-non-nil (note that diary entries are not shown). The calendar shows
-the hours 8-12am, 1-5pm. Optional EVENT indicates a buffer position
-to use instead of point."
+ "Make a one page LaTeX calendar for one week, showing hours of the day.
+There are two columns; with M-W in the first and T-S in the second.
+It shows the hours 8-12am and 1-5pm.
+It shows holidays if `cal-tex-holidays' is non-nil.
+It does not show diary entries.
+
+The optional prefix argument N specifies a number of weeks (default 1).
+
+By default, the calendar is for the week at point; the optional
+argument EVENT specifies a different buffer position."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
@@ -1097,7 +1109,7 @@ shown are hard-coded to 8-12, 13-17."
(cal-tex-longday "leftday" "2.75in"))
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle" "empty")
- ;; Let's assume this is something to with twopage documents.
+ ;; Let's assume this is something to do with twopage documents.
;; It has the downside that we start with a blank page.
;; It doesn't make obvious sense when oddside and evenside margins
;; are the same (non-filofax), but consider the left and right
@@ -1203,13 +1215,16 @@ shown are hard-coded to 8-12, 13-17."
(run-hooks 'cal-tex-hook)))
;;;###cal-autoload
-(defun cal-tex-cursor-week-at-a-glance (&optional n event)
- "One-week-at-a-glance full page calendar for week indicated by cursor.
-Optional prefix argument N specifies number of weeks (default 1),
-starting on Mondays. The calendar shows holiday and diary entries
-if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil.
-It does not show hours of the day. Optional EVENT indicates a buffer
-position to use instead of point."
+(defun cal-tex-cursor-week2-summary (&optional n event)
+ "Make a two page LaTeX calendar for one week, with optional diary entries.
+It does not show hours of the day.
+It shows holidays if `cal-tex-holidays' is non-nil.
+It shows diary entries if `cal-tex-diary' is non-nil.
+
+The optional prefix argument N specifies a number of weeks (default 1).
+
+By default, the calendar is for the week at point; the optional
+argument EVENT specifies a different buffer position."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(cal-tex-weekly-common n event))
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
index 0f2d43b2237..6fba7fb7423 100644
--- a/lisp/calendar/cal-x.el
+++ b/lisp/calendar/cal-x.el
@@ -155,29 +155,23 @@ If PROMPT is non-nil, prompt for the month and year to use."
(defun calendar-one-frame-setup (&optional prompt)
"Display calendar and diary in a single dedicated frame.
See `calendar-frame-setup' for more information."
+ (declare (obsolete calendar-frame-setup "23.1"))
(calendar-frame-setup 'one-frame prompt))
-(make-obsolete 'calendar-one-frame-setup 'calendar-frame-setup "23.1")
-
-
;;;###cal-autoload
(defun calendar-only-one-frame-setup (&optional prompt)
"Display calendar in a dedicated frame.
See `calendar-frame-setup' for more information."
+ (declare (obsolete calendar-frame-setup "23.1"))
(calendar-frame-setup 'calendar-only prompt))
-(make-obsolete 'calendar-only-one-frame-setup 'calendar-frame-setup "23.1")
-
-
;;;###cal-autoload
(defun calendar-two-frame-setup (&optional prompt)
"Display calendar and diary in separate, dedicated frames.
See `calendar-frame-setup' for more information."
+ (declare (obsolete calendar-frame-setup "23.1"))
(calendar-frame-setup 'two-frames prompt))
-(make-obsolete 'calendar-two-frame-setup 'calendar-frame-setup "23.1")
-
-
;; Undocumented and probably useless.
(defvar cal-x-load-hook nil
"Hook run on loading of the `cal-x' package.")
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index cdbf8d7aa86..96a5725ef69 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -921,6 +921,64 @@ styles."
calendar-american-date-display-form)
:group 'calendar)
+(defcustom calendar-american-month-header
+ '(propertize (format "%s %d" (calendar-month-name month) year)
+ 'font-lock-face 'font-lock-function-name-face)
+ "Default format for calendar month headings with the American date style.
+Normally you should not customize this, but `calender-month-header'."
+ :group 'calendar
+ :risky t
+ :type 'sexp
+ :version "24.3")
+
+(defcustom calendar-european-month-header
+ '(propertize (format "%s %d" (calendar-month-name month) year)
+ 'font-lock-face 'font-lock-function-name-face)
+ "Default format for calendar month headings with the European date style.
+Normally you should not customize this, but `calender-month-header'."
+ :group 'calendar
+ :risky t
+ :type 'sexp
+ :version "24.3")
+
+(defcustom calendar-iso-month-header
+ '(propertize (format "%d %s" year (calendar-month-name month))
+ 'font-lock-face 'font-lock-function-name-face)
+ "Default format for calendar month headings with the ISO date style.
+Normally you should not customize this, but `calender-month-header'."
+ :group 'calendar
+ :risky t
+ :type 'sexp
+ :version "24.3")
+
+(defcustom calendar-month-header
+ (cond ((eq calendar-date-style 'iso)
+ calendar-iso-month-header)
+ ((eq calendar-date-style 'european)
+ calendar-european-month-header)
+ (t calendar-american-month-header))
+ "Expression to evaluate to return the calendar month headings.
+When this expression is evaluated, the variables MONTH and YEAR are
+integers appropriate to the relevant month. The result is padded
+to the width of `calendar-month-digit-width'.
+
+For examples of three common styles, see `calendar-american-month-header',
+`calendar-european-month-header', and `calendar-iso-month-header'.
+
+Changing this variable without using customize has no effect on
+pre-existing calendar windows."
+ :group 'calendar
+ :initialize 'custom-initialize-default
+ :risky t
+ :set (lambda (sym val)
+ (set sym val)
+ (calendar-redraw))
+ :set-after '(calendar-date-style calendar-american-month-header
+ calendar-european-month-header
+ calendar-iso-month-header)
+ :type 'sexp
+ :version "24.3")
+
(defun calendar-set-date-style (style)
"Set the style of calendar and diary dates to STYLE (a symbol).
The valid styles are described in the documentation of `calendar-date-style'."
@@ -934,24 +992,25 @@ The valid styles are described in the documentation of `calendar-date-style'."
calendar-date-display-form
(symbol-value (intern-soft
(format "calendar-%s-date-display-form" style)))
+ calendar-month-header
+ (symbol-value (intern-soft (format "calendar-%s-month-header" style)))
diary-date-forms
(symbol-value (intern-soft (format "diary-%s-date-forms" style))))
+ (calendar-redraw)
(calendar-update-mode-line))
(defun european-calendar ()
"Set the interpretation and display of dates to the European style."
+ (declare (obsolete calendar-set-date-style "23.1"))
(interactive)
(calendar-set-date-style 'european))
-(make-obsolete 'european-calendar 'calendar-set-date-style "23.1")
-
(defun american-calendar ()
"Set the interpretation and display of dates to the American style."
+ (declare (obsolete calendar-set-date-style "23.1"))
(interactive)
(calendar-set-date-style 'american))
-(make-obsolete 'american-calendar 'calendar-set-date-style "23.1")
-
(define-obsolete-variable-alias 'holidays-in-diary-buffer
'diary-show-holidays-flag "23.1")
@@ -1087,14 +1146,13 @@ MON defaults to `displayed-month'. YR defaults to `displayed-year'."
"Execute a for loop.
Evaluate BODY with VAR bound to successive integers from INIT to FINAL,
inclusive. The standard macro `dotimes' is preferable in most cases."
- (declare (debug (symbolp "from" form "to" form "do" body))
+ (declare (obsolete "use `dotimes' or `while' instead." "23.1")
+ (debug (symbolp "from" form "to" form "do" body))
(indent defun))
`(let ((,var (1- ,init)))
(while (>= ,final (setq ,var (1+ ,var)))
,@body)))
-(make-obsolete 'calendar-for-loop "use `dotimes' or `while' instead." "23.1")
-
(defmacro calendar-sum (index initial condition expression)
"For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION."
(declare (debug (symbolp form form form)))
@@ -1463,9 +1521,8 @@ line."
(goto-char (point-min))
(calendar-move-to-column indent)
(insert
- (calendar-string-spread
- (list (format "%s %d" (calendar-month-name month) year))
- ?\s calendar-month-digit-width))
+ (calendar-string-spread (list calendar-month-header)
+ ?\s calendar-month-digit-width))
(calendar-ensure-newline)
(calendar-insert-at-column indent calendar-intermonth-header trunc)
;; Use the first two characters of each day to head the columns.
@@ -1626,8 +1683,9 @@ line."
(define-key map "td" 'cal-tex-cursor-day)
(define-key map "tw1" 'cal-tex-cursor-week)
(define-key map "tw2" 'cal-tex-cursor-week2)
- (define-key map "tw3" 'cal-tex-cursor-week-iso)
- (define-key map "tw4" 'cal-tex-cursor-week-monday)
+ (define-key map "tw3" 'cal-tex-cursor-week-iso) ; FIXME twi ?
+ (define-key map "tw4" 'cal-tex-cursor-week-monday) ; twm ?
+ (define-key map "twW" 'cal-tex-cursor-week2-summary)
(define-key map "tfd" 'cal-tex-cursor-filofax-daily)
(define-key map "tfw" 'cal-tex-cursor-filofax-2week)
(define-key map "tfW" 'cal-tex-cursor-filofax-week)
@@ -2222,9 +2280,12 @@ Negative years are interpreted as years BC; -1 being 1 BC, and so on."
(- mon2 mon1)))
(defvar calendar-font-lock-keywords
+ ;; Month and year. Not really needed now that calendar-month-header
+ ;; contains propertize, and not correct for non-american forms
+ ;; of that variable.
`((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
" -?[0-9]+")
- . font-lock-function-name-face) ; month and year
+ . font-lock-function-name-face)
(,(regexp-opt
(list (substring (aref calendar-day-name-array 6)
0 calendar-day-header-width)
@@ -2235,7 +2296,7 @@ Negative years are interpreted as years BC; -1 being 1 BC, and so on."
;; First two chars of each day are used in the calendar.
(,(regexp-opt (mapcar (lambda (x) (substring x 0 calendar-day-header-width))
calendar-day-name-array))
- . font-lock-reference-face))
+ . font-lock-constant-face))
"Default keywords to highlight in Calendar mode.")
(defun calendar-day-name (date &optional abbrev absolute)
@@ -2592,13 +2653,7 @@ If called by a mouse-event, pops up a menu with the result."
"---")
(calendar-string-spread (list str) ?- width)))))
-(defun calendar-version ()
- "Display the Calendar version."
- (interactive)
- (message "GNU Emacs %s" emacs-version))
-
-(make-obsolete 'calendar-version 'emacs-version "23.1")
-
+(define-obsolete-function-alias 'calendar-version 'emacs-version "23.1")
(run-hooks 'calendar-load-hook)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 4bce8ec0927..27c6f76581c 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -2400,10 +2400,10 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
(cons
(format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol)
(regexp-quote diary-sexp-entry-symbol))
- '(1 font-lock-reference-face))
+ '(1 font-lock-constant-face))
(cons
(format "^%s" (regexp-quote diary-nonmarking-symbol))
- 'font-lock-reference-face)
+ 'font-lock-constant-face)
(cons
(format "^%s?%s" (regexp-quote diary-nonmarking-symbol)
(regexp-opt (mapcar 'regexp-quote
@@ -2411,7 +2411,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
diary-islamic-entry-symbol
diary-bahai-entry-symbol))
t))
- '(1 font-lock-reference-face))
+ '(1 font-lock-constant-face))
'(diary-font-lock-sexps . font-lock-keyword-face)
;; Don't need to worry about space around "-" because the first
;; match takes care of that. It does mean the "-" itself may or
@@ -2482,7 +2482,7 @@ This depends on the calendar date style."
(defvar diary-fancy-font-lock-keywords
`((diary-fancy-date-matcher . diary-face)
("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
- ("^.*Yahrzeit.*$" . font-lock-reference-face)
+ ("^.*Yahrzeit.*$" . font-lock-constant-face)
("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
("^Day.*omer.*$" . font-lock-builtin-face)
("^Parashat.*$" . font-lock-comment-face)
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 7326aa530ad..27e7261263e 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -186,6 +186,7 @@ the URL."
This applies only if the UID is not empty! `%s' is replaced by
the UID."
:type 'string
+ :version "24.3"
:group 'icalendar)
(defcustom icalendar-import-format-status
@@ -931,8 +932,8 @@ Finto iCalendar file: ")
(set-buffer (find-file diary-filename))
(icalendar-export-region (point-min) (point-max) ical-filename)))
-(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
-(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file "22.1")
+(define-obsolete-function-alias 'icalendar-convert-diary-to-ical
+ 'icalendar-export-file "22.1")
(defvar icalendar--uid-count 0
"Auxiliary counter for creating unique ids.")
@@ -1881,8 +1882,8 @@ buffer `*icalendar-errors*'."
;; return nil, i.e. import did not work
nil)))
-(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
-(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer "22.1")
+(define-obsolete-function-alias 'icalendar-extract-ical-from-buffer
+ 'icalendar-import-buffer "22.1")
(defun icalendar--format-ical-event (event)
"Create a string representation of an iCalendar EVENT."
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 3151ce145de..7e7a737549f 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -321,6 +321,9 @@ display (non-nil means on)."
(force-mode-line-update)
(setq timeclock-mode-line-display on-p)))
+(define-obsolete-variable-alias 'timeclock-modeline-display
+ 'timeclock-mode-line-display "24.3")
+
;; This has to be here so that the function definition of
;; `timeclock-mode-line-display' is known to the "set" function.
(defcustom timeclock-mode-line-display nil
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index 925bde8a193..0aeeeebc562 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,3 +1,533 @@
+2012-10-07 David Engster <deng@randomsample.de>
+
+ * semantic/wisent/python.el (semantic-ctxt-current-function)
+ (semantic-ctxt-current-assignment): New overrides, simply
+ returning nil. The defaults do not work correctly and can send
+ the parser in an inifinite loop (bug#12458).
+
+2012-10-07 David Engster <deng@randomsample.de>
+
+ * semantic/ede-grammar.el (project-compile-target): Fix grammar
+ compilation after introduction of %provide statement.
+
+2012-10-07 David Engster <deng@randomsample.de>
+
+ * semantic.el (semantic-new-buffer-setup-functions): Remove setup
+ function for `f90-mode', since the parser only exists upstream.
+
+2012-10-06 Glenn Morris <rgm@gnu.org>
+
+ * semantic/complete.el (semantic-displayor-tooltip-max-tags): Doc fix.
+
+ * semantic/complete.el (semantic-displayor-tooltip-mode)
+ (semantic-displayor-tooltip-initial-max-tags)
+ (semantic-displayor-tooltip-max-tags): Add missing custom :version tags.
+ * ede/linux.el (project-linux): Add missing group :version tag.
+
+2012-10-06 Chong Yidong <cyd@gnu.org>
+
+ * semantic/bovine/grammar.el:
+ * semantic/wisent/grammar.el: Move from admin/grammars. Add
+ autoloads for bovine-grammar-mode and wisent-grammar-mode.
+
+2012-10-02 Chong Yidong <cyd@gnu.org>
+
+ * srecode.el, ede.el: Restore Version header.
+
+2012-10-01 Chong Yidong <cyd@gnu.org>
+
+ * semantic/bovine/c-by.el: Regenerate.
+ * semantic/bovine/make-by.el:
+ * semantic/bovine/scm-by.el:
+ * semantic/grammar-wy.el:
+ * semantic/wisent/javat-wy.el:
+ * semantic/wisent/js-wy.el:
+ * srecode/srt-wy.el:
+
+2012-10-01 Eric Ludlam <zappo@gnu.org>
+
+ * cedet.el (cedet-version, cedet-packages): Update.
+
+ * cedet-global.el (cedet-gnu-global-version-check): Support newer
+ versions that have extra (parens) in the version string.
+
+ * cedet-idutils.el (cedet-idutils-version-check): Make sure a
+ version number was found before calling inversion-check-version.
+
+ * data-debug.el (data-debug-insert-thing): Bind inhibit-read-only
+ while inserting the thing, then clear modified bit.
+ (data-debug-map): Suppress the keymap.
+ (data-debug-mode, data-debug-new-buffer): Make buffer read-only.
+ (data-debug-contract-current-line): Inhibit read-only, then clear
+ modified bit.
+
+ * ede.el (ede-buffer-belongs-to-project-p): Use ede-object-project
+ to allow use in more kinds of buffers.
+ (ede-project-forms-menu): Add `Default configuration' menu item.
+ (ede-configuration-forms-menu): New, for use in above.
+ (ede-project-configurations-set): New command used from menu.
+ (ede-java-classpath): New conveninece for Java support.
+ (ede-apply-object-keymap): Combine keybindings from the project
+ and the target, not just whatever is local to the buffer.
+ (ede-apply-target-options): Call fcn to apply project local
+ variables.
+ (ede-reset-all-buffers): Remove arg.
+ (ede, ede-rescan-toplevel): Callers changed.
+ (ede-new-target): Fix bug where you couldn't call this from Dired.
+ (ede-add-file): Replace assignment of ede-object with generic call
+ to re-init the buffer.
+ (ede-find-target): If ede-object is set, run short-cut code
+ instead of `or' shortcut.
+ (ede-project-buffers): Return buffers belonging to input project,
+ not any buffer belonging to any project.
+ (ede-system-include-path, ede-apply-project-local-variables)
+ (ede-set-project-local-variable): New functions.
+ (ede-make-project-local-variable): Apply to toplevel if none
+ specified.
+ (ede-set): Make it interactive.
+
+ * ede/auto.el (ede-project-autoload): New class.
+ (ede-do-dirmatch): New method.
+ (ede-project-dirmatch-p): New function.
+ (ede-project-root-directory): Call it.
+ (ede-dir-to-projectfile): Don't call project file function if we
+ didn't match the root.
+ (ede-project-root-directory): Don't call a project's root function
+ if the tool in question isn't installed.
+ (ede-dir-to-projectfile): Don't call project file function if we
+ didn't match the root.
+
+ * ede/autoconf-edit.el (autoconf-parameter-strip): Remove any
+ trailing `\' mid string, and replace with a space.
+ (autoconf-parameter-count): New function.
+ (autoconf-set-version): Use it.
+
+ * ede/base.el (ede-project): The :type of targets is now a list of
+ target base classes.
+
+ * ede/emacs.el (ede-emacs-load): Fix typo.
+
+ * ede/files.el (ede-flush-project-hash, ede-flush-directory-hash):
+ Protect against missing locator object.
+ (ede-get-locator-object): Protect against missing project.
+ (ede-flush-directory-hash): New command.
+ (ede-get-locator-object): Protect against missing project.
+
+ * ede/generic.el (ede-generic-config): Add configurable
+ `run-command' slot.
+ (project-compile-project, project-compile-target)
+ (project-debug-target, project-run-target): New methods.
+ (ede-generic-get-configuration): Specify the class to load.
+ (ede-generic-new-autoloader): Use ede-add-project-autoload.
+ (ede-enable-generic-projects): Rename projects so as to never
+ match the edeproject-* projects.
+
+ * ede/makefile-edit.el (makefile-macro-file-list): Case sensitive
+ searches. Protect against "SUBDIRS=$(subdirs)" infloop.
+
+ * ede/proj-elisp.el (ede-proj-tweak-autoconf)
+ (ede-proj-flush-autoconf): Disable local variables when loading
+ the autoconf lisp compile script.
+
+ * ede/proj.el (ede-proj-target-aux, -elisp, -elisp-autoloads)
+ (-scheme, -makefile-misc, ede-proj-target-makefile-program)
+ (-makefile-archive, -makefile-shared-object)
+ (ede-proj-target-makefile-info, -grammar): New autoloads.
+ (ede-proj-project): Inherit from eieio-persistent-read. Specify
+ extension and header line.
+ (ede-proj-load, ede-proj-save): Replace with impl using
+ eieio-persistent-read.
+
+ * ede/project-am.el (project-add-file): Use ede-target-parent
+ instead of loading the project file.
+
+ * semantic.el (semantic-version): Update.
+ (semantic-new-buffer-setup-functions): Add f90-mode, texinfo-mode.
+ (navigate-menu): Add menu item for Stickyfunc mode.
+
+ * semantic/analyze/debug.el
+ (semantic-analyzer-debug-insert-include-summary): Before
+ dereferencing tableinner, make sure it has a value.
+
+ * semantic/analyze/refs.el
+ (semantic-analyze-tag-references-default): When doing a lookup,
+ specify noerror.
+ (semantic--analyze-refs-full-lookup): Add optional noerror input
+ argument. Pass to to full-lookup-simple.
+ (semantic-analyze-refs-impl, semantic-analyze-refs-proto): Ignore
+ :typemodifiers during compare.
+
+ * semantic/bovine/c.el (semantic-lex-cpp-define): Specify limits
+ to looking back for comment chars.
+ (semantic--tag-similar-names-p, semantic--tag-similar-names-p-default)
+ (semantic--tag-attribute-similar-p): New.
+ (semantic-c-describe-environment): Handle list value of ede-object.
+ (semantic-lex-c-preprocessor-symbol-map-builtin): Add
+ __attribute_pure__.
+
+ * semantic/bovine/scm.el (semantic-format-tag-prototype): Add
+ parent and color argument. Pass them through.
+
+ * semantic/complete.el (semantic-collector-calculate-completions):
+ Search for more matches if new prefix is a substring of old one.
+ (semantic-complete-inline-project): New function.
+
+ * semantic/db-el.el (object-print): New method.
+
+ * semantic/db-file.el (semanticdb-load-database): Specify class.
+
+ * semantic/db-typecache.el
+ (semanticdb-abstract-table::semanticdb-typecache-find-method):
+ Allow proxied tags to be resolved during the search.
+ (semanticdb-typecache-complete-flush): Support missing or empty
+ pointmax slot, to allow for more database types.
+
+ * semantic/db.el (semanticdb-abstract-table): Add db-refs slot.
+ (object-print): Allow child classes to overwrite the display of
+ the (%d tags) extra string.
+ (semanticdb-project-database): Specify :type for table.
+ (semanticdb-create-table-for-file): Specify file-truename.
+ (semanticdb-synchronize, semanticdb-partial-synchronize): Restore
+ code that refreshes references to include files.
+
+ * semantic/decorate/include.el
+ (semantic-decoration-on-fileless-includes): New face.
+ (semantic-decoration-on-fileless-include-map)
+ (semantic-decoration-on-fileless-include-menu): New variables.
+ (semantic-decoration-on-includes-highlight-default): Support
+ includes that have a table, but are not associated with a file.
+ (semantic-decoration-fileless-include-describe)
+ (semantic-decoration-fileless-include-menu): New functions.
+ (semantic-decoration-all-include-summary): Add arrows to indicate
+ the file associated with an include name.
+
+ * semantic/find.el
+ (semantic-find-tags-by-scope-protection-default): Also filter on
+ package protection of the slot.
+
+ * semantic/java.el (semantic-java-expand-tag): If some type has a
+ fully qualified name, bust it up into one package and the type
+ with a short name.
+
+ * semantic/lex.el (define-lex-block-analyzer): Protect against
+ random extra close parenthesis.
+
+ * semantic/symref.el (semantic-symref-result-get-tags): Make sure
+ the cursor is on the matched name.
+
+ * semantic/symref/list.el (semantic-symref-results-mode-map):
+ Suppress keymap.
+
+ * semantic/tag-ls.el (semantic--tag-similar-names-p)
+ (semantic--tag-attribute-similar-p)
+ (semantic--tag-similar-types-p): New functions.
+ (semantic-tag-similar-ignorable-attributes): New variable.
+ (semantic-tag-protection-default): Add package concept to return
+ value.
+ (semantic-tag-package-protected-p): New function.
+ (semantic-tag-full-package): New overload method.
+ (semantic-tag-full-package-default): New default for above.
+ (semantic-tag-full-name-default): Look for the full package name.
+
+ * semantic/tag.el (semantic-create-tag-proxy)
+ (semantic-tag-set-proxy, semantic-tag-resolve-proxy): New.
+
+ * semantic/util.el (semantic-describe-buffer): Add
+ semantic-new-buffer-fcn-was-run.
+
+ * semantic/wisent/java-tags.el (semantic-get-local-variables): Add
+ `this' to the local variable context.
+ (semantic-analyze-split-name, semantic-analyze-unsplit-name): New.
+
+ * semantic/wisent/python.el (semantic-python-expand-tag): New
+ function.
+
+ * srecode/compile.el (srecode-compile-templates): Add "framework"
+ special variable support.
+ (srecode-compile-template-table): Support framework specifier.
+
+ * srecode/cpp.el (srecode-semantic-handle-:c)
+ (srecode-semantic-handle-:cpp): New functions.
+ (srecode-semantic-apply-tag-to-dict): Move from cpp-mode function
+ to c-mode function.
+ (srecode-c-apply-templates): Renamed from srecode-cpp-apply-templates.
+
+ * srecode/dictionary.el (initialize-instance): Remove bogus error
+ condition.
+ (srecode-create-section-dictionary): Remove unused function.
+
+ * srecode/java.el (srecode-semantic-handle-:java): Fix filename as
+ package variable. Add current_package variable.
+
+ * srecode/map.el (srecode-map-update-map): Specify the class.
+
+ * srecode/mode.el (srecode-minor-mode): Support the m3 menu.
+
+ * srecode/semantic.el (srecode-semantic-insert-tag): Support
+ system includes.
+
+ * srecode/srt-mode.el (srecode-font-lock-keywords): Update.
+
+ * srecode/table.el (srecode-template-table): Add :framework slot.
+ (srecode-dump): Dump it.
+ (srecode-mode-table): Add new modetables slot.
+ (srecode-get-mode-table): Find the mode, but also find all parent
+ modes, and merge the tables together in :tables from :modetables.
+ (srecode-make-mode-table): Init :modetables
+ (srecode-mode-table-find): Search in modetables.
+ (srecode-mode-table-new): Merge the differet files into the
+ modetables slot.
+
+2012-10-01 David Engster <deng@randomsample.de>
+
+ * ede.el (ede-apply-preprocessor-map): Check that
+ `semantic-lex-spp-macro-symbol-obarray' is non-nil.
+ (global-ede-mode): Fix call to `ede-reset-all-buffers'.
+
+ * ede/cpp-root.el (ede-preprocessor-map): Make sure we add the
+ lexical-table even when the table doesn't need to be refreshed.
+
+ * ede/dired.el (ede-dired-minor-mode): Use called-interactively-p.
+
+ * ede/pmake.el (ede-pmake-insert-variable-once): Wrap in
+ save-excursion.
+
+ * ede/proj-comp.el (ede-proj-makefile-insert-rules): Fix insertion
+ of phony rule.
+
+ * ede/proj-elisp.el (ede-proj-target-elisp): Remove
+ ede-emacs-preload-compiler.
+ (ede-proj-makefile-insert-rules, ede-proj-makefile-dependencies):
+ New methods.
+ (ede-emacs-compiler): Add 'require' macro to variables and pattern
+ rule. Add .elc object extension.
+ (ede-proj-elisp-packages-to-loadpath): Allow longer relative names.
+ (ede-proj-makefile-insert-variables): Do not insert preload items.
+ (ede-proj-target-elisp-autoloads): Don't depend on cedet-autogen.
+
+ * ede/util.el (ede-make-buffer-writable):
+ * semantic/debug.el (semantic-debug-mode): Set buffer-read-only
+ instead of calling toggle-read-only.
+
+ * semantic.el (semantic-fetch-tags): Use progress reporter only
+ when called interactively.
+ (semantic-submode-list): Add debugging modes.
+ (semantic-mode): Remove Semantic from after-change-functions.
+ Delete the cache, call semantic--tag-unlink-cache-from-buffer, and
+ set semantic-new-buffer-fcn-was-run to nil.
+
+ * semantic/analyze/fcn.el (semantic-analyze-tag-prototype-p)
+ (semantic-analyze-tag-prototype-p-default): Remove.
+ (semantic-analyze-type, semantic-analyze-dereference-metatype-1):
+ Use semantic-tag-prototype-p.
+
+ * semantic/bovine/c.el (semantic-c-reset-preprocessor-symbol-map):
+ Ensure semantic-mode is on before getting preprocessor symbols.
+ (semantic-c-skip-conditional-section): Use c-scan-conditionals.
+ (semantic-c-convert-spp-value-to-hideif-value)
+ (semantic-c-evaluate-symbol-for-hideif, semantic-c-hideif-lookup)
+ (semantic-c-hideif-defined): Revive hideif code from CEDET trunk.
+ (semantic-lex-c-if, semantic-c-do-lex-ifdef): Revert changes for
+ regular expression parsing.
+ (semantic-cpp-lexer): Add semantic-lex-c-ifdef.
+ (semantic-expand-c-tag): Check if tag is non-nil before adding it
+ to return list
+ (semantic-expand-c-extern-C, semantic-expand-c-complex-type): New
+ functions, copied from semantic-expand-c-tag.
+ (semantic-find-tags-included): New override which also searches
+ for include tags inside of namespaces.
+ (semantic-c-dereference-typedef): Use semantic-tag-prototype-p.
+ (semanticdb-find-table-for-include): New override.
+
+ * semantic/bovine/el.el: Remove emacs-lisp-mode-hook.
+
+ * semantic/complete.el (semantic-complete-post-command-hook): Exit
+ completion when user has deleted all characters from the prefix.
+ (semantic-displayor-focus-request): Return to previous window when
+ focussing tags.
+
+ * semantic/db-el.el (semanticdb-normalize-one-tag): Make obsolete.
+ (semanticdb-elisp-sym->tag): Use help-function-arglist instead.
+
+ * semantic/db-file.el (semanticdb-create-database): Use
+ semantic-tag-version instead of just semantic-version as the
+ initializer for the :semantic-tag-version slot.
+
+ * semantic/db-find.el (semanticdb-find-tags-by-class-method):
+ Delegate `include' to semantic-find-tags-included, which by
+ default will just call semantic-find-tags-by-class.
+
+ * semantic/db.el (semanticdb-refresh-table): Do not print warnings
+ when calling semantic-find-file-noselect. This avoids the "file
+ is write protected" messages when parsing system header files,
+ which might easily be mistaken to mean the currently loaded file.
+ (semanticdb-save-current-db, semanticdb-save-all-db): Only emit
+ message when running interactively.
+
+ * semantic/decorate/mode.el (semantic-decoration-mode): Activate
+ decoration of includes by default.
+
+ * semantic/doc.el (semantic-doc-snarf-comment-for-tag): Remove
+ comment delimiter at the end of the text.
+
+ * semantic/ede-grammar.el (semantic-ede-proj-target-grammar):
+ Change aux- and pre-load-packages.
+ (ede-proj-makefile-dependencies): Update pattern rule so that
+ resulting parsers are also byte-compiled.
+ (semantic-ede-grammar-compiler-bovine)
+ (semantic-ede-source-grammar-wisent): Remove .elc from gargage
+ pattern, since this is already covered by the elisp compiler.
+ (project-compile-target): Add compatibility code for Emacs 23,
+ which does not have `byte-recompile-file'.
+ (ede-proj-makefile-insert-rules): Add target specific EMACSFLAGS
+ to raise max-specpdl-size and max-lisp-eval-depth.
+
+ * semantic/find.el (semantic-find-tags-included): Make
+ overridable.
+
+ * semantic/fw.el (semantic-alias-obsolete)
+ (semantic-varalias-obsolete): Use byte-compile-warn.
+ (semantic-find-file-noselect): Disable font lock by calling
+ global-font-lock-mode.
+
+ * semantic/grammar.el (semantic-grammar-create-package): Fix
+ message.
+ (semantic-grammar-batch-build-one-package): When generating
+ parsers in batch-mode, ignore version control and make sure we do
+ not use cached versions.
+
+ * semantic/ia.el (semantic-ia-complete-symbol-menu): Bring back.
+
+ * semantic/lex-spp.el (semantic-lex-spp-symbol-merge): New fun.
+ (semantic-lex-spp-token-macro-to-macro-stream): Use it.
+ (semantic-lex-spp-lex-text-string): Instead of only setting the
+ lexer, call the major mode's setup function.
+
+ * semantic/scope.el (semantic-analyze-scoped-types-default): Use
+ semantic-tag-prototype-p.
+ (semantic-analyze-scope-nested-tags-default): Make sure we don't
+ return tags we already have in scopetypes.
+
+ * semantic/symref/filter.el
+ (semantic-symref-test-count-hits-in-tag): Restore.
+
+ * semantic/wisent/comp.el (wisent-BITS-PER-WORD): Use
+ most-positive-fixnum if available.
+
+ * semantic/wisent/javascript.el (semantic-tag-protection)
+ (semantic-analyze-scope-calculate-access)
+ (semantic-ctxt-current-symbol): New overrides.
+
+ * semantic/wisent/python.el (wisent-python-lex-beginning-of-line):
+ Rewrite to fix byte-compiler warning.
+
+2012-10-01 Robert Jarzmik <robert.jarzmik@free.fr>
+
+ * ede/linux.el (project-linux): New group.
+ (project-linux-compile-target-command)
+ (project-linux-compile-project-command): New options.
+ (project-compile-project, project-compiler-target): New methods.
+
+ * inversion.el (inversion-decoders): New regexps for SXEmacs.
+ (inversion-package-version): More verbose error message.
+ (inversion-<): Deal with new special cases.
+ (inversion-require-emacs): New argument sxemacs-ver; use it.
+
+2012-10-01 Nelson Ferreira <nelson.ferreira@ieee.org>
+
+ * ede/emacs.el (ede-emacs-version): Detect SXEmacs.
+
+2012-10-01 William Xu <william.xwl@gmail.com>
+
+ * semantic/bovine/gcc.el (semantic-gcc-query): Returns status when
+ there is an error.
+ (semantic-gcc-setup): If the first attempt at calling cpp fails,
+ try straight GCC.
+
+2012-10-01 Jan Moringen <jan.moringen@uni-bielefeld.de>
+
+ * semantic/idle.el
+ (semantic-idle-breadcrumbs--display-in-header-line): Escape
+ %-characters to avoid erroneous expansion in header line.
+ (semantic-idle-breadcrumbs--display-in-mode-line): Likewise.
+
+ * semantic/wisent/python.el (wisent-python-reconstitute-function-tag)
+ (wisent-python-reconstitute-class-tag, semantic-python-special-p)
+ (semantic-python-private-p, semantic-python-instance-variable-p)
+ (semantic-python-docstring-p): New functions.
+
+ * srecode/find.el (srecode-user-template-p): New function.
+ (srecode-all-template-hash): Accept new optional argument
+ predicate; return only templates matching the predicate.
+ (srecode-read-template-name): Only retrieve templates matching
+ srecode-user-template-p.
+
+ * srecode/insert.el (srecode-insert-show-error-report)
+ (srecode-insert-report-error): New functions.
+ (srecode-insert-variable-secondname-handler)
+ (srecode-insert-method, srecode-insert-ask-default)
+ (srecode-insert-variable-secondname-handler)
+ (srecode-insert-subtemplate, srecode-insert-method-helper)
+ (srecode-insert-include-lookup): Use them.
+
+2012-10-01 Thomas Bach <thbach@students.uni-mainz.de>
+
+ * semantic/wisent/python.el
+ (semantic-python-get-system-include-path): Add Python3k support.
+
+2012-10-01 Alexander Haeckel <_@_> (tiny change)
+
+ * srecode/getset.el (srecode-query-for-field): Return the first
+ tag found by name from all children tags.
+
+2012-10-01 Dale Sedivec <dale@codefu.org>
+
+ * semantic/wisent/python.el (wisent-python-string-start-re)
+ (wisent-python-string-re, wisent-python-forward-string)
+ (wisent-python-forward-line,wisent-python-lex-string): New
+ variables.
+ (wisent-python-forward-balanced-expression): New function.
+
+2012-10-01 Pete Beardmore <elbeardmorez@msn.com>
+
+ * semantic/complete.el (semantic-collector-calculate-completions):
+ Search for additional matches if new prefix is a substring of the
+ old prefix.
+ (semantic-displayor-next-action): Immediately show more
+ completions after user presses TAB the first time.
+ (semantic-displayor-tooltip-mode)
+ (semantic-displayor-tooltip-initial-max-tags)
+ (semantic-displayor-tooltip-max-tags): New defcustoms.
+ (semantic-displayor-tooltip): Use new variables as initforms. Use
+ new slot `mode' instead of `force-show'. Rename `max-tags' to
+ `max-tags-initial'.
+ (semantic-displayor-show-request): Display completions according
+ to new modes, and make variable names clearer.
+ (semantic-displayor-tooltip::semantic-displayor-scroll-request):
+ Use new max-tags-initial slot.
+
+ * semantic/idle.el (semantic-idle-local-symbol-highlight): Make
+ sure there actually is a tag at point.
+ (semantic-idle-completion-list-default): Report errors as messages
+ if semantic-idle-scheduler-verbose-flag is non-nil.
+
+2012-10-01 Richard Kim <emacs18@gmail.com>
+
+ * semantic/db-global.el (semanticdb-enable-gnu-global-databases):
+ Add optional NOERROR argument.
+
+2012-10-01 Alex Ott <alexott@gmail.com>
+
+ * semantic/idle.el (semantic-idle-scheduler-enabled-p): Fix
+ file-checking.
+
+2012-10-01 Darren Hoo <darren.hoo@gmail.com> (tiny change)
+
+ * semantic/db-find.el (semanticdb-find-default-throttle): Make
+ buffer-local.
+ (semanticdb-strip-find-results): Check for existing :filename
+ attribute, so that file information from GNU Global is not lost.
+
2012-08-07 Andreas Schwab <schwab@linux-m68k.org>
* ede/base.el (ede-with-projectfile): Use backquote forms.
diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el
index ae384b005f3..fe954a07712 100644
--- a/lisp/cedet/cedet-cscope.el
+++ b/lisp/cedet/cedet-cscope.el
@@ -28,7 +28,7 @@
(declare-function inversion-check-version "inversion")
-(defvar cedet-cscope-min-version "16.0"
+(defvar cedet-cscope-min-version "15.7"
"Minimum version of CScope required.")
(defcustom cedet-cscope-command "cscope"
diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el
index a6e94dcd5d9..d953d8c0980 100644
--- a/lisp/cedet/cedet-global.el
+++ b/lisp/cedet/cedet-global.el
@@ -147,7 +147,7 @@ return nil."
nil)
(with-current-buffer b
(goto-char (point-min))
- (re-search-forward "GNU GLOBAL \\([0-9.]+\\)" nil t)
+ (re-search-forward "(?GNU GLOBAL)? \\([0-9.]+\\)" nil t)
(setq rev (match-string 1))
(if (inversion-check-version rev nil cedet-global-min-version)
(if noerror
diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el
index b35035a58b6..db9f3c08c7e 100644
--- a/lisp/cedet/cedet-idutils.el
+++ b/lisp/cedet/cedet-idutils.el
@@ -179,8 +179,9 @@ return nil."
nil)
(with-current-buffer b
(goto-char (point-min))
- (re-search-forward "fnid - \\([0-9.]+\\)" nil t)
- (setq rev (match-string 1))
+ (if (re-search-forward "fnid - \\([0-9.]+\\)" nil t)
+ (setq rev (match-string 1))
+ (setq rev "0"))
(if (inversion-check-version rev nil cedet-idutils-min-version)
(if noerror
nil
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
index 6da3b5de547..5c21e4ab538 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -35,19 +35,22 @@
(declare-function inversion-find-version "inversion")
-(defconst cedet-version "1.0"
+(defconst cedet-version "1.1"
"Current version of CEDET.")
(defconst cedet-packages
`(
- ;;PACKAGE MIN-VERSION
- (cedet ,cedet-version)
- (eieio "1.3")
- (semantic "2.0")
- (srecode "1.0")
- (ede "1.0")
- (speedbar "1.0"))
- "Table of CEDET packages installed.")
+ ;;PACKAGE MIN-VERSION INSTALLDIR DOCDIR
+ (cedet ,cedet-version "common" "common" )
+ (eieio "1.4" nil "eieio" )
+ (semantic "2.1" nil "semantic/doc")
+ (srecode "1.1" nil "srecode" )
+ (ede "1.1" nil "ede" )
+ (speedbar "1.0.4" nil "speedbar" )
+ (cogre "1.1" nil "cogre" )
+ (cedet-contrib "1.1" "contrib" nil )
+ )
+ "Table of CEDET packages to install.")
(defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu")
(let ((map (make-sparse-keymap "CEDET menu")))
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index 03dca6ceccc..19d0e98aa00 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -821,20 +821,30 @@ FCN is a function that will display stuff in the data debug buffer."
PREBUTTONTEXT is some text to insert between prefix and the thing
that is not included in the indentation calculation of any children.
If PARENT is non-nil, it is somehow related as a parent to thing."
- (when (catch 'done
- (dolist (test data-debug-thing-alist)
- (when (funcall (car test) thing)
- (condition-case nil
- (funcall (cdr test) thing prefix prebuttontext parent)
- (error
- (funcall (cdr test) thing prefix prebuttontext)))
- (throw 'done nil))
- )
- nil)
- (data-debug-insert-simple-thing (format "%S" thing)
- prefix
- prebuttontext
- 'bold)))
+ (let ((inhibit-read-only t))
+ (when (catch 'done
+ (dolist (test data-debug-thing-alist)
+ (when (funcall (car test) thing)
+ (condition-case nil
+ (progn
+ (funcall (cdr test) thing prefix prebuttontext parent)
+ (throw 'done nil))
+ (error
+ (condition-case nil
+ (progn
+ (funcall (cdr test) thing prefix prebuttontext)
+ (throw 'done nil))
+ (error nil))))
+ ;; Only throw the 'done if no error was caught.
+ ;; If an error was caught, skip this predicate as being
+ ;; unsuccessful, and move on.
+ ))
+ nil)
+ (data-debug-insert-simple-thing (format "%S" thing)
+ prefix
+ prebuttontext
+ 'bold)))
+ (set-buffer-modified-p nil))
;;; MAJOR MODE
;;
@@ -861,6 +871,7 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
(defvar data-debug-map
(let ((km (make-sparse-keymap)))
+ (suppress-keymap km)
(define-key km [mouse-2] 'data-debug-expand-or-contract-mouse)
(define-key km " " 'data-debug-expand-or-contract)
(define-key km "\C-m" 'data-debug-expand-or-contract)
@@ -885,7 +896,8 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
(setq major-mode 'data-debug-mode
mode-name "DATA-DEBUG"
comment-start ";;"
- comment-end "")
+ comment-end ""
+ buffer-read-only t)
(set (make-local-variable 'comment-start-skip)
"\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
(set-syntax-table data-debug-mode-syntax-table)
@@ -902,6 +914,7 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
(let ((b (get-buffer-create name)))
(pop-to-buffer b)
(set-buffer b)
+ (setq buffer-read-only nil) ; disable read-only
(erase-buffer)
(data-debug-mode)
b))
@@ -964,7 +977,8 @@ Do nothing if already expanded."
(when (or (not (data-debug-line-expandable-p))
(not (data-debug-current-line-expanded-p)))
;; If the next line is the same or less indentation, expand.
- (let ((fcn (get-text-property (point) 'ddebug-function)))
+ (let ((fcn (get-text-property (point) 'ddebug-function))
+ (inhibit-read-only t))
(when fcn
(funcall fcn (point))
(beginning-of-line)
@@ -977,6 +991,7 @@ Do nothing if already contracted."
;; Don't contract if the current line is not expandable.
(get-text-property (point) 'ddebug-function))
(let ((ti (current-indentation))
+ (inhibit-read-only t)
)
;; If next indentation is larger, collapse.
(end-of-line)
@@ -995,7 +1010,8 @@ Do nothing if already contracted."
(error (setq end (point-max))))
(delete-region start end)
(forward-char -1)
- (beginning-of-line)))))
+ (beginning-of-line))))
+ (set-buffer-modified-p nil))
(defun data-debug-expand-or-contract ()
"Expand or contract anything at the current point."
@@ -1080,7 +1096,4 @@ If the result is a list or vector, then use the data debugger to display it."
(provide 'data-debug)
-(if (featurep 'eieio)
- (require 'eieio-datadebug))
-
;;; data-debug.el ends here
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index cc8b6f53242..22fe362d5d9 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -4,7 +4,7 @@
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
-;; Version: 1.0pre7
+;; Version: 1.0
;; This file is part of GNU Emacs.
@@ -194,7 +194,6 @@ Argument LIST-O-O is the list of objects to choose from."
(define-key pmap "t" 'ede-new-target)
(define-key pmap "g" 'ede-rescan-toplevel)
(define-key pmap "s" 'ede-speedbar)
- (define-key pmap "l" 'ede-load-project-file)
(define-key pmap "f" 'ede-find-file)
(define-key pmap "C" 'ede-compile-project)
(define-key pmap "c" 'ede-compile-target)
@@ -252,7 +251,7 @@ Argument LIST-O-O is the list of objects to choose from."
(defun ede-buffer-belongs-to-project-p ()
"Return non-nil if this buffer belongs to at least one project."
(if (or (null ede-object) (consp ede-object)) nil
- (obj-of-class-p ede-object ede-project)))
+ (obj-of-class-p ede-object-project ede-project)))
(defun ede-menu-obj-of-class-p (class)
"Return non-nil if some member of `ede-object' is a child of CLASS."
@@ -343,6 +342,7 @@ Argument MENU-DEF is the menu definition to use."
(append
'( [ "Add Target" ede-new-target (ede-current-project) ]
[ "Remove Target" ede-delete-target ede-object ]
+ ( "Default configuration" :filter ede-configuration-forms-menu )
"-")
menu
))
@@ -350,6 +350,41 @@ Argument MENU-DEF is the menu definition to use."
menu)
)))))
+(defun ede-configuration-forms-menu (menu-def)
+ "Create a submenu for selecting the default configuration for this project.
+The current default is in the current object's CONFIGURATION-DEFAULT slot.
+All possible configurations are in CONFIGURATIONS.
+Argument MENU-DEF specifies the menu being created."
+ (easy-menu-filter-return
+ (easy-menu-create-menu
+ "Configurations"
+ (let* ((obj (ede-current-project))
+ (conf (when obj (oref obj configurations)))
+ (cdef (when obj (oref obj configuration-default)))
+ (menu nil))
+ (dolist (C conf)
+ (setq menu (cons (vector C (list 'ede-project-configurations-set C)
+ :style 'toggle
+ :selected (string= C cdef))
+ menu))
+ )
+ (nreverse menu)))))
+
+(defun ede-project-configurations-set (newconfig)
+ "Set the current project's current configuration to NEWCONFIG.
+This function is designed to be used by `ede-configuration-forms-menu'
+but can also be used interactively."
+ (interactive
+ (list (let* ((proj (ede-current-project))
+ (configs (oref proj configurations)))
+ (completing-read "New configuration: "
+ configs nil t
+ (oref proj configuration-default)))))
+ (oset (ede-current-project) configuration-default newconfig)
+ (message "%s will now build in %s mode."
+ (object-name (ede-current-project))
+ newconfig))
+
(defun ede-customize-forms-menu (menu-def)
"Create a menu of the project, and targets that can be customized.
Argument MENU-DEF is the definition of the current menu."
@@ -377,9 +412,14 @@ Argument MENU-DEF is the definition of the current menu."
"Add target specific keybindings into the local map.
Optional argument DEFAULT indicates if this should be set to the default
version of the keymap."
- (let ((object (or ede-object ede-selected-object)))
+ (let ((object (or ede-object ede-selected-object))
+ (proj ede-object-project))
(condition-case nil
(let ((keys (ede-object-keybindings object)))
+ ;; Add keys for the project to whatever is in the current object
+ ;; so long as it isn't the same.
+ (when (not (eq object proj))
+ (setq keys (append keys (ede-object-keybindings proj))))
(while keys
(local-set-key (concat "\C-c." (car (car keys)))
(cdr (car keys)))
@@ -415,8 +455,8 @@ If optional argument CURRENT is non-nil, return sub-menu code."
(defun ede-apply-target-options ()
"Apply options to the current buffer for the active project/target."
- (if (ede-current-project)
- (ede-set-project-variables (ede-current-project)))
+ (ede-apply-project-local-variables)
+ ;; Apply keymaps and preprocessor symbols.
(ede-apply-object-keymap)
(ede-apply-preprocessor-map)
)
@@ -493,9 +533,9 @@ Sets buffer local variables for EDE."
(ede-apply-target-options)))))
-(defun ede-reset-all-buffers (onoff)
- "Reset all the buffers due to change in EDE.
-ONOFF indicates enabling or disabling the mode."
+(defun ede-reset-all-buffers ()
+ "Reset all the buffers due to change in EDE."
+ (interactive)
(let ((b (buffer-list)))
(while b
(when (buffer-file-name (car b))
@@ -533,7 +573,7 @@ an EDE controlled project."
(add-hook 'dired-mode-hook 'ede-turn-on-hook)
(add-hook 'kill-emacs-hook 'ede-save-cache)
(ede-load-cache)
- (ede-reset-all-buffers 1))
+ (ede-reset-all-buffers))
;; Turn off global-ede-mode
(define-key cedet-menu-map [cedet-menu-separator] nil)
(remove-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p)
@@ -543,7 +583,7 @@ an EDE controlled project."
(remove-hook 'dired-mode-hook 'ede-turn-on-hook)
(remove-hook 'kill-emacs-hook 'ede-save-cache)
(ede-save-cache)
- (ede-reset-all-buffers -1)))
+ (ede-reset-all-buffers)))
(defvar ede-ignored-file-alist
'( "\\.cvsignore$"
@@ -632,8 +672,7 @@ Otherwise, create a new project for DIR."
;; the user chooses.
(if (ede-check-project-directory dir)
(progn
- ;; If there is a project in DIR, load it, otherwise do
- ;; nothing.
+ ;; Load the project in DIR, or make one.
(ede-load-project-file dir)
;; Check if we loaded anything on the previous line.
@@ -643,7 +682,7 @@ Otherwise, create a new project for DIR."
;; buffers may also be referring to this project.
;; Resetting all the buffers will get them to also point
;; at this new open project.
- (ede-reset-all-buffers 1)
+ (ede-reset-all-buffers)
;; ELSE
;; There was no project, so switch to `ede-new' which is how
@@ -785,7 +824,7 @@ ARGS are additional arguments to pass to method SYM."
(ede-deep-rescan t))
(project-rescan (ede-load-project-file toppath))
- (ede-reset-all-buffers 1))))
+ (ede-reset-all-buffers))))
(defun ede-new-target (&rest args)
"Create a new target specific to this type of project file.
@@ -794,9 +833,11 @@ Typically you can specify NAME, target TYPE, and AUTOADD, where AUTOADD is
a string \"y\" or \"n\", which answers the y/n question done interactively."
(interactive)
(apply 'project-new-target (ede-current-project) args)
- (setq ede-object nil)
- (setq ede-object (ede-buffer-object (current-buffer)))
- (ede-apply-target-options))
+ (when (and buffer-file-name
+ (not (file-directory-p buffer-file-name)))
+ (setq ede-object nil)
+ (setq ede-object (ede-buffer-object (current-buffer)))
+ (ede-apply-target-options)))
(defun ede-new-target-custom ()
"Create a new target specific to this type of project file."
@@ -837,7 +878,10 @@ a string \"y\" or \"n\", which answers the y/n question done interactively."
(project-add-file target (buffer-file-name))
(setq ede-object nil)
- (setq ede-object (ede-buffer-object (current-buffer)))
+
+ ;; Setup buffer local variables.
+ (ede-initialize-state-current-buffer)
+
(when (not ede-object)
(error "Can't add %s to target %s: Wrong file type"
(file-name-nondirectory (buffer-file-name))
@@ -1188,16 +1232,24 @@ could become slow in time."
(defmethod ede-find-target ((proj ede-project) buffer)
"Fetch the target in PROJ belonging to BUFFER or nil."
(with-current-buffer buffer
- (or ede-object
- (if (ede-buffer-mine proj buffer)
- proj
- (let ((targets (oref proj targets))
- (f nil))
- (while targets
- (if (ede-buffer-mine (car targets) buffer)
- (setq f (cons (car targets) f)))
- (setq targets (cdr targets)))
- f)))))
+
+ ;; We can do a short-ut if ede-object local variable is set.
+ (if ede-object
+ ;; If the buffer is already loaded with good EDE stuff, make sure the
+ ;; saved project is the project we're looking for.
+ (when (and ede-object-project (eq proj ede-object-project)) ede-object)
+
+ ;; If the variable wasn't set, then we are probably initializing the buffer.
+ ;; In that case, search the file system.
+ (if (ede-buffer-mine proj buffer)
+ proj
+ (let ((targets (oref proj targets))
+ (f nil))
+ (while targets
+ (if (ede-buffer-mine (car targets) buffer)
+ (setq f (cons (car targets) f)))
+ (setq targets (cdr targets)))
+ f)))))
(defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source)
"Return non-nil if object THIS is in BUFFER to a SOURCE list.
@@ -1225,8 +1277,8 @@ This includes buffers controlled by a specific target of PROJECT."
(pl nil))
(while bl
(with-current-buffer (car bl)
- (if (ede-buffer-belongs-to-project-p)
- (setq pl (cons (car bl) pl))))
+ (when (and ede-object (ede-find-target project (car bl)))
+ (setq pl (cons (car bl) pl))))
(setq bl (cdr bl)))
pl))
@@ -1301,9 +1353,28 @@ Return the first non-nil value returned by PROC."
;;
;; These items are needed by ede-cpp-root to add better support for
;; configuring items for Semantic.
+
+;; Generic paths
+(defmethod ede-system-include-path ((this ede-project))
+ "Get the system include path used by project THIS."
+ nil)
+
+(defmethod ede-system-include-path ((this ede-target))
+ "Get the system include path used by project THIS."
+ nil)
+
+(defmethod ede-source-paths ((this ede-project) mode)
+ "Get the base to all source trees in the current project for MODE.
+For example, <root>/src for sources of c/c++, Java, etc,
+and <root>/doc for doc sources."
+ nil)
+
+;; C/C++
(defun ede-apply-preprocessor-map ()
"Apply preprocessor tables onto the current buffer."
- (when (and ede-object (boundp 'semantic-lex-spp-macro-symbol-obarray))
+ (when (and ede-object
+ (boundp 'semantic-lex-spp-macro-symbol-obarray)
+ semantic-lex-spp-macro-symbol-obarray)
(let* ((objs ede-object)
(map (ede-preprocessor-map (if (consp objs)
(car objs)
@@ -1324,27 +1395,66 @@ Return the first non-nil value returned by PROC."
"Get the pre-processor map for project THIS."
nil)
-(defmethod ede-system-include-path ((this ede-target))
- "Get the system include path used by project THIS."
- nil)
-
(defmethod ede-preprocessor-map ((this ede-target))
"Get the pre-processor map for project THIS."
nil)
+;; Java
+(defmethod ede-java-classpath ((this ede-project))
+ "Return the classpath for this project."
+ ;; @TODO - Can JDEE add something here?
+ nil)
+
;;; Project-local variables
-;;
+
+(defun ede-set (variable value &optional proj)
+ "Set the project local VARIABLE to VALUE.
+If VARIABLE is not project local, just use set. Optional argument PROJ
+is the project to use, instead of `ede-current-project'."
+ (interactive "sVariable: \nxExpression: ")
+ (let ((p (or proj (ede-toplevel)))
+ a)
+ ;; Make the change
+ (ede-make-project-local-variable variable p)
+ (ede-set-project-local-variable variable value p)
+ (ede-commit-local-variables p)
+
+ ;; This is a heavy hammer, but will apply variables properly
+ ;; based on stacking between the toplevel and child projects.
+ (ede-map-buffers 'ede-apply-project-local-variables)
+
+ value))
+
+(defun ede-apply-project-local-variables (&optional buffer)
+ "Apply project local variables to the current buffer."
+ (with-current-buffer (or buffer (current-buffer))
+ ;; Always apply toplevel variables.
+ (if (not (eq (ede-current-project) (ede-toplevel)))
+ (ede-set-project-variables (ede-toplevel)))
+ ;; Next apply more local project's variables.
+ (if (ede-current-project)
+ (ede-set-project-variables (ede-current-project)))
+ ))
+
(defun ede-make-project-local-variable (variable &optional project)
"Make VARIABLE project-local to PROJECT."
- (if (not project) (setq project (ede-current-project)))
+ (if (not project) (setq project (ede-toplevel)))
(if (assoc variable (oref project local-variables))
nil
(oset project local-variables (cons (list variable)
- (oref project local-variables)))
- (dolist (b (ede-project-buffers project))
- (with-current-buffer b
- (make-local-variable variable)))))
+ (oref project local-variables)))))
+
+(defun ede-set-project-local-variable (variable value &optional project)
+ "Set VARIABLE to VALUE for PROJECT.
+If PROJ isn't specified, use the current project.
+This function only assigns the value within the project structure.
+It does not apply the value to buffers."
+ (if (not project) (setq project (ede-toplevel)))
+ (let ((va (assoc variable (oref project local-variables))))
+ (unless va
+ (error "Cannot set project variable until it is added with `ede-make-project-local-variable'"))
+ (setcdr va value)))
(defmethod ede-set-project-variables ((project ede-project) &optional buffer)
"Set variables local to PROJECT in BUFFER."
@@ -1352,25 +1462,8 @@ Return the first non-nil value returned by PROC."
(with-current-buffer buffer
(dolist (v (oref project local-variables))
(make-local-variable (car v))
- ;; set its value here?
(set (car v) (cdr v)))))
-(defun ede-set (variable value &optional proj)
- "Set the project local VARIABLE to VALUE.
-If VARIABLE is not project local, just use set. Optional argument PROJ
-is the project to use, instead of `ede-current-project'."
- (let ((p (or proj (ede-current-project)))
- a)
- (if (and p (setq a (assoc variable (oref p local-variables))))
- (progn
- (setcdr a value)
- (dolist (b (ede-project-buffers p))
- (with-current-buffer b
- (set variable value))))
- (set variable value))
- (ede-commit-local-variables p))
- value)
-
(defmethod ede-commit-local-variables ((proj ede-project))
"Commit change to local variables in PROJ."
nil)
diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el
index a5ea8178858..152f8130ad7 100644
--- a/lisp/cedet/ede/auto.el
+++ b/lisp/cedet/ede/auto.el
@@ -34,6 +34,84 @@
(declare-function ede-directory-safe-p "ede")
(declare-function ede-add-project-to-global-list "ede")
+(defclass ede-project-autoload-dirmatch ()
+ ((fromconfig :initarg :fromconfig
+ :initform nil
+ :documentation
+ "A config file within which the match pattern lives.")
+ (configregex :initarg :configregex
+ :initform nil
+ :documentation
+ "A regexp to identify the dirmatch pattern.")
+ (configregexidx :initarg :configregexidx
+ :initform nil
+ :documentation
+ "An index into the match-data of `configregex'.")
+ (configdatastash :initform nil
+ :documentation
+ "Save discovered match string.")
+ )
+ "Support complex matches for projects that live in named directories.
+For most cases, a simple string is sufficient. If, however, a project
+location is varied dependent on other complex criteria, this class
+can be used to define that match without loading the specific project
+into memory.")
+
+(defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
+ "Return non-nil if the tool DIRMATCH might match is installed on the system."
+ (let ((fc (oref dirmatch fromconfig)))
+
+ (cond
+ ;; If the thing to match is stored in a config file.
+ ((stringp fc)
+ (file-exists-p fc))
+
+ ;; Add new types of dirmatches here.
+
+ ;; Error for weird stuff
+ (t (error "Unknown dirmatch type.")))))
+
+
+(defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
+ "Does DIRMATCH match the filename FILE."
+ (let ((fc (oref dirmatch fromconfig)))
+
+ (cond
+ ;; If the thing to match is stored in a config file.
+ ((stringp fc)
+ (when (file-exists-p fc)
+ (let ((matchstring (oref dirmatch configdatastash)))
+ (unless matchstring
+ (save-current-buffer
+ (let* ((buff (get-file-buffer fc))
+ (readbuff
+ (let ((find-file-hook nil)) ;; Disable ede from recursing
+ (find-file-noselect fc))))
+ (set-buffer readbuff)
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward (oref dirmatch configregex) nil t)
+ (setq matchstring
+ (match-string (or (oref dirmatch configregexidx) 0)))))
+ (if (not buff) (kill-buffer readbuff))))
+ ;; Save what we find in our cache.
+ (oset dirmatch configdatastash matchstring))
+ ;; Match against our discovered string
+ (and matchstring (string-match (regexp-quote matchstring) file))
+ )))
+
+ ;; Add new matches here
+ ;; ((stringp somenewslot ...)
+ ;; )
+
+ ;; Error if none others known
+ (t
+ (error "Unknown dirmatch object match style.")))
+ ))
+
+(declare-function ede-directory-safe-p "ede")
+(declare-function ede-add-project-to-global-list "ede")
+
(defclass ede-project-autoload ()
((name :initarg :name
:documentation "Name of this project type")
@@ -41,6 +119,13 @@
:documentation "The lisp file belonging to this class.")
(proj-file :initarg :proj-file
:documentation "Name of a project file of this type.")
+ (proj-root-dirmatch :initarg :proj-root-dirmatch
+ :initform ""
+ :type (or string ede-project-autoload-dirmatch)
+ :documentation
+ "To avoid loading a project, check if the directory matches this.
+For projects that use directory name matches, a function would load that project.
+Specifying this matcher will allow EDE to check without loading the project.")
(proj-root :initarg :proj-root
:type function
:documentation "A function symbol to call for the project root.
@@ -57,6 +142,11 @@ associated with a single object class, based on the initializers used.")
:documentation "Fn symbol used to load this project file.")
(class-sym :initarg :class-sym
:documentation "Symbol representing the project class to use.")
+ (generic-p :initform nil
+ :documentation
+ "Generic projects are added to the project list at the end.
+The add routine will set this to non-nil so that future non-generic placement will
+be successful.")
(new-p :initarg :new-p
:initform t
:documentation
@@ -93,11 +183,56 @@ type is required and the load function used.")
:proj-file "Makefile.am"
:load-type 'project-am-load
:class-sym 'project-am-makefile
- :new-p nil))
+ :new-p nil
+ :safe-p t)
+ )
"List of vectors defining how to determine what type of projects exist.")
(put 'ede-project-class-files 'risky-local-variable t)
+(defun ede-add-project-autoload (projauto &optional flag)
+ "Add PROJAUTO, an EDE autoload definition to `ede-project-class-files'.
+Optional argument FLAG indicates how this autoload should be
+added. Possible values are:
+ 'generic - A generic project type. Keep this at the very end.
+ 'unique - A unique project type for a specific project. Keep at the very
+ front of the list so more generic projects don't get priority."
+ ;; First, can we identify PROJAUTO as already in the list? If so, replace.
+ (let ((projlist ede-project-class-files)
+ (projname (object-name-string projauto)))
+ (while (and projlist (not (string= (object-name-string (car projlist)) projname)))
+ (setq projlist (cdr projlist)))
+
+ (if projlist
+ ;; Stick the new one into the old slot.
+ (setcar projlist projauto)
+
+ ;; Else, see where to insert it.
+ (cond ((and flag (eq flag 'unique))
+ ;; Unique items get stuck right onto the front.
+ (setq ede-project-class-files
+ (cons projauto ede-project-class-files)))
+
+ ;; Generic Projects go at the very end of the list.
+ ((and flag (eq flag 'generic))
+ (oset projauto generic-p t)
+ (setq ede-project-class-files
+ (append ede-project-class-files
+ (list projauto))))
+
+ ;; Normal projects go at the end of the list, but
+ ;; before the generic projects.
+ (t
+ (let ((prev nil)
+ (next ede-project-class-files))
+ (while (and next (not (oref (car next) generic-p)))
+ (setq prev next
+ next (cdr next)))
+ (when (not prev)
+ (error "ede-project-class-files not initialized"))
+ ;; Splice into the list.
+ (setcdr prev (cons projauto next))))))))
+
;;; EDE project-autoload methods
;;
(defmethod ede-project-root ((this ede-project-autoload))
@@ -105,6 +240,21 @@ type is required and the load function used.")
Allows for one-project-object-for-a-tree type systems."
nil)
+(defun ede-project-dirmatch-p (file dirmatch)
+ "Return non-nil if FILE matches DIRMATCH.
+DIRMATCH could be nil (no match), a string (regexp match),
+or an `ede-project-autoload-dirmatch' object."
+ ;; If dirmatch is a string, then we simply match it against
+ ;; the file we are testing.
+ (if (stringp dirmatch)
+ (string-match dirmatch file)
+ ;; if dirmatch is instead a dirmatch object, we test against
+ ;; that object instead.
+ (if (ede-project-autoload-dirmatch-p dirmatch)
+ (ede-do-dirmatch dirmatch file)
+ (error "Unknown project directory match type."))
+ ))
+
(defmethod ede-project-root-directory ((this ede-project-autoload)
&optional file)
"If a project knows its root, return it here.
@@ -114,12 +264,36 @@ the current buffer."
(when (not file)
(setq file default-directory))
(when (slot-boundp this :proj-root)
- (let ((rootfcn (oref this proj-root)))
+ (let ((dirmatch (oref this proj-root-dirmatch))
+ (rootfcn (oref this proj-root))
+ (callfcn t))
(when rootfcn
- (condition-case nil
- (funcall rootfcn file)
- (error
- (funcall rootfcn)))
+ (if ;; If the dirmatch (an object) is not installed, then we
+ ;; always skip doing a match.
+ (and (ede-project-autoload-dirmatch-p dirmatch)
+ (not (ede-dirmatch-installed dirmatch)))
+ (setq callfcn nil)
+ ;; Other types of dirmatch:
+ (when (and
+ ;; If the Emacs Lisp file handling this project hasn't
+ ;; been loaded, we will use the quick dirmatch feature.
+ (not (featurep (oref this file)))
+ ;; If the dirmatch is an empty string, then we always
+ ;; skip doing a match.
+ (not (and (stringp dirmatch) (string= dirmatch "")))
+ )
+ ;; If this file DOES NOT match dirmatch, we set the callfcn
+ ;; to nil, meaning don't load the ede support file for this
+ ;; type of project. If it does match, we will load the file
+ ;; and use a more accurate programmatic match from there.
+ (unless (ede-project-dirmatch-p file dirmatch)
+ (setq callfcn nil))))
+ ;; Call into the project support file for a match.
+ (when callfcn
+ (condition-case nil
+ (funcall rootfcn file)
+ (error
+ (funcall rootfcn))))
))))
(defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir)
@@ -128,10 +302,20 @@ Return nil if the project file does not exist."
(let* ((d (file-name-as-directory dir))
(root (ede-project-root-directory this d))
(pf (oref this proj-file))
+ (dm (oref this proj-root-dirmatch))
(f (cond ((stringp pf)
(expand-file-name pf (or root d)))
((and (symbolp pf) (fboundp pf))
- (funcall pf (or root d)))))
+ ;; If there is a symbol to call, lets make extra
+ ;; sure we really can call it without loading in
+ ;; other EDE projects. This happens if the file is
+ ;; already loaded, or if there is a dirmatch, but
+ ;; root is empty.
+ (when (and (featurep (oref this file))
+ (or (not (stringp dm))
+ (not (string= dm "")))
+ root)
+ (funcall pf (or root d))))))
)
(when (and f (file-exists-p f))
f)))
diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el
index e3c9d2cb4f8..ebfb4154d81 100644
--- a/lisp/cedet/ede/autoconf-edit.el
+++ b/lisp/cedet/ede/autoconf-edit.el
@@ -165,6 +165,9 @@ items such as CHECK_HEADERS."
(setq param (substring param (match-end 0))))
(when (string-match "\\s-*\\]?\\s-*\\'" param)
(setq param (substring param 0 (match-beginning 0))))
+ ;; Look for occurrences of backslash newline
+ (while (string-match "\\s-*\\\\\\s-*\n\\s-*" param)
+ (setq param (replace-match " " t t param)))
param)
(defun autoconf-parameters-for-macro (macro &optional ignore-bol ignore-case)
@@ -373,6 +376,38 @@ Optional argument BODY is the code to execute which edits the autoconf file."
(string= autoconf-deleted-text autoconf-inserted-text))
(set-buffer-modified-p nil))))
+(defun autoconf-parameter-count ()
+ "Return the number of parameters to the function on the current line."
+ (save-excursion
+ (beginning-of-line)
+ (let* ((end-of-cmd
+ (save-excursion
+ (if (re-search-forward "(" (point-at-eol) t)
+ (progn
+ (forward-char -1)
+ (forward-sexp 1)
+ (point))
+ ;; Else, just return EOL.
+ (point-at-eol))))
+ (cnt 0))
+ (save-restriction
+ (narrow-to-region (point-at-bol) end-of-cmd)
+ (condition-case nil
+ (progn
+ (down-list 1)
+ (while (re-search-forward ", ?" end-of-cmd t)
+ (setq cnt (1+ cnt)))
+ (cond ((> cnt 1)
+ ;; If the # is > 1, then there is one fewer , than args.
+ (1+ cnt))
+ ((not (looking-at "\\s-*)"))
+ ;; If there are 0 args, then we have to see if there is one arg.
+ (1+ cnt))
+ (t
+ ;; Else, just return the 0.
+ cnt)))
+ (error 0))))))
+
(defun autoconf-delete-parameter (index)
"Delete the INDEXth parameter from the macro starting on the current line.
Leaves the cursor where a new parameter can be inserted.
@@ -396,12 +431,19 @@ INDEX starts at 1."
"Set the version used with automake to VERSION."
(if (not (stringp version))
(signal 'wrong-type-argument '(stringp version)))
- (if (not (autoconf-find-last-macro "AM_INIT_AUTOMAKE"))
- (error "Cannot update version")
- ;; Move to correct position.
+ (if (and (autoconf-find-last-macro "AM_INIT_AUTOMAKE")
+ (>= (autoconf-parameter-count) 2))
+ ;; We can edit right here.
+ nil
+ ;; Else, look for AC init instead.
+ (if (not (and (autoconf-find-last-macro "AC_INIT")
+ (>= (autoconf-parameter-count) 2)))
+ (error "Cannot update version")))
+
+ ;; Perform the edit.
(autoconf-edit-cycle
(autoconf-delete-parameter 2)
- (autoconf-insert version))))
+ (autoconf-insert (concat "[" version "]"))))
(defun autoconf-set-output (outputlist)
"Set the files created in AC_OUTPUT to OUTPUTLIST.
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index ce3d4a036f3..fe12720500b 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -163,7 +163,7 @@ and querying them will cause the actual project to get loaded.")
:documentation "Sub projects controlled by this project.
For Automake based projects, each directory is treated as a project.")
(targets :initarg :targets
- :type list
+ :type ede-target-list
:custom (repeat (object :objectcreatefcn ede-new-target-custom))
:label "Local Targets"
:group (targets)
@@ -287,10 +287,7 @@ All specific project types must derive from this project."
"For the project in which OBJ resides, execute FORMS."
`(save-window-excursion
(let* ((pf (if (obj-of-class-p ,obj ede-target)
- ;; @todo -I think I can change
- ;; this to not need ede-load-project-file
- ;; but I'm not sure how to test well.
- (ede-load-project-file (oref ,obj path))
+ (ede-target-parent ,obj)
,obj))
(dbka (get-file-buffer (oref pf file))))
(if (not dbka) (find-file (oref pf file))
diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el
index e6fd92759de..48b83f30bb0 100644
--- a/lisp/cedet/ede/cpp-root.el
+++ b/lisp/cedet/ede/cpp-root.el
@@ -85,7 +85,7 @@
;; file name for a header in your project where most of your CPP
;; macros reside. Doing this can be easier than listing everything in
;; the :spp-table option. The files listed in :spp-files should not
-;; start with a /, and are relative to something in :include-path.;;
+;; start with a /, and are relative to something in :include-path.
;;
;; If you want to override the file-finding tool with your own
;; function you can do this:
@@ -135,7 +135,8 @@
;; :proj-file 'MY-FILE-FOR-DIR
;; :proj-root 'MY-ROOT-FCN
;; :load-type 'MY-LOAD
-;; :class-sym 'ede-cpp-root)
+;; :class-sym 'ede-cpp-root-project
+;; :safe-p t)
;; t)
;;
;;; TODO
@@ -238,16 +239,20 @@ ROOTPROJ is nil, since there is only one project."
(ede-cpp-root-file-existing dir))
;;;###autoload
-(add-to-list 'ede-project-class-files
- (ede-project-autoload "cpp-root"
- :name "CPP ROOT"
- :file 'ede/cpp-root
- :proj-file 'ede-cpp-root-project-file-for-dir
- :proj-root 'ede-cpp-root-project-root
- :load-type 'ede-cpp-root-load
- :class-sym 'ede-cpp-root
- :new-p nil)
- t)
+(ede-add-project-autoload
+ (ede-project-autoload "cpp-root"
+ :name "CPP ROOT"
+ :file 'ede-cpp-root
+ :proj-file 'ede-cpp-root-project-file-for-dir
+ :proj-root 'ede-cpp-root-project-root
+ :load-type 'ede-cpp-root-load
+ :class-sym 'ede-cpp-root
+ :new-p nil
+ :safe-p t)
+ ;; When a user creates one of these, it should override any other project
+ ;; type that might happen to be in this directory, so force this to the
+ ;; very front.
+ 'unique)
;;; CLASSES
;;
@@ -439,6 +444,7 @@ This knows details about or source tree."
;; Else, do the usual.
(setq ans (call-next-method)))
)))
+ ;; TODO - does this call-next-method happen twice. Is that bad?? Why is it here?
(or ans (call-next-method))))
(defmethod ede-project-root ((this ede-cpp-root-project))
@@ -500,16 +506,16 @@ Also set up the lexical preprocessor map."
(table (when expfile
(semanticdb-file-table-object expfile)))
)
- (when (not table)
- (message "Cannot find file %s in project." F))
- (when (and table (semanticdb-needs-refresh-p table))
- (semanticdb-refresh-table table)
+ (if (not table)
+ (message "Cannot find file %s in project." F)
+ (when (semanticdb-needs-refresh-p table)
+ (semanticdb-refresh-table table))
(setq spp (append spp (oref table lexical-table))))))
(oref this spp-files))
spp))
(defmethod ede-system-include-path ((this ede-cpp-root-target))
- "Get the system include path used by project THIS."
+ "Get the system include path used by target THIS."
(ede-system-include-path (ede-target-parent this)))
(defmethod ede-preprocessor-map ((this ede-cpp-root-target))
diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el
index bf9ab272785..fa56a9ac5ca 100644
--- a/lisp/cedet/ede/dired.el
+++ b/lisp/cedet/ede/dired.el
@@ -64,7 +64,7 @@ negative, force off."
(setq ede-dired-minor-mode nil)
(error "Not in DIRED mode"))
(unless (or (ede-directory-project-p default-directory)
- (interactive-p))
+ (called-interactively-p 'any))
(setq ede-dired-minor-mode nil)))
(defun ede-dired-add-to-target (target)
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index e3afe30063c..e3a5789cf3b 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -99,6 +99,17 @@ emacs_beta_version=\\([0-9]+\\)")
(match-string 2) "."
(match-string 3)))
)
+ ((file-exists-p "sxemacs.pc.in")
+ (setq emacs "SXEmacs")
+ (insert-file-contents "sxemacs_version.m4")
+ (goto-char (point-min))
+ (re-search-forward "m4_define(\\[SXEM4CS_MAJOR_VERSION\\], \\[\\([0-9]+\\)\\])
+m4_define(\\[SXEM4CS_MINOR_VERSION\\], \\[\\([0-9]+\\)\\])
+m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])")
+ (setq ver (concat (match-string 1) "."
+ (match-string 2) "."
+ (match-string 3)))
+ )
;; Insert other Emacs here...
;; Vaguely recent version of GNU Emacs?
@@ -125,28 +136,29 @@ Argument DIR is the directory it is created for.
ROOTPROJ is nil, since there is only one project."
(or (ede-emacs-file-existing dir)
;; Doesn't already exist, so let's make one.
- (let* ((vertuple (ede-emacs-version dir)))
- (ede-emacs-project (car vertuple)
- :name (car vertuple)
- :version (cdr vertuple)
- :directory (file-name-as-directory dir)
- :file (expand-file-name "src/emacs.c"
- dir)))
- (ede-add-project-to-global-list this)
- )
- )
+ (let* ((vertuple (ede-emacs-version dir))
+ (proj (ede-emacs-project
+ (car vertuple)
+ :name (car vertuple)
+ :version (cdr vertuple)
+ :directory (file-name-as-directory dir)
+ :file (expand-file-name "src/emacs.c"
+ dir))))
+ (ede-add-project-to-global-list proj))))
;;;###autoload
-(add-to-list 'ede-project-class-files
- (ede-project-autoload "emacs"
- :name "EMACS ROOT"
- :file 'ede/emacs
- :proj-file "src/emacs.c"
- :proj-root 'ede-emacs-project-root
- :load-type 'ede-emacs-load
- :class-sym 'ede-emacs-project
- :new-p nil)
- t)
+(ede-add-project-autoload
+ (ede-project-autoload "emacs"
+ :name "EMACS ROOT"
+ :file 'ede/emacs
+ :proj-file "src/emacs.c"
+ :proj-root-dirmatch "emacs[^/]*"
+ :proj-root 'ede-emacs-project-root
+ :load-type 'ede-emacs-load
+ :class-sym 'ede-emacs-project
+ :new-p nil
+ :safe-p t)
+ 'unique)
(defclass ede-emacs-target-c (ede-target)
()
diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el
index 02aeffc5e2b..e5d75234b49 100644
--- a/lisp/cedet/ede/files.el
+++ b/lisp/cedet/ede/files.el
@@ -63,7 +63,8 @@ the current EDE project."
(interactive)
(require 'ede/locate)
(let* ((loc (ede-get-locator-object (ede-current-project))))
- (ede-locate-flush-hash loc)))
+ (when loc
+ (ede-locate-flush-hash loc))))
;;; Placeholders for ROOT directory scanning on base objects
;;
@@ -110,7 +111,7 @@ of the anchor file for the project."
(when (not ans)
(if (equal (ede--project-inode SP) inode)
(setq ans SP)
- (ede-find-subproject-for-directory SP dir)))))
+ (setq ans (ede-find-subproject-for-directory SP dir))))))
ans)))
;;; DIRECTORY IN OPEN PROJECT
@@ -219,6 +220,18 @@ Does not check subprojects."
:test 'equal)
"A hash of directory names and associated EDE objects.")
+(defun ede-flush-directory-hash ()
+ "Flush the project directory hash.
+Do this only when developing new projects that are incorrectly putting
+'nomatch tokens into the hash."
+ (interactive)
+ (setq ede-project-directory-hash (make-hash-table :test 'equal))
+ ;; Also slush the current project's locator hash.
+ (let ((loc (ede-get-locator-object ede-object)))
+ (when loc
+ (ede-locate-flush-hash loc)))
+ )
+
(defun ede-project-directory-remove-hash (dir)
"Reset the directory hash for DIR.
Do this whenever a new project is created, as opposed to loaded."
@@ -368,10 +381,11 @@ Get it from the toplevel project. If it doesn't have one, make one."
;; Make sure we have a location object available for
;; caching values, and for locating things more robustly.
(let ((top (ede-toplevel proj)))
- (when (not (slot-boundp top 'locate-obj))
- (ede-enable-locate-on-project top))
- (oref top locate-obj)
- ))
+ (when top
+ (when (not (slot-boundp top 'locate-obj))
+ (ede-enable-locate-on-project top))
+ (oref top locate-obj)
+ )))
(defmethod ede-expand-filename ((this ede-project) filename &optional force)
"Return a fully qualified file name based on project THIS.
diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el
index 67ef63f662e..c4fc5c6b6a9 100644
--- a/lisp/cedet/ede/generic.el
+++ b/lisp/cedet/ede/generic.el
@@ -79,6 +79,7 @@
(require 'eieio-opt)
(require 'ede)
+(require 'ede/shell)
(require 'semantic/db)
;;; Code:
@@ -105,6 +106,13 @@
:group (default build)
:documentation
"Command used for debugging this project.")
+ (run-command :initarg :run-command
+ :initform nil
+ :type (or null string)
+ :custom string
+ :group (default build)
+ :documentation
+ "Command used to run something related to this project.")
;; C target customizations
(c-include-path :initarg :c-include-path
:initform nil
@@ -196,7 +204,7 @@ The class allocated value is replace by different sub classes.")
(oref proj :directory))))
(if (file-exists-p fname)
;; Load in the configuration
- (setq config (eieio-persistent-read fname))
+ (setq config (eieio-persistent-read fname 'ede-generic-config))
;; Create a new one.
(setq config (ede-generic-config
"Configuration"
@@ -321,6 +329,44 @@ If one doesn't exist, create a new one for this directory."
(config (ede-generic-get-configuration proj)))
(oref config c-include-path)))
+;;; Commands
+;;
+(defmethod project-compile-project ((proj ede-generic-project) &optional command)
+ "Compile the entire current project PROJ.
+Argument COMMAND is the command to use when compiling."
+ (let* ((config (ede-generic-get-configuration proj))
+ (comp (oref config :build-command)))
+ (compile comp)))
+
+(defmethod project-compile-target ((obj ede-generic-target) &optional command)
+ "Compile the current target OBJ.
+Argument COMMAND is the command to use for compiling the target."
+ (project-compile-project (ede-current-project) command))
+
+(defmethod project-debug-target ((target ede-generic-target))
+ "Run the current project derived from TARGET in a debugger."
+ (let* ((proj (ede-target-parent target))
+ (config (ede-generic-get-configuration proj))
+ (debug (oref config :debug-command))
+ (cmd (read-from-minibuffer
+ "Debug Command: "
+ debug))
+ (cmdsplit (split-string cmd " " t))
+ ;; @TODO - this depends on the user always typing in something good
+ ;; like "gdb" or "dbx" which also exists as a useful Emacs command.
+ ;; Is there a better way?
+ (cmdsym (intern-soft (car cmdsplit))))
+ (call-interactively cmdsym t)))
+
+(defmethod project-run-target ((target ede-generic-target))
+ "Run the current project derived from TARGET."
+ (require 'ede-shell)
+ (let* ((proj (ede-target-parent target))
+ (config (ede-generic-get-configuration proj))
+ (run (concat "./" (oref config :run-command)))
+ (cmd (read-from-minibuffer "Run (like this): " run)))
+ (ede-shell-run-something target cmd)))
+
;;; Customization
;;
(defmethod ede-customize ((proj ede-generic-project))
@@ -365,27 +411,31 @@ PROJECTFILE is a file name that identifies a project of this type to EDE, such a
a Makefile, or SConstruct file.
CLASS is the EIEIO class that is used to track this project. It should subclass
the class `ede-generic-project' project."
- (add-to-list 'ede-project-class-files
- (ede-project-autoload internal-name
- :name external-name
- :file 'ede/generic
- :proj-file projectfile
- :load-type 'ede-generic-load
- :class-sym class
- :new-p nil)
- ;; Generics must go at the end, since more specific types
- ;; can create Makefiles also.
- t))
+ (ede-add-project-autoload
+ (ede-project-autoload internal-name
+ :name external-name
+ :file 'ede/generic
+ :proj-file projectfile
+ :load-type 'ede-generic-load
+ :class-sym class
+ :new-p nil
+ :safe-p nil) ; @todo - could be
+ ; safe if we do something
+ ; about the loading of the
+ ; generic config file.
+ ;; Generics must go at the end, since more specific types
+ ;; can create Makefiles also.
+ 'generic))
;;;###autoload
(defun ede-enable-generic-projects ()
"Enable generic project loaders."
(interactive)
- (ede-generic-new-autoloader "edeproject-makefile" "Make"
+ (ede-generic-new-autoloader "generic-makefile" "Make"
"Makefile" 'ede-generic-makefile-project)
- (ede-generic-new-autoloader "edeproject-scons" "SCons"
+ (ede-generic-new-autoloader "generic-scons" "SCons"
"SConstruct" 'ede-generic-scons-project)
- (ede-generic-new-autoloader "edeproject-cmake" "CMake"
+ (ede-generic-new-autoloader "generic-cmake" "CMake"
"CMakeLists" 'ede-generic-cmake-project)
)
diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el
index 70cd9498f69..5c708039ec4 100644
--- a/lisp/cedet/ede/linux.el
+++ b/lisp/cedet/ede/linux.el
@@ -33,11 +33,29 @@
;; * Add website
(require 'ede)
+(require 'ede/make)
+
(declare-function semanticdb-file-table-object "semantic/db")
(declare-function semanticdb-needs-refresh-p "semantic/db")
(declare-function semanticdb-refresh-table "semantic/db")
;;; Code:
+(defgroup project-linux nil
+ "File and tag browser frame."
+ :group 'tools
+ :group 'ede
+ :version "24.3")
+
+(defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s")
+ "*Default command used to compile a target."
+ :group 'project-linux
+ :type 'string)
+
+(defcustom project-linux-compile-project-command (concat ede-make-command " -k -C %s")
+ "*Default command used to compile a project."
+ :group 'project-linux
+ :type 'string)
+
(defvar ede-linux-project-list nil
"List of projects created by option `ede-linux-project'.")
@@ -95,6 +113,7 @@ DIR is the directory to search from."
"Project Type for the Linux source code."
:method-invocation-order :depth-first)
+;;;###autoload
(defun ede-linux-load (dir &optional rootproj)
"Return an Linux Project object if there is a match.
Return nil if there isn't one.
@@ -102,27 +121,29 @@ Argument DIR is the directory it is created for.
ROOTPROJ is nil, since there is only one project."
(or (ede-linux-file-existing dir)
;; Doesn't already exist, so let's make one.
- (ede-linux-project "Linux"
- :name "Linux"
- :version (ede-linux-version dir)
- :directory (file-name-as-directory dir)
- :file (expand-file-name "scripts/ver_linux"
- dir))
- (ede-add-project-to-global-list this)
- )
- )
+ (let ((proj (ede-linux-project
+ "Linux"
+ :name "Linux"
+ :version (ede-linux-version dir)
+ :directory (file-name-as-directory dir)
+ :file (expand-file-name "scripts/ver_linux"
+ dir))))
+ (ede-add-project-to-global-list proj))
+ ))
;;;###autoload
-(add-to-list 'ede-project-class-files
- (ede-project-autoload "linux"
- :name "LINUX ROOT"
- :file 'ede/linux
- :proj-file "scripts/ver_linux"
- :proj-root 'ede-linux-project-root
- :load-type 'ede-linux-load
- :class-sym 'ede-linux-project
- :new-p nil)
- t)
+(ede-add-project-autoload
+ (ede-project-autoload "linux"
+ :name "LINUX ROOT"
+ :file 'ede/linux
+ :proj-file "scripts/ver_linux"
+ :proj-root-dirmatch "linux[^/]*"
+ :proj-root 'ede-linux-project-root
+ :load-type 'ede-linux-load
+ :class-sym 'ede-linux-project
+ :new-p nil
+ :safe-p t)
+ 'unique)
(defclass ede-linux-target-c (ede-target)
()
@@ -238,6 +259,42 @@ Knows about how the Linux source tree is organized."
)
(or F (call-next-method))))
+(defmethod project-compile-project ((proj ede-linux-project)
+ &optional command)
+ "Compile the entire current project.
+Argument COMMAND is the command to use when compiling."
+ (let* ((dir (ede-project-root-directory proj)))
+
+ (require 'compile)
+ (if (not project-linux-compile-project-command)
+ (setq project-linux-compile-project-command compile-command))
+ (if (not command)
+ (setq command
+ (format
+ project-linux-compile-project-command
+ dir)))
+
+ (compile command)))
+
+(defmethod project-compile-target ((obj ede-linux-target-c) &optional command)
+ "Compile the current target.
+Argument COMMAND is the command to use for compiling the target."
+ (let* ((proj (ede-target-parent obj))
+ (root (ede-project-root proj))
+ (dir (ede-project-root-directory root))
+ (subdir (oref obj path)))
+
+ (require 'compile)
+ (if (not project-linux-compile-project-command)
+ (setq project-linux-compile-project-command compile-command))
+ (if (not command)
+ (setq command
+ (format
+ project-linux-compile-target-command
+ dir subdir)))
+
+ (compile command)))
+
(provide 'ede/linux)
;; Local variables:
diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el
index afa1c7200ec..739b774ee52 100644
--- a/lisp/cedet/ede/makefile-edit.el
+++ b/lisp/cedet/ede/makefile-edit.el
@@ -99,7 +99,8 @@ STOP-BEFORE is a regular expression matching a file name."
"Return a list of all files in MACRO."
(save-excursion
(goto-char (point-min))
- (let ((lst nil))
+ (let ((lst nil)
+ (case-fold-search nil))
(while (makefile-move-to-macro macro t)
(let ((e (save-excursion
(makefile-end-of-command)
diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el
index bd5400bb615..c638a5f0307 100644
--- a/lisp/cedet/ede/pmake.el
+++ b/lisp/cedet/ede/pmake.el
@@ -265,12 +265,13 @@ Execute BODY in a location where a value can be placed."
"Add VARNAME into the current Makefile if it doesn't exist.
Execute BODY in a location where a value can be placed."
`(let ((addcr t) (v ,varname))
- (unless (re-search-backward (concat "^" v "\\s-*=") nil t)
- (insert v "=")
- ,@body
- (if addcr (insert "\n"))
- (goto-char (point-max)))
- ))
+ (unless
+ (save-excursion
+ (re-search-backward (concat "^" v "\\s-*=") nil t))
+ (insert v "=")
+ ,@body
+ (when addcr (insert "\n"))
+ (goto-char (point-max)))))
(put 'ede-pmake-insert-variable-once 'lisp-indent-function 1)
;;; SOURCE VARIABLE NAME CONSTRUCTION
diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el
index 8277f58a5e0..87a722ef9be 100644
--- a/lisp/cedet/ede/proj-comp.el
+++ b/lisp/cedet/ede/proj-comp.el
@@ -319,7 +319,7 @@ Not all compilers do this."
(defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule))
"Insert rules needed for THIS rule object."
- (if (oref this phony) (insert ".PHONY: (oref this target)\n"))
+ (if (oref this phony) (insert ".PHONY: " (oref this target) "\n"))
(insert (oref this target) ": " (oref this dependencies) "\n\t"
(mapconcat (lambda (c) c) (oref this rules) "\n\t")
"\n\n"))
@@ -331,15 +331,16 @@ compiler it decides to use after inserting in the rule."
(when (slot-boundp this 'commands)
(with-slots (commands) this
(mapc
- (lambda (obj) (insert "\t"
- (cond ((stringp obj)
- obj)
- ((and (listp obj)
- (eq (car obj) 'lambda))
- (funcall obj))
- (t
- (format "%S" obj)))
- "\n"))
+ (lambda (obj) (insert
+ (if (bolp) "\t" " ")
+ (cond ((stringp obj)
+ obj)
+ ((and (listp obj)
+ (eq (car obj) 'lambda))
+ (funcall obj))
+ (t
+ (format "%S" obj)))
+ "\n"))
commands))
(insert "\n")))
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index 78200acff7d..db8803fa002 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -45,10 +45,37 @@
There should only be one toplevel package per auxiliary tool needed.
These packages location is found, and added to the compile time
load path."
- ))
+ )
+ (pre-load-packages :initarg :pre-load-packages
+ :initform nil
+ :type list
+ :custom (repeat string)
+ :documentation "Additional packages to pre-load.
+Each package name will be loaded with `require'.
+Each package's directory should also appear in :aux-packages via a package name.")
+ )
"This target consists of a group of lisp files.
A lisp target may be one general program with many separate lisp files in it.")
+(defmethod ede-proj-makefile-insert-rules :after ((this ede-proj-target-elisp))
+ "Insert rules needed by THIS target.
+This inserts the PRELOADS target-local variable."
+ (let ((preloads (oref this pre-load-packages)))
+ (when preloads
+ (insert (format "%s: PRELOADS=%s\n"
+ (oref this name)
+ (mapconcat 'identity preloads " ")))))
+ (insert "\n"))
+
+(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp))
+ "Return a string representing the dependencies for THIS.
+Some compilers only use the first element in the dependencies, others
+have a list of intermediates (object files), and others don't care.
+This allows customization of how these elements appear.
+For Emacs Lisp, return addsuffix command on source files."
+ (format "$(addsuffix c, $(%s))"
+ (ede-proj-makefile-sourcevar this)))
+
(defvar ede-source-emacs
(ede-sourcecode "ede-emacs-source"
:name "Emacs Lisp"
@@ -61,18 +88,17 @@ A lisp target may be one general program with many separate lisp files in it.")
"ede-emacs-compiler"
:name "emacs"
:variables '(("EMACS" . "emacs")
- ("EMACSFLAGS" . "-batch --no-site-file"))
- :commands
- '("@echo \"(add-to-list 'load-path nil)\" > $@-compile-script"
- "for loadpath in . ${LOADPATH}; do \\"
- " echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> $@-compile-script; \\"
- "done;"
- "@echo \"(setq debug-on-error t)\" >> $@-compile-script"
- "\"$(EMACS)\" $(EMACSFLAGS) -l $@-compile-script -f batch-byte-compile $^"
- )
+ ("EMACSFLAGS" . "-batch --no-site-file --eval '(setq debug-on-error t)'")
+ ("require" . "$(foreach r,$(1),(require (quote $(r))))"))
+ :rules (list (ede-makefile-rule
+ "elisp-inference-rule"
+ :target "%.elc"
+ :dependencies "%.el"
+ :rules '("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \
+--eval '(progn $(call require, $(PRELOADS)))' -f batch-byte-compile $^")))
:autoconf '("AM_PATH_LISPDIR")
:sourcetype '(ede-source-emacs)
-; :objectextention ".elc"
+ :objectextention ".elc"
)
"Compile Emacs Lisp programs.")
@@ -112,7 +138,7 @@ Lays claim to all .elc files that match .el files in this target."
(full nil)
)
;; Make sure the relative name isn't to far off
- (when (string-match "^\\.\\./\\.\\./\\.\\./\\.\\." rel)
+ (when (string-match "^\\.\\./\\.\\./\\.\\./\\.\\./\\.\\." rel)
(setq full fnd))
;; Do the setup.
(setq paths (cons (or full rel) paths)
@@ -129,9 +155,20 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(mapc (lambda (src)
(let* ((fsrc (expand-file-name src dir))
(elc (concat (file-name-sans-extension fsrc) ".elc")))
- (if (eq (byte-recompile-file fsrc nil 0) t)
- (setq comp (1+ comp))
- (setq utd (1+ utd)))))
+ (with-no-warnings
+ (if (< emacs-major-version 24)
+ ;; Does not have `byte-recompile-file'
+ (if (or (not (file-exists-p elc))
+ (file-newer-than-file-p fsrc elc))
+ (progn
+ (setq comp (1+ comp))
+ (byte-compile-file fsrc))
+ (setq utd (1+ utd)))
+
+ (if (eq (byte-recompile-file fsrc nil 0) t)
+ (setq comp (1+ comp))
+ (setq utd (1+ utd)))))))
+
(oref obj source))
(message "All Emacs Lisp sources are up to date in %s" (object-name obj))
(cons comp utd)))
@@ -185,8 +222,7 @@ is found, such as a `-version' variable, or the standard header."
"Insert variables needed by target THIS."
(let ((newitems (if (oref this aux-packages)
(ede-proj-elisp-packages-to-loadpath
- (oref this aux-packages))))
- )
+ (oref this aux-packages)))))
(ede-proj-makefile-insert-loadpath-items newitems)))
(defun ede-proj-elisp-add-path (path)
@@ -211,7 +247,8 @@ is found, such as a `-version' variable, or the standard header."
"Tweak the configure file (current buffer) to accommodate THIS."
(call-next-method)
;; Ok, now we have to tweak the autoconf provided `elisp-comp' program.
- (let ((ec (ede-expand-filename this "elisp-comp" 'newfile)))
+ (let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
+ (enable-local-variables nil))
(if (or (not ec) (not (file-exists-p ec)))
(message "No elisp-comp file. There may be compile errors? Rerun a second time.")
(save-excursion
@@ -235,7 +272,7 @@ is found, such as a `-version' variable, or the standard header."
"Flush the configure file (current buffer) to accommodate THIS."
;; Remove crufty old paths from elisp-compile
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
- )
+ (enable-local-variables nil))
(if (and ec (file-exists-p ec))
(with-current-buffer (find-file-noselect ec t)
(goto-char (point-min))
@@ -251,8 +288,8 @@ is found, such as a `-version' variable, or the standard header."
;;
(defclass ede-proj-target-elisp-autoloads (ede-proj-target-elisp)
((availablecompilers :initform '(ede-emacs-cedet-autogen-compiler))
- (aux-packages :initform ("cedet-autogen"))
(phony :initform t)
+ (rules :initform nil)
(autoload-file :initarg :autoload-file
:initform "loaddefs.el"
:type string
@@ -287,15 +324,14 @@ Lays claim to all .elc files that match .el files in this target."
(ede-compiler
"ede-emacs-autogen-compiler"
:name "emacs"
- :variables '(("EMACS" . "emacs"))
+ :variables '(("EMACS" . "emacs")
+ ("EMACSFLAGS" . "-batch --no-site-file --eval '(setq debug-on-error t)'")
+ ("require" . "$(foreach r,$(1),(require (quote $(r))))"))
:commands
- '("@echo \"(add-to-list 'load-path nil)\" > $@-compile-script"
- "for loadpath in . ${LOADPATH}; do \\"
- " echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> $@-compile-script; \\"
- "done;"
- "@echo \"(require 'cedet-autogen)\" >> $@-compile-script"
- "\"$(EMACS)\" -batch --no-site-file -l $@-compile-script -f cedet-batch-update-autoloads $(LOADDEFS) $(LOADDIRS)"
- )
+ '("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \
+--eval '(setq generated-autoload-file \"$(abspath $(LOADDEFS))\")' \
+-f batch-update-autoloads $(abspath $(LOADDIRS))")
+ :rules (list (ede-makefile-rule "clean-autoloads" :target "clean-autoloads" :phony t :rules '("rm -f $(LOADDEFS)")))
:sourcetype '(ede-source-emacs)
)
"Build an autoloads file.")
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index a8afe9ec804..8d81b825565 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -53,6 +53,39 @@
(autoload 'ede-proj-target-makefile-info "ede/proj-info"
"Target class for info files." nil nil)
+(eieio-defclass-autoload 'ede-proj-target-aux '(ede-proj-target)
+ "ede/proj-aux"
+ "Target class for a group of lisp files.")
+(eieio-defclass-autoload 'ede-proj-target-elisp '(ede-proj-target-makefile)
+ "ede/proj-elisp"
+ "Target class for a group of lisp files.")
+(eieio-defclass-autoload 'ede-proj-target-elisp-autoloads '(ede-proj-target-elisp)
+ "ede/proj-elisp"
+ "Target class for generating autoload files.")
+(eieio-defclass-autoload 'ede-proj-target-scheme '(ede-proj-target)
+ "ede/proj-scheme"
+ "Target class for a group of lisp files.")
+(eieio-defclass-autoload 'ede-proj-target-makefile-miscelaneous '(ede-proj-target-makefile)
+ "ede/proj-misc"
+ "Target class for a group of miscellaneous w/ a special makefile.")
+(eieio-defclass-autoload 'ede-proj-target-makefile-program '(ede-proj-target-makefile-objectcode)
+ "ede/proj-prog"
+ "Target class for building a program.")
+(eieio-defclass-autoload 'ede-proj-target-makefile-archive '(ede-proj-target-makefile-objectcode)
+ "ede/proj-archive"
+ "Target class for building an archive of object code.")
+(eieio-defclass-autoload 'ede-proj-target-makefile-shared-object '(ede-proj-target-makefile-program)
+ "ede/proj-shared"
+ "Target class for building a shared object.")
+(eieio-defclass-autoload 'ede-proj-target-makefile-info '(ede-proj-target-makefile)
+ "ede/proj-info"
+ "Target class for info files.")
+
+;; Not in ede/ , but part of semantic.
+(eieio-defclass-autoload 'semantic-ede-proj-target-grammar '(ede-proj-target-elisp)
+ "semantic/ede-grammar"
+ "Target classfor Semantic grammar files.")
+
;;; Class Definitions:
(defclass ede-proj-target (ede-target)
((auxsource :initarg :auxsource
@@ -181,8 +214,10 @@ This enables the creation of your target type."
(setq ede-proj-target-alist
(cons (cons name class) ede-proj-target-alist)))))
-(defclass ede-proj-project (ede-project)
- ((makefile-type :initarg :makefile-type
+(defclass ede-proj-project (eieio-persistent ede-project)
+ ((extension :initform ".ede")
+ (file-header-line :initform ";; EDE Project Files are auto generated: Do Not Edit")
+ (makefile-type :initarg :makefile-type
:initform Makefile
:type symbol
:custom (choice (const Makefile)
@@ -259,23 +294,16 @@ If optional ROOTPROJ is provided then ROOTPROJ is the root project
for the tree being read in. If ROOTPROJ is nil, then assume that
the PROJECT being read in is the root project."
(save-excursion
- (let ((ret nil)
+ (let ((ret (eieio-persistent-read (concat project "Project.ede")
+ ede-proj-project))
(subdirs (directory-files project nil "[^.].*" nil)))
- (set-buffer (get-buffer-create " *tmp proj read*"))
- (unwind-protect
- (progn
- (insert-file-contents (concat project "Project.ede")
- nil nil nil t)
- (goto-char (point-min))
- (setq ret (read (current-buffer)))
- (if (not (eq (car ret) 'ede-proj-project))
- (error "Corrupt project file"))
- (setq ret (eval ret))
- (oset ret file (concat project "Project.ede"))
- (oset ret directory project)
- (oset ret rootproject rootproj)
- )
- (kill-buffer " *tmp proj read*"))
+ (if (not (object-of-class-p ret 'ede-proj-project))
+ (error "Corrupt project file"))
+ (oset ret directory project)
+ (oset ret rootproject rootproj)
+
+ ;; Load the project file of each subdirectory containing a
+ ;; loadable Project.ede.
(while subdirs
(let ((sd (file-name-as-directory
(expand-file-name (car subdirs) project))))
@@ -291,22 +319,13 @@ the PROJECT being read in is the root project."
"Write out object PROJECT into its file."
(save-excursion
(if (not project) (setq project (ede-current-project)))
- (let ((b (set-buffer (get-buffer-create " *tmp proj write*")))
- (cfn (oref project file))
- (cdir (oref project directory)))
+ (let ((cdir (oref project directory)))
(unwind-protect
- (save-excursion
- (erase-buffer)
- (let ((standard-output (current-buffer)))
- (oset project file (file-name-nondirectory cfn))
- (slot-makeunbound project :directory)
- (object-write project ";; EDE project file."))
- (write-file cfn nil)
- )
- ;; Restore the :file on exit.
- (oset project file cfn)
- (oset project directory cdir)
- (kill-buffer b)))))
+ (progn
+ (slot-makeunbound project :directory)
+ (eieio-persistent-save project))
+ ;; Restore the directory slot
+ (oset project directory cdir))) ))
(defmethod ede-commit-local-variables ((proj ede-proj-project))
"Commit change to local variables in PROJ."
@@ -670,6 +689,8 @@ Optional argument FORCE will force items to be regenerated."
(let ((root (or (ede-project-root this) this))
)
(setq ede-projects (delq root ede-projects))
+ ;; NOTE : parent function double-checks that this dir was
+ ;; already in memory once.
(ede-load-project-file (ede-project-root-directory root))
))
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index e951598ba55..5053701192e 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -205,7 +205,7 @@ OT is the object target. DIR is the directory to start in."
(oref amf targets))
nil t))))
;; The input target might be new. See if we can find it.
- (amf (ede-load-project-file (oref ot path)))
+ (amf (ede-target-parent ot))
(ot (object-assoc target 'name (oref amf targets)))
(ofn (file-name-nondirectory (buffer-file-name))))
(if (not ot)
diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el
index 05688aa56ff..489c4d3dbf1 100644
--- a/lisp/cedet/ede/util.el
+++ b/lisp/cedet/ede/util.el
@@ -87,7 +87,7 @@ their sources to VERSION."
If BUFFER isn't specified, use the current buffer."
(save-excursion
(if buffer (set-buffer buffer))
- (toggle-read-only -1)))
+ (setq buffer-read-only nil)))
(provide 'ede/util)
diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el
index 877ed54566c..6b0f007916b 100644
--- a/lisp/cedet/inversion.el
+++ b/lisp/cedet/inversion.el
@@ -79,15 +79,20 @@
(defconst inversion-decoders
'(
- (alpha "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*\\.?alpha\\([0-9]+\\)?$" 3)
- (beta "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*\\.?beta\\([0-9]+\\)?$" 3)
- (beta "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*(beta\\([0-9]+\\)?)" 3)
+ (alpha "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]*\\)?\\s-*\\.?alpha\\([0-9]+\\)?$" 4)
+ (beta "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]*\\)?\\s-*\\.?beta\\([0-9]+\\)?$" 4)
+ (beta "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]*\\)?\\s-*\\.?(beta\\([0-9]+\\)?)$" 4)
+ (beta "^[^/]+/\\w+--\\w+--\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)--patch-\\([0-9]+\\)" 4)
+ (beta "^\\w+: v\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)-\\([0-9]+\\)-\\(.*\\)" 5)
(prerelease "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*\\.?pre\\([0-9]+\\)?$" 3)
- (full "^\\([0-9]+\\)\\.\\([0-9]+\\)$" 2)
+ (full "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?$" 3)
(fullsingle "^\\([0-9]+\\)$" 1)
- (patch "^\\([0-9]+\\)\\.\\([0-9]+\\) (patch \\([0-9]+\\))" 3)
+ (patch "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?\\s-*(patch \\([0-9]+\\))" 4)
(point "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" 3)
+ (point "^\\w+: v\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)-\\(0\\)-\\(.*\\)" 5)
(build "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\).\\([0-9]+\\)$" 4)
+ (full "^[^/]+/\\w+--\\w+--\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)--version-\\([0-9]+\\)" 4)
+ (full "^\\w+: v\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)" 5)
)
"List of decoders for version strings.
Each decoder is of the form:
@@ -140,7 +145,7 @@ where RELEASE is a symbol such as `full', or `beta'."
;; Decode the code
(setq code (inversion-decode-version ver))
(unless code
- (error "%S-version value cannot be decoded" package))
+ (error "%S-version value (%s) cannot be decoded" package ver))
code))
(defun inversion-package-incompatibility-version (package)
@@ -195,24 +200,25 @@ not an indication of new features or bug fixes."
(v2-3 (nth 3 ver2))
(v2-4 (nth 4 ver2))
)
- (or (and (= v1-0 v2-0)
- (= v1-1 v2-1)
- (= v1-2 v2-2)
- (= v1-3 v2-3)
- v1-4 v2-4 ; all or nothing if elt - is =
+
+ (cond ((and (equal (list v1-1 v1-2 v1-3 v1-4)
+ (list v2-1 v2-2 v2-3 v2-4))
+ v1-0 v2-0)
+ (< v1-0 v2-0))
+ ((and (equal v1-1 v2-1)
+ (equal v1-2 v2-2)
+ (equal v1-3 v2-3)
+ v1-4 v2-4) ; all or nothing if elt - is =
(< v1-4 v2-4))
- (and (= v1-0 v2-0)
- (= v1-1 v2-1)
- (= v1-2 v2-2)
- v1-3 v2-3 ; all or nothing if elt - is =
+ ((and (equal v1-1 v2-1)
+ (equal v1-2 v2-2)
+ v1-3 v2-3) ; all or nothing if elt - is =
(< v1-3 v2-3))
- (and (= v1-1 v2-1)
+ ((and (equal v1-1 v2-1)
+ v1-2 v2-2)
(< v1-2 v2-2))
- (and (< v1-1 v2-1))
- (and (< v1-0 v2-0)
- (= v1-1 v2-1)
- (= v1-2 v2-2)
- )
+ ((and v1-1 v2-1)
+ (< v1-1 v2-1))
)))
(defun inversion-check-version (version incompatible-version
@@ -340,13 +346,17 @@ Optional argument RESERVED is saved for later use."
;; Return the package symbol that was required.
package))
-(defun inversion-require-emacs (emacs-ver xemacs-ver)
- "Declare that you need either EMACS-VER, or XEMACS-VER.
+;;;###autoload
+(defun inversion-require-emacs (emacs-ver xemacs-ver sxemacs-ver)
+ "Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver.
Only checks one based on which kind of Emacs is being run."
(let ((err (inversion-test 'emacs
- (if (featurep 'xemacs)
- xemacs-ver
- emacs-ver))))
+ (cond ((featurep 'sxemacs)
+ sxemacs-ver)
+ ((featurep 'xemacs)
+ xemacs-ver)
+ (t
+ emacs-ver)))))
(if err (error err)
;; Something nice...
t)))
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index aeb5241b2d0..e02790cbfa8 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -38,7 +38,7 @@
(require 'semantic/tag)
(require 'semantic/lex)
-(defvar semantic-version "2.0"
+(defvar semantic-version "2.1beta"
"Current version of Semantic.")
(declare-function inversion-test "inversion")
@@ -274,6 +274,7 @@ setup to use Semantic."
(python-mode . wisent-python-default-setup)
(scheme-mode . semantic-default-scheme-setup)
(srecode-template-mode . srecode-template-setup-parser)
+ (texinfo-mode . semantic-default-texi-setup)
(makefile-automake-mode . semantic-default-make-setup)
(makefile-gmake-mode . semantic-default-make-setup)
(makefile-makepp-mode . semantic-default-make-setup)
@@ -623,16 +624,18 @@ was marked unparseable, then do nothing, and return the cache."
;;;; Parse the whole system.
((semantic-parse-tree-needs-rebuild-p)
- ;; Use Emacs's built-in progress-reporter
- (let ((semantic--progress-reporter
- (and (>= (point-max) semantic-minimum-working-buffer-size)
- (eq semantic-working-type 'percent)
- (make-progress-reporter
- (semantic-parser-working-message (buffer-name))
- 0 100))))
- (setq res (semantic-parse-region (point-min) (point-max)))
- (if semantic--progress-reporter
- (progress-reporter-done semantic--progress-reporter)))
+ ;; Use Emacs's built-in progress-reporter (only interactive).
+ (if noninteractive
+ (setq res (semantic-parse-region (point-min) (point-max)))
+ (let ((semantic--progress-reporter
+ (and (>= (point-max) semantic-minimum-working-buffer-size)
+ (eq semantic-working-type 'percent)
+ (make-progress-reporter
+ (semantic-parser-working-message (buffer-name))
+ 0 100))))
+ (setq res (semantic-parse-region (point-min) (point-max)))
+ (if semantic--progress-reporter
+ (progress-reporter-done semantic--progress-reporter))))
;; Clear the caches when we see there were no errors.
;; But preserve the unmatched syntax cache and warnings!
@@ -986,6 +989,12 @@ Throw away all the old tags, and recreate the tag database."
:help "Highlight the tag at point"
:visible semantic-mode
:button (:toggle . global-semantic-highlight-func-mode)))
+ (define-key cedet-menu-map [global-semantic-stickyfunc-mode]
+ '(menu-item "Stick Top Tag to Headerline" global-semantic-stickyfunc-mode
+ :help "Stick the tag scrolled off the top of the buffer into the header line"
+ :visible semantic-mode
+ :button (:toggle . (bound-and-true-p
+ global-semantic-stickyfunc-mode))))
(define-key cedet-menu-map [global-semantic-decoration-mode]
'(menu-item "Decorate Tags" global-semantic-decoration-mode
:help "Decorate tags based on tag attributes"
@@ -1031,7 +1040,12 @@ Prevent this load system from loading files in twice.")
global-semantic-idle-scheduler-mode
global-semanticdb-minor-mode
global-semantic-idle-summary-mode
- global-semantic-mru-bookmark-mode)
+ global-semantic-mru-bookmark-mode
+ global-cedet-m3-minor-mode
+ global-semantic-idle-local-symbol-highlight-mode
+ global-semantic-highlight-edits-mode
+ global-semantic-show-unmatched-syntax-mode
+ global-semantic-show-parser-state-mode)
"List of auxiliary minor modes in the Semantic package.")
;;;###autoload
@@ -1048,7 +1062,17 @@ The possible elements of this list include the following:
`global-semantic-highlight-func-mode' - Highlight the current tag.
`global-semantic-stickyfunc-mode' - Show current fun in header line.
`global-semantic-mru-bookmark-mode' - Provide `switch-to-buffer'-like
- keybinding for tag names."
+ keybinding for tag names.
+ `global-cedet-m3-minor-mode' - A mouse 3 context menu.
+ `global-semantic-idle-local-symbol-highlight-mode' - Highlight references
+ of the symbol under point.
+The following modes are more targeted at people who want to see
+ some internal information of the semantic parser in action:
+ `global-semantic-highlight-edits-mode' - Visualize incremental parser by
+ highlighting not-yet parsed changes.
+ `global-semantic-show-unmatched-syntax-mode' - Highlight unmatched lexical
+ syntax tokens.
+ `global-semantic-show-parser-state-mode' - Display the parser cache state."
:group 'semantic
:type `(set ,@(mapcar (lambda (c) (list 'const c))
semantic-submode-list)))
@@ -1095,16 +1119,27 @@ Semantic mode.
(dolist (b (buffer-list))
(with-current-buffer b
(semantic-new-buffer-fcn))))
- ;; Disable all Semantic features.
+ ;; Disable Semantic features. Removing everything Semantic has
+ ;; introduced in the buffer is pretty much futile, but we have to
+ ;; clean the hooks and delete Semantic-related overlays, so that
+ ;; Semantic can be re-activated cleanly.
(remove-hook 'mode-local-init-hook 'semantic-new-buffer-fcn)
(remove-hook 'completion-at-point-functions
'semantic-completion-at-point-function)
+ (remove-hook 'after-change-functions
+ 'semantic-change-function)
(define-key cedet-menu-map [cedet-menu-separator] nil)
(define-key cedet-menu-map [semantic-options-separator] nil)
;; FIXME: handle semanticdb-load-ebrowse-caches
(dolist (mode semantic-submode-list)
(if (and (boundp mode) (eval mode))
- (funcall mode -1)))))
+ (funcall mode -1)))
+ ;; Unlink buffer and clear cache
+ (semantic--tag-unlink-cache-from-buffer)
+ (setq semantic--buffer-cache nil)
+ ;; Make sure we run the setup function if Semantic gets
+ ;; re-activated.
+ (setq semantic-new-buffer-fcn-was-run nil)))
(defun semantic-completion-at-point-function ()
'semantic-ia-complete-symbol)
@@ -1141,6 +1176,11 @@ minor mode can be turned on only if semantic feature is available and
the current buffer was set up for parsing. Return non-nil if the
minor mode is enabled." t nil)
+(autoload 'global-semantic-idle-local-symbol-highlight-mode "semantic/idle"
+ "Highlight the tag and symbol references of the symbol under point.
+Call `semantic-analyze-current-context' to find the reference tag.
+Call `semantic-symref-hits-in-region' to identify local references." t nil)
+
(autoload 'srecode-template-setup-parser "srecode/srecode-template"
"Set up buffer for parsing SRecode template files." t nil)
diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el
index 5fe0078478d..19c61cb74c7 100644
--- a/lisp/cedet/semantic/analyze/debug.el
+++ b/lisp/cedet/semantic/analyze/debug.el
@@ -443,7 +443,7 @@ or implementing a version specific to ")
(semanticdb-file-table-object fileinner t))))
(cond ((not fileinner)
(setq unknown (1+ unknown)))
- ((number-or-marker-p (oref tableinner pointmax))
+ ((and tableinner (number-or-marker-p (oref tableinner pointmax)))
(setq ok (1+ ok)))
(t
(setq unparsed (1+ unparsed))))))
diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el
index a27356c784b..d780327b7e9 100644
--- a/lisp/cedet/semantic/analyze/fcn.el
+++ b/lisp/cedet/semantic/analyze/fcn.el
@@ -37,24 +37,6 @@
;;
;; These queries allow a major mode to help the analyzer make decisions.
;;
-(define-overloadable-function semantic-analyze-tag-prototype-p (tag)
- "Non-nil if TAG is a prototype."
- )
-
-(defun semantic-analyze-tag-prototype-p-default (tag)
- "Non-nil if TAG is a prototype."
- (let ((p (semantic-tag-get-attribute tag :prototype-flag)))
- (cond
- ;; Trust the parser author.
- (p p)
- ;; Empty types might be a prototype.
- ((eq (semantic-tag-class tag) 'type)
- (not (semantic-tag-type-members tag)))
- ;; No other heuristics.
- (t nil))
- ))
-
-;;------------------------------------------------------------
(define-overloadable-function semantic-analyze-split-name (name)
"Split a tag NAME into a sequence.
@@ -219,7 +201,7 @@ used by the analyzer debugger."
(if (and type-declaration
(semantic-tag-p type-declaration)
(semantic-tag-of-class-p type-declaration 'type)
- (not (semantic-analyze-tag-prototype-p type-declaration))
+ (not (semantic-tag-prototype-p type-declaration))
)
;; We have an anonymous type for TAG with children.
;; Use this type directly.
@@ -312,7 +294,7 @@ SCOPE is the current scope."
(when (and (semantic-tag-p ans)
(eq (semantic-tag-class ans) 'type))
;; We have a tag.
- (if (semantic-analyze-tag-prototype-p ans)
+ (if (semantic-tag-prototype-p ans)
;; It is a prototype.. find the real one.
(or (and scope
(car-safe
diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el
index 09a4c08c059..05ac56eac69 100644
--- a/lisp/cedet/semantic/analyze/refs.el
+++ b/lisp/cedet/semantic/analyze/refs.el
@@ -87,7 +87,7 @@ Use `semantic-analyze-current-tag' to debug this fcn."
(semantic-go-to-tag tag db)
(setq scope (semantic-calculate-scope))
- (setq allhits (semantic--analyze-refs-full-lookup tag scope))
+ (setq allhits (semantic--analyze-refs-full-lookup tag scope t))
(semantic-analyze-references (semantic-tag-name tag)
:tag tag
@@ -115,7 +115,10 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
(aDB (car ans))
)
(when (and (not (semantic-tag-prototype-p aT))
- (semantic-tag-similar-p tag aT :prototype-flag :parent))
+ (semantic-tag-similar-p tag aT
+ :prototype-flag
+ :parent
+ :typemodifiers))
(when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
(push aT impl))))
allhits)
@@ -135,7 +138,10 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
(aDB (car ans))
)
(when (and (semantic-tag-prototype-p aT)
- (semantic-tag-similar-p tag aT :prototype-flag :parent))
+ (semantic-tag-similar-p tag aT
+ :prototype-flag
+ :parent
+ :typemodifiers))
(when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
(push aT proto))))
allhits)
@@ -143,14 +149,15 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
;;; LOOKUP
;;
-(defun semantic--analyze-refs-full-lookup (tag scope)
+(defun semantic--analyze-refs-full-lookup (tag scope &optional noerror)
"Perform a full lookup for all occurrences of TAG in the current project.
TAG should be the tag currently under point.
SCOPE is the scope the cursor is in. From this a list of parents is
-derived. If SCOPE does not have parents, then only a simple lookup is done."
+derived. If SCOPE does not have parents, then only a simple lookup is done.
+Optional argument NOERROR means don't error if the lookup fails."
(if (not (oref scope parents))
;; If this tag has some named parent, but is not
- (semantic--analyze-refs-full-lookup-simple tag)
+ (semantic--analyze-refs-full-lookup-simple tag noerror)
;; We have some sort of lineage we need to consider when we do
;; our side lookup of tags.
diff --git a/lisp/cedet/semantic/bovine/c-by.el b/lisp/cedet/semantic/bovine/c-by.el
index b47dac49a52..96e12bba900 100644
--- a/lisp/cedet/semantic/bovine/c-by.el
+++ b/lisp/cedet/semantic/bovine/c-by.el
@@ -19,17 +19,21 @@
;;; Commentary:
;;
-;; This file was generated from etc/grammars/c.by.
+;; This file was generated from admin/grammars/c.by.
;;; Code:
(require 'semantic/lex)
(eval-when-compile (require 'semantic/bovine))
-
+
+;;; Prologue
+;;
(declare-function semantic-c-reconstitute-token "semantic/bovine/c")
(declare-function semantic-c-reconstitute-template "semantic/bovine/c")
(declare-function semantic-expand-c-tag "semantic/bovine/c")
-
+
+;;; Declarations
+;;
(defconst semantic-c-by--keyword-table
(semantic-lex-make-keyword-table
'(("extern" . EXTERN)
@@ -42,6 +46,7 @@
("inline" . INLINE)
("virtual" . VIRTUAL)
("mutable" . MUTABLE)
+ ("explicit" . EXPLICIT)
("struct" . STRUCT)
("union" . UNION)
("enum" . ENUM)
@@ -124,6 +129,7 @@
("enum" summary "Enumeration Type Declaration: enum [name] { ... };")
("union" summary "Union Type Declaration: union [name] { ... };")
("struct" summary "Structure Type Declaration: struct [name] { ... };")
+ ("explicit" summary "Forbids implicit type conversion: explicit <constructor>")
("mutable" summary "Member Declaration Modifier: mutable <type> <name> ...")
("virtual" summary "Method Modifier: virtual <type> <name>(...) ...")
("inline" summary "Function Modifier: inline <return type> <name>(...) {...};")
@@ -486,6 +492,12 @@
)
(template)
(using)
+ (spp-include
+ ,(semantic-lambda
+ (semantic-tag
+ (nth 0 vals)
+ 'include :inside-ns t))
+ )
( ;;EMPTY
)
) ;; end namespacesubparts
@@ -1987,6 +1999,15 @@
"*"
(nth 2 vals))))
)
+ (open-paren
+ "("
+ symbol
+ close-paren
+ ")"
+ ,(semantic-lambda
+ (list
+ (nth 1 vals)))
+ )
) ;; end function-pointer
(fun-or-proto-end
@@ -2186,6 +2207,10 @@
semantic-flex-keywords-obarray semantic-c-by--keyword-table
semantic-equivalent-major-modes '(c-mode c++-mode)
))
+
+
+;;; Analyzers
+;;
;;; Epilogue
;;
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 886b15d183e..02ad6e05d1a 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -27,10 +27,13 @@
(require 'semantic)
(require 'semantic/analyze)
+(require 'semantic/bovine)
(require 'semantic/bovine/gcc)
(require 'semantic/idle)
(require 'semantic/lex-spp)
(require 'semantic/bovine/c-by)
+(require 'semantic/db-find)
+(require 'hideif)
(eval-when-compile
(require 'semantic/find))
@@ -103,8 +106,13 @@ NOTE: In process of obsoleting this."
'( ("__THROW" . "")
("__const" . "const")
("__restrict" . "")
+ ("__attribute_pure__" . "")
+ ("__attribute_malloc__" . "")
+ ("__nonnull" . "")
+ ("__wur" . "")
("__declspec" . ((spp-arg-list ("foo") 1 . 2)))
("__attribute__" . ((spp-arg-list ("foo") 1 . 2)))
+ ("__asm" . ((spp-arg-list ("foo") 1 . 2)))
)
"List of symbols to include by default.")
@@ -118,7 +126,15 @@ part of the preprocessor map.")
(defun semantic-c-reset-preprocessor-symbol-map ()
"Reset the C preprocessor symbol map based on all input variables."
- (when (featurep 'semantic/bovine/c)
+ (when (and semantic-mode
+ (featurep 'semantic/bovine/c))
+ (remove-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map)
+ ;; Initialize semantic-lex-spp-macro-symbol-obarray with symbols.
+ (setq-mode-local c-mode
+ semantic-lex-spp-macro-symbol-obarray
+ (semantic-lex-make-spp-table
+ (append semantic-lex-c-preprocessor-symbol-map-builtin
+ semantic-lex-c-preprocessor-symbol-map)))
(let ((filemap nil)
)
(when (and (not semantic-c-in-reset-preprocessor-table)
@@ -141,17 +157,17 @@ part of the preprocessor map.")
(error (message "Error updating tables for %S"
(object-name table)))))
(setq filemap (append filemap (oref table lexical-table)))
- )
- ))))
-
- (setq-mode-local c-mode
- semantic-lex-spp-macro-symbol-obarray
- (semantic-lex-make-spp-table
- (append semantic-lex-c-preprocessor-symbol-map-builtin
- semantic-lex-c-preprocessor-symbol-map
- filemap))
- )
- )))
+ ;; Update symbol obarray
+ (setq-mode-local c-mode
+ semantic-lex-spp-macro-symbol-obarray
+ (semantic-lex-make-spp-table
+ (append semantic-lex-c-preprocessor-symbol-map-builtin
+ semantic-lex-c-preprocessor-symbol-map
+ filemap)))))))))))
+
+;; Make sure the preprocessor symbols are set up when mode-local kicks
+;; in.
+(add-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map)
(defcustom semantic-lex-c-preprocessor-symbol-map nil
"Table of C Preprocessor keywords used by the Semantic C lexer.
@@ -236,6 +252,7 @@ Return the defined symbol as a special spp lex token."
nil
(let* ((name (buffer-substring-no-properties
(match-beginning 1) (match-end 1)))
+ (beginning-of-define (match-end 1))
(with-args (save-excursion
(goto-char (match-end 0))
(looking-at "(")))
@@ -246,7 +263,13 @@ Return the defined symbol as a special spp lex token."
(raw-stream
(semantic-lex-spp-stream-for-macro (save-excursion
(semantic-c-end-of-macro)
- (point))))
+ ;; HACK - If there's a C comment after
+ ;; the macro, do not parse it.
+ (if (looking-back "/\\*.*" beginning-of-define)
+ (progn
+ (goto-char (match-beginning 0))
+ (1- (point)))
+ (point)))))
)
;; Only do argument checking if the paren was immediately after
@@ -295,8 +318,10 @@ Moves completely over balanced #if blocks."
(cond
((looking-at "^\\s-*#\\s-*if")
;; We found a nested if. Skip it.
- ;; @TODO - can we use the new c-scan-conditionals
- (c-forward-conditional 1))
+ (if (fboundp 'c-scan-conditionals)
+ (goto-char (c-scan-conditionals 1))
+ ;; For older Emacsen, but this will set the mark.
+ (c-forward-conditional 1)))
((looking-at "^\\s-*#\\s-*elif")
;; We need to let the preprocessor analyze this one.
(beginning-of-line)
@@ -315,34 +340,207 @@ Moves completely over balanced #if blocks."
;; We found an elif. Stop here.
(setq done t))))))
+;;; HIDEIF USAGE:
+;; NOTE: All hideif using code was contributed by Brian Carlson as
+;; copies from hideif plus modifications and additions.
+;; Eric then converted things to use hideif functions directly,
+;; deleting most of that code, and added the advice.
+
+;;; SPP SYM EVAL
+;;
+;; Convert SPP symbols into values usable by hideif.
+;;
+;; @TODO - can these conversion fcns be a part of semantic-lex-spp.el?
+;; -- TRY semantic-lex-spp-one-token-to-txt
+(defun semantic-c-convert-spp-value-to-hideif-value (symbol macrovalue)
+ "Convert an spp macro SYMBOL MACROVALUE, to something that hideif can use.
+Take the first interesting thing and convert it."
+ ;; Just warn for complex macros.
+ (when (> (length macrovalue) 1)
+ (semantic-push-parser-warning
+ (format "Complex macro value (%s) may be improperly evaluated. "
+ symbol) 0 0))
+
+ (let* ((lextoken (car macrovalue))
+ (key (semantic-lex-token-class lextoken))
+ (value (semantic-lex-token-text lextoken)))
+ (cond
+ ((eq key 'number) (string-to-number value))
+ ((eq key 'symbol) (semantic-c-evaluate-symbol-for-hideif value))
+ ((eq key 'string)
+ (if (string-match "^[0-9]+L?$" value)
+ ;; If it matches a number expression, then
+ ;; convert to a number.
+ (string-to-number value)
+ value))
+ (t (semantic-push-parser-warning
+ (format "Unknown macro value. Token class = %s value = %s. " key value)
+ 0 0)
+ nil)
+ )))
+
+(defun semantic-c-evaluate-symbol-for-hideif (spp-symbol)
+ "Lookup the symbol SPP-SYMBOL (a string) to something hideif can use.
+Pulls out the symbol list, and call `semantic-c-convert-spp-value-to-hideif-value'."
+ (interactive "sSymbol name: ")
+ (when (symbolp spp-symbol) (setq spp-symbol (symbol-name spp-symbol)))
+
+ (if (semantic-lex-spp-symbol-p spp-symbol )
+ ;; Convert the symbol into a stream of tokens from the macro which we
+ ;; can then interpret.
+ (let ((stream (semantic-lex-spp-symbol-stream spp-symbol)))
+ (cond
+ ;; Empty string means defined, so t.
+ ((null stream) t)
+ ;; A list means a parsed macro stream.
+ ((listp stream)
+ ;; Convert the macro to something we can return.
+ (semantic-c-convert-spp-value-to-hideif-value spp-symbol stream))
+
+ ;; Strings might need to be turned into numbers
+ ((stringp stream)
+ (if (string-match "^[0-9]+L?$" stream)
+ ;; If it matches a number expression, then convert to a
+ ;; number.
+ (string-to-number stream)
+ stream))
+
+ ;; Just return the stream. A user might have just stuck some
+ ;; value in it directly.
+ (t stream)
+ ))
+ ;; Else, store an error, return nil.
+ (progn
+ (semantic-push-parser-warning
+ (format "SPP Symbol %s not available" spp-symbol)
+ (point) (point))
+ nil)))
+
+;;; HIDEIF HACK support fcns
+;;
+;; These fcns can replace the impl of some hideif features.
+;;
+;; @TODO - Should hideif and semantic-c merge?
+;; I picture a grammar just for CPP that expands into
+;; a second token stream for the parser.
+(defun semantic-c-hideif-lookup (var)
+ "Replacement for `hif-lookup'.
+I think it just gets the value for some CPP variable VAR."
+ (let ((val (semantic-c-evaluate-symbol-for-hideif
+ (cond
+ ((stringp var) var)
+ ((symbolp var) (symbol-name var))
+ (t "Unable to determine var")))))
+ (if val
+ val
+ ;; Real hideif will return the right undefined symbol.
+ nil)))
+
+(defun semantic-c-hideif-defined (var)
+ "Replacement for `hif-defined'.
+I think it just returns t/nil dependent on if VAR has been defined."
+ (let ((var-symbol-name
+ (cond
+ ((symbolp var) (symbol-name var))
+ ((stringp var) var)
+ (t "Not A Symbol"))))
+ (if (not (semantic-lex-spp-symbol-p var-symbol-name))
+ (progn
+ (semantic-push-parser-warning
+ (format "Skip %s" (buffer-substring-no-properties
+ (point-at-bol) (point-at-eol)))
+ (point-at-bol) (point-at-eol))
+ nil)
+ t)))
+
+;;; HIDEIF ADVICE
+;;
+;; Advise hideif functions to use our lexical tables instead.
+(defvar semantic-c-takeover-hideif nil
+ "Non-nil when Semantic is taking over hideif features.")
+
+;; (defadvice hif-defined (around semantic-c activate)
+;; "Is the variable defined?"
+;; (if semantic-c-takeover-hideif
+;; (setq ad-return-value
+;; (semantic-c-hideif-defined (ad-get-arg 0)))
+;; ad-do-it))
+
+;; (defadvice hif-lookup (around semantic-c activate)
+;; "Is the argument defined? Return true or false."
+;; (let ((ans nil))
+;; (when semantic-c-takeover-hideif
+;; (setq ans (semantic-c-hideif-lookup (ad-get-arg 0))))
+;; (if (null ans)
+;; ad-do-it
+;; (setq ad-return-value ans))))
+
+;;; #if macros
+;;
+;; Support #if macros by evaluating the values via use of hideif
+;; logic. See above for hacks to make this work.
(define-lex-regex-analyzer semantic-lex-c-if
"Code blocks wrapped up in #if, or #ifdef.
Uses known macro tables in SPP to determine what block to skip."
- "^\\s-*#\\s-*\\(if\\|ifndef\\|ifdef\\|elif\\)\\s-+\\(!?defined(\\|\\)\\s-*\\(\\(\\sw\\|\\s_\\)+\\)\\(\\s-*)\\)?\\s-*$"
+ "^\\s-*#\\s-*\\(if\\|elif\\).*$"
(semantic-c-do-lex-if))
(defun semantic-c-do-lex-if ()
+ "Handle lexical CPP if statements.
+Enables a takeover of some hideif functions, then uses hideif to
+evaluate the #if expression and enables us to make decisions on which
+code to parse."
+ ;; Enable our advice, and use hideif to parse.
+ (let* ((semantic-c-takeover-hideif t)
+ (hif-ifx-regexp (concat hif-cpp-prefix "\\(elif\\|if\\(n?def\\)?\\)[ \t]+"))
+ (parsedtokelist
+ (condition-case nil
+ ;; This is imperfect, so always assume on error.
+ (hif-canonicalize)
+ (error nil))))
+
+ (let ((eval-form (eval parsedtokelist)))
+ (if (or (not eval-form)
+ (and (numberp eval-form)
+ (equal eval-form 0)));; ifdefline resulted in false
+
+ ;; The if indicates to skip this preprocessor section
+ (let ((pt nil))
+ (semantic-push-parser-warning (format "Skip %s" (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+ (point-at-bol) (point-at-eol))
+ (beginning-of-line)
+ (setq pt (point))
+ ;; This skips only a section of a conditional. Once that section
+ ;; is opened, encountering any new #else or related conditional
+ ;; should be skipped.
+ (semantic-c-skip-conditional-section)
+ (setq semantic-lex-end-point (point))
+
+ ;; @TODO -somewhere around here, we also need to skip
+ ;; other sections of the conditional.
+
+ nil)
+ ;; Else, don't ignore it, but do handle the internals.
+ (end-of-line)
+ (setq semantic-lex-end-point (point))
+ nil))))
+
+(define-lex-regex-analyzer semantic-lex-c-ifdef
+ "Code blocks wrapped up in #ifdef.
+Uses known macro tables in SPP to determine what block to skip."
+ "^\\s-*#\\s-*\\(ifndef\\|ifdef\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)$"
+ (semantic-c-do-lex-ifdef))
+
+(defun semantic-c-do-lex-ifdef ()
"Handle lexical CPP if statements."
(let* ((sym (buffer-substring-no-properties
- (match-beginning 3) (match-end 3)))
- (defstr (buffer-substring-no-properties
- (match-beginning 2) (match-end 2)))
- (defined (string= defstr "defined("))
- (notdefined (string= defstr "!defined("))
+ (match-beginning 2) (match-end 2)))
(ift (buffer-substring-no-properties
(match-beginning 1) (match-end 1)))
- (ifdef (or (string= ift "ifdef")
- (and (string= ift "if") defined)
- (and (string= ift "elif") defined)
- ))
- (ifndef (or (string= ift "ifndef")
- (and (string= ift "if") notdefined)
- (and (string= ift "elif") notdefined)
- ))
+ (ifdef (string= ift "ifdef"))
+ (ifndef (string= ift "ifndef"))
)
- (if (or (and (or (string= ift "if") (string= ift "elif"))
- (string= sym "0"))
- (and ifdef (not (semantic-lex-spp-symbol-p sym)))
+ (if (or (and ifdef (not (semantic-lex-spp-symbol-p sym)))
(and ifndef (semantic-lex-spp-symbol-p sym)))
;; The if indicates to skip this preprocessor section.
(let ((pt nil))
@@ -556,6 +754,7 @@ Use semantic-cpp-lexer for parsing text inside a CPP macro."
;; C preprocessor features
semantic-lex-cpp-define
semantic-lex-cpp-undef
+ semantic-lex-c-ifdef
semantic-lex-c-if
semantic-lex-c-macro-else
semantic-lex-c-macrobits
@@ -724,6 +923,8 @@ the regular parser."
;; Hack in mode-local
(activate-mode-local-bindings)
+ ;; Setup C parser
+ (semantic-default-c-setup)
;; CHEATER! The following 3 lines are from
;; `semantic-new-buffer-fcn', but we don't want to turn
;; on all the other annoying modes for this little task.
@@ -800,51 +1001,18 @@ now.
)
;; Expand an EXTERN C first.
(when (eq (semantic-tag-class tag) 'extern)
- (let* ((mb (semantic-tag-get-attribute tag :members))
- (ret mb))
- (while mb
- (let ((mods (semantic-tag-get-attribute (car mb) :typemodifiers)))
- (setq mods (cons "extern" (cons "\"C\"" mods)))
- (semantic-tag-put-attribute (car mb) :typemodifiers mods))
- (setq mb (cdr mb)))
- (setq return-list ret)))
+ (setq return-list (semantic-expand-c-extern-C tag))
+ ;; The members will be expanded in the next iteration. The
+ ;; 'extern' tag itself isn't needed anymore.
+ (setq tag nil))
- ;; Function or variables that have a :type that is some complex
- ;; thing, extract it, and replace it with a reference.
- ;;
- ;; Thus, struct A { int a; } B;
- ;;
- ;; will create 2 toplevel tags, one is type A, and the other variable B
- ;; where the :type of B is just a type tag A that is a prototype, and
- ;; the actual struct info of A is its own toplevel tag.
+ ;; Check if we have a complex type
(when (or (semantic-tag-of-class-p tag 'function)
(semantic-tag-of-class-p tag 'variable))
- (let* ((basetype (semantic-tag-type tag))
- (typeref nil)
- (tname (when (consp basetype)
- (semantic-tag-name basetype))))
- ;; Make tname be a string.
- (when (consp tname) (setq tname (car (car tname))))
- ;; Is the basetype a full type with a name of its own?
- (when (and basetype (semantic-tag-p basetype)
- (not (semantic-tag-prototype-p basetype))
- tname
- (not (string= tname "")))
- ;; a type tag referencing the type we are extracting.
- (setq typeref (semantic-tag-new-type
- (semantic-tag-name basetype)
- (semantic-tag-type basetype)
- nil nil
- :prototype t))
- ;; Convert original tag to only have a reference.
- (setq tag (semantic-tag-copy tag))
- (semantic-tag-put-attribute tag :type typeref)
- ;; Convert basetype to have the location information.
- (semantic--tag-copy-properties tag basetype)
- (semantic--tag-set-overlay basetype
- (semantic-tag-overlay tag))
- ;; Store the base tag as part of the return list.
- (setq return-list (cons basetype return-list)))))
+ (setq tag (semantic-expand-c-complex-type tag))
+ ;; Extract new basetag
+ (setq return-list (car tag))
+ (setq tag (cdr tag)))
;; Name of the tag is a list, so expand it. Tag lists occur
;; for variables like this: int var1, var2, var3;
@@ -865,13 +1033,63 @@ now.
;; If we didn't have a list, but the return-list is non-empty,
;; that means we still need to take our existing tag, and glom
;; it onto our extracted type.
- (if (consp return-list)
+ (if (and tag (consp return-list))
(setq return-list (cons tag return-list)))
)
;; Default, don't change the tag means returning nil.
return-list))
+(defun semantic-expand-c-extern-C (tag)
+ "Expand TAG containing an 'extern \"C\"' statement.
+This will return all members of TAG with 'extern \"C\"' added to
+the typemodifiers attribute."
+ (when (eq (semantic-tag-class tag) 'extern)
+ (let* ((mb (semantic-tag-get-attribute tag :members))
+ (ret mb))
+ (while mb
+ (let ((mods (semantic-tag-get-attribute (car mb) :typemodifiers)))
+ (setq mods (cons "extern" (cons "\"C\"" mods)))
+ (semantic-tag-put-attribute (car mb) :typemodifiers mods))
+ (setq mb (cdr mb)))
+ (nreverse ret))))
+
+(defun semantic-expand-c-complex-type (tag)
+ "Check if TAG has a full :type with a name on its own.
+If so, extract it, and replace it with a reference to that type.
+Thus, 'struct A { int a; } B;' will create 2 toplevel tags, one
+is type A, and the other variable B where the :type of B is just
+a type tag A that is a prototype, and the actual struct info of A
+is its own toplevel tag. This function will return (cons A B)."
+ (let* ((basetype (semantic-tag-type tag))
+ (typeref nil)
+ (ret nil)
+ (tname (when (consp basetype)
+ (semantic-tag-name basetype))))
+ ;; Make tname be a string.
+ (when (consp tname) (setq tname (car (car tname))))
+ ;; Is the basetype a full type with a name of its own?
+ (when (and basetype (semantic-tag-p basetype)
+ (not (semantic-tag-prototype-p basetype))
+ tname
+ (not (string= tname "")))
+ ;; a type tag referencing the type we are extracting.
+ (setq typeref (semantic-tag-new-type
+ (semantic-tag-name basetype)
+ (semantic-tag-type basetype)
+ nil nil
+ :prototype t))
+ ;; Convert original tag to only have a reference.
+ (setq tag (semantic-tag-copy tag))
+ (semantic-tag-put-attribute tag :type typeref)
+ ;; Convert basetype to have the location information.
+ (semantic--tag-copy-properties tag basetype)
+ (semantic--tag-set-overlay basetype
+ (semantic-tag-overlay tag))
+ ;; Store the base tag as part of the return list.
+ (setq ret (cons basetype ret)))
+ (cons ret tag)))
+
(defun semantic-expand-c-tag-namelist (tag)
"Expand TAG whose name is a list into a list of tags, or nil."
(cond ((semantic-tag-of-class-p tag 'variable)
@@ -1238,6 +1456,22 @@ Override function for `semantic-tag-protection'."
'public
nil))))
+(define-mode-local-override semantic-find-tags-included c-mode
+ (&optional table)
+ "Find all tags in TABLE that are of the 'include class.
+TABLE is a tag table. See `semantic-something-to-tag-table'.
+For C++, we also have to search namespaces for include tags."
+ (let ((tags (semantic-find-tags-by-class 'include table))
+ (namespaces (semantic-find-tags-by-type "namespace" table)))
+ (dolist (cur namespaces)
+ (setq tags
+ (append tags
+ (semantic-find-tags-by-class
+ 'include
+ (semantic-tag-get-attribute cur :members)))))
+ tags))
+
+
(define-mode-local-override semantic-tag-components c-mode (tag)
"Return components for TAG."
(if (and (eq (semantic-tag-class tag) 'type)
@@ -1342,7 +1576,7 @@ SCOPE is not used, and TYPE-DECLARATION is used only if TYPE is not a typedef."
(string= (semantic-tag-type type) "typedef"))
(let ((dt (semantic-tag-get-attribute type :typedef)))
(cond ((and (semantic-tag-p dt)
- (not (semantic-analyze-tag-prototype-p dt)))
+ (not (semantic-tag-prototype-p dt)))
;; In this case, DT was declared directly. We need
;; to clone DT and apply a filename to it.
(let* ((fname (semantic-tag-file-name type))
@@ -1656,6 +1890,58 @@ For types with a :parent, create faux namespaces to put TAG into."
;; Else, return tag unmodified.
tag)))
+(define-mode-local-override semanticdb-find-table-for-include c-mode
+ (includetag &optional table)
+ "For a single INCLUDETAG found in TABLE, find a `semanticdb-table' object
+INCLUDETAG is a semantic TAG of class 'include.
+TABLE is a semanticdb table that identifies where INCLUDETAG came from.
+TABLE is optional if INCLUDETAG has an overlay of :filename attribute.
+
+For C++, we also have to check if the include is inside a
+namespace, since this means all tags inside this include will
+have to be wrapped in that namespace."
+ (let ((inctable (semanticdb-find-table-for-include-default includetag table))
+ (inside-ns (semantic-tag-get-attribute includetag :inside-ns))
+ tags newtags namespaces prefix parenttable newtable)
+ (if (or (null inside-ns)
+ (not inctable)
+ (not (slot-boundp inctable 'tags)))
+ inctable
+ (when (and (eq inside-ns t)
+ ;; Get the table which has this include.
+ (setq parenttable
+ (semanticdb-find-table-for-include-default
+ (semantic-tag-new-include
+ (semantic--tag-get-property includetag :filename) nil)))
+ table)
+ ;; Find the namespace where this include is located.
+ (setq namespaces
+ (semantic-find-tags-by-type "namespace" parenttable))
+ (when (and namespaces
+ (slot-boundp inctable 'tags))
+ (dolist (cur namespaces)
+ (when (semantic-find-tags-by-name
+ (semantic-tag-name includetag)
+ (semantic-tag-get-attribute cur :members))
+ (setq inside-ns (semantic-tag-name cur))
+ ;; Cache the namespace value.
+ (semantic-tag-put-attribute includetag :inside-ns inside-ns)))))
+ (unless (semantic-find-tags-by-name
+ inside-ns
+ (semantic-find-tags-by-type "namespace" inctable))
+ (setq tags (oref inctable tags))
+ ;; Wrap tags inside namespace tag
+ (setq newtags
+ (list (semantic-tag-new-type inside-ns "namespace" tags nil)))
+ ;; Create new semantic-table for the wrapped tags, since we don't want
+ ;; the namespace to actually be a part of the header file.
+ (setq newtable (semanticdb-table "include with context"))
+ (oset newtable tags newtags)
+ (oset newtable parent-db (oref inctable parent-db))
+ (oset newtable file (oref inctable file)))
+ newtable)))
+
+
(define-mode-local-override semantic-get-local-variables c++-mode ()
"Do what `semantic-get-local-variables' does, plus add `this' if needed."
(let* ((origvar (semantic-get-local-variables-default))
@@ -1693,6 +1979,52 @@ For types with a :parent, create faux namespaces to put TAG into."
txt)
(semantic-idle-summary-current-symbol-info-default))))
+(define-mode-local-override semantic--tag-similar-names-p c-mode (tag1 tag2 blankok)
+ "Compare the names of TAG1 and TAG2.
+If BLANKOK is false, then the names must exactly match.
+If BLANKOK is true, then always return t, as for C, the names don't matter
+for arguments compared."
+ (if blankok t (semantic--tag-similar-names-p-default tag1 tag2 nil)))
+
+(define-mode-local-override semantic--tag-similar-types-p c-mode (tag1 tag2)
+ "For c-mode, deal with TAG1 and TAG2 being used in different namespaces.
+In this case, one type will be shorter than the other. Instead
+of fully resolving all namespaces currently in scope for both
+types, we simply compare as many elements as the shorter type
+provides."
+ ;; First, we see if the default method fails
+ (if (semantic--tag-similar-types-p-default tag1 tag2)
+ t
+ (let* ((names
+ (mapcar
+ (lambda (tag)
+ (let ((type (semantic-tag-type tag)))
+ (unless (stringp type)
+ (setq type (semantic-tag-name type)))
+ (setq type (semantic-analyze-split-name type))
+ (when (stringp type)
+ (setq type (list type)))
+ type))
+ (list tag1 tag2)))
+ (len1 (length (car names)))
+ (len2 (length (cadr names))))
+ (cond
+ ((<= len1 len2)
+ (equal (nthcdr len1 (cadr names)) (car names)))
+ ((< len2 len1)
+ (equal (nthcdr len2 (car names)) (cadr names)))))))
+
+
+(define-mode-local-override semantic--tag-attribute-similar-p c-mode
+ (attr value1 value2 ignorable-attributes)
+ "For c-mode, allow function :arguments to ignore the :name attributes."
+ (cond ((eq attr :arguments)
+ (semantic--tag-attribute-similar-p-default attr value1 value2
+ (cons :name ignorable-attributes)))
+ (t
+ (semantic--tag-attribute-similar-p-default attr value1 value2
+ ignorable-attributes))))
+
(defvar-mode-local c-mode semantic-orphaned-member-metaparent-type "struct"
"When lost members are found in the class hierarchy generator, use a struct.")
@@ -1725,6 +2057,12 @@ For types with a :parent, create faux namespaces to put TAG into."
(defvar-mode-local c-mode senator-step-at-tag-classes '(function variable)
"Tag classes where senator will stop at the end.")
+(defvar-mode-local c-mode semantic-tag-similar-ignorable-attributes
+ '(:prototype-flag :parent :typemodifiers)
+ "Tag attributes to ignore during similarity tests.
+:parent is here because some tags might specify a parent, while others are
+actually in their parent which is not accessible.")
+
;;;###autoload
(defun semantic-default-c-setup ()
"Set up a buffer for semantic parsing of the C language."
@@ -1736,6 +2074,8 @@ For types with a :parent, create faux namespaces to put TAG into."
(setq semantic-lex-analyzer #'semantic-c-lexer)
(add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t)
+ (when (eq major-mode 'c++-mode)
+ (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__cplusplus" . "")))
)
;;;###autoload
@@ -1759,7 +2099,7 @@ For types with a :parent, create faux namespaces to put TAG into."
(defun semantic-c-describe-environment ()
"Describe the Semantic features of the current C environment."
(interactive)
- (if (not (or (eq major-mode 'c-mode) (eq major-mode 'c++-mode)))
+ (if (not (member 'c-mode (mode-local-equivalent-mode-p major-mode)))
(error "Not useful to query C mode in %s mode" major-mode))
(let ((gcc (when (boundp 'semantic-gcc-setup-data)
semantic-gcc-setup-data))
@@ -1780,13 +2120,20 @@ For types with a :parent, create faux namespaces to put TAG into."
(princ "\n\nInclude Path Summary:\n")
(when (and (boundp 'ede-object) ede-object)
(princ "\n This file's project include is handled by:\n")
- (princ " ")
- (princ (object-print ede-object))
- (princ "\n with the system path:\n")
- (dolist (dir (ede-system-include-path ede-object))
- (princ " ")
- (princ dir)
- (princ "\n"))
+ (let ((objs (if (listp ede-object)
+ ede-object
+ (list ede-object))))
+ (dolist (O objs)
+ (princ " EDE : ")
+ (princ (object-print O))
+ (let ((ipath (ede-system-include-path O)))
+ (if (not ipath)
+ (princ "\n with NO specified system include path.\n")
+ (princ "\n with the system path:\n")
+ (dolist (dir ipath)
+ (princ " ")
+ (princ dir)
+ (princ "\n"))))))
)
(when semantic-dependency-include-path
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index 818b8b581a4..7bad1483dc3 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -944,8 +944,6 @@ ELisp variables can be pretty long, so track this one too.")
"Setup hook function for Emacs Lisp files and Semantic."
)
-(add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup)
-
;;; LISP MODE
;;
;; @TODO: Lisp supports syntaxes that Emacs Lisp does not.
@@ -956,7 +954,7 @@ ELisp variables can be pretty long, so track this one too.")
;;
(add-hook 'lisp-mode-hook 'semantic-default-elisp-setup)
-(eval-after-load "semanticdb"
+(eval-after-load "semantic/db"
'(require 'semantic/db-el)
)
diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el
index 8b47ae14eee..842ef0914fd 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -33,30 +33,32 @@
;;; Code:
(defun semantic-gcc-query (gcc-cmd &rest gcc-options)
- "Return program output to both standard output and standard error.
+ "Return program output or error code in case error happens.
GCC-CMD is the program to execute and GCC-OPTIONS are the options
to give to the program."
;; $ gcc -v
;;
- (let ((buff (get-buffer-create " *gcc-query*"))
- (old-lc-messages (getenv "LC_ALL")))
+ (let* ((buff (get-buffer-create " *gcc-query*"))
+ (old-lc-messages (getenv "LC_ALL"))
+ (options `(,nil ,(cons buff t) ,nil ,@gcc-options))
+ (err 0))
(with-current-buffer buff
(erase-buffer)
(setenv "LC_ALL" "C")
(condition-case nil
- (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options)
+ (setq err (apply 'call-process gcc-cmd options))
(error ;; Some bogus directory for the first time perhaps?
(let ((default-directory (expand-file-name "~/")))
(condition-case nil
- (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options)
+ (setq err (apply 'call-process gcc-cmd options))
(error ;; gcc doesn't exist???
nil)))))
(setenv "LC_ALL" old-lc-messages)
(prog1
- (buffer-string)
- (kill-buffer buff)
- )
- )))
+ (if (zerop err)
+ (buffer-string)
+ err)
+ (kill-buffer buff)))))
;;(semantic-gcc-get-include-paths "c")
;;(semantic-gcc-get-include-paths "c++")
@@ -148,7 +150,14 @@ It should also include other symbols GCC was compiled with.")
(interactive)
(let* ((fields (or semantic-gcc-setup-data
(semantic-gcc-fields (semantic-gcc-query "gcc" "-v"))))
- (defines (semantic-cpp-defs (semantic-gcc-query "cpp" "-E" "-dM" "-x" "c++" null-device)))
+ (cpp-options `("-E" "-dM" "-x" "c++" ,null-device))
+ (query (let ((q (apply 'semantic-gcc-query "cpp" cpp-options)))
+ (if (stringp q)
+ q
+ ;; `cpp' command in `semantic-gcc-setup' doesn't work on
+ ;; Mac, try `gcc'.
+ (apply 'semantic-gcc-query "gcc" cpp-options))))
+ (defines (semantic-cpp-defs query))
(ver (cdr (assoc 'version fields)))
(host (or (cdr (assoc 'target fields))
(cdr (assoc '--target fields))
@@ -156,13 +165,14 @@ It should also include other symbols GCC was compiled with.")
(prefix (cdr (assoc '--prefix fields)))
;; gcc output supplied paths
(c-include-path (semantic-gcc-get-include-paths "c"))
- (c++-include-path (semantic-gcc-get-include-paths "c++")))
+ (c++-include-path (semantic-gcc-get-include-paths "c++"))
+ (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable))
+ )
;; Remember so we don't have to call GCC twice.
(setq semantic-gcc-setup-data fields)
- (unless c-include-path
+ (when (and (not c-include-path) gcc-exe)
;; Fallback to guesses
(let* ( ;; gcc include dirs
- (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable))
(gcc-root (expand-file-name ".." (file-name-directory gcc-exe)))
(gcc-include (expand-file-name "include" gcc-root))
(gcc-include-c++ (expand-file-name "c++" gcc-include))
@@ -196,20 +206,24 @@ It should also include other symbols GCC was compiled with.")
(semantic-add-system-include D 'c-mode))
(dolist (D (semantic-gcc-get-include-paths "c++"))
(semantic-add-system-include D 'c++-mode)
- (let ((cppconfig (concat D "/bits/c++config.h")))
- ;; Presumably there will be only one of these files in the try-paths list...
- (when (file-readable-p cppconfig)
+ (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h"))))
+ (dolist (cur cppconfig)
+ ;; Presumably there will be only one of these files in the try-paths list...
+ (when (file-readable-p cur)
;; Add it to the symbol file
(if (boundp 'semantic-lex-c-preprocessor-symbol-file)
;; Add to the core macro header list
- (add-to-list 'semantic-lex-c-preprocessor-symbol-file cppconfig)
+ (add-to-list 'semantic-lex-c-preprocessor-symbol-file cur)
;; Setup the core macro header
- (setq semantic-lex-c-preprocessor-symbol-file (list cppconfig)))
- )))
+ (setq semantic-lex-c-preprocessor-symbol-file (list cur)))
+ ))))
(if (not (boundp 'semantic-lex-c-preprocessor-symbol-map))
(setq semantic-lex-c-preprocessor-symbol-map nil))
(dolist (D defines)
(add-to-list 'semantic-lex-c-preprocessor-symbol-map D))
+ ;; Needed for parsing OS X libc
+ (when (eq system-type 'darwin)
+ (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__i386__" . "")))
(when (featurep 'semantic/bovine/c)
(semantic-c-reset-preprocessor-symbol-map))
nil))
diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el
new file mode 100644
index 00000000000..cc27c5b0646
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -0,0 +1,506 @@
+;;; semantic/bovine/grammar.el --- Bovine's input grammar mode
+;;
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
+;;
+;; Author: David Ponce <david@dponce.com>
+;; Maintainer: David Ponce <david@dponce.com>
+;; Created: 26 Aug 2002
+;; Keywords: syntax
+
+;; 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:
+;;
+;; Major mode for editing Bovine's input grammar (.by) files.
+
+;;; History:
+
+;;; Code:
+(require 'semantic)
+(require 'semantic/grammar)
+(require 'semantic/find)
+(require 'semantic/lex)
+(require 'semantic/wisent)
+(require 'semantic/bovine)
+
+(defun bovine-grammar-EXPAND (bounds nonterm)
+ "Expand call to EXPAND grammar macro.
+Return the form to parse from within a nonterminal between BOUNDS.
+NONTERM is the nonterminal symbol to start with."
+ `(semantic-bovinate-from-nonterminal
+ (car ,bounds) (cdr ,bounds) ',nonterm))
+
+(defun bovine-grammar-EXPANDFULL (bounds nonterm)
+ "Expand call to EXPANDFULL grammar macro.
+Return the form to recursively parse the area between BOUNDS.
+NONTERM is the nonterminal symbol to start with."
+ `(semantic-parse-region
+ (car ,bounds) (cdr ,bounds) ',nonterm 1))
+
+(defun bovine-grammar-TAG (name class &rest attributes)
+ "Expand call to TAG grammar macro.
+Return the form to create a generic semantic tag.
+See the function `semantic-tag' for the meaning of arguments NAME,
+CLASS and ATTRIBUTES."
+ `(semantic-tag ,name ,class ,@attributes))
+
+(defun bovine-grammar-VARIABLE-TAG (name type default-value &rest attributes)
+ "Expand call to VARIABLE-TAG grammar macro.
+Return the form to create a semantic tag of class variable.
+See the function `semantic-tag-new-variable' for the meaning of
+arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES."
+ `(semantic-tag-new-variable ,name ,type ,default-value ,@attributes))
+
+(defun bovine-grammar-FUNCTION-TAG (name type arg-list &rest attributes)
+ "Expand call to FUNCTION-TAG grammar macro.
+Return the form to create a semantic tag of class function.
+See the function `semantic-tag-new-function' for the meaning of
+arguments NAME, TYPE, ARG-LIST and ATTRIBUTES."
+ `(semantic-tag-new-function ,name ,type ,arg-list ,@attributes))
+
+(defun bovine-grammar-TYPE-TAG (name type members parents &rest attributes)
+ "Expand call to TYPE-TAG grammar macro.
+Return the form to create a semantic tag of class type.
+See the function `semantic-tag-new-type' for the meaning of arguments
+NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES."
+ `(semantic-tag-new-type ,name ,type ,members ,parents ,@attributes))
+
+(defun bovine-grammar-INCLUDE-TAG (name system-flag &rest attributes)
+ "Expand call to INCLUDE-TAG grammar macro.
+Return the form to create a semantic tag of class include.
+See the function `semantic-tag-new-include' for the meaning of
+arguments NAME, SYSTEM-FLAG and ATTRIBUTES."
+ `(semantic-tag-new-include ,name ,system-flag ,@attributes))
+
+(defun bovine-grammar-PACKAGE-TAG (name detail &rest attributes)
+ "Expand call to PACKAGE-TAG grammar macro.
+Return the form to create a semantic tag of class package.
+See the function `semantic-tag-new-package' for the meaning of
+arguments NAME, DETAIL and ATTRIBUTES."
+ `(semantic-tag-new-package ,name ,detail ,@attributes))
+
+(defun bovine-grammar-CODE-TAG (name detail &rest attributes)
+ "Expand call to CODE-TAG grammar macro.
+Return the form to create a semantic tag of class code.
+See the function `semantic-tag-new-code' for the meaning of arguments
+NAME, DETAIL and ATTRIBUTES."
+ `(semantic-tag-new-code ,name ,detail ,@attributes))
+
+(defun bovine-grammar-ALIAS-TAG (name aliasclass definition &rest attributes)
+ "Expand call to ALIAS-TAG grammar macro.
+Return the form to create a semantic tag of class alias.
+See the function `semantic-tag-new-alias' for the meaning of arguments
+NAME, ALIASCLASS, DEFINITION and ATTRIBUTES."
+ `(semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes))
+
+;; Cache of macro definitions currently in use.
+(defvar bovine--grammar-macros nil)
+
+(defun bovine-grammar-expand-form (form quotemode &optional inplace)
+ "Expand FORM into a new one suitable to the bovine parser.
+FORM is a list in which we are substituting.
+Argument QUOTEMODE is non-nil if we are in backquote mode.
+When non-nil, optional argument INPLACE indicates that FORM is being
+expanded from elsewhere."
+ (when (eq (car form) 'quote)
+ (setq form (cdr form))
+ (cond
+ ((and (= (length form) 1) (listp (car form)))
+ (insert "\n(append")
+ (bovine-grammar-expand-form (car form) quotemode nil)
+ (insert ")")
+ (setq form nil inplace nil)
+ )
+ ((and (= (length form) 1) (symbolp (car form)))
+ (insert "\n'" (symbol-name (car form)))
+ (setq form nil inplace nil)
+ )
+ (t
+ (insert "\n(list")
+ (setq inplace t)
+ )))
+ (let ((macro (assq (car form) bovine--grammar-macros))
+ inlist first n q x)
+ (if macro
+ (bovine-grammar-expand-form
+ (apply (cdr macro) (cdr form))
+ quotemode t)
+ (if inplace (insert "\n("))
+ (while form
+ (setq first (car form)
+ form (cdr form))
+ ;; Hack for dealing with new reading of unquotes outside of
+ ;; backquote (introduced in 2010-12-06T16:37:26Z!monnier@iro.umontreal.ca).
+ (when (and (>= emacs-major-version 24)
+ (listp first)
+ (or (equal (car first) '\,)
+ (equal (car first) '\,@)))
+ (if (listp (cadr first))
+ (setq form (append (cdr first) form)
+ first (car first))
+ (setq first (intern (concat (symbol-name (car first))
+ (symbol-name (cadr first)))))))
+ (cond
+ ((eq first nil)
+ (when (and (not inlist) (not inplace))
+ (insert "\n(list")
+ (setq inlist t))
+ (insert " nil")
+ )
+ ((listp first)
+ ;;(let ((fn (and (symbolp (caar form)) (fboundp (caar form)))))
+ (when (and (not inlist) (not inplace))
+ (insert "\n(list")
+ (setq inlist t))
+ ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND)))
+ ;; (insert " (append"))
+ (bovine-grammar-expand-form
+ first quotemode t) ;;(and fn (not (eq fn 'quote))))
+ ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND)))
+ ;; (insert ")"))
+ ;;)
+ )
+ ((symbolp first)
+ (setq n (symbol-name first) ;the name
+ q quotemode ;implied quote flag
+ x nil) ;expand flag
+ (if (eq (aref n 0) ?,)
+ (if quotemode
+ ;; backquote mode needs the @
+ (if (eq (aref n 1) ?@)
+ (setq n (substring n 2)
+ q nil
+ x t)
+ ;; non backquote mode behaves normally.
+ (setq n (substring n 1)
+ q nil))
+ (setq n (substring n 1)
+ x t)))
+ (if (string= n "")
+ (progn
+ ;; We expand only the next item in place (a list?)
+ ;; A regular inline-list...
+ (bovine-grammar-expand-form (car form) quotemode t)
+ (setq form (cdr form)))
+ (if (and (eq (aref n 0) ?$)
+ ;; Don't expand $ tokens in implied quote mode.
+ ;; This acts like quoting in other symbols.
+ (not q))
+ (progn
+ (cond
+ ((and (not x) (not inlist) (not inplace))
+ (insert "\n(list"))
+ ((and x inlist (not inplace))
+ (insert ")")
+ (setq inlist nil)))
+ (insert "\n(nth " (int-to-string
+ (1- (string-to-number
+ (substring n 1))))
+ " vals)")
+ (and (not x) (not inplace)
+ (setq inlist t)))
+
+ (when (and (not inlist) (not inplace))
+ (insert "\n(list")
+ (setq inlist t))
+ (or (char-equal (char-before) ?\()
+ (insert " "))
+ (insert (if (or inplace (eq first t))
+ "" "'")
+ n))) ;; " "
+ )
+ (t
+ (when (and (not inlist) (not inplace))
+ (insert "\n(list")
+ (setq inlist t))
+ (insert (format "\n%S" first))
+ )
+ ))
+ (if inlist (insert ")"))
+ (if inplace (insert ")")))
+ ))
+
+(defun bovine-grammar-expand-action (textform quotemode)
+ "Expand semantic action string TEXTFORM into Lisp code.
+QUOTEMODE is the mode in which quoted symbols are slurred."
+ (if (string= "" textform)
+ nil
+ (let ((sexp (read textform)))
+ ;; We converted the lambda string into a list. Now write it
+ ;; out as the bovine lambda expression, and do macro-like
+ ;; conversion upon it.
+ (insert "\n")
+ (cond
+ ((eq (car sexp) 'EXPAND)
+ (insert ",(lambda (vals start end)")
+ ;; The EXPAND macro definition is mandatory
+ (bovine-grammar-expand-form
+ (apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp))
+ quotemode t)
+ )
+ ((and (listp (car sexp)) (eq (caar sexp) 'EVAL))
+ ;; The user wants to evaluate the following args.
+ ;; Use a simpler expander
+ )
+ (t
+ (insert ",(semantic-lambda")
+ (bovine-grammar-expand-form sexp quotemode)
+ ))
+ (insert ")\n")))
+)
+
+(defun bovine-grammar-parsetable-builder ()
+ "Return the parser table expression as a string value.
+The format of a bovine parser table is:
+
+ ( ( NONTERMINAL-SYMBOL1 MATCH-LIST1 )
+ ( NONTERMINAL-SYMBOL2 MATCH-LIST2 )
+ ...
+ ( NONTERMINAL-SYMBOLn MATCH-LISTn )
+
+Where each NONTERMINAL-SYMBOL is an artificial symbol which can appear
+in any child state. As a starting place, one of the NONTERMINAL-SYMBOLS
+must be `bovine-toplevel'.
+
+A MATCH-LIST is a list of possible matches of the form:
+
+ ( STATE-LIST1
+ STATE-LIST2
+ ...
+ STATE-LISTN )
+
+where STATE-LIST is of the form:
+ ( TYPE1 [ \"VALUE1\" ] TYPE2 [ \"VALUE2\" ] ... LAMBDA )
+
+where TYPE is one of the returned types of the token stream.
+VALUE is a value, or range of values to match against. For
+example, a SYMBOL might need to match \"foo\". Some TYPES will not
+have matching criteria.
+
+LAMBDA is a lambda expression which is evalled with the text of the
+type when it is found. It is passed the list of all buffer text
+elements found since the last lambda expression. It should return a
+semantic element (see below.)
+
+For consistency between languages, try to use common return values
+from your parser. Please reference the chapter \"Writing Parsers\" in
+the \"Language Support Developer's Guide -\" in the semantic texinfo
+manual."
+ (let* ((start (semantic-grammar-start))
+ (scopestart (semantic-grammar-scopestart))
+ (quotemode (semantic-grammar-quotemode))
+ (tags (semantic-find-tags-by-class
+ 'token (current-buffer)))
+ (nterms (semantic-find-tags-by-class
+ 'nonterminal (current-buffer)))
+ ;; Setup the cache of macro definitions.
+ (bovine--grammar-macros (semantic-grammar-macros))
+ nterm rules items item actn prec tag type regex)
+
+ ;; Check some trivial things
+ (cond
+ ((null nterms)
+ (error "Bad input grammar"))
+ (start
+ (if (cdr start)
+ (message "Extra start symbols %S ignored" (cdr start)))
+ (setq start (symbol-name (car start)))
+ (unless (semantic-find-first-tag-by-name start nterms)
+ (error "start symbol `%s' has no rule" start)))
+ (t
+ ;; Default to the first grammar rule.
+ (setq start (semantic-tag-name (car nterms)))))
+ (when scopestart
+ (setq scopestart (symbol-name scopestart))
+ (unless (semantic-find-first-tag-by-name scopestart nterms)
+ (error "scopestart symbol `%s' has no rule" scopestart)))
+
+ ;; Generate the grammar Lisp form.
+ (with-temp-buffer
+ (erase-buffer)
+ (insert "`(")
+ ;; Insert the start/scopestart rules
+ (insert "\n(bovine-toplevel \n("
+ start
+ ")\n) ;; end bovine-toplevel\n")
+ (when scopestart
+ (insert "\n(bovine-inner-scope \n("
+ scopestart
+ ")\n) ;; end bovine-inner-scope\n"))
+ ;; Process each nonterminal
+ (while nterms
+ (setq nterm (car nterms)
+ ;; We can't use the override form because the current buffer
+ ;; is not the originator of the tag.
+ rules (semantic-tag-components-semantic-grammar-mode nterm)
+ nterm (semantic-tag-name nterm)
+ nterms (cdr nterms))
+ (when (member nterm '("bovine-toplevel" "bovine-inner-scope"))
+ (error "`%s' is a reserved internal name" nterm))
+ (insert "\n(" nterm)
+ ;; Process each rule
+ (while rules
+ (setq items (semantic-tag-get-attribute (car rules) :value)
+ prec (semantic-tag-get-attribute (car rules) :prec)
+ actn (semantic-tag-get-attribute (car rules) :expr)
+ rules (cdr rules))
+ ;; Process each item
+ (insert "\n(")
+ (if (null items)
+ ;; EMPTY rule
+ (insert ";;EMPTY" (if actn "" "\n"))
+ ;; Expand items
+ (while items
+ (setq item (car items)
+ items (cdr items))
+ (if (consp item) ;; mid-rule action
+ (message "Mid-rule action %S ignored" item)
+ (or (char-equal (char-before) ?\()
+ (insert "\n"))
+ (cond
+ ((member item '("bovine-toplevel" "bovine-inner-scope"))
+ (error "`%s' is a reserved internal name" item))
+ ;; Replace ITEM by its %token definition.
+ ;; If a '%token TYPE ITEM [REGEX]' definition exists
+ ;; in the grammar, ITEM is replaced by TYPE [REGEX].
+ ((setq tag (semantic-find-first-tag-by-name
+ item tags)
+ type (semantic-tag-get-attribute tag :type))
+ (insert type)
+ (if (setq regex (semantic-tag-get-attribute tag :value))
+ (insert (format "\n%S" regex))))
+ ;; Don't change ITEM
+ (t
+ (insert (semantic-grammar-item-text item)))
+ ))))
+ (if prec
+ (message "%%prec %S ignored" prec))
+ (if actn
+ (bovine-grammar-expand-action actn quotemode))
+ (insert ")"))
+ (insert "\n) ;; end " nterm "\n"))
+ (insert ")\n")
+ (buffer-string))))
+
+(defun bovine-grammar-setupcode-builder ()
+ "Return the text of the setup code."
+ (format
+ "(setq semantic--parse-table %s\n\
+ semantic-debug-parser-source %S\n\
+ semantic-debug-parser-class 'semantic-bovine-debug-parser
+ semantic-flex-keywords-obarray %s\n\
+ %s)"
+ (semantic-grammar-parsetable)
+ (buffer-name)
+ (semantic-grammar-keywordtable)
+ (let ((mode (semantic-grammar-languagemode)))
+ ;; Is there more than one major mode?
+ (if (and (listp mode) (> (length mode) 1))
+ (format "semantic-equivalent-major-modes '%S\n" mode)
+ ""))))
+
+(defvar bovine-grammar-menu
+ '("BY Grammar")
+ "BY mode specific grammar menu.
+Menu items are appended to the common grammar menu.")
+
+;;;###autoload
+(define-derived-mode bovine-grammar-mode semantic-grammar-mode "BY"
+ "Major mode for editing Bovine grammars."
+ (semantic-grammar-setup-menu bovine-grammar-menu)
+ (semantic-install-function-overrides
+ '((grammar-parsetable-builder . bovine-grammar-parsetable-builder)
+ (grammar-setupcode-builder . bovine-grammar-setupcode-builder))))
+
+(add-to-list 'auto-mode-alist '("\\.by\\'" . bovine-grammar-mode))
+
+(defvar-mode-local bovine-grammar-mode semantic-grammar-macros
+ '(
+ (ASSOC . semantic-grammar-ASSOC)
+ (EXPAND . bovine-grammar-EXPAND)
+ (EXPANDFULL . bovine-grammar-EXPANDFULL)
+ (TAG . bovine-grammar-TAG)
+ (VARIABLE-TAG . bovine-grammar-VARIABLE-TAG)
+ (FUNCTION-TAG . bovine-grammar-FUNCTION-TAG)
+ (TYPE-TAG . bovine-grammar-TYPE-TAG)
+ (INCLUDE-TAG . bovine-grammar-INCLUDE-TAG)
+ (PACKAGE-TAG . bovine-grammar-PACKAGE-TAG)
+ (CODE-TAG . bovine-grammar-CODE-TAG)
+ (ALIAS-TAG . bovine-grammar-ALIAS-TAG)
+ )
+ "Semantic grammar macros used in bovine grammars.")
+
+(defun bovine-make-parsers ()
+ "Generate Emacs' built-in Bovine-based parser files."
+ (interactive)
+ (semantic-mode 1)
+ ;; Loop through each .by file in current directory, and run
+ ;; `semantic-grammar-batch-build-one-package' to build the grammar.
+ (dolist (f (directory-files default-directory nil "\\.by\\'"))
+ (let ((packagename
+ (condition-case err
+ (with-current-buffer (find-file-noselect f)
+ (semantic-grammar-create-package))
+ (error (message "%s" (error-message-string err)) nil)))
+ lang filename)
+ (when (and packagename
+ (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename))
+ (setq lang (match-string 1 packagename))
+ (setq filename (concat lang "-by.el"))
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (setq buffer-file-name (expand-file-name filename))
+ ;; Fix copyright header:
+ (goto-char (point-min))
+ (re-search-forward "^;; Author:")
+ (setq copyright-end (match-beginning 0))
+ (re-search-forward "^;;; Code:\n")
+ (delete-region copyright-end (match-end 0))
+ (goto-char copyright-end)
+ (insert ";; 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 was generated from admin/grammars/"
+ lang ".by.
+
+;;; Code:
+")
+ (goto-char (point-min))
+ (delete-region (point-min) (line-end-position))
+ (insert ";;; " packagename
+ " --- Generated parser support file")
+ (delete-trailing-whitespace)
+ (re-search-forward ";;; \\(.*\\) ends here")
+ (replace-match packagename nil nil nil 1)
+ (save-buffer))))))
+
+(provide 'semantic/bovine/grammar)
+
+;;; semantic/bovine/grammar.el ends here
diff --git a/lisp/cedet/semantic/bovine/make-by.el b/lisp/cedet/semantic/bovine/make-by.el
index ac38d1707c3..59738188bbe 100644
--- a/lisp/cedet/semantic/bovine/make-by.el
+++ b/lisp/cedet/semantic/bovine/make-by.el
@@ -19,13 +19,12 @@
;;; Commentary:
;;
-;; This file was generated from etc/grammars/make.by.
+;; This file was generated from admin/grammars/make.by.
;;; Code:
(require 'semantic/lex)
(eval-when-compile (require 'semantic/bovine))
-
;;; Prologue
;;
@@ -380,6 +379,13 @@
semantic-flex-keywords-obarray semantic-make-by--keyword-table
))
+
+;;; Analyzers
+;;
+
+;;; Epilogue
+;;
+
(provide 'semantic/bovine/make-by)
;;; semantic/bovine/make-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el
index 4098b2c0374..041e1f11902 100644
--- a/lisp/cedet/semantic/bovine/make.el
+++ b/lisp/cedet/semantic/bovine/make.el
@@ -27,6 +27,7 @@
(require 'make-mode)
(require 'semantic)
+(require 'semantic/bovine)
(require 'semantic/bovine/make-by)
(require 'semantic/analyze)
(require 'semantic/dep)
diff --git a/lisp/cedet/semantic/bovine/scm-by.el b/lisp/cedet/semantic/bovine/scm-by.el
index d580a5fb22e..476945fa8a3 100644
--- a/lisp/cedet/semantic/bovine/scm-by.el
+++ b/lisp/cedet/semantic/bovine/scm-by.el
@@ -1,4 +1,4 @@
-;;; semantic-scm-by.el --- Generated parser support file
+;;; semantic/bovine/scm-by.el --- Generated parser support file
;; Copyright (C) 2001, 2003, 2009-2012 Free Software Foundation, Inc.
@@ -19,12 +19,11 @@
;;; Commentary:
;;
-;; This file was generated from etc/grammars/scm.by.
+;; This file was generated from admin/grammars/scm.by.
;;; Code:
(require 'semantic/lex)
-
(eval-when-compile (require 'semantic/bovine))
;;; Prologue
@@ -185,6 +184,13 @@
semantic-flex-keywords-obarray semantic-scm-by--keyword-table
))
+
+;;; Analyzers
+;;
+
+;;; Epilogue
+;;
+
(provide 'semantic/bovine/scm-by)
;;; semantic/bovine/scm-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el
index 5c4e2ae6d60..cf2b1f0e212 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -24,6 +24,7 @@
;; Use the Semantic Bovinator for Scheme (guile)
(require 'semantic)
+(require 'semantic/bovine)
(require 'semantic/bovine/scm-by)
(require 'semantic/format)
(require 'semantic/dep)
@@ -37,7 +38,7 @@
This should probably do some sort of search to see what is
actually on the local machine.")
-(define-mode-local-override semantic-format-tag-prototype scheme-mode (tag)
+(define-mode-local-override semantic-format-tag-prototype scheme-mode (tag &optional parent color)
"Return a prototype for the Emacs Lisp nonterminal TAG."
(let* ((tok (semantic-tag-class tag))
(args (semantic-tag-components tag))
@@ -46,7 +47,7 @@ actually on the local machine.")
(concat (semantic-tag-name tag) " ("
(mapconcat (lambda (a) a) args " ")
")")
- (semantic-format-tag-prototype-default tag))))
+ (semantic-format-tag-prototype-default tag parent color))))
(define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional nosnarf)
"Return the documentation string for TAG.
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index 18d4052eb43..9c2da9faefa 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -113,6 +113,7 @@
(require 'semantic/ctxt)
(require 'semantic/decorate)
(require 'semantic/format)
+(require 'semantic/idle)
(eval-when-compile
;; For the semantic-find-tags-for-completion macro.
@@ -685,7 +686,7 @@ a reasonable distance."
(cond
;; EXIT when we are no longer in a good place.
((or (not (eq b (current-buffer)))
- (< (point) s)
+ (<= (point) s)
(> (point) e))
;;(message "Exit: %S %S %S" s e (point))
(semantic-complete-inline-exit)
@@ -904,13 +905,44 @@ a completion displayor object, and tracking the current progress
of a completion."
:abstract t)
+;;; Smart completion collector
+(defclass semantic-collector-analyze-completions (semantic-collector-abstract)
+ ((context :initarg :context
+ :type semantic-analyze-context
+ :documentation "An analysis context.
+Specifies some context location from whence completion lists will be drawn."
+ )
+ (first-pass-completions :type list
+ :documentation "List of valid completion tags.
+This list of tags is generated when completion starts. All searches
+derive from this list.")
+ )
+ "Completion engine that uses the context analyzer to provide options.
+The only options available for completion are those which can be logically
+inserted into the current context.")
+
+(defmethod semantic-collector-calculate-completions-raw
+ ((obj semantic-collector-analyze-completions) prefix completionlist)
+ "calculate the completions for prefix from completionlist."
+ ;; if there are no completions yet, calculate them.
+ (if (not (slot-boundp obj 'first-pass-completions))
+ (oset obj first-pass-completions
+ (semantic-analyze-possible-completions (oref obj context))))
+ ;; search our cached completion list. make it look like a semanticdb
+ ;; results type.
+ (list (cons (with-current-buffer (oref (oref obj context) buffer)
+ semanticdb-current-table)
+ (semantic-find-tags-for-completion
+ prefix
+ (oref obj first-pass-completions)))))
+
(defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
"Clean up any mess this collector may have."
nil)
(defmethod semantic-collector-next-action
((obj semantic-collector-abstract) partial)
- "What should we do next? OBJ can predict a next good action.
+ "What should we do next? OBJ can be used to determine the next action.
PARTIAL indicates if we are doing a partial completion."
(if (and (slot-boundp obj 'last-completion)
(string= (semantic-completion-text) (oref obj last-completion)))
@@ -966,21 +998,38 @@ Output must be in semanticdb Find result format."
"Calculate completions for prefix as setup for other queries."
(let* ((case-fold-search semantic-case-fold)
(same-prefix-p (semantic-collector-last-prefix= obj prefix))
+ (last-prefix (and (slot-boundp obj 'last-prefix)
+ (oref obj last-prefix)))
(completionlist
- (if (or same-prefix-p
- (and (slot-boundp obj 'last-prefix)
- (eq (compare-strings (oref obj last-prefix) 0 nil
- prefix 0 (length prefix))
- t)))
- ;; New prefix is subset of old prefix
- (oref obj last-all-completions)
- (semantic-collector-get-cache obj)))
+ (cond ((or same-prefix-p
+ (and last-prefix (eq (compare-strings
+ last-prefix 0 nil
+ prefix 0 (length last-prefix)) t)))
+ ;; We have the same prefix, or last-prefix is a
+ ;; substring of the of new prefix, in which case we are
+ ;; refining our symbol so just re-use cache.
+ (oref obj last-all-completions))
+ ((and last-prefix
+ (> (length prefix) 1)
+ (eq (compare-strings
+ prefix 0 nil
+ last-prefix 0 (length prefix)) t))
+ ;; The new prefix is a substring of the old
+ ;; prefix, and it's longer than one character.
+ ;; Perform a full search to pull in additional
+ ;; matches.
+ (let ((context (semantic-analyze-current-context (point))))
+ ;; Set new context and make first-pass-completions
+ ;; unbound so that they are newly calculated.
+ (oset obj context context)
+ (when (slot-boundp obj 'first-pass-completions)
+ (slot-makeunbound obj 'first-pass-completions)))
+ nil)))
;; Get the result
(answer (if same-prefix-p
completionlist
(semantic-collector-calculate-completions-raw
- obj prefix completionlist))
- )
+ obj prefix completionlist)))
(completion nil)
(complete-not-uniq nil)
)
@@ -1153,7 +1202,7 @@ NEWCACHE is the new tag table, but we ignore it."
(semantic-collector-buffer-abstract)
()
"Completion engine for tags in the current buffer.
-When searching for a tag, uses semantic deep searche functions.
+When searching for a tag, uses semantic deep search functions.
Basics search only in the current buffer.")
(defmethod semantic-collector-calculate-cache
@@ -1225,37 +1274,6 @@ Uses semanticdb for searching all tags in the current project."
(semantic-find-tags-for-completion prefix localstuff)))))
;(semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path))))
-;;; Smart completion collector
-(defclass semantic-collector-analyze-completions (semantic-collector-abstract)
- ((context :initarg :context
- :type semantic-analyze-context
- :documentation "An analysis context.
-Specifies some context location from whence completion lists will be drawn."
- )
- (first-pass-completions :type list
- :documentation "List of valid completion tags.
-This list of tags is generated when completion starts. All searches
-derive from this list.")
- )
- "Completion engine that uses the context analyzer to provide options.
-The only options available for completion are those which can be logically
-inserted into the current context.")
-
-(defmethod semantic-collector-calculate-completions-raw
- ((obj semantic-collector-analyze-completions) prefix completionlist)
- "calculate the completions for prefix from completionlist."
- ;; if there are no completions yet, calculate them.
- (if (not (slot-boundp obj 'first-pass-completions))
- (oset obj first-pass-completions
- (semantic-analyze-possible-completions (oref obj context))))
- ;; search our cached completion list. make it look like a semanticdb
- ;; results type.
- (list (cons (with-current-buffer (oref (oref obj context) buffer)
- semanticdb-current-table)
- (semantic-find-tags-for-completion
- prefix
- (oref obj first-pass-completions)))))
-
;;; ------------------------------------------------------------
;;; Tag List Display Engines
@@ -1300,8 +1318,9 @@ a collector, and tracking tables of completion to display."
(defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
"The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix)
- (string= (oref obj last-prefix) (semantic-completion-text))
- (eq last-command this-command))
+ (or (eq this-command 'semantic-complete-inline-TAB)
+ (and (string= (oref obj last-prefix) (semantic-completion-text))
+ (eq last-command this-command))))
'scroll
'display))
@@ -1477,7 +1496,7 @@ one in the source buffer."
(nt (semanticdb-normalize-one-tag rtable rtag))
(tag (cdr nt))
(table (car nt))
- )
+ (curwin (selected-window)))
;; If we fail to normalize, reset.
(when (not tag) (setq table rtable tag rtag))
;; Do the focus.
@@ -1502,17 +1521,14 @@ one in the source buffer."
(switch-to-buffer-other-window buf t)
(select-window (get-buffer-window buf)))
;; Now do some positioning
- (unwind-protect
- (if (semantic-tag-with-position-p tag)
- ;; Full tag positional information available
- (progn
- (goto-char (semantic-tag-start tag))
- ;; This avoids a dangerous problem if we just loaded a tag
- ;; from a file, but the original position was not updated
- ;; in the TAG variable we are currently using.
- (semantic-momentary-highlight-tag (semantic-current-tag))
- ))
- (select-window (minibuffer-window)))
+ (when (semantic-tag-with-position-p tag)
+ ;; Full tag positional information available
+ (goto-char (semantic-tag-start tag))
+ ;; This avoids a dangerous problem if we just loaded a tag
+ ;; from a file, but the original position was not updated
+ ;; in the TAG variable we are currently using.
+ (semantic-momentary-highlight-tag (semantic-current-tag)))
+ (select-window curwin)
;; Calculate text difference between contents and the focus item.
(let* ((mbc (semantic-completion-text))
(ftn (semantic-tag-name tag))
@@ -1530,32 +1546,66 @@ one in the source buffer."
;; * Safe compatibility for tooltip free systems.
;; * Don't use 'avoid package for tooltip positioning.
+;;;###autoload
+(defcustom semantic-displayor-tooltip-mode 'standard
+ "Mode for the tooltip inline completion.
+
+Standard: Show only `semantic-displayor-tooltip-initial-max-tags'
+number of completions initially. Pressing TAB will show the
+extended set.
+
+Quiet: Only show completions when we have narrowed all
+possibilities down to a maximum of
+`semantic-displayor-tooltip-initial-max-tags' tags. Pressing TAB
+multiple times will also show completions.
+
+Verbose: Always show all completions available.
+
+The absolute maximum number of completions for all mode is
+determined through `semantic-displayor-tooltip-max-tags'."
+ :group 'semantic
+ :version "24.3"
+ :type '(choice (const :tag "Standard" standard)
+ (const :tag "Quiet" quiet)
+ (const :tag "Verbose" verbose)))
+
+;;;###autoload
+(defcustom semantic-displayor-tooltip-initial-max-tags 5
+ "Maximum number of tags to be displayed initially.
+See doc-string of `semantic-displayor-tooltip-mode' for details."
+ :group 'semantic
+ :version "24.3"
+ :type 'integer)
+
+(defcustom semantic-displayor-tooltip-max-tags 25
+ "The maximum number of tags to be displayed.
+Maximum number of completions where we have activated the
+extended completion list through typing TAB or SPACE multiple
+times. This limit needs to fit on your screen!
+
+Note: If available, customizing this variable increases
+`x-max-tooltip-size' to force over-sized tooltips when necessary.
+This will not happen if you directly set this variable via `setq'."
+ :group 'semantic
+ :version "24.3"
+ :type 'integer
+ :set '(lambda (sym var)
+ (set-default sym var)
+ (when (boundp 'x-max-tooltip-size)
+ (setcdr x-max-tooltip-size (max (1+ var) (cdr x-max-tooltip-size))))))
+
+
(defclass semantic-displayor-tooltip (semantic-displayor-traditional)
- ((max-tags :type integer
- :initarg :max-tags
- :initform 5
- :custom integer
- :documentation
- "Max number of tags displayed on tooltip at once.
-If `force-show' is 1, this value is ignored with typing tab or space twice continuously.
-if `force-show' is 0, this value is always ignored.")
- (force-show :type integer
- :initarg :force-show
- :initform 1
- :custom (choice (const
- :tag "Show when double typing"
- 1)
- (const
- :tag "Show always"
- 0)
- (const
- :tag "Show if the number of tags is less than `max-tags'."
- -1))
- :documentation
- "Control the behavior of the number of tags is greater than `max-tags'.
--1 means tags are never shown.
-0 means the tags are always shown.
-1 means tags are shown if space or tab is typed twice continuously.")
+ ((mode :initarg :mode
+ :initform
+ (symbol-value 'semantic-displayor-tooltip-mode)
+ :documentation
+ "See `semantic-displayor-tooltip-mode'.")
+ (max-tags-initial :initarg max-tags-initial
+ :initform
+ (symbol-value 'semantic-displayor-tooltip-initial-max-tags)
+ :documentation
+ "See `semantic-displayor-tooltip-initial-max-tags'.")
(typing-count :type integer
:initform 0
:documentation
@@ -1563,7 +1613,7 @@ if `force-show' is 0, this value is always ignored.")
(shown :type boolean
:initform nil
:documentation
- "Flag representing whether tags is shown once or not.")
+ "Flag representing whether tooltip has been shown yet.")
)
"Display completions options in a tooltip.
Display mechanism using tooltip for a list of possible completions.")
@@ -1583,50 +1633,63 @@ Display mechanism using tooltip for a list of possible completions.")
(call-next-method)
(let* ((tablelong (semanticdb-strip-find-results (oref obj table)))
(table (semantic-unique-tag-table-by-name tablelong))
- (l (mapcar semantic-completion-displayor-format-tag-function table))
- (ll (length l))
+ (completions (mapcar semantic-completion-displayor-format-tag-function table))
+ (numcompl (length completions))
(typing-count (oref obj typing-count))
- (force-show (oref obj force-show))
+ (mode (oref obj mode))
+ (max-tags (oref obj max-tags-initial))
(matchtxt (semantic-completion-text))
- msg)
- (if (or (oref obj shown)
- (< ll (oref obj max-tags))
- (and (<= 0 force-show)
- (< (1- force-show) typing-count)))
- (progn
- (oset obj typing-count 0)
- (oset obj shown t)
- (if (eq 1 ll)
- ;; We Have only one possible match. There could be two cases.
- ;; 1) input text != single match.
- ;; --> Show it!
- ;; 2) input text == single match.
- ;; --> Complain about it, but still show the match.
- (if (string= matchtxt (semantic-tag-name (car table)))
- (setq msg (concat "[COMPLETE]\n" (car l)))
- (setq msg (car l)))
- ;; Create the long message.
- (setq msg (mapconcat 'identity l "\n"))
- ;; If there is nothing, say so!
- (if (eq 0 (length msg))
- (setq msg "[NO MATCH]")))
- (semantic-displayor-tooltip-show msg))
- ;; The typing count determines if the user REALLY REALLY
- ;; wanted to show that much stuff. Only increment
- ;; if the current command is a completion command.
- (if (and (stringp (this-command-keys))
- (string= (this-command-keys) "\C-i"))
- (oset obj typing-count (1+ typing-count)))
- ;; At this point, we know we have too many items.
- ;; Let's be brave, and truncate l
- (setcdr (nthcdr (oref obj max-tags) l) nil)
- (setq msg (mapconcat 'identity l "\n"))
+ msg msg-tail)
+ ;; Keep a count of the consecutive completion commands entered by the user.
+ (if (and (stringp (this-command-keys))
+ (string= (this-command-keys) "\C-i"))
+ (oset obj typing-count (1+ (oref obj typing-count)))
+ (oset obj typing-count 0))
+ (cond
+ ((eq mode 'quiet)
+ ;; Switch back to standard mode if user presses key more than 5 times.
+ (when (>= (oref obj typing-count) 5)
+ (oset obj mode 'standard)
+ (setq mode 'standard)
+ (message "Resetting inline-mode to 'standard'."))
+ (when (and (> numcompl max-tags)
+ (< (oref obj typing-count) 2))
+ ;; Discretely hint at completion availability.
+ (setq msg "...")))
+ ((eq mode 'verbose)
+ ;; Always show extended match set.
+ (oset obj max-tags semantic-displayor-tooltip-max-tags)
+ (setq max-tags semantic-displayor-tooltip-max-tags)))
+ (unless msg
+ (oset obj shown t)
(cond
- ((= force-show -1)
- (semantic-displayor-tooltip-show (concat msg "\n...")))
- ((= force-show 1)
- (semantic-displayor-tooltip-show (concat msg "\n(TAB for more)")))
- )))))
+ ((> numcompl max-tags)
+ ;; We have too many items, be brave and truncate 'completions'.
+ (setcdr (nthcdr (1- max-tags) completions) nil)
+ (if (= max-tags semantic-displayor-tooltip-initial-max-tags)
+ (setq msg-tail (concat "\n[<TAB> " (number-to-string (- numcompl max-tags)) " more]"))
+ (setq msg-tail (concat "\n[<n/a> " (number-to-string (- numcompl max-tags)) " more]"))
+ (when (>= (oref obj typing-count) 2)
+ (message "Refine search to display results beyond the '%s' limit"
+ (symbol-name 'semantic-complete-inline-max-tags-extended)))))
+ ((= numcompl 1)
+ ;; two possible cases
+ ;; 1. input text != single match - we found a unique completion!
+ ;; 2. input text == single match - we found no additional matches, it's just the input text!
+ (when (string= matchtxt (semantic-tag-name (car table)))
+ (setq msg "[COMPLETE]\n")))
+ ((zerop numcompl)
+ (oset obj shown nil)
+ ;; No matches, say so if in verbose mode!
+ (when semantic-idle-scheduler-verbose-flag
+ (setq msg "[NO MATCH]"))))
+ ;; Create the tooltip text.
+ (setq msg (concat msg (mapconcat 'identity completions "\n"))))
+ ;; Add any tail info.
+ (setq msg (concat msg msg-tail))
+ ;; Display tooltip.
+ (when (not (eq msg ""))
+ (semantic-displayor-tooltip-show msg)))))
;;; Compatibility
;;
@@ -1644,8 +1707,10 @@ Display mechanism using tooltip for a list of possible completions.")
"Return the location of POINT as positioned on the selected frame.
Return a cons cell (X . Y)"
(let* ((frame (selected-frame))
- (left (frame-parameter frame 'left))
- (top (frame-parameter frame 'top))
+ (left (or (car-safe (cdr-safe (frame-parameter frame 'left)))
+ (frame-parameter frame 'left)))
+ (top (or (car-safe (cdr-safe (frame-parameter frame 'top)))
+ (frame-parameter frame 'top)))
(point-pix-pos (posn-x-y (posn-at-point)))
(edges (window-inside-pixel-edges (selected-window))))
(cons (+ (car point-pix-pos) (car edges) left)
@@ -1668,7 +1733,7 @@ Return a cons cell (X . Y)"
(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
"A request to for the displayor to scroll the completion list (if needed)."
;; Do scrolling in the tooltip.
- (oset obj max-tags 30)
+ (oset obj max-tags-initial 30)
(semantic-displayor-show-request obj)
)
@@ -2151,6 +2216,23 @@ use `semantic-complete-analyze-inline' to complete."
(error nil))
))
+;;;;###autoload
+(defun semantic-complete-inline-project ()
+ "Perform inline completion for any symbol in the current project.
+`semantic-analyze-possible-completions' is used to determine the
+possible values.
+The function returns immediately, leaving the buffer in a mode that
+will perform the completion."
+ (interactive)
+ ;; Only do this if we are not already completing something.
+ (if (not (semantic-completion-inline-active-p))
+ (semantic-complete-inline-tag-project))
+ ;; Report a message if things didn't startup.
+ (if (and (called-interactively-p 'interactive)
+ (not (semantic-completion-inline-active-p)))
+ (message "Inline completion not needed."))
+ )
+
(provide 'semantic/complete)
;; Local variables:
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 23410b1eb1b..281479045ea 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -39,6 +39,7 @@
(require 'eieio-base))
(declare-function semantic-elisp-desymbolify "semantic/bovine/el")
+(declare-function semantic-tag-similar-p "semantic/tag-ls")
;;; Code:
@@ -57,6 +58,11 @@ It does not need refreshing."
"Return nil, we never need a refresh."
nil)
+(defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings)
+ "Pretty printer extension for `semanticdb-table-emacs-lisp'.
+Adds the number of tags in this file to the object print name."
+ (apply 'call-next-method obj (cons " (proxy)" strings)))
+
(defclass semanticdb-project-database-emacs-lisp
(semanticdb-project-database eieio-singleton)
((new-table-class :initform semanticdb-table-emacs-lisp
@@ -66,6 +72,15 @@ It does not need refreshing."
)
"Database representing Emacs core.")
+(defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings)
+ "Pretty printer extension for `semanticdb-table-emacs-lisp'.
+Adds the number of tags in this file to the object print name."
+ (let ((count 0))
+ (mapatoms (lambda (sym) (setq count (1+ count))))
+ (apply 'call-next-method obj (cons
+ (format " (%d known syms)" count)
+ strings))))
+
;; Create the database, and add it to searchable databases for Emacs Lisp mode.
(defvar-mode-local emacs-lisp-mode semanticdb-project-system-databases
(list
@@ -159,9 +174,9 @@ If Emacs cannot resolve this symbol to a particular file, then return nil."
(setq file (concat file ".gz"))))
(let* ((tab (semanticdb-file-table-object file))
- (alltags (semanticdb-get-tags tab))
- (newtags (semanticdb-find-tags-by-name-method
- tab (semantic-tag-name tag)))
+ (alltags (when tab (semanticdb-get-tags tab)))
+ (newtags (when tab (semanticdb-find-tags-by-name-method
+ tab (semantic-tag-name tag))))
(match nil))
;; Find the best match.
(dolist (T newtags)
@@ -171,32 +186,12 @@ If Emacs cannot resolve this symbol to a particular file, then return nil."
(when (not match)
(setq match (car newtags)))
;; Return it.
- (cons tab match)))))
-
-(defun semanticdb-elisp-sym-function-arglist (sym)
- "Get the argument list for SYM.
-Deal with all different forms of function.
-This was snarfed out of eldoc."
- (let* ((prelim-def
- (let ((sd (and (fboundp sym)
- (symbol-function sym))))
- (and (symbolp sd)
- (condition-case err
- (setq sd (indirect-function sym))
- (error (setq sd nil))))
- sd))
- (def (if (eq (car-safe prelim-def) 'macro)
- (cdr prelim-def)
- prelim-def))
- (arglist (cond ((null def) nil)
- ((byte-code-function-p def)
- ;; This is an eieio compatibility function.
- ;; We depend on EIEIO, so use this.
- (eieio-compiled-function-arglist def))
- ((eq (car-safe def) 'lambda)
- (nth 1 def))
- (t nil))))
- arglist))
+ (when tab (cons tab match))))))
+
+(autoload 'help-function-arglist "help-fns")
+(defalias 'semanticdb-elisp-sym-function-arglist 'help-function-arglist)
+(make-obsolete 'semanticdb-elisp-sym-function-arglist
+ 'help-function-arglist "CEDET 1.1")
(defun semanticdb-elisp-sym->tag (sym &optional toktype)
"Convert SYM into a semantic tag.
@@ -210,7 +205,7 @@ TOKTYPE is a hint to the type of tag desired."
(symbol-name sym)
nil ;; return type
(semantic-elisp-desymbolify
- (semanticdb-elisp-sym-function-arglist sym)) ;; arg-list
+ (help-function-arglist sym)) ;; arg-list
:user-visible-flag (condition-case nil
(interactive-form sym)
(error nil))
diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el
index c487e39c7b2..7b4a47bd260 100644
--- a/lisp/cedet/semantic/db-file.el
+++ b/lisp/cedet/semantic/db-file.el
@@ -29,6 +29,9 @@
(require 'semantic/db)
(require 'cedet-files)
+(eval-when-compile
+ (require 'data-debug))
+
(defvar semanticdb-file-version semantic-version
"Version of semanticdb we are writing files to disk with.")
(defvar semanticdb-file-incompatible-version "1.4"
@@ -140,7 +143,7 @@ If DIRECTORY doesn't exist, create a new one."
directory))
"/")
:file fn :tables nil
- :semantic-tag-version semantic-version
+ :semantic-tag-version semantic-tag-version
:semanticdb-version semanticdb-file-version)))
;; Set this up here. We can't put it in the constructor because it
;; would be saved, and we want DB files to be portable.
@@ -154,7 +157,7 @@ If DIRECTORY doesn't exist, create a new one."
(defun semanticdb-load-database (filename)
"Load the database FILENAME."
(condition-case foo
- (let* ((r (eieio-persistent-read filename))
+ (let* ((r (eieio-persistent-read filename semanticdb-project-database-file))
(c (semanticdb-get-database-tables r))
(tv (oref r semantic-tag-version))
(fv (oref r semanticdb-version))
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 15ef3b09238..d42ecf7c4fc 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -123,6 +123,7 @@
(defvar data-debug-thing-alist)
(declare-function data-debug-insert-stuff-list "data-debug")
+(declare-function data-debug-new-buffer "data-debug")
;;;(declare-function data-debug-insert-tag-list "adebug")
(declare-function semantic-scope-reset-cache "semantic/scope")
(declare-function semanticdb-typecache-notify-reset "semantic/db-typecache")
@@ -167,6 +168,8 @@ the following keys:
:group 'semanticdb
:type semanticdb-find-throttle-custom-list)
+(make-variable-buffer-local 'semanticdb-find-default-throttle)
+
(defun semanticdb-find-throttle-active-p (access-type)
"Non-nil if ACCESS-TYPE is an active throttle type."
(or (memq access-type semanticdb-find-default-throttle)
@@ -879,8 +882,9 @@ instead."
;; Find-file-match allows a tool to make sure the tag is
;; 'live', somewhere in a buffer.
(cond ((eq find-file-match 'name)
- (let ((f (semanticdb-full-filename nametable)))
- (semantic--tag-put-property ntag :filename f)))
+ (or (semantic--tag-get-property ntag :filename)
+ (let ((f (semanticdb-full-filename nametable)))
+ (semantic--tag-put-property ntag :filename f))))
((and find-file-match ntab)
(semanticdb-get-buffer ntab))
)
@@ -1322,7 +1326,12 @@ Returns a table of all matching tags."
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (semantic-find-tags-by-class class (or tags (semanticdb-get-tags table))))
+ ;; Delegate 'include' to the overridable
+ ;; `semantic-find-tags-included', which by default will just call
+ ;; `semantic-find-tags-by-class'.
+ (if (eq class 'include)
+ (semantic-find-tags-included (or tags (semanticdb-get-tags table)))
+ (semantic-find-tags-by-class class (or tags (semanticdb-get-tags table)))))
(defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
"In TABLE, find all occurrences of tags whose parent is the PARENT type.
diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el
index eceb830341f..a7bb130810e 100644
--- a/lisp/cedet/semantic/db-global.el
+++ b/lisp/cedet/semantic/db-global.el
@@ -40,10 +40,17 @@
;;; Code:
;;;###autoload
-(defun semanticdb-enable-gnu-global-databases (mode)
+(defun semanticdb-enable-gnu-global-databases (mode &optional noerror)
"Enable the use of the GNU Global SemanticDB back end for all files of MODE.
This will add an instance of a GNU Global database to each buffer
-in a GNU Global supported hierarchy."
+in a GNU Global supported hierarchy.
+
+Two sanity checks are performed to assure (a) that GNU global program exists
+and (b) that the GNU global program version is compatibility with the database
+version. If optional NOERROR is nil, then an error may be signalled on version
+mismatch. If NOERROR is not nil, then no error will be signaled. Instead
+return value will indicate success or failure with non-nil or nil respective
+values."
(interactive
(list (completing-read
"Enable in Mode: " obarray
@@ -51,17 +58,18 @@ in a GNU Global supported hierarchy."
t (symbol-name major-mode))))
;; First, make sure the version is ok.
- (cedet-gnu-global-version-check)
-
- ;; Make sure mode is a symbol.
- (when (stringp mode)
- (setq mode (intern mode)))
-
- (let ((ih (mode-local-value mode 'semantic-init-mode-hook)))
- (eval `(setq-mode-local
- ,mode semantic-init-mode-hook
- (cons 'semanticdb-enable-gnu-global-hook ih))))
-
+ (if (not (cedet-gnu-global-version-check noerror))
+ nil
+ ;; Make sure mode is a symbol.
+ (when (stringp mode)
+ (setq mode (intern mode)))
+
+ (let ((ih (mode-local-value mode 'semantic-init-mode-hook)))
+ (eval `(setq-mode-local
+ ,mode semantic-init-mode-hook
+ (cons 'semanticdb-enable-gnu-global-hook ih))))
+ t
+ )
)
(defun semanticdb-enable-gnu-global-hook ()
@@ -72,6 +80,8 @@ MODE is the major mode to support."
(defclass semanticdb-project-database-global
;; @todo - convert to one DB per directory.
(semanticdb-project-database eieio-instance-tracker)
+
+ ;; @todo - use instance tracker symbol.
()
"Database representing a GNU Global tags file.")
@@ -102,6 +112,11 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error."
)
"A table for returning search results from GNU Global.")
+(defmethod object-print ((obj semanticdb-table-global) &rest strings)
+ "Pretty printer extension for `semanticdb-table-global'.
+Adds the number of tags in this file to the object print name."
+ (apply 'call-next-method obj (cons " (proxy)" strings)))
+
(defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
"Return t, pretend that this table's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el
index 4698949b5e0..0da98a6d357 100644
--- a/lisp/cedet/semantic/db-typecache.el
+++ b/lisp/cedet/semantic/db-typecache.el
@@ -483,6 +483,11 @@ found tag to be loaded."
(setq ans nil)))
)
+ ;; The typecache holds all the known types and elements. Some databases
+ ;; may provide tags that are simplified by name, and are proxies. These
+ ;; proxies must be resolved in order to extract type members.
+ (setq ans (semantic-tag-resolve-proxy ans))
+
(push ans calculated-scope)
;; Track most recent file.
@@ -577,7 +582,11 @@ If there isn't one, create it.
(interactive)
(let* ((path (semanticdb-find-translate-path nil nil)))
(dolist (P path)
- (oset P pointmax nil)
+ (condition-case nil
+ (oset P pointmax nil)
+ ;; Pointmax may not exist for all tables discovered in the
+ ;; path.
+ (error nil))
(semantic-reset (semanticdb-get-typecache P)))))
(defun semanticdb-typecache-dump ()
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 4e09f9fc3f2..afac974d7fb 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -33,8 +33,15 @@
(require 'eieio-base)
(require 'semantic)
+(eval-when-compile
+ (require 'semantic/find))
+
(declare-function semantic-lex-spp-save-table "semantic/lex-spp")
+;; Use autoload to avoid recursive require of semantic/db-ref
+(autoload 'semanticdb-refresh-references "semantic/db-ref"
+ "Refresh references to DBT in other files.")
+
;;; Variables:
(defgroup semanticdb nil
"Parser Generator Persistent Database interface."
@@ -80,6 +87,11 @@ same major mode as the current buffer.")
:accessor semanticdb-get-tags
:printer semantic-tag-write-list-slot-value
:documentation "The tags belonging to this table.")
+ (db-refs :initform nil
+ :documentation
+ "List of `semanticdb-table' objects refering to this one.
+These aren't saved, but are instead recalculated after load.
+See the file semanticdb-ref.el for how this slot is used.")
(index :type semanticdb-abstract-search-index
:documentation "The search index.
Used by semanticdb-find to store additional information about
@@ -148,13 +160,16 @@ them to convert TAG into a more complete form."
(cons obj tag))
(defmethod object-print ((obj semanticdb-abstract-table) &rest strings)
- "Pretty printer extension for `semanticdb-table'.
+ "Pretty printer extension for `semanticdb-abstract-table'.
Adds the number of tags in this file to the object print name."
- (apply 'call-next-method obj
- (cons (format " (%d tags)"
- (length (semanticdb-get-tags obj))
- )
- strings)))
+ (if (or (not strings)
+ (and (= (length strings) 1) (stringp (car strings))
+ (string= (car strings) "")))
+ ;; Else, add a tags quantifier.
+ (call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj))))
+ ;; Pass through.
+ (apply 'call-next-method obj strings)
+ ))
;;; Index Cache
;;
@@ -201,8 +216,7 @@ If one doesn't exist, create it."
;; a semanticdb-table associated with a file.
;;
(defclass semanticdb-search-results-table (semanticdb-abstract-table)
- (
- )
+ ()
"Table used for search results when there is no file or table association.
Examples include search results from external sources such as from
Emacs's own symbol table, or from external libraries.")
@@ -299,7 +313,8 @@ If OBJ's file is not loaded, read it in first."
"Pretty printer extension for `semanticdb-table'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj
- (cons (if (oref obj dirty) ", DIRTY" "") strings)))
+ (cons (format " (%d tags)" (length (semanticdb-get-tags obj)))
+ (cons (if (oref obj dirty) ", DIRTY" "") strings))))
;;; DATABASE BASE CLASS
;;
@@ -324,7 +339,7 @@ so your cache will need to be recalculated at runtime.
Note: This index will not be saved in a persistent file.")
(tables :initarg :tables
- :type list
+ :type semanticdb-abstract-table-list
;; Need this protection so apps don't try to access
;; the tables without using the accessor.
:accessor semanticdb-get-database-tables
@@ -416,7 +431,7 @@ If FILENAME exists in the database already, return that.
If there is no database for the table to live in, create one."
(let ((cdb nil)
(tbl nil)
- (dd (file-name-directory filename))
+ (dd (file-name-directory (file-truename filename)))
)
;; Allow a database override function
(setq cdb (semanticdb-create-database semanticdb-new-database-class
@@ -555,7 +570,7 @@ This will call `semantic-fetch-tags' if that file is in memory."
;; semanticdb-create-table-for-file-not-in-buffer
(save-excursion
(let ((buff (semantic-find-file-noselect
- (semanticdb-full-filename obj))))
+ (semanticdb-full-filename obj) t)))
(set-buffer buff)
(semantic-fetch-tags)
;; Kill off the buffer if it didn't exist when we were called.
@@ -620,7 +635,7 @@ The file associated with OBJ does not need to be in a buffer."
)
;; Update cross references
- ;; (semanticdb-refresh-references table)
+ (semanticdb-refresh-references table)
)
(defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
@@ -650,8 +665,8 @@ The file associated with OBJ does not need to be in a buffer."
)
;; Update cross references
- ;;(when (semantic-find-tags-by-class 'include new-tags)
- ;; (semanticdb-refresh-references table))
+ (when (semantic-find-tags-by-class 'include new-tags)
+ (semanticdb-refresh-references table))
)
;;; SAVE/LOAD
@@ -667,9 +682,11 @@ form."
(defun semanticdb-save-current-db ()
"Save the current tag database."
(interactive)
- (message "Saving current tag summaries...")
+ (unless noninteractive
+ (message "Saving current tag summaries..."))
(semanticdb-save-db semanticdb-current-database)
- (message "Saving current tag summaries...done"))
+ (unless noninteractive
+ (message "Saving current tag summaries...done")))
;; This prevents Semanticdb from querying multiple times if the users
;; answers "no" to creating the Semanticdb directory.
@@ -678,10 +695,12 @@ form."
(defun semanticdb-save-all-db ()
"Save all semantic tag databases."
(interactive)
- (message "Saving tag summaries...")
+ (unless noninteractive
+ (message "Saving tag summaries..."))
(let ((semanticdb--inhibit-make-directory nil))
(mapc 'semanticdb-save-db semanticdb-database-list))
- (message "Saving tag summaries...done"))
+ (unless noninteractive
+ (message "Saving tag summaries...done")))
(defun semanticdb-save-all-db-idle ()
"Save all semantic tag databases from idle time.
diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el
index e88517b15ce..3c0bf877728 100644
--- a/lisp/cedet/semantic/debug.el
+++ b/lisp/cedet/semantic/debug.el
@@ -308,13 +308,13 @@ Argument ONOFF is non-nil when we are entering debug mode.
;; Install our map onto this buffer
(use-local-map semantic-debug-mode-map)
;; Make the buffer read only
- (toggle-read-only 1)
+ (setq buffer-read-only t)
(set-buffer (oref iface source-buffer))
;; Use our map in the source buffer also
(use-local-map semantic-debug-mode-map)
;; Make the buffer read only
- (toggle-read-only 1)
+ (setq buffer-read-only t)
;; Hooks
(run-hooks 'semantic-debug-mode-hook)
)
diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el
index 50b50398e16..0c2c5e3ce37 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -175,6 +175,69 @@ Used by the decoration style: `semantic-decoration-on-unknown-includes'."
:help "Add an include path for this session." ])
))
+;;; Includes with no file, but a table
+;;
+(defface semantic-decoration-on-fileless-includes
+ '((((class color) (background dark))
+ (:background "#009000"))
+ (((class color) (background light))
+ (:background "#f0fdf0")))
+ "*Face used to show includes that have no file, but do have a DB table.
+Used by the decoration style: `semantic-decoration-on-fileless-includes'."
+ :group 'semantic-faces)
+
+(defvar semantic-decoration-on-fileless-include-map
+ (let ((km (make-sparse-keymap)))
+ ;(define-key km [ mouse-2 ] 'semantic-decoration-fileless-include-describe)
+ (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-fileless-include-menu)
+ km)
+ "Keymap used on unparsed includes.")
+
+(defvar semantic-decoration-on-fileless-include-menu nil
+ "Menu used for unparsed include headers.")
+
+(easy-menu-define
+ semantic-decoration-on-fileless-include-menu
+ semantic-decoration-on-fileless-include-map
+ "Fileless Include Menu"
+ (list
+ "Fileless Include"
+ (semantic-menu-item
+ ["What Is This?" semantic-decoration-fileless-include-describe
+ :active t
+ :help "Describe why this include has been marked this way." ])
+ (semantic-menu-item
+ ["List all unknown includes" semanticdb-find-adebug-lost-includes
+ :active t
+ :help "Show a list of all includes semantic cannot find for this file." ])
+ "---"
+ (semantic-menu-item
+ ["Summarize includes current buffer" semantic-decoration-all-include-summary
+ :active t
+ :help "Show a summary for the current buffer containing this include." ])
+ (semantic-menu-item
+ ["List found includes (load unparsed)" semanticdb-find-test-translate-path
+ :active t
+ :help "List all includes found for this file, and parse unparsed files." ])
+ (semantic-menu-item
+ ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
+ :active t
+ :help "List all includes found for this file, do not parse unparsed files." ])
+ "---"
+ (semantic-menu-item
+ ["Customize System Include Path" semantic-customize-system-include-path
+ :active (get 'semantic-dependency-system-include-path major-mode)
+ :help "Run customize for the system include path for this major mode." ])
+ (semantic-menu-item
+ ["Add a System Include Path" semantic-add-system-include
+ :active t
+ :help "Add an include path for this session." ])
+ (semantic-menu-item
+ ["Remove a System Include Path" semantic-remove-system-include
+ :active t
+ :help "Add an include path for this session." ])
+ ))
+
;;; Includes that need to be parsed.
;;
(defface semantic-decoration-on-unparsed-includes
@@ -272,17 +335,22 @@ This mode provides a nice context menu on the include statements."
(defun semantic-decoration-on-includes-highlight-default (tag)
"Highlight the include TAG to show that semantic can't find it."
(let* ((file (semantic-dependency-tag-file tag))
- (table (when file
- (semanticdb-file-table-object file t)))
+ (table (semanticdb-find-table-for-include tag (current-buffer)))
(face nil)
(map nil)
)
(cond
- ((not file)
+ ((and (not file) (not table))
;; Cannot find this header.
(setq face 'semantic-decoration-on-unknown-includes
map semantic-decoration-on-unknown-include-map)
)
+ ((and (not file) table)
+ ;; There is no file, but the language supports a table for this
+ ;; include. Import perhaps? System include with no file?
+ (setq face 'semantic-decoration-on-fileless-includes
+ map semantic-decoration-on-fileless-include-map)
+ )
((and table (number-or-marker-p (oref table pointmax)))
;; A found and parsed file.
(setq face 'semantic-decoration-on-includes
@@ -319,7 +387,7 @@ This mode provides a nice context menu on the include statements."
;;; Regular Include Functions
;;
(defun semantic-decoration-include-describe ()
- "Describe what unparsed includes are in the current buffer.
+ "Describe the current include tag.
Argument EVENT is the mouse clicked event."
(interactive)
(let* ((tag (or (semantic-current-tag)
@@ -421,7 +489,7 @@ Argument EVENT describes the event that caused this function to be called."
;;; Unknown Include functions
;;
(defun semantic-decoration-unknown-include-describe ()
- "Describe what unknown includes are in the current buffer.
+ "Describe the current unknown include.
Argument EVENT is the mouse clicked event."
(interactive)
(let ((tag (semantic-current-tag))
@@ -484,7 +552,7 @@ See the Semantic manual node on SemanticDB for more about search paths.")
)))
(defun semantic-decoration-unknown-include-menu (event)
- "Popup a menu that can help a user understand unparsed includes.
+ "Popup a menu that can help a user understand unknown includes.
Argument EVENT describes the event that caused this function to be called."
(interactive "e")
(let* ((startwin (selected-window))
@@ -501,6 +569,49 @@ Argument EVENT describes the event that caused this function to be called."
(select-window startwin)))
+;;; Fileless Include functions
+;;
+(defun semantic-decoration-fileless-include-describe ()
+ "Describe the current fileless include.
+Argument EVENT is the mouse clicked event."
+ (interactive)
+ (let* ((tag (semantic-current-tag))
+ (table (semanticdb-find-table-for-include tag (current-buffer)))
+ (mm major-mode))
+ (with-output-to-temp-buffer (help-buffer) ; "*Help*"
+ (help-setup-xref (list #'semantic-decoration-fileless-include-describe)
+ (called-interactively-p 'interactive))
+ (princ "Include Tag: ")
+ (princ (semantic-format-tag-name tag nil t))
+ (princ "\n\n")
+ (princ "This header tag has been marked \"Fileless\".
+This means that Semantic cannot find a file associated with this tag
+on disk, but a database table of tags has been associated with it.
+
+This means that the include will still be used to find tags for
+searches, but you cannot visit this include.\n\n")
+ (princ "This Header is now represented by the following database table:\n\n ")
+ (princ (object-print table))
+ )))
+
+(defun semantic-decoration-fileless-include-menu (event)
+ "Popup a menu that can help a user understand fileless includes.
+Argument EVENT describes the event that caused this function to be called."
+ (interactive "e")
+ (let* ((startwin (selected-window))
+ ;; This line has an issue in XEmacs.
+ (win (semantic-event-window event))
+ )
+ (select-window win t)
+ (save-excursion
+ ;(goto-char (window-start win))
+ (mouse-set-point event)
+ (sit-for 0)
+ (semantic-popup-menu semantic-decoration-on-fileless-include-menu)
+ )
+ (select-window startwin)))
+
+
;;; Interactive parts of unparsed includes
;;
(defun semantic-decoration-unparsed-include-describe ()
@@ -667,6 +778,9 @@ Argument EVENT describes the event that caused this function to be called."
(dolist (tag unk)
(princ " ")
(princ (semantic-tag-name tag))
+ (when (not (eq (semantic-tag-name tag) (semantic-tag-include-filename tag)))
+ (princ " -> ")
+ (princ (semantic-tag-include-filename tag)))
(princ "\n"))
))
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index f67978a2620..69dfa119167 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -265,6 +265,8 @@ minor mode is enabled."
(semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook)
(add-hook 'semantic-after-toplevel-cache-change-hook
'semantic-decorate-tags-after-full-reparse nil t)
+ ;; Decorate includes by default
+ (require 'semantic/decorate/include)
;; Add decorations to available tags. The above hooks ensure
;; that new tags will be decorated when they become available.
(semantic-decorate-add-decorations (semantic-fetch-available-tags)))
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index ddf1518f539..8a4e61fbad2 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -115,7 +115,10 @@ If NOSNARF is 'lex, then return the lex token."
;; In case it's a real string, STRIPIT.
(while (string-match "\\s-*\\s\"+\\s-*" ct)
(setq ct (concat (substring ct 0 (match-beginning 0))
- (substring ct (match-end 0))))))
+ (substring ct (match-end 0)))))
+ ;; Remove comment delimiter at the end of the string.
+ (when (string-match (concat (regexp-quote comment-end) "$") ct)
+ (setq ct (substring ct 0 (match-beginning 0)))))
;; Now return the text.
ct))))
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index 0fc1829566c..16cf0ca96a2 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -32,7 +32,7 @@
(require 'semantic/grammar)
;;; Code:
-(defclass semantic-ede-proj-target-grammar (ede-proj-target-makefile)
+(defclass semantic-ede-proj-target-grammar (ede-proj-target-elisp)
((menu :initform nil)
(keybindings :initform nil)
(phony :initform t)
@@ -44,15 +44,33 @@
(semantic-ede-grammar-compiler-wisent
semantic-ede-grammar-compiler-bovine
))
+ (aux-packages :initform '("semantic" "cedet-compat"))
+ (pre-load-packages :initform '("cedet-compat" "semantic/grammar" "semantic/bovine/grammar" "semantic/wisent/grammar"))
)
"This target consists of a group of grammar files.
A grammar target consists of grammar files that build Emacs Lisp programs for
parsing different languages.")
+(defmethod ede-proj-makefile-dependencies ((this semantic-ede-proj-target-grammar))
+ "Return a string representing the dependencies for THIS.
+Some compilers only use the first element in the dependencies, others
+have a list of intermediates (object files), and others don't care.
+This allows customization of how these elements appear.
+For Emacs Lisp, return addsuffix command on source files."
+ (let ((source (car (oref this source))))
+ (cond
+ ((string-match "\\.wy$" source)
+ (format "$(addsuffix -wy.elc, $(basename $(%s)))"
+ (ede-proj-makefile-sourcevar this)))
+ ((string-match "\\.by$" source)
+ (format "$(addsuffix -by.elc, $(basename $(%s)))"
+ (ede-proj-makefile-sourcevar this))))))
+
(defvar semantic-ede-source-grammar-wisent
(ede-sourcecode "semantic-ede-grammar-source-wisent"
:name "Wisent Grammar"
:sourcepattern "\\.wy$"
+ :garbagepattern '("*-wy.el")
)
"Semantic Grammar source code definition for wisent.")
@@ -64,21 +82,17 @@ parsing different languages.")
(semantic-ede-grammar-compiler-class
"ede-emacs-wisent-compiler"
:name "emacs"
- :variables '(("EMACS" . "emacs"))
- :commands
- '(
- "@echo \"(add-to-list 'load-path nil)\" > grammar-make-script"
- "@for loadpath in . ${LOADPATH}; do \\"
- " echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> grammar-make-script; \\"
- "done;"
- "@echo \"(require 'semantic/load)\" >> grammar-make-script"
- "@echo \"(require 'semantic/grammar)\" >> grammar-make-script"
- ;; "@echo \"(setq debug-on-error t)\" >> grammar-make-script"
- "\"$(EMACS)\" -batch --no-site-file -l grammar-make-script -f semantic-grammar-batch-build-packages $^"
- )
- ;; :autoconf '("AM_PATH_LISPDIR")
+ :variables '(("EMACS" . "emacs")
+ ("EMACSFLAGS" . "-batch --no-site-file --eval '(setq debug-on-error t)'")
+ ("require" . "$(foreach r,$(1),(require (quote $(r))))"))
+ :rules (list (ede-makefile-rule
+ "elisp-inference-rule"
+ :target "%-wy.el"
+ :dependencies "%.wy"
+ :rules '("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \
+--eval '(progn $(call require,$(PRELOADS)))' -f semantic-grammar-batch-build-packages $^")))
:sourcetype '(semantic-ede-source-grammar-wisent)
- :objectextention "-wy.elc"
+ :objectextention "-wy.el"
)
"Compile Emacs Lisp programs.")
@@ -87,6 +101,7 @@ parsing different languages.")
(ede-sourcecode "semantic-ede-grammar-source-bovine"
:name "Bovine Grammar"
:sourcepattern "\\.by$"
+ :garbagepattern '("*-by.el")
)
"Semantic Grammar source code definition for the bovinator.")
@@ -94,21 +109,17 @@ parsing different languages.")
(semantic-ede-grammar-compiler-class
"ede-emacs-wisent-compiler"
:name "emacs"
- :variables '(("EMACS" . "emacs"))
- :commands
- '(
- "@echo \"(add-to-list 'load-path nil)\" > grammar-make-script"
- "@for loadpath in . ${LOADPATH}; do \\"
- " echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> grammar-make-script; \\"
- "done;"
- "@echo \"(require 'semantic/load)\" >> grammar-make-script"
- "@echo \"(require 'semantic/grammar)\" >> grammar-make-script"
- ;; "@echo \"(setq debug-on-error t)\" >> grammar-make-script"
- "\"$(EMACS)\" -batch --no-site-file -l grammar-make-script -f semantic-grammar-batch-build-packages $^"
- )
- ;; :autoconf '("AM_PATH_LISPDIR")
+ :variables '(("EMACS" . "emacs")
+ ("EMACSFLAGS" . "-batch --no-site-file --eval '(setq debug-on-error t)'")
+ ("require" . "$(foreach r,$(1),(require (quote $(r))))"))
+ :rules (list (ede-makefile-rule
+ "elisp-inference-rule"
+ :target "%-by.el"
+ :dependencies "%.by"
+ :rules '("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \
+--eval '(progn $(call require,$(PRELOADS)))' -f semantic-grammar-batch-build-packages $^")))
:sourcetype '(semantic-ede-source-grammar-bovine)
- :objectextention "-by.elc"
+ :objectextention "-by.el"
)
"Compile Emacs Lisp programs.")
@@ -127,15 +138,32 @@ Lays claim to all -by.el, and -wy.el files."
"Compile all sources in a Lisp target OBJ."
(let* ((cb (current-buffer))
(proj (ede-target-parent obj))
- (default-directory (oref proj directory)))
+ (default-directory (oref proj directory))
+ (comp 0)
+ (utd 0))
(mapc (lambda (src)
(with-current-buffer (find-file-noselect src)
- (save-excursion
- (semantic-grammar-create-package))
- (save-buffer)
- (byte-recompile-file (concat (semantic-grammar-package) ".el") nil 0)))
- (oref obj source)))
- (message "All Semantic Grammar sources are up to date in %s" (object-name obj)))
+ (let* ((package (semantic-grammar-create-package))
+ (fname (progn (string-match ".*/\\(.+\\.el\\)" package)
+ (match-string 1 package)))
+ (src (with-current-buffer fname (buffer-file-name)))
+ (csrc (concat (file-name-sans-extension src) ".elc")))
+ (if (< emacs-major-version 24)
+ ;; Does not have `byte-recompile-file'
+ (if (or (not (file-exists-p csrc))
+ (file-newer-than-file-p src csrc))
+ (progn
+ (setq comp (1+ comp))
+ (byte-compile-file src))
+ (setq utd (1+ utd)))
+ ;; Emacs 24 and newer
+ (with-no-warnings
+ (if (eq (byte-recompile-file src nil 0) t)
+ (setq comp (1+ comp))
+ (setq utd (1+ utd))))))))
+ (oref obj source))
+ (message "All Semantic Grammar sources are up to date in %s" (object-name obj))
+ (cons comp utd)))
;;; Makefile generation functions
;;
@@ -164,18 +192,13 @@ Lays claim to all -by.el, and -wy.el files."
" ")))
)
-(defmethod ede-proj-makefile-insert-rules ((this semantic-ede-proj-target-grammar))
- "Insert rules needed by THIS target."
- ;; Add in some dependencies.
-;; (mapc (lambda (src)
-;; (let ((nm (file-name-sans-extension src)))
-;; (insert nm "-wy.el: " src "\n"
-;; nm "-wy.elc: " nm "-wy.el\n\n")
-;; ))
-;; (oref this source))
- ;; Call the normal insertion of rules.
- (call-next-method)
- )
+(defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar))
+ "Insert rules needed by THIS target.
+This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be
+needed for the compilation of the resulting parsers."
+ (insert (format "%s: EMACSFLAGS+= --eval '(setq max-specpdl-size 1500 \
+max-lisp-eval-depth 700)'\n"
+ (oref this name))))
(defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar))
"Insert dist dependencies, or intermediate targets.
diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el
index ce7ba9926d2..5c724a96d40 100644
--- a/lisp/cedet/semantic/find.el
+++ b/lisp/cedet/semantic/find.el
@@ -49,6 +49,7 @@
(require 'semantic/tag)
(declare-function semantic-tag-protected-p "semantic/tag-ls")
+(declare-function semantic-tag-package-protected-p "semantic/tag-ls")
;;; Overlay Search Routines
;;
@@ -362,12 +363,19 @@ See `semantic-tag-protected-p' for details on which tags are returned."
table
(require 'semantic/tag-ls)
(semantic--find-tags-by-macro
- (not (semantic-tag-protected-p (car tags) scopeprotection parent))
+ (not (and (semantic-tag-protected-p (car tags) scopeprotection parent)
+ (semantic-tag-package-protected-p (car tags) parent)))
table)))
-(defsubst semantic-find-tags-included (&optional table)
+;;;###autoload
+(define-overloadable-function semantic-find-tags-included (&optional table)
"Find all tags in TABLE that are of the 'include class.
-TABLE is a tag table. See `semantic-something-to-tag-table'."
+TABLE is a tag table. See `semantic-something-to-tag-table'.")
+
+(defun semantic-find-tags-included-default (&optional table)
+ "Find all tags in TABLE that are of the 'include class.
+TABLE is a tag table. See `semantic-something-to-tag-table'.
+By default, just call `semantic-find-tags-by-class'."
(semantic-find-tags-by-class 'include table))
;;; Deep Searches
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 851d5cd9e8e..5a12047eb76 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -33,42 +33,140 @@
(load "semantic/loaddefs" nil 'nomessage)
;;; Compatibility
-
-(defalias 'semantic-buffer-local-value 'buffer-local-value)
-(defalias 'semantic-overlay-live-p 'overlay-buffer)
-(defalias 'semantic-make-overlay 'make-overlay)
-(defalias 'semantic-overlay-put 'overlay-put)
-(defalias 'semantic-overlay-get 'overlay-get)
-(defalias 'semantic-overlay-properties 'overlay-properties)
-(defalias 'semantic-overlay-move 'move-overlay)
-(defalias 'semantic-overlay-delete 'delete-overlay)
-(defalias 'semantic-overlays-at 'overlays-at)
-(defalias 'semantic-overlays-in 'overlays-in)
-(defalias 'semantic-overlay-buffer 'overlay-buffer)
-(defalias 'semantic-overlay-start 'overlay-start)
-(defalias 'semantic-overlay-end 'overlay-end)
-(defalias 'semantic-overlay-size 'overlay-size)
-(defalias 'semantic-overlay-next-change 'next-overlay-change)
-(defalias 'semantic-overlay-previous-change 'previous-overlay-change)
-(defalias 'semantic-overlay-lists 'overlay-lists)
-(defalias 'semantic-overlay-p 'overlayp)
-(defalias 'semantic-read-event 'read-event)
-(defalias 'semantic-popup-menu 'popup-menu)
-(defalias 'semantic-make-local-hook 'identity)
-(defalias 'semantic-mode-line-update 'force-mode-line-update)
-(defalias 'semantic-run-mode-hooks 'run-mode-hooks)
-(defalias 'semantic-compile-warn 'byte-compile-warn)
-(defalias 'semantic-menu-item 'identity)
-
-(defun semantic-event-window (event)
- "Extract the window from EVENT."
- (car (car (cdr event))))
+;;
+(eval-and-compile
+ (if (featurep 'xemacs)
+ (progn
+ (defalias 'semantic-buffer-local-value 'symbol-value-in-buffer)
+ (defalias 'semantic-overlay-live-p
+ (lambda (o)
+ (and (extent-live-p o)
+ (not (extent-detached-p o))
+ (bufferp (extent-buffer o)))))
+ (defalias 'semantic-make-overlay
+ (lambda (beg end &optional buffer &rest rest)
+ "Xemacs `make-extent', supporting the front/rear advance options."
+ (let ((ol (make-extent beg end buffer)))
+ (when rest
+ (set-extent-property ol 'start-open (car rest))
+ (setq rest (cdr rest)))
+ (when rest
+ (set-extent-property ol 'end-open (car rest)))
+ ol)))
+ (defalias 'semantic-overlay-put 'set-extent-property)
+ (defalias 'semantic-overlay-get 'extent-property)
+ (defalias 'semantic-overlay-properties 'extent-properties)
+ (defalias 'semantic-overlay-move 'set-extent-endpoints)
+ (defalias 'semantic-overlay-delete 'delete-extent)
+ (defalias 'semantic-overlays-at
+ (lambda (pos)
+ (condition-case nil
+ (extent-list nil pos pos)
+ (error nil))
+ ))
+ (defalias 'semantic-overlays-in
+ (lambda (beg end) (extent-list nil beg end)))
+ (defalias 'semantic-overlay-buffer 'extent-buffer)
+ (defalias 'semantic-overlay-start 'extent-start-position)
+ (defalias 'semantic-overlay-end 'extent-end-position)
+ (defalias 'semantic-overlay-size 'extent-length)
+ (defalias 'semantic-overlay-next-change 'next-extent-change)
+ (defalias 'semantic-overlay-previous-change 'previous-extent-change)
+ (defalias 'semantic-overlay-lists
+ (lambda () (list (extent-list))))
+ (defalias 'semantic-overlay-p 'extentp)
+ (defalias 'semantic-event-window 'event-window)
+ (defun semantic-read-event ()
+ (let ((event (next-command-event)))
+ (if (key-press-event-p event)
+ (let ((c (event-to-character event)))
+ (if (char-equal c (quit-char))
+ (keyboard-quit)
+ c)))
+ event))
+ (defun semantic-popup-menu (menu)
+ "Blocking version of `popup-menu'"
+ (popup-menu menu)
+ ;; Wait...
+ (while (popup-up-p) (dispatch-event (next-event))))
+ )
+ ;; Emacs Bindings
+ (defalias 'semantic-overlay-live-p 'overlay-buffer)
+ (defalias 'semantic-make-overlay 'make-overlay)
+ (defalias 'semantic-overlay-put 'overlay-put)
+ (defalias 'semantic-overlay-get 'overlay-get)
+ (defalias 'semantic-overlay-properties 'overlay-properties)
+ (defalias 'semantic-overlay-move 'move-overlay)
+ (defalias 'semantic-overlay-delete 'delete-overlay)
+ (defalias 'semantic-overlays-at 'overlays-at)
+ (defalias 'semantic-overlays-in 'overlays-in)
+ (defalias 'semantic-overlay-buffer 'overlay-buffer)
+ (defalias 'semantic-overlay-start 'overlay-start)
+ (defalias 'semantic-overlay-end 'overlay-end)
+ (defalias 'semantic-overlay-next-change 'next-overlay-change)
+ (defalias 'semantic-overlay-previous-change 'previous-overlay-change)
+ (defalias 'semantic-overlay-lists 'overlay-lists)
+ (defalias 'semantic-overlay-p 'overlayp)
+ (defalias 'semantic-read-event 'read-event)
+ (defalias 'semantic-popup-menu 'popup-menu)
+ (defun semantic-event-window (event)
+ "Extract the window from EVENT."
+ (car (car (cdr event))))
+
+ (if (> emacs-major-version 21)
+ (defalias 'semantic-buffer-local-value 'buffer-local-value)
+
+ (defun semantic-buffer-local-value (sym &optional buf)
+ "Get the value of SYM from buffer local variable in BUF."
+ (cdr (assoc sym (buffer-local-variables buf)))))
+ )
+
+
+ (if (and (not (featurep 'xemacs))
+ (>= emacs-major-version 21))
+ (defalias 'semantic-make-local-hook 'identity)
+ (defalias 'semantic-make-local-hook 'make-local-hook)
+ )
+
+ (if (featurep 'xemacs)
+ (defalias 'semantic-mode-line-update 'redraw-modeline)
+ (defalias 'semantic-mode-line-update 'force-mode-line-update))
+
+ ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to
+ ;; run major mode hooks.
+ (defalias 'semantic-run-mode-hooks
+ (if (fboundp 'run-mode-hooks)
+ 'run-mode-hooks
+ 'run-hooks))
+
+ ;; Fancy compat usage now handled in cedet-compat
+ (defalias 'semantic-subst-char-in-string 'subst-char-in-string)
+ )
(defun semantic-delete-overlay-maybe (overlay)
"Delete OVERLAY if it is a semantic token overlay."
(if (semantic-overlay-get overlay 'semantic)
(semantic-overlay-delete overlay)))
+;;; Menu Item compatibility
+;;
+(defun semantic-menu-item (item)
+ "Build an XEmacs compatible menu item from vector ITEM.
+That is remove the unsupported :help stuff."
+ (if (featurep 'xemacs)
+ (let ((n (length item))
+ (i 0)
+ slot l)
+ (while (< i n)
+ (setq slot (aref item i))
+ (if (and (keywordp slot)
+ (eq slot :help))
+ (setq i (1+ i))
+ (setq l (cons slot l)))
+ (setq i (1+ i)))
+ (apply #'vector (nreverse l)))
+ item))
+
;;; Positional Data Cache
;;
(defvar semantic-cache-data-overlays nil
@@ -138,6 +236,23 @@ Remove self from `post-command-hook' if it is empty."
(when ans
(semantic-overlay-get ans 'cached-value)))))
+(defun semantic-test-data-cache ()
+ "Test the data cache."
+ (interactive)
+ (let ((data '(a b c)))
+ (save-current-buffer
+ (set-buffer (get-buffer-create " *semantic-test-data-cache*"))
+ (save-excursion
+ (erase-buffer)
+ (insert "The Moose is Loose")
+ (goto-char (point-min))
+ (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
+ data 'moose 'exit-cache-zone)
+ (if (equal (semantic-get-cache-data 'moose) data)
+ (message "Successfully retrieved cached data.")
+ (error "Failed to retrieve cached data"))
+ ))))
+
;;; Obsoleting various functions & variables
;;
(defun semantic-overload-symbol-from-function (name)
@@ -161,7 +276,7 @@ will throw a warning when it encounters this symbol."
(not (string-match "cedet" byte-compile-current-file))
)
(make-obsolete-overload oldfnalias newfn when)
- (semantic-compile-warn
+ (byte-compile-warn
"%s: `%s' obsoletes overload `%s'"
byte-compile-current-file
newfn
@@ -179,7 +294,7 @@ will throw a warning when it encounters this symbol."
;; Only throw this warning when byte compiling things.
(when (and (boundp 'byte-compile-current-file)
byte-compile-current-file)
- (semantic-compile-warn
+ (byte-compile-warn
"variable `%s' obsoletes, but isn't alias of `%s'"
newvar oldvaralias)
))))
@@ -276,6 +391,17 @@ calling this one."
"Call `find-file-noselect' with various features turned off.
Use this when referencing a file that will be soon deleted.
FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'"
+ ;; Hack -
+ ;; Check if we are in set-auto-mode, and if so, warn about this.
+ (when (or (and (featurep 'emacs) (boundp 'keep-mode-if-same))
+ (and (featurep 'xemacs) (boundp 'just-from-file-name)))
+ (let ((filename (or (and (boundp 'filename) filename)
+ "(unknown)")))
+ (message "WARNING: semantic-find-file-noselect called for \
+%s while in set-auto-mode for %s. You should call the responsible function \
+into `mode-local-init-hook'." file filename)
+ (sit-for 1)))
+
(let* ((recentf-exclude '( (lambda (f) t) ))
;; This is a brave statement. Don't waste time loading in
;; lots of modes. Especially decoration mode can waste a lot
@@ -285,8 +411,11 @@ FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'"
(ede-auto-add-method 'never)
;; Ask font-lock to not colorize these buffers, nor to
;; whine about it either.
- (font-lock-maximum-size 0)
+ (global-font-lock-mode nil)
(font-lock-verbose nil)
+ ;; This forces flymake to ignore this buffer on find-file, and
+ ;; prevents flymake processes from being started.
+ (flymake-start-syntax-check-on-find-file nil)
;; Disable revision control
(vc-handled-backends nil)
;; Don't prompt to insert a template if we visit an empty file
diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el
index 7408dd6702e..8a33c8c8a1a 100644
--- a/lisp/cedet/semantic/grammar-wy.el
+++ b/lisp/cedet/semantic/grammar-wy.el
@@ -2,9 +2,6 @@
;; Copyright (C) 2002-2004, 2009-2012 Free Software Foundation, Inc.
-;; Author: David Ponce <david@dponce.com>
-;; Keywords: syntax
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -27,6 +24,10 @@
;;; Code:
(require 'semantic/lex)
+(eval-when-compile (require 'semantic/bovine))
+
+;;; Prologue
+;;
(defvar semantic-grammar-lex-c-char-re)
;; Current parsed nonterminal name.
@@ -45,6 +46,7 @@
("%left" . LEFT)
("%nonassoc" . NONASSOC)
("%package" . PACKAGE)
+ ("%provide" . PROVIDE)
("%prec" . PREC)
("%put" . PUT)
("%quotemode" . QUOTEMODE)
@@ -109,7 +111,7 @@
(eval-when-compile
(require 'semantic/wisent/comp))
(wisent-compile-grammar
- '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT)
+ '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT)
nil
(grammar
((prologue))
@@ -133,6 +135,7 @@
((no_default_prec_decl))
((languagemode_decl))
((package_decl))
+ ((provide_decl))
((precedence_decl))
((put_decl))
((quotemode_decl))
@@ -161,6 +164,10 @@
((PACKAGE SYMBOL)
`(wisent-raw-tag
(semantic-tag-new-package ',$2 nil))))
+ (provide_decl
+ ((PROVIDE SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'provide))))
(precedence_decl
((associativity token_type_opt items)
`(wisent-raw-tag
@@ -411,31 +418,17 @@
'((parse-stream . wisent-parse-stream)))
(setq semantic-parser-name "LALR"
semantic--parse-table semantic-grammar-wy--parse-table
- semantic-debug-parser-source "semantic-grammar.wy"
+ semantic-debug-parser-source "grammar.wy"
semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table
semantic-lex-types-obarray semantic-grammar-wy--token-table)
;; Collect unmatched syntax lexical tokens
(semantic-make-local-hook 'wisent-discarding-token-functions)
(add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
+ 'wisent-collect-unmatched-syntax nil t))
;;; Analyzers
-
-(define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer
- "sexp analyzer for <sexp> tokens."
- "\\="
- 'SEXP)
-
-(define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer
- "sexp analyzer for <qlist> tokens."
- "\\s'\\s-*("
- 'PREFIXED_LIST)
-
-(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer
- "keyword analyzer for <keyword> tokens."
- "\\(\\sw\\|\\s_\\)+")
-
+;;
(define-lex-block-type-analyzer semantic-grammar-wy--<block>-block-analyzer
"block analyzer for <block> tokens."
"\\s(\\|\\s)"
@@ -451,17 +444,22 @@
nil
'CHARACTER)
-(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer
- "sexp analyzer for <string> tokens."
- "\\s\""
- 'STRING)
-
(define-lex-regex-type-analyzer semantic-grammar-wy--<symbol>-regexp-analyzer
"regexp analyzer for <symbol> tokens."
":?\\(\\sw\\|\\s_\\)+"
'((PERCENT_PERCENT . "\\`%%\\'"))
'SYMBOL)
+(define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer
+ "sexp analyzer for <qlist> tokens."
+ "\\s'\\s-*("
+ 'PREFIXED_LIST)
+
+(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer
+ "sexp analyzer for <string> tokens."
+ "\\s\""
+ 'STRING)
+
(define-lex-string-type-analyzer semantic-grammar-wy--<punctuation>-string-analyzer
"string analyzer for <punctuation> tokens."
"\\(\\s.\\|\\s$\\|\\s'\\)+"
@@ -472,6 +470,22 @@
(COLON . ":"))
'punctuation)
+(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer
+ "keyword analyzer for <keyword> tokens."
+ "\\(\\sw\\|\\s_\\)+")
+
+(define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer
+ "sexp analyzer for <sexp> tokens."
+ "\\="
+ 'SEXP)
+
+
+;;; Epilogue
+;;
+
+
+
+
(provide 'semantic/grammar-wy)
;;; semantic/grammar-wy.el ends here
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index ac28702787d..b85396a79ae 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -30,10 +30,12 @@
;;; Code:
(require 'semantic)
+(require 'semantic/wisent)
(require 'semantic/ctxt)
(require 'semantic/format)
(require 'semantic/grammar-wy)
(require 'semantic/idle)
+
(declare-function semantic-momentary-highlight-tag "semantic/decorate")
(declare-function semantic-analyze-context "semantic/analyze")
(declare-function semantic-analyze-tags-of-class-list
@@ -42,7 +44,8 @@
(eval-when-compile
(require 'eldoc)
(require 'semantic/edit)
- (require 'semantic/find))
+ (require 'semantic/find)
+ (require 'semantic/db))
;;;;
@@ -488,33 +491,27 @@ Also load the specified macro libraries."
;;;;
(defvar semantic--grammar-input-buffer nil)
(defvar semantic--grammar-output-buffer nil)
+(defvar semantic--grammar-package nil)
+(defvar semantic--grammar-provide nil)
(defsubst semantic-grammar-keywordtable ()
"Return the variable name of the keyword table."
- (concat (file-name-sans-extension
- (semantic-grammar-buffer-file
- semantic--grammar-output-buffer))
+ (concat semantic--grammar-package
"--keyword-table"))
(defsubst semantic-grammar-tokentable ()
"Return the variable name of the token table."
- (concat (file-name-sans-extension
- (semantic-grammar-buffer-file
- semantic--grammar-output-buffer))
+ (concat semantic--grammar-package
"--token-table"))
(defsubst semantic-grammar-parsetable ()
"Return the variable name of the parse table."
- (concat (file-name-sans-extension
- (semantic-grammar-buffer-file
- semantic--grammar-output-buffer))
+ (concat semantic--grammar-package
"--parse-table"))
(defsubst semantic-grammar-setupfunction ()
"Return the name of the parser setup function."
- (concat (file-name-sans-extension
- (semantic-grammar-buffer-file
- semantic--grammar-output-buffer))
+ (concat semantic--grammar-package
"--install-parser"))
(defmacro semantic-grammar-as-string (object)
@@ -592,6 +589,9 @@ Typically a DEFINE expression should look like this:
;;
;;; Code:
+
+(require 'semantic/lex)
+(eval-when-compile (require 'semantic/bovine))
")
"Generated header template.
The symbols in the template are local variables in
@@ -642,7 +642,8 @@ The symbols in the list are local variables in
"Return text of a generated standard footer."
(let* ((file (semantic-grammar-buffer-file
semantic--grammar-output-buffer))
- (libr (file-name-sans-extension file))
+ (libr (or semantic--grammar-provide
+ semantic--grammar-package))
(out ""))
(dolist (S semantic-grammar-footer-template)
(cond ((stringp S)
@@ -748,9 +749,7 @@ Block definitions are read from the current table of lexical types."
;; explicitly declared in a %type statement, and if at least the
;; syntax property has been provided.
(when (and declared syntax)
- (setq prefix (file-name-sans-extension
- (semantic-grammar-buffer-file
- semantic--grammar-output-buffer))
+ (setq prefix semantic--grammar-package
mtype (or (get type 'matchdatatype) 'regexp)
name (intern (format "%s--<%s>-%s-analyzer" prefix type mtype))
doc (format "%s analyzer for <%s> tokens." mtype type))
@@ -801,7 +800,6 @@ Block definitions are read from the current table of lexical types."
(with-current-buffer semantic--grammar-input-buffer
(setq tokens (semantic-grammar-tokens)
props (semantic-grammar-token-properties tokens)))
- (insert "(require 'semantic/lex)\n\n")
(let ((semantic-lex-types-obarray
(semantic-lex-make-type-table tokens props))
semantic-grammar--lex-block-specs)
@@ -833,10 +831,14 @@ Lisp code."
;; Values of the following local variables are obtained from
;; the grammar parsed tree in current buffer, that is before
;; switching to the output file.
- (package (semantic-grammar-package))
- (output (concat package ".el"))
+ (semantic--grammar-package (semantic-grammar-package))
+ (semantic--grammar-provide (semantic-grammar-first-tag-name 'provide))
+ (output (concat (or semantic--grammar-provide
+ semantic--grammar-package) ".el"))
(semantic--grammar-input-buffer (current-buffer))
- (semantic--grammar-output-buffer (find-file-noselect output))
+ (semantic--grammar-output-buffer
+ (find-file-noselect
+ (file-name-nondirectory output)))
(header (semantic-grammar-header))
(prologue (semantic-grammar-prologue))
(epilogue (semantic-grammar-epilogue))
@@ -847,7 +849,7 @@ Lisp code."
(file-newer-than-file-p
(buffer-file-name semantic--grammar-output-buffer)
(buffer-file-name semantic--grammar-input-buffer)))
- (message "Package `%s' is up to date." package)
+ (message "Package `%s' is up to date." semantic--grammar-package)
;; Create the package
(set-buffer semantic--grammar-output-buffer)
;; Use Unix EOLs, so that the file is portable to all platforms.
@@ -965,7 +967,11 @@ Return non-nil if there were no errors, nil if errors."
(let ((packagename
(condition-case err
(with-current-buffer (find-file-noselect file)
- (semantic-grammar-create-package))
+ (let ((semantic-new-buffer-setup-functions nil)
+ (vc-handled-backends nil))
+ (setq semanticdb-new-database-class 'semanticdb-project-database)
+ (semantic-mode 1)
+ (semantic-grammar-create-package)))
(error
(message "%s" (error-message-string err))
nil))))
@@ -1000,7 +1006,6 @@ See also the variable `semantic-grammar-file-regexp'."
;; Remove vc from find-file-hook. It causes bad stuff to
;; happen in Emacs 20.
(find-file-hook (delete 'vc-find-file-hook find-file-hook)))
- (message "Compiling Grammars from: %s" (locate-library "semantic-grammar"))
(dolist (arg command-line-args-left)
(unless (and arg (file-exists-p arg))
(error "Argument %s is not a valid file name" arg))
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index 1aedc7b6d45..9f6a82159e8 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -37,9 +37,10 @@
(require 'semantic/analyze)
(require 'semantic/format)
(require 'pulse)
+(require 'semantic/senator)
+(require 'semantic/analyze/refs)
(eval-when-compile
(require 'semantic/analyze)
- (require 'semantic/analyze/refs)
(require 'semantic/find))
(declare-function imenu--mouse-menu "imenu")
@@ -143,11 +144,50 @@ Completion options are calculated with `semantic-analyze-possible-completions'."
(mapcar semantic-ia-completion-format-tag-function syms)))))))))
(defcustom semantic-ia-completion-menu-format-tag-function
- 'semantic-uml-concise-prototype-nonterminal
+ 'semantic-format-tag-uml-concise-prototype
"*Function used to convert a tag to a string during completion."
:group 'semantic
:type semantic-format-tag-custom-list)
+;;;###autoload
+(defun semantic-ia-complete-symbol-menu (point)
+ "Complete the current symbol via a menu based at POINT.
+Completion options are calculated with `semantic-analyze-possible-completions'."
+ (interactive "d")
+ (require 'imenu)
+ (let* ((a (semantic-analyze-current-context point))
+ (syms (semantic-analyze-possible-completions a))
+ )
+ ;; Complete this symbol.
+ (if (not syms)
+ (progn
+ (message "No smart completions found. Trying Senator.")
+ (when (semantic-analyze-context-p a)
+ ;; This is a quick way of getting a nice completion list
+ ;; in the menu if the regular context mechanism fails.
+ (senator-completion-menu-popup)))
+
+ (let* ((menu
+ (mapcar
+ (lambda (tag)
+ (cons
+ (funcall semantic-ia-completion-menu-format-tag-function tag)
+ (vector tag)))
+ syms))
+ (ans
+ (imenu--mouse-menu
+ ;; XEmacs needs that the menu has at least 2 items. So,
+ ;; include a nil item that will be ignored by imenu.
+ (cons nil menu)
+ (senator-completion-menu-point-as-event)
+ "Completions")))
+ (when ans
+ (if (not (semantic-tag-p ans))
+ (setq ans (aref (cdr ans) 0)))
+ (delete-region (car (oref a bounds)) (cdr (oref a bounds)))
+ (semantic-ia-insert-tag ans))
+ ))))
+
;;; Completions Tip
;;
;; This functions shows how to get the list of completions,
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 7ed1612d592..57cb17a233e 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -41,6 +41,7 @@
(require 'semantic/format)
(require 'semantic/tag)
(require 'timer)
+;;(require 'working)
;; For the semantic-find-tags-by-name macro.
(eval-when-compile (require 'semantic/find))
@@ -150,12 +151,18 @@ all buffers regardless of their size."
"Return non-nil if idle-scheduler is enabled for this buffer.
idle-scheduler is disabled when debugging or if the buffer size
exceeds the `semantic-idle-scheduler-max-buffer-size' threshold."
- (and semantic-idle-scheduler-mode
- (not (and (boundp 'semantic-debug-enabled)
- semantic-debug-enabled))
- (not semantic-lex-debug)
- (or (<= semantic-idle-scheduler-max-buffer-size 0)
- (< (buffer-size) semantic-idle-scheduler-max-buffer-size))))
+ (let* ((remote-file? (when (stringp buffer-file-name) (file-remote-p buffer-file-name))))
+ (and semantic-idle-scheduler-mode
+ (not (and (boundp 'semantic-debug-enabled)
+ semantic-debug-enabled))
+ (not semantic-lex-debug)
+ ;; local file should exist on disk
+ ;; remote file should have active connection
+ (or (and (null remote-file?) (stringp buffer-file-name)
+ (file-exists-p buffer-file-name))
+ (and remote-file? (file-remote-p buffer-file-name nil t)))
+ (or (<= semantic-idle-scheduler-max-buffer-size 0)
+ (< (buffer-size) semantic-idle-scheduler-max-buffer-size)))))
;;;###autoload
(define-minor-mode semantic-idle-scheduler-mode
@@ -554,10 +561,11 @@ FORMS will be called during idle time after the current buffer's
semantic tag information has been updated.
This routine creates the following functions and variables:"
(let ((global (intern (concat "global-" (symbol-name name) "-mode")))
- (mode (intern (concat (symbol-name name) "-mode")))
- (hook (intern (concat (symbol-name name) "-mode-hook")))
- (map (intern (concat (symbol-name name) "-mode-map")))
- (func (intern (concat (symbol-name name) "-idle-function"))))
+ (mode (intern (concat (symbol-name name) "-mode")))
+ (hook (intern (concat (symbol-name name) "-mode-hook")))
+ (map (intern (concat (symbol-name name) "-mode-map")))
+ (setup (intern (concat (symbol-name name) "-mode-setup")))
+ (func (intern (concat (symbol-name name) "-idle-function"))))
`(eval-and-compile
(define-minor-mode ,global
@@ -607,7 +615,10 @@ turned on in every Semantic-supported buffer.")
(symbol-name mode) "'.")
,@forms))))
(put 'define-semantic-idle-service 'lisp-indent-function 1)
-
+(add-hook 'edebug-setup-hook
+ (lambda ()
+ (def-edebug-spec define-semantic-idle-service
+ (&define name stringp def-body))))
;;; SUMMARY MODE
;;
@@ -878,7 +889,7 @@ Call `semantic-symref-hits-in-region' to identify local references."
;; We use pulse, but we don't want the flashy version,
;; just the stable version.
(pulse-flag nil))
- (when ctxt
+ (when (and ctxt tag)
;; Highlight the original tag? Protect against problems.
(condition-case nil
(semantic-idle-symbol-maybe-highlight target)
@@ -932,15 +943,18 @@ doing fancy completions."
"Calculate and display a list of completions."
(when (and (semantic-idle-summary-useful-context-p)
(semantic-idle-completions-end-of-symbol-p))
- ;; This mode can be fragile. Ignore problems.
- ;; If something doesn't do what you expect, run
- ;; the below command by hand instead.
- (condition-case nil
+ ;; This mode can be fragile, hence don't raise errors, and only
+ ;; report problems if semantic-idle-scheduler-verbose-flag is
+ ;; non-nil. If something doesn't do what you expect, run the
+ ;; below command by hand instead.
+ (condition-case err
(semanticdb-without-unloaded-file-searches
;; Use idle version.
(semantic-complete-analyze-inline-idle)
)
- (error nil))
+ (error
+ (when semantic-idle-scheduler-verbose-flag
+ (message " %s" (error-message-string err)))))
))
(define-semantic-idle-service semantic-idle-completions
@@ -1133,7 +1147,7 @@ be called."
;; :active t
;; :style 'toggle
;; :selected '(let ((tag (semantic-current-tag)))
- ;; (and tag (semantic-tag-folded-p tag)))
+ ;; (and tag (semantic-tag-folded-p tag)))
;; :help "Fold the current tag to one line"))
"---"
(semantic-menu-item
@@ -1168,17 +1182,19 @@ be called."
;; Format TAG-LIST and put the formatted string into the header
;; line.
(setq header-line-format
- (concat
- semantic-idle-breadcrumbs-header-line-prefix
- (if tag-list
- (semantic-idle-breadcrumbs--format-tag-list
- tag-list
- (- width
- (length semantic-idle-breadcrumbs-header-line-prefix)))
- (propertize
- "<not on tags>"
- 'face
- 'font-lock-comment-face)))))
+ (replace-regexp-in-string ;; Since % is interpreted in the
+ "\\(%\\)" "%\\1" ;; mode/header line format, we
+ (concat ;; have to escape all occurrences.
+ semantic-idle-breadcrumbs-header-line-prefix
+ (if tag-list
+ (semantic-idle-breadcrumbs--format-tag-list
+ tag-list
+ (- width
+ (length semantic-idle-breadcrumbs-header-line-prefix)))
+ (propertize
+ "<not on tags>"
+ 'face
+ 'font-lock-comment-face))))))
;; Update the header line.
(force-mode-line-update))
@@ -1192,7 +1208,9 @@ TODO THIS FUNCTION DOES NOT WORK YET."
(let ((width (- (nth 2 (window-edges))
(nth 0 (window-edges)))))
(setq mode-line-format
- (semantic-idle-breadcrumbs--format-tag-list tag-list width)))
+ (replace-regexp-in-string ;; see comment in
+ "\\(%\\)" "%\\1" ;; `semantic-idle-breadcrumbs--display-in-header-line'
+ (semantic-idle-breadcrumbs--format-tag-list tag-list width))))
(force-mode-line-update))
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index 8747d793ab8..e560e6ecab2 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -121,6 +121,7 @@ corresponding compound declaration."
(setq clone (semantic-tag-clone tag (car dim))
xpand (cons clone xpand))
(semantic-tag-put-attribute clone :dereference (cdr dim)))
+
((eq class 'variable)
(or (consp elts) (setq elts (list (list elts))))
(setq dim (semantic-java-dim (semantic-tag-get-attribute tag :type))
@@ -139,7 +140,20 @@ corresponding compound declaration."
(semantic-tag-put-attribute clone :type type)
(semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim)))
(semantic-tag-set-bounds clone start end)))
- )
+
+ ((and (eq class 'type) (string-match "\\." (semantic-tag-name tag)))
+ ;; javap outputs files where the package name is stuck onto the class or interface
+ ;; name. To make this more regular, we extract the package name into a package statement,
+ ;; then make the class name regular.
+ (let* ((name (semantic-tag-name tag))
+ (rsplit (nreverse (split-string name "\\." t)))
+ (newclassname (car rsplit))
+ (newpkg (mapconcat 'identity (reverse (cdr rsplit)) ".")))
+ (semantic-tag-set-name tag newclassname)
+ (setq xpand
+ (list tag
+ (semantic-tag-new-package newpkg nil))))
+ ))
xpand))
;;; Environment
@@ -159,6 +173,15 @@ corresponding compound declaration."
(semantic-find-tags-by-class
'type (semantic-find-tag-by-overlay point))))
+;; Tag Protection
+;;
+(define-mode-local-override semantic-tag-protection
+ java-mode (tag &optional parent)
+ "Return the protection of TAG in PARENT.
+Override function for `semantic-tag-protection'."
+ (let ((prot (semantic-tag-protection-default tag parent)))
+ (or prot 'package)))
+
;; Prototype handler
;;
(defun semantic-java-prototype-function (tag &optional parent color)
@@ -242,7 +265,6 @@ Optional argument COLOR indicates that color should be mixed in."
(let ((name (semantic-tag-name tag)))
(concat (mapconcat 'identity (split-string name "\\.") "/") ".java")))
-
;; Documentation handler
;;
(defsubst semantic-java-skip-spaces-backward ()
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 5f121d88ac6..406f2900563 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -497,7 +497,7 @@ and what valid VAL values are."
;; (symbol "name" 569 . 573)
;; (semantic-list "(int in)" 574 . 582))
;;
- ;; In the second case, a macro with an argument list as the a rgs as the
+ ;; In the second case, a macro with an argument list as the args as the
;; first entry.
;;
;; CASE 3: Symbol text merge
@@ -577,13 +577,7 @@ and what valid VAL values are."
(cond
;; CASE 3: Merge symbols together.
((eq (semantic-lex-token-class v) 'spp-symbol-merge)
- ;; We need to merge the tokens in the 'text segment together,
- ;; and produce a single symbol from it.
- (let ((newsym
- (mapconcat (lambda (tok)
- (semantic-lex-spp-one-token-to-txt tok))
- txt
- "")))
+ (let ((newsym (semantic-lex-spp-symbol-merge txt)))
(semantic-lex-push-token
(semantic-lex-token 'symbol beg end newsym))
))
@@ -637,6 +631,27 @@ and what valid VAL values are."
(semantic-lex-spp-symbol-pop A))
))
+(defun semantic-lex-spp-symbol-merge (txt)
+ "Merge the tokens listed in TXT.
+TXT might contain further 'spp-symbol-merge, which will
+be merged recursively."
+ ;; We need to merge the tokens in the 'text segment together,
+ ;; and produce a single symbol from it.
+ (mapconcat (lambda (tok)
+ (cond
+ ((eq (car tok) 'symbol)
+ (semantic-lex-spp-one-token-to-txt tok))
+ ((eq (car tok) 'spp-symbol-merge)
+ ;; Call recursively for multiple merges, like
+ ;; #define FOO(a) foo##a##bar
+ (semantic-lex-spp-symbol-merge (cadr tok)))
+ (t
+ (message "Invalid merge macro encountered; \
+will return empty string instead.")
+ "")))
+ txt
+ ""))
+
;;; Macro Merging
;;
;; Used when token streams from different macros include each other.
@@ -869,7 +884,14 @@ Parsing starts inside the parens, and ends at the end of TOKEN."
(forward-char 1)
(setq fresh-toks (semantic-lex-spp-stream-for-macro (1- end)))
(dolist (tok fresh-toks)
- (when (memq (semantic-lex-token-class tok) '(symbol semantic-list))
+ ;; march 2011: This is too restrictive! For example "void"
+ ;; can't get through. What elements was I trying to expunge
+ ;; to put this in here in the first place? If I comment it
+ ;; out, does anything new break?
+ ;(when (memq (semantic-lex-token-class tok) '(symbol semantic-list))
+ ;; It appears the commas need to be dumped. perhaps this is better,
+ ;; but will it cause more problems later?
+ (unless (eq (semantic-lex-token-class tok) 'punctuation)
(setq toks (cons tok toks))))
(nreverse toks)))))
@@ -890,6 +912,7 @@ and variable state from the current buffer."
(fresh-toks nil)
(toks nil)
(origbuff (current-buffer))
+ (analyzer semantic-lex-analyzer)
(important-vars '(semantic-lex-spp-macro-symbol-obarray
semantic-lex-spp-project-macro-symbol-obarray
semantic-lex-spp-dynamic-macro-symbol-obarray
@@ -913,6 +936,11 @@ and variable state from the current buffer."
;; Hack in mode-local
(activate-mode-local-bindings)
+ ;; Call the major mode's setup function
+ (let ((entry (assq major-mode semantic-new-buffer-setup-functions)))
+ (when entry
+ (funcall (cdr entry))))
+
;; CHEATER! The following 3 lines are from
;; `semantic-new-buffer-fcn', but we don't want to turn
;; on all the other annoying modes for this little task.
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index e47cc1eaee9..d7ab5911a67 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -691,20 +691,6 @@ Return the overlay."
(semantic-overlay-put o 'face 'highlight)
o))
-(defsubst semantic-lex-debug-break (token)
- "Break during lexical analysis at TOKEN."
- (when semantic-lex-debug
- (let ((o nil))
- (unwind-protect
- (progn
- (when token
- (setq o (semantic-lex-highlight-token token)))
- (semantic-read-event
- (format "%S :: SPC - continue" token))
- )
- (when o
- (semantic-overlay-delete o))))))
-
;;; Lexical analyzer creation
;;
;; Code for creating a lex function from lists of analyzers.
@@ -754,6 +740,20 @@ a LOCAL option.")
;;(defvar semantic-lex-timeout 5
;; "*Number of sections of lexing before giving up.")
+(defsubst semantic-lex-debug-break (token)
+ "Break during lexical analysis at TOKEN."
+ (when semantic-lex-debug
+ (let ((o nil))
+ (unwind-protect
+ (progn
+ (when token
+ (setq o (semantic-lex-highlight-token token)))
+ (semantic-read-event
+ (format "%S :: Depth: %d :: SPC - continue" token semantic-lex-current-depth))
+ )
+ (when o
+ (semantic-overlay-delete o))))))
+
(defmacro define-lex (name doc &rest analyzers)
"Create a new lexical analyzer with NAME.
DOC is a documentation string describing this analyzer.
@@ -1205,11 +1205,13 @@ symbols returned in open and close tokens."
))
))
((setq match (assoc text ',clist))
- (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
- (semantic-lex-push-token
- (semantic-lex-token
- (nth 1 match)
- (match-beginning 0) (match-end 0)))))))
+ (if (> semantic-lex-current-depth 0)
+ (progn
+ (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
+ (semantic-lex-push-token
+ (semantic-lex-token
+ (nth 1 match)
+ (match-beginning 0) (match-end 0)))))))))
)))
;;; Analyzers
diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el
index 4216e099857..d042ba42582 100644
--- a/lisp/cedet/semantic/mru-bookmark.el
+++ b/lisp/cedet/semantic/mru-bookmark.el
@@ -53,6 +53,7 @@
(declare-function data-debug-new-buffer "data-debug")
(declare-function data-debug-insert-object-slots "eieio-datadebug")
(declare-function semantic-momentary-highlight-tag "semantic/decorate")
+(declare-function semantic-tag-similar-p "semantic/tag-ls")
;;; TRACKING CORE
;;
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index c5b07b9d440..0882120fc65 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -56,6 +56,7 @@
(declare-function semantic-analyze-princ-sequence "semantic/analyze")
(declare-function semanticdb-typecache-merge-streams "semantic/db-typecache")
(declare-function semanticdb-typecache-add-dependant "semantic/db-typecache")
+(declare-function semantic-tag-similar-p "semantic/tag-ls")
;;; Code:
@@ -158,7 +159,7 @@ If nil, then the typescope is reset."
;; tag can be passed in and a scope derived from it.
(defun semantic-scope-tag-clone-with-scope (tag scopetags)
- "Close TAG, and return it. Add SCOPETAGS as a tag-local scope.
+ "Clone TAG, and return it. Add SCOPETAGS as a tag-local scope.
Stores the SCOPETAGS as a set of tag properties on the cloned tag."
(let ((clone (semantic-tag-clone tag))
)
@@ -197,7 +198,7 @@ Use `semantic-ctxt-scoped-types' to find types."
(semanticdb-typecache-find (car sp)))
;(semantic-analyze-find-tag (car sp) 'type))
((semantic-tag-p (car sp))
- (if (semantic-analyze-tag-prototype-p (car sp))
+ (if (semantic-tag-prototype-p (car sp))
(semanticdb-typecache-find (semantic-tag-name (car sp)))
;;(semantic-analyze-find-tag (semantic-tag-name (car sp)) 'type)
(car sp)))
@@ -271,9 +272,11 @@ are from nesting data types."
(setq stack (reverse stack))
;; Add things to STACK until we cease finding tags of class type.
(while (and stack (eq (semantic-tag-class (car stack)) 'type))
- ;; Otherwise, just add this to the returnlist.
- (setq returnlist (cons (car stack) returnlist))
- (setq stack (cdr stack)))
+ ;; Otherwise, just add this to the returnlist, but make
+ ;; sure we didn't already have that tag in scopetypes
+ (unless (member (car stack) scopetypes)
+ (setq returnlist (cons (car stack) returnlist)))
+ (setq stack (cdr stack)))
(setq returnlist (nreverse returnlist))
))
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index 1c8063134d6..540c766cc94 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -185,7 +185,7 @@ to perform the search. This was added for use by a test harness."
;;;###autoload
(defun semantic-symref-find-tags-by-name (name &optional scope)
- "Find a list of references to NAME in the current project.
+ "Find a list of tags by NAME in the current project.
Optional SCOPE specifies which file set to search. Defaults to 'project.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
@@ -389,9 +389,11 @@ already."
(forward-line (1- line))
;; Search forward for the matching text
- (re-search-forward (regexp-quote txt)
- (point-at-eol)
- t)
+ (when (re-search-forward (regexp-quote txt)
+ (point-at-eol)
+ t)
+ (goto-char (match-beginning 0))
+ )
(setq tag (semantic-current-tag))
diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el
index 57d628b2681..c6aa48bfbc3 100644
--- a/lisp/cedet/semantic/symref/filter.el
+++ b/lisp/cedet/semantic/symref/filter.el
@@ -85,6 +85,27 @@ Search occurs in the current buffer between START and END."
(funcall hookfcn start end prefix)))))
(point)))))))
+(defun semantic-symref-test-count-hits-in-tag ()
+ "Lookup in the current tag the symbol under point.
+the count all the other references to the same symbol within the
+tag that contains point, and return that."
+ (interactive)
+ (let* ((ctxt (semantic-analyze-current-context))
+ (target (car (reverse (oref ctxt prefix))))
+ (tag (semantic-current-tag))
+ (start (current-time))
+ (Lcount 0))
+ (when (semantic-tag-p target)
+ (semantic-symref-hits-in-region
+ target (lambda (start end prefix) (setq Lcount (1+ Lcount)))
+ (semantic-tag-start tag)
+ (semantic-tag-end tag))
+ (when (called-interactively-p 'interactive)
+ (message "Found %d occurrences of %s in %.2f seconds"
+ Lcount (semantic-tag-name target)
+ (semantic-elapsed-time start (current-time))))
+ Lcount)))
+
(defun semantic-symref-rename-local-variable ()
"Fancy way to rename the local variable under point.
Depends on the SRecode Field editing API."
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index 9a3cb1f524a..55ccf1c103f 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -120,6 +120,7 @@ Display the references in`semantic-symref-results-mode'."
(defvar semantic-symref-results-mode-map
(let ((km (make-sparse-keymap)))
+ (suppress-keymap km)
(define-key km "\C-i" 'forward-button)
(define-key km "\M-C-i" 'backward-button)
(define-key km " " 'push-button)
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
index e4c248934c3..094ea554287 100644
--- a/lisp/cedet/semantic/tag-ls.el
+++ b/lisp/cedet/semantic/tag-ls.el
@@ -30,9 +30,217 @@
;; the information.
(require 'semantic)
+(require 'semantic/find)
;;; Code:
+;;; TAG SIMILARITY:
+;;
+;; Two tags that represent the same thing are "similar", but not the "same".
+;; Similar tags might have the same name, but one is a :prototype, while
+;; the other is an implementation.
+;;
+;; Each language will have different things that can be ignored
+;; between two "similar" tags, so similarity checks involve a series
+;; of mode overridable features. Some are "internal" features.
+(defvar semantic-tag-similar-ignorable-attributes '(:prototype-flag)
+ "The tag attributes that can be ignored during a similarity test.")
+
+(define-overloadable-function semantic--tag-similar-names-p (tag1 tag2 blankok)
+ "Compare the names of TAG1 and TAG2.
+If BLANKOK is false, then the names must exactly match.
+If BLANKOK is true, then if either of TAG1 or TAG2 has blank
+names, then that is ok, and this returns true, but if they both
+have values, they must still match.")
+
+(defun semantic--tag-similar-names-p-default (tag1 tag2 blankok)
+ "Compare the names of TAG1 and TAG2.
+If BLANKOK is false, then the names must exactly match.
+If BLANKOK is true, then if either of TAG1 or TAG2 has blank
+names, then that is ok, and this returns true, but if they both
+have values, they must still match."
+ (let ((n1 (semantic-tag-name tag1))
+ (n2 (semantic-tag-name tag2)))
+ (or (and blankok (or (null n1) (null n2) (string= n1 "") (string= n2 "")))
+ (string= n1 n2))))
+
+(define-overloadable-function semantic--tag-similar-types-p (tag1 tag2)
+ "Compare the types of TAG1 and TAG2.
+This function can be overridden, for example to compare a fully
+qualified with an unqualified type."
+ (cond
+ ((and (null (semantic-tag-type tag1))
+ (null (semantic-tag-type tag2)))
+ t)
+ ((or (null (semantic-tag-type tag1))
+ (null (semantic-tag-type tag2)))
+ nil)
+ (t
+ (:override))))
+
+(defun semantic--tag-similar-types-p-default (tag1 tag2)
+ "Compare the types of TAG1 and TAG2.
+This function can be overridden, for example to compare a fully
+qualified with an unqualified type."
+ (semantic-tag-of-type-p tag1 (semantic-tag-type tag2)))
+
+(define-overloadable-function semantic--tag-attribute-similar-p (attr value1 value2 ignorable-attributes)
+ "Test to see if attribute ATTR is similar for VALUE1 and VALUE2.
+IGNORABLE-ATTRIBUTES is described in `semantic-tag-similar-p'.
+This function is internal, but allows customization of `semantic-tag-similar-p'
+for a given mode at a more granular level.
+
+Note that :type, :name, and anything in IGNORABLE-ATTRIBUTES will
+not be passed to this function.
+
+Modes that override this function can call `semantic--tag-attribute-similar-p-default'
+to do the default equality tests if ATTR is not special for that mode.")
+
+(defun semantic--tag-attribute-similar-p-default (attr value1 value2 ignorable-attributes)
+ "For ATTR, VALUE1, VALUE2 and IGNORABLE-ATTRIBUTES, test for similarity."
+ (cond
+ ;; Tag sublists require special testing.
+ ((and (listp value1) (semantic-tag-p (car value1))
+ (listp value2) (semantic-tag-p (car value2)))
+ (let ((ans t)
+ (taglist1 value1)
+ (taglist2 value2))
+ (when (not (eq (length taglist1) (length taglist2)))
+ (setq ans nil))
+ (while (and ans taglist1 taglist2)
+ (setq ans (apply 'semantic-tag-similar-p
+ (car taglist1) (car taglist2)
+ ignorable-attributes)
+ taglist1 (cdr taglist1)
+ taglist2 (cdr taglist2)))
+ ans))
+
+ ;; The attributes are not the same?
+ ((not (equal value1 value2))
+ nil)
+
+ (t t))
+ )
+
+(define-overloadable-function semantic-tag-similar-p (tag1 tag2 &rest ignorable-attributes)
+ "Test to see if TAG1 and TAG2 are similar.
+Two tags are similar if their name, datatype, and various attributes
+are the same.
+
+Similar tags that have sub-tags such as arg lists or type members,
+are similar w/out checking the sub-list of tags.
+Optional argument IGNORABLE-ATTRIBUTES are attributes to ignore while comparing similarity.
+By default, `semantic-tag-similar-ignorable-attributes' is referenced for
+attributes, and IGNORABLE-ATTRIBUTES will augment this list.
+
+Note that even though :name is not an attribute, it can be used to
+to indicate lax comparison of names via `semantic--tag-similar-names-p'")
+
+;; Note: optional thing is because overloadable fcns don't handle this
+;; quite right.
+(defun semantic-tag-similar-p-default (tag1 tag2 &optional ignorable-attributes)
+ "Test to see if TAG1 and TAG2 are similar.
+Two tags are similar if their name, datatype, and various attributes
+are the same.
+
+IGNORABLE-ATTRIBUTES are tag attributes that can be ignored.
+
+See `semantic-tag-similar-p' for details."
+ (let* ((ignore (append ignorable-attributes semantic-tag-similar-ignorable-attributes))
+ (A1 (and (semantic--tag-similar-names-p tag1 tag2 (memq :name ignore))
+ (semantic--tag-similar-types-p tag1 tag2)
+ (semantic-tag-of-class-p tag1 (semantic-tag-class tag2))))
+ (attr1 (semantic-tag-attributes tag1))
+ (attr2 (semantic-tag-attributes tag2))
+ (A2 t)
+ (A3 t)
+ )
+ ;; Test if there are non-ignorable attributes in A2 which are not present in A1
+ (while (and A2 attr2)
+ (let ((a (car attr2)))
+ (unless (or (eq a :type) (memq a ignore))
+ (setq A2 (semantic-tag-get-attribute tag1 a)))
+ (setq attr2 (cdr (cdr attr2)))))
+ (while (and A2 attr1 A3)
+ (let ((a (car attr1)))
+
+ (cond ((or (eq a :type) ;; already tested above.
+ (memq a ignore)) ;; Ignore them...
+ nil)
+
+ (t
+ (setq A3
+ (semantic--tag-attribute-similar-p
+ a (car (cdr attr1)) (semantic-tag-get-attribute tag2 a)
+ ignorable-attributes)))
+ ))
+ (setq attr1 (cdr (cdr attr1))))
+ (and A1 A2 A3)))
+
+;;; FULL NAMES
+;;
+;; For programmer convenience, a full name is not specified in source
+;; code. Instead some abbreviation is made, and the local environment
+;; will contain the info needed to determine the full name.
+(define-overloadable-function semantic-tag-full-package (tag &optional stream-or-buffer)
+ "Return the fully qualified package name of TAG in a package hierarchy.
+STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
+but must be a toplevel semantic tag stream that contains TAG.
+A Package Hierarchy is defined in UML by the way classes and methods
+are organized on disk. Some languages use this concept such that a
+class can be accessed via it's fully qualified name, (such as Java.)
+Other languages qualify names within a Namespace (such as C++) which
+result in a different package like structure.
+
+Languages which do not override this function will just search the
+stream for a tag of class 'package, and return that."
+ (let ((stream (semantic-something-to-tag-table
+ (or stream-or-buffer tag))))
+ (:override-with-args (tag stream))))
+
+(defun semantic-tag-full-package-default (tag stream)
+ "Default method for `semantic-tag-full-package' for TAG.
+Return the name of the first tag of class `package' in STREAM."
+ (let ((pack (car-safe (semantic-find-tags-by-class 'package stream))))
+ (when (and pack (semantic-tag-p pack))
+ (semantic-tag-name pack))))
+
+(define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer)
+ "Return the fully qualified name of TAG in the package hierarchy.
+STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
+but must be a toplevel semantic tag stream that contains TAG.
+A Package Hierarchy is defined in UML by the way classes and methods
+are organized on disk. Some languages use this concept such that a
+class can be accessed via it's fully qualified name, (such as Java.)
+Other languages qualify names within a Namespace (such as C++) which
+result in a different package like structure.
+
+Languages which do not override this function with
+`tag-full-name' will combine `semantic-tag-full-package' and
+`semantic-tag-name', separated with language separator character.
+Override functions only need to handle STREAM-OR-BUFFER with a
+tag stream value, or nil.
+
+TODO - this function should probably also take a PARENT to TAG to
+resolve issues where a method in a class in a package is present."
+ (let ((stream (semantic-something-to-tag-table
+ (or stream-or-buffer tag))))
+ (:override-with-args (tag stream))))
+
+(make-obsolete-overload 'semantic-nonterminal-full-name
+ 'semantic-tag-full-name "23.2")
+
+(defun semantic-tag-full-name-default (tag stream)
+ "Default method for `semantic-tag-full-name'.
+Return the name of TAG found in the toplevel STREAM."
+ (let ((pack (semantic-tag-full-package tag stream))
+ (name (semantic-tag-name tag)))
+ (if pack
+ (concat pack
+ (car semantic-type-relation-separator-character)
+ name)
+ name)))
+
;;; UML features:
;;
;; UML can represent several types of features of a tag
@@ -93,10 +301,38 @@ See `semantic-tag-protection'."
((string= s "private")
'private)
((string= s "protected")
- 'protected)))))
+ 'protected)
+ ((string= s "package")
+ 'package)
+ ))))
(setq mods (cdr mods)))
prot))
+(defun semantic-tag-package-protected-p (tag &optional parent currentpackage)
+ "Non-nil if TAG is not available via package access control.
+For languages (such as Java) where a method is package protected,
+this method will return nil if TAG, as found in PARENT is available
+for access from a file in CURRENTPACKAGE.
+If TAG is not protected by PACKAGE, also return t. Use
+`semantic-tag-protected-p' instead.
+If PARENT is not provided, it will be derived when passed to
+`semantic-tag-protection'.
+If CURRENTPACKAGE is not provided, it will be derived from the current
+buffer."
+ (let ((tagpro (semantic-tag-protection tag parent)))
+ (if (not (eq tagpro 'package))
+ t ;; protected
+
+ ;; package protection, so check currentpackage.
+ ;; Deriving the package is better from the parent, as TAG is
+ ;; probably a field or method.
+ (if (not currentpackage)
+ (setq currentpackage (semantic-tag-full-package nil (current-buffer))))
+ (let ((tagpack (semantic-tag-full-package (or parent tag))))
+ (if (string= currentpackage tagpack)
+ nil
+ t)) )))
+
(defun semantic-tag-protected-p (tag protection &optional parent)
"Non-nil if TAG is protected.
PROTECTION is a symbol which can be returned by the method
@@ -213,36 +449,6 @@ something without an implementation."
(t nil))
))
-;;; FULL NAMES
-;;
-;; For programmer convenience, a full name is not specified in source
-;; code. Instead some abbreviation is made, and the local environment
-;; will contain the info needed to determine the full name.
-
-(define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer)
- "Return the fully qualified name of TAG in the package hierarchy.
-STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
-but must be a toplevel semantic tag stream that contains TAG.
-A Package Hierarchy is defined in UML by the way classes and methods
-are organized on disk. Some language use this concept such that a
-class can be accessed via it's fully qualified name, (such as Java.)
-Other languages qualify names within a Namespace (such as C++) which
-result in a different package like structure. Languages which do not
-override this function with `tag-full-name' will use
-`semantic-tag-name'. Override functions only need to handle
-STREAM-OR-BUFFER with a tag stream value, or nil."
- (let ((stream (semantic-something-to-tag-table
- (or stream-or-buffer tag))))
- (:override-with-args (tag stream))))
-
-(make-obsolete-overload 'semantic-nonterminal-full-name
- 'semantic-tag-full-name "23.2")
-
-(defun semantic-tag-full-name-default (tag stream)
- "Default method for `semantic-tag-full-name'.
-Return the name of TAG found in the toplevel STREAM."
- (semantic-tag-name tag))
-
(provide 'semantic/tag-ls)
;; Local variables:
diff --git a/lisp/cedet/semantic/tag-write.el b/lisp/cedet/semantic/tag-write.el
index 757609fac3f..69d26245850 100644
--- a/lisp/cedet/semantic/tag-write.el
+++ b/lisp/cedet/semantic/tag-write.el
@@ -41,12 +41,12 @@ INDENT is the amount of indentation to use for this tag."
(signal 'wrong-type-argument (list tag 'semantic-tag-p)))
(when (not indent) (setq indent 0))
;(princ (make-string indent ? ))
- (princ "(\"")
+ (princ "(")
;; Base parts
(let ((name (semantic-tag-name tag))
(class (semantic-tag-class tag)))
- (princ name)
- (princ "\" ")
+ (prin1 name)
+ (princ " ")
(princ (symbol-name class))
)
(let ((attr (semantic-tag-attributes tag))
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index 29e83cd558b..38166871cea 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -51,6 +51,7 @@
(declare-function semantic-analyze-split-name "semantic/analyze/fcn")
(declare-function semantic-fetch-tags "semantic")
(declare-function semantic-clear-toplevel-cache "semantic")
+(declare-function semantic-tag-similar-p "semantic/tag-ls")
(defconst semantic-tag-version "2.0"
"Version string of semantic tags made with this code.")
@@ -362,45 +363,6 @@ of different cons cells."
(equal (semantic-tag-bounds tag1)
(semantic-tag-bounds tag2))))))
-(defun semantic-tag-similar-p (tag1 tag2 &rest ignorable-attributes)
- "Test to see if TAG1 and TAG2 are similar.
-Two tags are similar if their name, datatype, and various attributes
-are the same.
-
-Similar tags that have sub-tags such as arg lists or type members,
-are similar w/out checking the sub-list of tags.
-Optional argument IGNORABLE-ATTRIBUTES are attributes to ignore while comparing similarity."
- (let* ((A1 (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2))
- (semantic-tag-of-class-p tag1 (semantic-tag-class tag2))
- (semantic-tag-of-type-p tag1 (semantic-tag-type tag2))))
- (attr1 (semantic-tag-attributes tag1))
- (A2 (= (length attr1) (length (semantic-tag-attributes tag2))))
- (A3 t)
- )
- (when (and (not A2) ignorable-attributes)
- (setq A2 t))
- (while (and A2 attr1 A3)
- (let ((a (car attr1))
- (v (car (cdr attr1))))
-
- (cond ((or (eq a :type) ;; already tested above.
- (memq a ignorable-attributes)) ;; Ignore them...
- nil)
-
- ;; Don't test sublists of tags
- ((and (listp v) (semantic-tag-p (car v)))
- nil)
-
- ;; The attributes are not the same?
- ((not (equal v (semantic-tag-get-attribute tag2 a)))
- (setq A3 nil))
- (t
- nil))
- )
- (setq attr1 (cdr (cdr attr1))))
-
- (and A1 A2 A3)
- ))
(defun semantic-tag-similar-with-subtags-p (tag1 tag2 &rest ignorable-attributes)
"Test to see if TAG1 and TAG2 are similar.
@@ -408,28 +370,8 @@ Uses `semantic-tag-similar-p' but also recurses through sub-tags, such
as argument lists and type members.
Optional argument IGNORABLE-ATTRIBUTES is passed down to
`semantic-tag-similar-p'."
- (let ((C1 (semantic-tag-components tag1))
- (C2 (semantic-tag-components tag2))
- )
- (if (or (/= (length C1) (length C2))
- (not (semantic-tag-similar-p tag1 tag2 ignorable-attributes))
- )
- ;; Basic test fails.
- nil
- ;; Else, check component lists.
- (catch 'component-dissimilar
- (while C1
-
- (if (not (semantic-tag-similar-with-subtags-p
- (car C1) (car C2) ignorable-attributes))
- (throw 'component-dissimilar nil))
-
- (setq C1 (cdr C1))
- (setq C2 (cdr C2))
- )
- ;; If we made it this far, we are ok.
- t) )))
-
+ ;; DEPRECATE THIS.
+ (semantic-tag-similar-p tag1 tag2 ignorable-attributes))
(defun semantic-tag-of-type-p (tag type)
"Compare TAG's type against TYPE. Non nil if equivalent.
@@ -612,6 +554,51 @@ You can identify a faux tag with `semantic-tag-faux-p'"
"Set TAG name to NAME."
(setcar tag name))
+;;; TAG Proxies
+;;
+;; A new kind of tag is a TAG PROXY. These are tags that have some
+;; minimal number of features set, such as name and class, but have a
+;; marker in them that indicates how to complete them.
+;;
+;; To make the tags easier to view, the proxy is stored as custom
+;; symbol that is not in the global obarray, but has properties set on
+;; it. This prevents saving of massive amounts of proxy data.
+(defun semantic-create-tag-proxy (function data)
+ "Create a tag proxy symbol.
+FUNCTION will be used to resolve the proxy. It should take 3
+two arguments, DATA and TAG. TAG is a proxy tag that needs
+to be resolved, and DATA is the DATA passed into this function.
+DATA is data to help resolve the proxy. DATA can be an EIEIO object,
+such that FUNCTION is a method.
+FUNCTION should return a list of tags, preferably one tag."
+ (let ((sym (make-symbol ":tag-proxy")))
+ (put sym 'proxy-function function)
+ (put sym 'proxy-data data)
+ sym))
+
+(defun semantic-tag-set-proxy (tag proxy &optional filename)
+ "Set TAG to be a proxy. The proxy can be resolved with PROXY.
+This function will also make TAG be a faux tag with
+`semantic-tag-set-faux', and possibly set the tag's
+:filename with FILENAME.
+To create a proxy, see `semantic-create-tag-proxy'."
+ (semantic-tag-set-faux tag)
+ (semantic--tag-put-property tag :proxy proxy)
+ (when filename
+ (semantic--tag-put-property tag :filename filename)))
+
+(defun semantic-tag-resolve-proxy (tag)
+ "Resolve the proxy in TAG.
+The return value is whatever format the proxy was setup as.
+It should be a list of complete tags.
+If TAG has no proxy, then just return tag."
+ (let* ((proxy (semantic--tag-get-property tag :proxy))
+ (function (get proxy 'proxy-function))
+ (data (get proxy 'proxy-data)))
+ (if proxy
+ (funcall function data tag)
+ tag)))
+
;;; Copying and cloning tags.
;;
(defsubst semantic-tag-clone (tag &optional name)
@@ -1350,6 +1337,7 @@ of parent classes. The `cdr' of the list is the list of
interfaces, or abstract classes which are parents of TAG."
(cons (semantic-tag-get-attribute tag :superclasses)
(semantic-tag-type-interfaces tag)))
+
(make-obsolete 'semantic-token-type-parent
"\
use `semantic-tag-type-superclass' \
diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el
index 36c14ce7c2a..9380940282f 100644
--- a/lisp/cedet/semantic/texi.el
+++ b/lisp/cedet/semantic/texi.el
@@ -451,6 +451,7 @@ that start with that symbol."
(defvar semantic-imenu-bucketize-file)
(defvar semantic-imenu-bucketize-type-members)
+;;;###autoload
(defun semantic-default-texi-setup ()
"Set up a buffer for parsing of Texinfo files."
;; This will use our parser.
@@ -687,4 +688,9 @@ If TAG is nil, it is derived from the deffn under POINT."
(provide 'semantic/texi)
+;; Local variables:
+;; generated-autoload-file: "loaddefs.el"
+;; generated-autoload-load-name: "semantic/texi"
+;; End:
+
;;; semantic/texi.el ends here
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index 1cc4d898a34..65201c4fd12 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -298,6 +298,7 @@ If TAG is not specified, use the tag at point."
semantic-dump-parse
semantic-type-relation-separator-character
semantic-command-separation-character
+ semantic-new-buffer-fcn-was-run
)))
(dolist (V vars)
(semantic-describe-buffer-var-helper V buff)))
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 30dbafaa6cc..388c8f332a4 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -134,8 +134,11 @@ If optional LEFT is non-nil insert spaces on left."
;;;; ------------------------
(defconst wisent-BITS-PER-WORD
- (let ((i 1))
- (while (not (zerop (lsh 1 i)))
+ (let ((i 1)
+ (do-shift (if (boundp 'most-positive-fixnum)
+ (lambda (i) (lsh most-positive-fixnum (- i)))
+ (lambda (i) (lsh 1 i)))))
+ (while (not (zerop (funcall do-shift i)))
(setq i (1+ i)))
i))
@@ -3539,4 +3542,12 @@ See also `wisent-compile-grammar' for more details on AUTOMATON."
(provide 'semantic/wisent/comp)
+;; Disable messages with regards to lexical scoping, since this will
+;; produce a bunch of 'lacks a prefix' warnings with the
+;; `wisent-defcontext' trickery above.
+
+;; Local variables:
+;; byte-compile-warnings: (not lexical)
+;; End:
+
;;; semantic/wisent/comp.el ends here
diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el
new file mode 100644
index 00000000000..6fa52dc2adc
--- /dev/null
+++ b/lisp/cedet/semantic/wisent/grammar.el
@@ -0,0 +1,526 @@
+;;; semantic/wisent/grammar.el --- Wisent's input grammar mode
+
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
+;;
+;; Author: David Ponce <david@dponce.com>
+;; Maintainer: David Ponce <david@dponce.com>
+;; Created: 26 Aug 2002
+;; Keywords: syntax
+;; 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:
+;;
+;; Major mode for editing Wisent's input grammar (.wy) files.
+
+;;; Code:
+(require 'semantic)
+(require 'semantic/grammar)
+(require 'semantic/find)
+(require 'semantic/lex)
+(require 'semantic/wisent)
+(require 'semantic/bovine)
+
+(defsubst wisent-grammar-region-placeholder (symb)
+ "Given a $N placeholder symbol in SYMB, return a $regionN symbol.
+Return nil if $N is not a valid placeholder symbol."
+ (let ((n (symbol-name symb)))
+ (if (string-match "^[$]\\([1-9][0-9]*\\)$" n)
+ (intern (concat "$region" (match-string 1 n))))))
+
+(defun wisent-grammar-EXPAND (symb nonterm)
+ "Expand call to EXPAND grammar macro.
+Return the form to parse from within a nonterminal.
+SYMB is a $I placeholder symbol that gives the bounds of the area to
+parse.
+NONTERM is the nonterminal symbol to start with."
+ (unless (member nonterm (semantic-grammar-start))
+ (error "EXPANDFULL macro called with %s, but not used with %%start"
+ nonterm))
+ (let (($ri (wisent-grammar-region-placeholder symb)))
+ (if $ri
+ `(semantic-bovinate-from-nonterminal
+ (car ,$ri) (cdr ,$ri) ',nonterm)
+ (error "Invalid form (EXPAND %s %s)" symb nonterm))))
+
+(defun wisent-grammar-EXPANDFULL (symb nonterm)
+ "Expand call to EXPANDFULL grammar macro.
+Return the form to recursively parse an area.
+SYMB is a $I placeholder symbol that gives the bounds of the area.
+NONTERM is the nonterminal symbol to start with."
+ (unless (member nonterm (semantic-grammar-start))
+ (error "EXPANDFULL macro called with %s, but not used with %%start"
+ nonterm))
+ (let (($ri (wisent-grammar-region-placeholder symb)))
+ (if $ri
+ `(semantic-parse-region
+ (car ,$ri) (cdr ,$ri) ',nonterm 1)
+ (error "Invalid form (EXPANDFULL %s %s)" symb nonterm))))
+
+(defun wisent-grammar-TAG (name class &rest attributes)
+ "Expand call to TAG grammar macro.
+Return the form to create a generic semantic tag.
+See the function `semantic-tag' for the meaning of arguments NAME,
+CLASS and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag ,name ,class ,@attributes)))
+
+(defun wisent-grammar-VARIABLE-TAG (name type default-value &rest attributes)
+ "Expand call to VARIABLE-TAG grammar macro.
+Return the form to create a semantic tag of class variable.
+See the function `semantic-tag-new-variable' for the meaning of
+arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-variable ,name ,type ,default-value ,@attributes)))
+
+(defun wisent-grammar-FUNCTION-TAG (name type arg-list &rest attributes)
+ "Expand call to FUNCTION-TAG grammar macro.
+Return the form to create a semantic tag of class function.
+See the function `semantic-tag-new-function' for the meaning of
+arguments NAME, TYPE, ARG-LIST and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-function ,name ,type ,arg-list ,@attributes)))
+
+(defun wisent-grammar-TYPE-TAG (name type members parents &rest attributes)
+ "Expand call to TYPE-TAG grammar macro.
+Return the form to create a semantic tag of class type.
+See the function `semantic-tag-new-type' for the meaning of arguments
+NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-type ,name ,type ,members ,parents ,@attributes)))
+
+(defun wisent-grammar-INCLUDE-TAG (name system-flag &rest attributes)
+ "Expand call to INCLUDE-TAG grammar macro.
+Return the form to create a semantic tag of class include.
+See the function `semantic-tag-new-include' for the meaning of
+arguments NAME, SYSTEM-FLAG and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-include ,name ,system-flag ,@attributes)))
+
+(defun wisent-grammar-PACKAGE-TAG (name detail &rest attributes)
+ "Expand call to PACKAGE-TAG grammar macro.
+Return the form to create a semantic tag of class package.
+See the function `semantic-tag-new-package' for the meaning of
+arguments NAME, DETAIL and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-package ,name ,detail ,@attributes)))
+
+(defun wisent-grammar-CODE-TAG (name detail &rest attributes)
+ "Expand call to CODE-TAG grammar macro.
+Return the form to create a semantic tag of class code.
+See the function `semantic-tag-new-code' for the meaning of arguments
+NAME, DETAIL and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-code ,name ,detail ,@attributes)))
+
+(defun wisent-grammar-ALIAS-TAG (name aliasclass definition &rest attributes)
+ "Expand call to ALIAS-TAG grammar macro.
+Return the form to create a semantic tag of class alias.
+See the function `semantic-tag-new-alias' for the meaning of arguments
+NAME, ALIASCLASS, DEFINITION and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes)))
+
+(defun wisent-grammar-EXPANDTAG (raw-tag)
+ "Expand call to EXPANDTAG grammar macro.
+Return the form to produce a list of cooked tags from raw form of
+Semantic tag RAW-TAG."
+ `(wisent-cook-tag ,raw-tag))
+
+(defun wisent-grammar-AST-ADD (ast &rest nodes)
+ "Expand call to AST-ADD grammar macro.
+Return the form to update the abstract syntax tree AST with NODES.
+See also the function `semantic-ast-add'."
+ `(semantic-ast-add ,ast ,@nodes))
+
+(defun wisent-grammar-AST-PUT (ast &rest nodes)
+ "Expand call to AST-PUT grammar macro.
+Return the form to update the abstract syntax tree AST with NODES.
+See also the function `semantic-ast-put'."
+ `(semantic-ast-put ,ast ,@nodes))
+
+(defun wisent-grammar-AST-GET (ast node)
+ "Expand call to AST-GET grammar macro.
+Return the form to get, from the abstract syntax tree AST, the value
+of NODE.
+See also the function `semantic-ast-get'."
+ `(semantic-ast-get ,ast ,node))
+
+(defun wisent-grammar-AST-GET1 (ast node)
+ "Expand call to AST-GET1 grammar macro.
+Return the form to get, from the abstract syntax tree AST, the first
+value of NODE.
+See also the function `semantic-ast-get1'."
+ `(semantic-ast-get1 ,ast ,node))
+
+(defun wisent-grammar-AST-GET-STRING (ast node)
+ "Expand call to AST-GET-STRING grammar macro.
+Return the form to get, from the abstract syntax tree AST, the value
+of NODE as a string.
+See also the function `semantic-ast-get-string'."
+ `(semantic-ast-get-string ,ast ,node))
+
+(defun wisent-grammar-AST-MERGE (ast1 ast2)
+ "Expand call to AST-MERGE grammar macro.
+Return the form to merge the abstract syntax trees AST1 and AST2.
+See also the function `semantic-ast-merge'."
+ `(semantic-ast-merge ,ast1 ,ast2))
+
+(defun wisent-grammar-SKIP-BLOCK (&optional symb)
+ "Expand call to SKIP-BLOCK grammar macro.
+Return the form to skip a parenthesized block.
+Optional argument SYMB is a $I placeholder symbol that gives the
+bounds of the block to skip. By default, skip the block at `$1'.
+See also the function `wisent-skip-block'."
+ (let ($ri)
+ (when symb
+ (unless (setq $ri (wisent-grammar-region-placeholder symb))
+ (error "Invalid form (SKIP-BLOCK %s)" symb)))
+ `(wisent-skip-block ,$ri)))
+
+(defun wisent-grammar-SKIP-TOKEN ()
+ "Expand call to SKIP-TOKEN grammar macro.
+Return the form to skip the lookahead token.
+See also the function `wisent-skip-token'."
+ `(wisent-skip-token))
+
+(defun wisent-grammar-assocs ()
+ "Return associativity and precedence level definitions."
+ (mapcar
+ #'(lambda (tag)
+ (cons (intern (semantic-tag-name tag))
+ (mapcar #'semantic-grammar-item-value
+ (semantic-tag-get-attribute tag :value))))
+ (semantic-find-tags-by-class 'assoc (current-buffer))))
+
+(defun wisent-grammar-terminals ()
+ "Return the list of terminal symbols.
+Keep order of declaration in the WY file without duplicates."
+ (let (terms)
+ (mapc
+ #'(lambda (tag)
+ (mapcar #'(lambda (name)
+ (add-to-list 'terms (intern name)))
+ (cons (semantic-tag-name tag)
+ (semantic-tag-get-attribute tag :rest))))
+ (semantic--find-tags-by-function
+ #'(lambda (tag)
+ (memq (semantic-tag-class tag) '(token keyword)))
+ (current-buffer)))
+ (nreverse terms)))
+
+;; Cache of macro definitions currently in use.
+(defvar wisent--grammar-macros nil)
+
+(defun wisent-grammar-expand-macros (expr)
+ "Expand expression EXPR into a form without grammar macros.
+Return the expanded expression."
+ (if (or (atom expr) (semantic-grammar-quote-p (car expr)))
+ expr ;; Just return atom or quoted expression.
+ (let* ((expr (mapcar 'wisent-grammar-expand-macros expr))
+ (macro (assq (car expr) wisent--grammar-macros)))
+ (if macro ;; Expand Semantic built-in.
+ (apply (cdr macro) (cdr expr))
+ expr))))
+
+(defun wisent-grammar-nonterminals ()
+ "Return the list form of nonterminal definitions."
+ (let ((nttags (semantic-find-tags-by-class
+ 'nonterminal (current-buffer)))
+ ;; Setup the cache of macro definitions.
+ (wisent--grammar-macros (semantic-grammar-macros))
+ rltags nterms rules rule elems elem actn sexp prec)
+ (while nttags
+ (setq rltags (semantic-tag-components (car nttags))
+ rules nil)
+ (while rltags
+ (setq elems (semantic-tag-get-attribute (car rltags) :value)
+ prec (semantic-tag-get-attribute (car rltags) :prec)
+ actn (semantic-tag-get-attribute (car rltags) :expr)
+ rule nil)
+ (when elems ;; not an EMPTY rule
+ (while elems
+ (setq elem (car elems)
+ elems (cdr elems))
+ (setq elem (if (consp elem) ;; mid-rule action
+ (wisent-grammar-expand-macros (read (car elem)))
+ (semantic-grammar-item-value elem)) ;; item
+ rule (cons elem rule)))
+ (setq rule (nreverse rule)))
+ (if prec
+ (setq prec (vector (semantic-grammar-item-value prec))))
+ (if actn
+ (setq sexp (wisent-grammar-expand-macros (read actn))))
+ (setq rule (if actn
+ (if prec
+ (list rule prec sexp)
+ (list rule sexp))
+ (if prec
+ (list rule prec)
+ (list rule))))
+ (setq rules (cons rule rules)
+ rltags (cdr rltags)))
+ (setq nterms (cons (cons (intern (semantic-tag-name (car nttags)))
+ (nreverse rules))
+ nterms)
+ nttags (cdr nttags)))
+ (nreverse nterms)))
+
+(defun wisent-grammar-grammar ()
+ "Return Elisp form of the grammar."
+ (let* ((terminals (wisent-grammar-terminals))
+ (nonterminals (wisent-grammar-nonterminals))
+ (assocs (wisent-grammar-assocs)))
+ (cons terminals (cons assocs nonterminals))))
+
+(defun wisent-grammar-parsetable-builder ()
+ "Return the value of the parser table."
+ `(progn
+ ;; Ensure that the grammar [byte-]compiler is available.
+ (eval-when-compile (require 'semantic/wisent/comp))
+ (wisent-compile-grammar
+ ',(wisent-grammar-grammar)
+ ',(semantic-grammar-start))))
+
+(defun wisent-grammar-setupcode-builder ()
+ "Return the parser setup code."
+ (format
+ "(semantic-install-function-overrides\n\
+ '((parse-stream . wisent-parse-stream)))\n\
+ (setq semantic-parser-name \"LALR\"\n\
+ semantic--parse-table %s\n\
+ semantic-debug-parser-source %S\n\
+ semantic-flex-keywords-obarray %s\n\
+ semantic-lex-types-obarray %s)\n\
+ ;; Collect unmatched syntax lexical tokens\n\
+ (semantic-make-local-hook 'wisent-discarding-token-functions)\n\
+ (add-hook 'wisent-discarding-token-functions\n\
+ 'wisent-collect-unmatched-syntax nil t)"
+ (semantic-grammar-parsetable)
+ (buffer-name)
+ (semantic-grammar-keywordtable)
+ (semantic-grammar-tokentable)))
+
+(defvar wisent-grammar-menu
+ '("WY Grammar"
+ ["LALR Compiler Verbose" wisent-toggle-verbose-flag
+ :style toggle :active (boundp 'wisent-verbose-flag)
+ :selected (and (boundp 'wisent-verbose-flag)
+ wisent-verbose-flag)]
+ )
+ "WY mode specific grammar menu.
+Menu items are appended to the common grammar menu.")
+
+;;;###autoload
+(define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY"
+ "Major mode for editing Wisent grammars."
+ (semantic-grammar-setup-menu wisent-grammar-menu)
+ (semantic-install-function-overrides
+ '((grammar-parsetable-builder . wisent-grammar-parsetable-builder)
+ (grammar-setupcode-builder . wisent-grammar-setupcode-builder))))
+
+(defvar-mode-local wisent-grammar-mode semantic-grammar-macros
+ '(
+ (ASSOC . semantic-grammar-ASSOC)
+ (EXPAND . wisent-grammar-EXPAND)
+ (EXPANDFULL . wisent-grammar-EXPANDFULL)
+ (TAG . wisent-grammar-TAG)
+ (VARIABLE-TAG . wisent-grammar-VARIABLE-TAG)
+ (FUNCTION-TAG . wisent-grammar-FUNCTION-TAG)
+ (TYPE-TAG . wisent-grammar-TYPE-TAG)
+ (INCLUDE-TAG . wisent-grammar-INCLUDE-TAG)
+ (PACKAGE-TAG . wisent-grammar-PACKAGE-TAG)
+ (EXPANDTAG . wisent-grammar-EXPANDTAG)
+ (CODE-TAG . wisent-grammar-CODE-TAG)
+ (ALIAS-TAG . wisent-grammar-ALIAS-TAG)
+ (AST-ADD . wisent-grammar-AST-ADD)
+ (AST-PUT . wisent-grammar-AST-PUT)
+ (AST-GET . wisent-grammar-AST-GET)
+ (AST-GET1 . wisent-grammar-AST-GET1)
+ (AST-GET-STRING . wisent-grammar-AST-GET-STRING)
+ (AST-MERGE . wisent-grammar-AST-MERGE)
+ (SKIP-BLOCK . wisent-grammar-SKIP-BLOCK)
+ (SKIP-TOKEN . wisent-grammar-SKIP-TOKEN)
+ )
+ "Semantic grammar macros used in wisent grammars.")
+
+(defvar wisent-make-parsers--emacs-license
+ ";; 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/>.")
+
+(defvar wisent-make-parsers--python-license
+ ";; It is derived in part from the Python grammar, used under the
+;; following license:
+;;
+;; PYTHON SOFTWARE FOUNDATION LICENSE VERSION 2
+;; --------------------------------------------
+;; 1. This LICENSE AGREEMENT is between the Python Software Foundation
+;; (\"PSF\"), and the Individual or Organization (\"Licensee\") accessing
+;; and otherwise using this software (\"Python\") in source or binary
+;; form and its associated documentation.
+;;
+;; 2. Subject to the terms and conditions of this License Agreement,
+;; PSF hereby grants Licensee a nonexclusive, royalty-free, world-wide
+;; license to reproduce, analyze, test, perform and/or display
+;; publicly, prepare derivative works, distribute, and otherwise use
+;; Python alone or in any derivative version, provided, however, that
+;; PSF's License Agreement and PSF's notice of copyright, i.e.,
+;; \"Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010 Python Software Foundation; All Rights Reserved\" are
+;; retained in Python alone or in any derivative version prepared by
+;; Licensee.
+;;
+;; 3. In the event Licensee prepares a derivative work that is based
+;; on or incorporates Python or any part thereof, and wants to make
+;; the derivative work available to others as provided herein, then
+;; Licensee hereby agrees to include in any such work a brief summary
+;; of the changes made to Python.
+;;
+;; 4. PSF is making Python available to Licensee on an \"AS IS\"
+;; basis. PSF MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
+;; IMPLIED. BY WAY OF EXAMPLE, BUT NOT LIMITATION, PSF MAKES NO AND
+;; DISCLAIMS ANY REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS
+;; FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF PYTHON WILL NOT
+;; INFRINGE ANY THIRD PARTY RIGHTS.
+;;
+;; 5. PSF SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PYTHON
+;; FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+;; RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PYTHON, OR
+;; ANY DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+;;
+;; 6. This License Agreement will automatically terminate upon a
+;; material breach of its terms and conditions.
+;;
+;; 7. Nothing in this License Agreement shall be deemed to create any
+;; relationship of agency, partnership, or joint venture between PSF
+;; and Licensee. This License Agreement does not grant permission to
+;; use PSF trademarks or trade name in a trademark sense to endorse or
+;; promote products or services of Licensee, or any third party.
+;;
+;; 8. By copying, installing or otherwise using Python, Licensee
+;; agrees to be bound by the terms and conditions of this License
+;; Agreement.")
+
+(defvar wisent-make-parsers--ecmascript-license
+ "\n;; It is derived from the grammar in the ECMAScript Language
+;; Specification published at
+;;
+;; http://www.ecma-international.org/publications/standards/Ecma-262.htm
+;;
+;; and redistributed under the following license:
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above
+;; copyright notice, this list of conditions and the following
+;; disclaimer in the documentation and/or other materials provided
+;; with the distribution.
+;;
+;; 3. Neither the name of the authors nor Ecma International may be
+;; used to endorse or promote products derived from this software
+;; without specific prior written permission. THIS SOFTWARE IS
+;; PROVIDED BY THE ECMA INTERNATIONAL \"AS IS\" AND ANY EXPRESS OR
+;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;; ARE DISCLAIMED. IN NO EVENT SHALL ECMA INTERNATIONAL BE LIABLE FOR
+;; ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
+;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+;; DAMAGE.")
+
+(defvar wisent-make-parsers--parser-file-name
+ `(("semantic/grammar-wy.el")
+ ("srecode/srt-wy.el")
+ ("semantic/wisent/js-wy.el"
+ "Copyright (C) 1998-2011 Ecma International."
+ ,wisent-make-parsers--ecmascript-license)
+ ("semantic/wisent/javat-wy.el")
+ ("semantic/wisent/python-wy.el"
+ "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+\;; 2009, 2010 Python Software Foundation; All Rights Reserved"
+ ,wisent-make-parsers--python-license)))
+
+(defun wisent-make-parsers ()
+ "Generate Emacs' built-in Wisent-based parser files."
+ (interactive)
+ (semantic-mode 1)
+ ;; Loop through each .wy file in current directory, and run
+ ;; `semantic-grammar-batch-build-one-package' to build the grammar.
+ (dolist (f (directory-files default-directory nil "\\.wy\\'"))
+ (let ((packagename
+ (condition-case err
+ (with-current-buffer (find-file-noselect f)
+ (semantic-grammar-create-package))
+ (error (message "%s" (error-message-string err)) nil)))
+ output-data)
+ (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
+ (let ((additional-copyright (nth 1 output-data))
+ (additional-license (nth 2 output-data))
+ (filename (progn (string-match ".*/\\(.*\\)" packagename) (match-string 1 packagename)))
+ copyright-end)
+ ;; Touch up the generated parsers for Emacs integration.
+ (with-temp-buffer
+ (insert-file-contents filename)
+ ;; Fix copyright header:
+ (goto-char (point-min))
+ (when additional-copyright
+ (re-search-forward "Copyright (C).*$")
+ (insert "\n;; " additional-copyright))
+ (re-search-forward "^;; Author:")
+ (setq copyright-end (match-beginning 0))
+ (re-search-forward "^;;; Code:\n")
+ (delete-region copyright-end (match-end 0))
+ (goto-char copyright-end)
+ (insert wisent-make-parsers--emacs-license)
+ (insert "\n\n;;; Commentary:
+;;
+;; This file was generated from admin/grammars/"
+ f ".")
+ (when additional-license
+ (insert "\n" additional-license))
+ (insert "\n\n;;; Code:\n")
+ (goto-char (point-min))
+ (delete-region (point-min) (line-end-position))
+ (insert ";;; " packagename
+ " --- Generated parser support file")
+ (re-search-forward ";;; \\(.*\\) ends here")
+ (replace-match packagename nil nil nil 1)
+ (delete-trailing-whitespace)
+ (write-region nil nil (expand-file-name filename))))))))
+
+(provide 'semantic/wisent/grammar)
+
+;;; semantic/wisent/grammar.el ends here
diff --git a/lisp/cedet/semantic/wisent/java-tags.el b/lisp/cedet/semantic/wisent/java-tags.el
index 6bdc2736b1b..a85935ad83b 100644
--- a/lisp/cedet/semantic/wisent/java-tags.el
+++ b/lisp/cedet/semantic/wisent/java-tags.el
@@ -59,6 +59,7 @@ Parse the current context for `field_declaration' nonterminals to
collect tags, such as local variables or prototypes.
This function override `get-local-variables'."
(let ((vars nil)
+ (ct (semantic-current-tag))
;; We want nothing to do with funny syntaxing while doing this.
(semantic-unmatched-syntax-hook nil))
(while (not (semantic-up-context (point) 'function))
@@ -71,8 +72,31 @@ This function override `get-local-variables'."
'field_declaration
0 t)
vars))))
+ ;; Add 'this' if in a fcn
+ (when (semantic-tag-of-class-p ct 'function)
+ ;; Append a new tag THIS into our space.
+ (setq vars (cons (semantic-tag-new-variable
+ "this" (semantic-tag-name (semantic-current-tag-parent))
+ nil)
+ vars)))
vars))
+;;;
+;;; Analyzer and type cache support
+;;;
+(define-mode-local-override semantic-analyze-split-name java-mode (name)
+ "Split up tag names on colon . boundaries."
+ (let ((ans (split-string name "\\.")))
+ (if (= (length ans) 1)
+ name
+ (delete "" ans))))
+
+(define-mode-local-override semantic-analyze-unsplit-name java-mode (namelist)
+ "Assemble the list of names NAMELIST into a namespace name."
+ (mapconcat 'identity namelist "."))
+
+
+
;;;;
;;;; Semantic integration of the Java LALR parser
;;;;
@@ -109,6 +133,10 @@ Use the alternate LALR(1) parser."
(package . "Package")))
;; navigation inside 'type children
senator-step-at-tag-classes '(function variable)
+ ;; Remove 'recursive from the default semanticdb find throttle
+ ;; since java imports never recurse.
+ semanticdb-find-default-throttle
+ (remq 'recursive (default-value 'semanticdb-find-default-throttle))
)
;; Setup javadoc stuff
(semantic-java-doc-setup))
diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el
index 8ed83e87bce..610df0edc86 100644
--- a/lisp/cedet/semantic/wisent/javascript.el
+++ b/lisp/cedet/semantic/wisent/javascript.el
@@ -51,8 +51,8 @@ to this variable NAME."
start (if elts (car (cddr elt)) (semantic-tag-start tag))
end (if xpand (cdr (cddr elt)) (semantic-tag-end tag))
xpand (cons clone xpand))
- ;; Set the definition of the cloned tag
- (semantic-tag-put-attribute clone :default-value value)
+ ;; Set the definition of the cloned tag
+ (semantic-tag-put-attribute clone :default-value value)
;; Set the bounds of the cloned tag with those of the name
;; element.
(semantic-tag-set-bounds clone start end))
@@ -70,10 +70,56 @@ This function overrides `get-local-variables'."
;; Does javascript have identifiable local variables?
nil)
+(define-mode-local-override semantic-tag-protection javascript-mode (tag &optional parent)
+ "Return protection information about TAG with optional PARENT.
+This function returns on of the following symbols:
+ nil - No special protection. Language dependent.
+ 'public - Anyone can access this TAG.
+ 'private - Only methods in the local scope can access TAG.
+ 'protected - Like private for outside scopes, like public for child
+ classes.
+Some languages may choose to provide additional return symbols specific
+to themselves. Use of this function should allow for this.
+
+The default behavior (if not overridden with `tag-protection'
+is to return a symbol based on type modifiers."
+ nil)
+
+(define-mode-local-override semantic-analyze-scope-calculate-access javascript-mode (type scope)
+ "Calculate the access class for TYPE as defined by the current SCOPE.
+Access is related to the :parents in SCOPE. If type is a member of SCOPE
+then access would be 'private. If TYPE is inherited by a member of SCOPE,
+the access would be 'protected. Otherwise, access is 'public."
+ nil)
+(define-mode-local-override semantic-ctxt-current-symbol javascript-mode (&optional point)
+ "Return the current symbol the cursor is on at POINT in a list.
+This is a very simple implementation for Javascript symbols. It
+will at maximum do one split, so that the first part is seen as
+one type. For example: $('#sel').foo.bar will return (\"$('sel').foo\" \"bar\").
+This is currently needed for the mozrepl omniscient database."
+ (save-excursion
+ (if point (goto-char point))
+ (let* ((case-fold-search semantic-case-fold)
+ symlist tmp end)
+ (with-syntax-table semantic-lex-syntax-table
+ (save-excursion
+ (when (looking-at "\\w\\|\\s_")
+ (forward-sexp 1))
+ (setq end (point))
+ (unless (re-search-backward "\\s-" (point-at-bol) t)
+ (beginning-of-line))
+ (setq tmp (buffer-substring-no-properties (point) end))
+ (if (string-match "\\(.+\\)\\." tmp)
+ (setq symlist (list (match-string 1 tmp)
+ (substring tmp (1+ (match-end 1)) (length tmp))))
+ (setq symlist (list tmp))))))))
+
;;; Setup Function
;;
-;; This sets up the javascript parser
+;; Since javascript-mode is an alias for js-mode, let it inherit all
+;; the overrides.
+(define-child-mode js-mode javascript-mode)
;; Since javascript-mode is an alias for js-mode, let it inherit all
;; the overrides.
diff --git a/lisp/cedet/semantic/wisent/javat-wy.el b/lisp/cedet/semantic/wisent/javat-wy.el
index 1f0a480d554..01f80d3c598 100644
--- a/lisp/cedet/semantic/wisent/javat-wy.el
+++ b/lisp/cedet/semantic/wisent/javat-wy.el
Binary files differ
diff --git a/lisp/cedet/semantic/wisent/js-wy.el b/lisp/cedet/semantic/wisent/js-wy.el
index 05346b02c8d..92c5aa6b0d2 100644
--- a/lisp/cedet/semantic/wisent/js-wy.el
+++ b/lisp/cedet/semantic/wisent/js-wy.el
@@ -60,6 +60,7 @@
;;; Code:
(require 'semantic/lex)
+(eval-when-compile (require 'semantic/bovine))
;;; Prologue
;;
@@ -416,6 +417,29 @@
;;; Analyzers
+;;
+(define-lex-block-type-analyzer wisent-javascript-jv-wy--<block>-block-analyzer
+ "block analyzer for <block> tokens."
+ "\\s(\\|\\s)"
+ '((("(" OPEN_PARENTHESIS PAREN_BLOCK)
+ ("{" START_BLOCK BRACE_BLOCK)
+ ("[" OPEN_SQ_BRACKETS BRACK_BLOCK))
+ (")" CLOSE_PARENTHESIS)
+ ("}" END_BLOCK)
+ ("]" CLOSE_SQ_BRACKETS))
+ )
+
+(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<symbol>-regexp-analyzer
+ "regexp analyzer for <symbol> tokens."
+ "\\(\\sw\\|\\s_\\)+"
+ nil
+ 'VARIABLE)
+
+(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<number>-regexp-analyzer
+ "regexp analyzer for <number> tokens."
+ semantic-lex-number-expression
+ nil
+ 'NUMBER)
(define-lex-string-type-analyzer wisent-javascript-jv-wy--<punctuation>-string-analyzer
"string analyzer for <punctuation> tokens."
@@ -462,29 +486,6 @@
(ASSIGN_SYMBOL . "="))
'punctuation)
-(define-lex-block-type-analyzer wisent-javascript-jv-wy--<block>-block-analyzer
- "block analyzer for <block> tokens."
- "\\s(\\|\\s)"
- '((("(" OPEN_PARENTHESIS PAREN_BLOCK)
- ("{" START_BLOCK BRACE_BLOCK)
- ("[" OPEN_SQ_BRACKETS BRACK_BLOCK))
- (")" CLOSE_PARENTHESIS)
- ("}" END_BLOCK)
- ("]" CLOSE_SQ_BRACKETS))
- )
-
-(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- "\\(\\sw\\|\\s_\\)+"
- nil
- 'VARIABLE)
-
-(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<number>-regexp-analyzer
- "regexp analyzer for <number> tokens."
- semantic-lex-number-expression
- nil
- 'NUMBER)
-
(define-lex-sexp-type-analyzer wisent-javascript-jv-wy--<string>-sexp-analyzer
"sexp analyzer for <string> tokens."
"\\s\""
diff --git a/lisp/cedet/semantic/wisent/python-wy.el b/lisp/cedet/semantic/wisent/python-wy.el
index e8229dcd9ea..d215a4b2414 100644
--- a/lisp/cedet/semantic/wisent/python-wy.el
+++ b/lisp/cedet/semantic/wisent/python-wy.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/python-wy.el --- Generated parser support file
-;; Copyright (C) 2002-2004, 2007, 2010-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Python Software Foundation; All Rights Reserved
@@ -77,9 +77,12 @@
;;; Code:
(require 'semantic/lex)
+(eval-when-compile (require 'semantic/bovine))
;;; Prologue
;;
+(declare-function wisent-python-reconstitute-function-tag "semantic/wisent/python")
+(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python")
;;; Declarations
;;
@@ -114,8 +117,10 @@
("return" . RETURN)
("try" . TRY)
("while" . WHILE)
+ ("with" . WITH)
("yield" . YIELD))
'(("yield" summary "Create a generator function")
+ ("with" summary "Start statement with an associated context object")
("while" summary "Start a 'while' loop")
("try" summary "Start of statements protected by exception handlers")
("return" summary "Return from a function")
@@ -156,6 +161,7 @@
("string"
(STRING_LITERAL))
("punctuation"
+ (AT . "@")
(BACKQUOTE . "`")
(ASSIGN . "=")
(COMMA . ",")
@@ -226,7 +232,7 @@
(eval-when-compile
(require 'semantic/wisent/comp))
(wisent-compile-grammar
- '((BACKSLASH NEWLINE INDENT DEDENT INDENT_BLOCK PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK LTLTEQ GTGTEQ EXPEQ DIVDIVEQ DIVDIV LTLT GTGT EXPONENT EQ GE LE PLUSEQ MINUSEQ MULTEQ DIVEQ MODEQ AMPEQ OREQ HATEQ LTGT NE HAT LT GT AMP MULT DIV MOD PLUS MINUS PERIOD TILDE BAR COLON SEMICOLON COMMA ASSIGN BACKQUOTE STRING_LITERAL NUMBER_LITERAL NAME AND AS ASSERT BREAK CLASS CONTINUE DEF DEL ELIF ELSE EXCEPT EXEC FINALLY FOR FROM GLOBAL IF IMPORT IN IS LAMBDA NOT OR PASS PRINT RAISE RETURN TRY WHILE YIELD)
+ '((BACKSLASH NEWLINE INDENT DEDENT INDENT_BLOCK PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK LTLTEQ GTGTEQ EXPEQ DIVDIVEQ DIVDIV LTLT GTGT EXPONENT EQ GE LE PLUSEQ MINUSEQ MULTEQ DIVEQ MODEQ AMPEQ OREQ HATEQ LTGT NE HAT LT GT AMP MULT DIV MOD PLUS MINUS PERIOD TILDE BAR COLON SEMICOLON COMMA ASSIGN BACKQUOTE AT STRING_LITERAL NUMBER_LITERAL NAME AND AS ASSERT BREAK CLASS CONTINUE DEF DEL ELIF ELSE EXCEPT EXEC FINALLY FOR FROM GLOBAL IF IMPORT IN IS LAMBDA NOT OR PASS PRINT RAISE RETURN TRY WHILE WITH YIELD)
nil
(goal
((NEWLINE))
@@ -364,8 +370,10 @@
(wisent-raw-tag
(semantic-tag-new-include $2 nil))))
(dotted_as_name_list
- ((dotted_as_name))
- ((dotted_as_name_list COMMA dotted_as_name)))
+ ((dotted_as_name_list COMMA dotted_as_name)
+ (cons $3 $1))
+ ((dotted_as_name)
+ (list $1)))
(star_or_import_as_name_list
((MULT)
nil)
@@ -417,6 +425,7 @@
((while_stmt))
((for_stmt))
((try_stmt))
+ ((with_stmt))
((funcdef))
((class_declaration)))
(if_stmt
@@ -476,10 +485,36 @@
(nil)
((test zero_or_one_comma_test)
nil))
+ (with_stmt
+ ((WITH test COLON suite)
+ (wisent-raw-tag
+ (semantic-tag-new-code $1 nil)))
+ ((WITH test with_var COLON suite)
+ (wisent-raw-tag
+ (semantic-tag-new-code $1 nil))))
+ (with_var
+ ((AS expr)
+ nil))
+ (decorator
+ ((AT dotted_name varargslist_opt NEWLINE)
+ (wisent-raw-tag
+ (semantic-tag-new-function $2 "decorator" $3))))
+ (decorators
+ ((decorator)
+ (list $1))
+ ((decorator decorators)
+ (cons $1 $2)))
(funcdef
((DEF NAME function_parameter_list COLON suite)
- (wisent-raw-tag
- (semantic-tag-new-function $2 nil $3))))
+ (wisent-python-reconstitute-function-tag
+ (wisent-raw-tag
+ (semantic-tag-new-function $2 nil $3))
+ $5))
+ ((decorators DEF NAME function_parameter_list COLON suite)
+ (wisent-python-reconstitute-function-tag
+ (wisent-raw-tag
+ (semantic-tag-new-function $3 nil $4 :decorators $1))
+ $6)))
(function_parameter_list
((PAREN_BLOCK)
(let
@@ -505,9 +540,10 @@
(semantic-tag-new-variable $2 nil nil))))
(class_declaration
((CLASS NAME paren_class_list_opt COLON suite)
- (wisent-raw-tag
- (semantic-tag-new-type $2 $1 $5
- (cons $3 nil)))))
+ (wisent-python-reconstitute-class-tag
+ (wisent-raw-tag
+ (semantic-tag-new-type $2 $1 $5
+ (cons $3 nil))))))
(paren_class_list_opt
(nil)
((paren_class_list)))
@@ -726,7 +762,7 @@
;;; Analyzers
-
+;;
(define-lex-block-type-analyzer wisent-python-wy--<block>-block-analyzer
"block analyzer for <block> tokens."
"\\s(\\|\\s)"
@@ -738,10 +774,23 @@
("]" RBRACK))
)
+(define-lex-regex-type-analyzer wisent-python-wy--<symbol>-regexp-analyzer
+ "regexp analyzer for <symbol> tokens."
+ "\\(\\sw\\|\\s_\\)+"
+ nil
+ 'NAME)
+
+(define-lex-regex-type-analyzer wisent-python-wy--<number>-regexp-analyzer
+ "regexp analyzer for <number> tokens."
+ semantic-lex-number-expression
+ nil
+ 'NUMBER_LITERAL)
+
(define-lex-string-type-analyzer wisent-python-wy--<punctuation>-string-analyzer
"string analyzer for <punctuation> tokens."
"\\(\\s.\\|\\s$\\|\\s'\\)+"
- '((BACKQUOTE . "`")
+ '((AT . "@")
+ (BACKQUOTE . "`")
(ASSIGN . "=")
(COMMA . ",")
(SEMICOLON . ";")
@@ -781,18 +830,6 @@
(LTLTEQ . "<<="))
'punctuation)
-(define-lex-regex-type-analyzer wisent-python-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- "\\(\\sw\\|\\s_\\)+"
- nil
- 'NAME)
-
-(define-lex-regex-type-analyzer wisent-python-wy--<number>-regexp-analyzer
- "regexp analyzer for <number> tokens."
- semantic-lex-number-expression
- nil
- 'NUMBER_LITERAL)
-
(define-lex-keyword-type-analyzer wisent-python-wy--<keyword>-keyword-analyzer
"keyword analyzer for <keyword> tokens."
"\\(\\sw\\|\\s_\\)+")
diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el
index fef22b16995..a0ea488f0fe 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -28,27 +28,90 @@
;;; Code:
+(require 'rx)
+
+;; Try to load python support, but fail silently since it is only used
+;; for optional functionality
+(require 'python nil t)
+
(require 'semantic/wisent)
(require 'semantic/wisent/python-wy)
+(require 'semantic/find)
(require 'semantic/dep)
(require 'semantic/ctxt)
+(eval-when-compile
+ (require 'cl))
+
+;;; Customization
+;;
+
+(defun semantic-python-get-system-include-path ()
+ "Evaluate some Python code that determines the system include path."
+ (python-proc)
+ (if python-buffer
+ (with-current-buffer python-buffer
+ (set (make-local-variable 'python-preoutput-result) nil)
+ (python-send-string
+ "import sys; print '_emacs_out ' + '\\0'.join(sys.path)")
+ (accept-process-output (python-proc) 2)
+ (if python-preoutput-result
+ (split-string python-preoutput-result "[\0\n]" t)
+ ;; Try a second, Python3k compatible shot
+ (python-send-string
+ "import sys; print('_emacs_out ' + '\\0'.join(sys.path))")
+ (accept-process-output (python-proc) 2)
+ (if python-preoutput-result
+ (split-string python-preoutput-result "[\0\n]" t)
+ (message "Timeout while querying Python for system include path.")
+ nil)))
+ (message "Python seems to be unavailable on this system.")))
+
+(defcustom-mode-local-semantic-dependency-system-include-path
+ python-mode semantic-python-dependency-system-include-path
+ (when (and (featurep 'python)
+ ;; python-mode and batch somehow often hangs.
+ (not noninteractive))
+ (semantic-python-get-system-include-path))
+ "The system include path used by Python language.")
;;; Lexical analysis
;;
;; Python strings are delimited by either single quotes or double
-;; quotes, e.g., "I'm a string" and 'I too am s string'.
+;; quotes, e.g., "I'm a string" and 'I too am a string'.
;; In addition a string can have either a 'r' and/or 'u' prefix.
;; The 'r' prefix means raw, i.e., normal backslash substitutions are
;; to be suppressed. For example, r"01\n34" is a string with six
;; characters 0, 1, \, n, 3 and 4. The 'u' prefix means the following
;; string is Unicode.
-(defconst wisent-python-string-re
- (concat (regexp-opt '("r" "u" "ur" "R" "U" "UR" "Ur" "uR") t)
- "?['\"]")
+(defconst wisent-python-string-start-re "[uU]?[rR]?['\"]"
"Regexp matching beginning of a Python string.")
+(defconst wisent-python-string-re
+ (rx
+ (opt (any "uU")) (opt (any "rR"))
+ (or
+ ;; Triple-quoted string using apostrophes
+ (: "'''" (zero-or-more (or "\\'"
+ (not (any "'"))
+ (: (repeat 1 2 "'") (not (any "'")))))
+ "'''")
+ ;; String using apostrophes
+ (: "'" (zero-or-more (or "\\'"
+ (not (any "'"))))
+ "'")
+ ;; Triple-quoted string using quotation marks.
+ (: "\"\"\"" (zero-or-more (or "\\\""
+ (not (any "\""))
+ (: (repeat 1 2 "\"") (not (any "\"")))))
+ "\"\"\"")
+ ;; String using quotation marks.
+ (: "\"" (zero-or-more (or "\\\""
+ (not (any "\""))))
+ "\"")))
+ "Regexp matching a complete Python string.")
+
(defvar wisent-python-EXPANDING-block nil
"Non-nil when expanding a paren block for Python lexical analyzer.")
@@ -60,16 +123,46 @@ curly braces."
(defsubst wisent-python-forward-string ()
"Move point at the end of the Python string at point."
- (when (looking-at wisent-python-string-re)
- ;; skip the prefix
- (and (match-end 1) (goto-char (match-end 1)))
- ;; skip the quoted part
- (cond
- ((looking-at "\"\"\"[^\"]")
- (search-forward "\"\"\"" nil nil 2))
- ((looking-at "'''[^']")
- (search-forward "'''" nil nil 2))
- ((forward-sexp 1)))))
+ (if (looking-at wisent-python-string-re)
+ (let ((start (match-beginning 0))
+ (end (match-end 0)))
+ ;; Incomplete triple-quoted string gets matched instead as a
+ ;; complete single quoted string. (This special case would be
+ ;; unnecessary if Emacs regular expressions had negative
+ ;; look-ahead assertions.)
+ (when (and (= (- end start) 2)
+ (looking-at "\"\\{3\\}\\|'\\{3\\}"))
+ (error "unterminated syntax"))
+ (goto-char end))
+ (error "unterminated syntax")))
+
+(defun wisent-python-forward-balanced-expression ()
+ "Move point to the end of the balanced expression at point.
+Here 'balanced expression' means anything matched by Emacs'
+open/close parenthesis syntax classes. We can't use forward-sexp
+for this because that Emacs built-in can't parse Python's
+triple-quoted string syntax."
+ (let ((end-char (cdr (syntax-after (point)))))
+ (forward-char 1)
+ (while (not (or (eobp) (eq (char-after (point)) end-char)))
+ (cond
+ ;; Skip over python strings.
+ ((looking-at wisent-python-string-start-re)
+ (wisent-python-forward-string))
+ ;; At a comment start just goto end of line.
+ ((looking-at "\\s<")
+ (end-of-line))
+ ;; Skip over balanced expressions.
+ ((looking-at "\\s(")
+ (wisent-python-forward-balanced-expression))
+ ;; Skip over white space, word, symbol, punctuation, paired
+ ;; delimiter (backquote) characters, line continuation, and end
+ ;; of comment characters (AKA newline characters in Python).
+ ((zerop (skip-syntax-forward "-w_.$\\>"))
+ (error "can't figure out how to go forward from here"))))
+ ;; Skip closing character. As a last resort this should raise an
+ ;; error if we hit EOB before we find our closing character..
+ (forward-char 1)))
(defun wisent-python-forward-line ()
"Move point to the beginning of the next logical line.
@@ -83,14 +176,14 @@ line ends at the end of the buffer, leave the point there."
(progn
(cond
;; Skip over python strings.
- ((looking-at wisent-python-string-re)
+ ((looking-at wisent-python-string-start-re)
(wisent-python-forward-string))
;; At a comment start just goto end of line.
((looking-at "\\s<")
(end-of-line))
- ;; Skip over generic lists and strings.
- ((looking-at "\\(\\s(\\|\\s\"\\)")
- (forward-sexp 1))
+ ;; Skip over balanced expressions.
+ ((looking-at "\\s(")
+ (wisent-python-forward-balanced-expression))
;; At the explicit line continuation character
;; (backslash) move to next line.
((looking-at "\\s\\")
@@ -107,8 +200,8 @@ line ends at the end of the buffer, leave the point there."
(defun wisent-python-forward-line-skip-indented ()
"Move point to the next logical line, skipping indented lines.
-That is the next line whose indentation is less than or equal to the
-indentation of the current line."
+That is the next line whose indentation is less than or equal to
+the indentation of the current line."
(let ((indent (current-indentation)))
(while (progn (wisent-python-forward-line)
(and (not (eobp))
@@ -185,17 +278,18 @@ indentation of the current line."
;; Loop lexer to handle tokens in current line.
t)
;; Indentation decreased
- (t
- ;; Pop items from indentation stack
- (while (< curr-indent last-indent)
- (pop wisent-python-indent-stack)
- (setq semantic-lex-current-depth (1- semantic-lex-current-depth)
- last-indent (car wisent-python-indent-stack))
- (semantic-lex-push-token
- (semantic-lex-token 'DEDENT last-pos (point))))
+ ((progn
+ ;; Pop items from indentation stack
+ (while (< curr-indent last-indent)
+ (pop wisent-python-indent-stack)
+ (setq semantic-lex-current-depth (1- semantic-lex-current-depth)
+ last-indent (car wisent-python-indent-stack))
+ (semantic-lex-push-token
+ (semantic-lex-token 'DEDENT last-pos (point))))
+ (= last-pos (point)))
;; If pos did not change, then we must return nil so that
;; other lexical analyzers can be run.
- (/= last-pos (point))))))
+ nil))))
;; All the work was done in the above analyzer matching condition.
)
@@ -211,7 +305,7 @@ continuation of current line."
(define-lex-regex-analyzer wisent-python-lex-string
"Detect and create python string tokens."
- wisent-python-string-re
+ wisent-python-string-start-re
(semantic-lex-push-token
(semantic-lex-token
'STRING_LITERAL
@@ -250,9 +344,113 @@ elsewhere on a line outside a string literal."
semantic-lex-ignore-comments
;; Signal error on unhandled syntax.
semantic-lex-default-action)
+
+
+;;; Parsing
+;;
+
+(defun wisent-python-reconstitute-function-tag (tag suite)
+ "Move a docstring from TAG's members into its :documentation attribute.
+Set attributes for constructors, special, private and static methods."
+ ;; Analyze first statement to see whether it is a documentation
+ ;; string.
+ (let ((first-statement (car suite)))
+ (when (semantic-python-docstring-p first-statement)
+ (semantic-tag-put-attribute
+ tag :documentation
+ (semantic-python-extract-docstring first-statement))))
+
+ ;; TODO HACK: we try to identify methods using the following
+ ;; heuristic:
+ ;; + at least one argument
+ ;; + first argument is self
+ (when (and (> (length (semantic-tag-function-arguments tag)) 0)
+ (string= (semantic-tag-name
+ (first (semantic-tag-function-arguments tag)))
+ "self"))
+ (semantic-tag-put-attribute tag :parent "dummy"))
+
+ ;; Identify constructors, special and private functions
+ (cond
+ ;; TODO only valid when the function resides inside a class
+ ((string= (semantic-tag-name tag) "__init__")
+ (semantic-tag-put-attribute tag :constructor-flag t)
+ (semantic-tag-put-attribute tag :suite suite))
+
+ ((semantic-python-special-p tag)
+ (semantic-tag-put-attribute tag :special-flag t))
+
+ ((semantic-python-private-p tag)
+ (semantic-tag-put-attribute tag :protection "private")))
+
+ ;; If there is a staticmethod decorator, add a static typemodifier
+ ;; for the function.
+ (when (semantic-find-tags-by-name
+ "staticmethod"
+ (semantic-tag-get-attribute tag :decorators))
+ (semantic-tag-put-attribute
+ tag :typemodifiers
+ (cons "static"
+ (semantic-tag-get-attribute tag :typemodifiers))))
+
+ ;; TODO
+ ;; + check for decorators classmethod
+ ;; + check for operators
+ tag)
+
+(defun wisent-python-reconstitute-class-tag (tag)
+ "Move a docstring from TAG's members into its :documentation attribute."
+ ;; The first member of TAG may be a documentation string. If that is
+ ;; the case, remove of it from the members list and stick its
+ ;; content into the :documentation attribute.
+ (let ((first-member (car (semantic-tag-type-members tag))))
+ (when (semantic-python-docstring-p first-member)
+ (semantic-tag-put-attribute
+ tag :members
+ (cdr (semantic-tag-type-members tag)))
+ (semantic-tag-put-attribute
+ tag :documentation
+ (semantic-python-extract-docstring first-member))))
+
+ ;; Try to find the constructor, determine the name of the instance
+ ;; parameter, find assignments to instance variables and add
+ ;; corresponding variable tags to the list of members.
+ (dolist (member (semantic-tag-type-members tag))
+ (when (semantic-tag-function-constructor-p member)
+ (let ((self (semantic-tag-name
+ (car (semantic-tag-function-arguments member)))))
+ (dolist (statement (semantic-tag-get-attribute member :suite))
+ (when (semantic-python-instance-variable-p statement self)
+ (let ((variable (semantic-tag-clone
+ statement
+ (substring (semantic-tag-name statement) 5)))
+ (members (semantic-tag-get-attribute tag :members)))
+ (when (semantic-python-private-p variable)
+ (semantic-tag-put-attribute variable :protection "private"))
+ (setcdr (last members) (list variable))))))))
+
+ ;; TODO remove the :suite attribute
+ tag)
+
+(defun semantic-python-expand-tag (tag)
+ "Expand compound declarations found in TAG into separate tags.
+TAG contains compound declaration if the NAME part of the tag is
+a list. In python, this can happen with `import' statements."
+ (let ((class (semantic-tag-class tag))
+ (elts (semantic-tag-name tag))
+ (expand nil))
+ (cond
+ ((and (eq class 'include) (listp elts))
+ (dolist (E elts)
+ (setq expand (cons (semantic-tag-clone tag E) expand)))
+ (setq expand (nreverse expand)))
+ )))
+
+
;;; Overridden Semantic API.
;;
+
(define-mode-local-override semantic-lex python-mode
(start end &optional depth length)
"Lexically analyze Python code in current buffer.
@@ -274,10 +472,27 @@ what remains in the `wisent-python-indent-stack'."
To be implemented for Python! For now just return nil."
nil)
-(defcustom-mode-local-semantic-dependency-system-include-path
- python-mode semantic-python-dependency-system-include-path
- nil
- "The system include path used by Python language.")
+;; Adapted from the semantic Java support by Andrey Torba
+(define-mode-local-override semantic-tag-include-filename python-mode (tag)
+ "Return a suitable path for (some) Python imports."
+ (let ((name (semantic-tag-name tag)))
+ (concat (mapconcat 'identity (split-string name "\\.") "/") ".py")))
+
+;; Override ctxt-current-function/assignment defaults, since they do
+;; not work properly with Python code, even leading to endless loops
+;; (see bug #xxxxx).
+(define-mode-local-override semantic-ctxt-current-function python-mode (&optional point)
+ "Return the current function call the cursor is in at POINT.
+The function returned is the one accepting the arguments that
+the cursor is currently in. It will not return function symbol if the
+cursor is on the text representing that function."
+ nil)
+
+(define-mode-local-override semantic-ctxt-current-assignment python-mode (&optional point)
+ "Return the current assignment near the cursor at POINT.
+Return a list as per `semantic-ctxt-current-symbol'.
+Return nil if there is nothing relevant."
+ nil)
;;; Enable Semantic in `python-mode'.
;;
@@ -287,13 +502,15 @@ To be implemented for Python! For now just return nil."
"Setup buffer for parse."
(wisent-python-wy--install-parser)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
+ ;; Give python modes the possibility to overwrite this:
+ (if (not comment-start-skip)
+ (set (make-local-variable 'comment-start-skip) "#+\\s-*"))
(setq
- ;; Character used to separation a parent/child relationship
+ ;; Character used to separation a parent/child relationship
semantic-type-relation-separator-character '(".")
semantic-command-separation-character ";"
- ;; The following is no more necessary as semantic-lex is overridden
- ;; in python-mode.
- ;; semantic-lex-analyzer 'wisent-python-lexer
+ ;; Parsing
+ semantic-tag-expand-function 'semantic-python-expand-tag
;; Semantic to take over from the one provided by python.
;; The python one, if it uses the senator advice, will hang
@@ -320,8 +537,56 @@ To be implemented for Python! For now just return nil."
(define-child-mode python-3-mode python-mode "Python 3 mode")
+;;; Utility functions
+;;
+
+(defun semantic-python-special-p (tag)
+ "Return non-nil if the name of TAG is a special identifier of
+the form __NAME__. "
+ (string-match
+ (rx (seq string-start "__" (1+ (syntax symbol)) "__" string-end))
+ (semantic-tag-name tag)))
+
+(defun semantic-python-private-p (tag)
+ "Return non-nil if the name of TAG follows the convention _NAME
+for private names."
+ (string-match
+ (rx (seq string-start "_" (0+ (syntax symbol)) string-end))
+ (semantic-tag-name tag)))
+
+(defun semantic-python-instance-variable-p (tag &optional self)
+ "Return non-nil if TAG is an instance variable of the instance
+SELF or the instance name \"self\" if SELF is nil."
+ (when (semantic-tag-of-class-p tag 'variable)
+ (let ((name (semantic-tag-name tag)))
+ (when (string-match
+ (rx-to-string
+ `(seq string-start ,(or self "self") "."))
+ name)
+ (not (string-match "\\." (substring name 5)))))))
+
+(defun semantic-python-docstring-p (tag)
+ "Return non-nil, when TAG is a Python documentation string."
+ ;; TAG is considered to be a documentation string if the first
+ ;; member is of class 'code and its name looks like a documentation
+ ;; string.
+ (let ((class (semantic-tag-class tag))
+ (name (semantic-tag-name tag)))
+ (and (eq class 'code)
+ (string-match
+ (rx (seq string-start "\"\"\"" (0+ anything) "\"\"\"" string-end))
+ name))))
+
+(defun semantic-python-extract-docstring (tag)
+ "Return the Python documentation string contained in TAG."
+ ;; Strip leading and trailing """
+ (let ((name (semantic-tag-name tag)))
+ (substring name 3 -3)))
+
+
;;; Test
;;
+
(defun wisent-python-lex-buffer ()
"Run `wisent-python-lexer' on current buffer."
(interactive)
diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el
index f973ee9065e..17121c7547e 100644
--- a/lisp/cedet/srecode.el
+++ b/lisp/cedet/srecode.el
@@ -4,7 +4,7 @@
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: codegeneration
-;; Version: 1.0pre7
+;; Version: 1.0
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index d5389a97f03..8a1291f8d72 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -210,6 +210,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(buffer-file-name))))
(mode nil)
(application nil)
+ (framework nil)
(priority nil)
(project nil)
(vars nil)
@@ -253,6 +254,8 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
)
((string= name "application")
(setq application (read firstvalue)))
+ ((string= name "framework")
+ (setq framework (read firstvalue)))
((string= name "priority")
(setq priority (read firstvalue)))
((string= name "project")
@@ -319,7 +322,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
priority))
;; Save it up!
- (srecode-compile-template-table table mode priority application project vars)
+ (srecode-compile-template-table table mode priority application framework project vars)
)
)
@@ -376,8 +379,8 @@ It is hard if the previous inserter is a newline object."
(while (and comp (stringp (car comp)))
(setq comp (cdr comp)))
(or (not comp)
- (require 'srecode/insert)
- (srecode-template-inserter-newline-child-p (car comp))))
+ (progn (require 'srecode/insert)
+ (srecode-template-inserter-newline-child-p (car comp)))))
(defun srecode-compile-split-code (tag str STATE
&optional end-name)
@@ -522,12 +525,13 @@ to the inserter constructor."
(if (not new) (error "SRECODE: Unknown macro code %S" key))
new)))
-(defun srecode-compile-template-table (templates mode priority application project vars)
+(defun srecode-compile-template-table (templates mode priority application framework project vars)
"Compile a list of TEMPLATES into an semantic recode table.
The table being compiled is for MODE, or the string \"default\".
PRIORITY is a numerical value that indicates this tables location
in an ordered search.
APPLICATION is the name of the application these templates belong to.
+FRAMEWORK is the name of the framework these templates belong to.
PROJECT is a directory name which these templates scope to.
A list of defined variables VARS provides a variable table."
(let ((namehash (make-hash-table :test 'equal
@@ -569,6 +573,7 @@ A list of defined variables VARS provides a variable table."
:major-mode mode
:priority priority
:application application
+ :framework framework
:project project))
(tmpl (oref table templates)))
;; Loop over all the templates, and xref.
diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el
index 12bfd3af903..d63e1a7a49f 100644
--- a/lisp/cedet/srecode/cpp.el
+++ b/lisp/cedet/srecode/cpp.el
@@ -47,16 +47,16 @@ buffer contains a using NAMESPACE; statement "
:group 'srecode-cpp
:type '(repeat string))
-;;; :cpp ARGUMENT HANDLING
+;;; :c ARGUMENT HANDLING
;;
-;; When a :cpp argument is required, fill the dictionary with
-;; information about the current C++ file.
+;; When a :c argument is required, fill the dictionary with
+;; information about the current C file.
;;
-;; Error if not in a C++ mode.
+;; Error if not in a C mode.
;;;###autoload
-(defun srecode-semantic-handle-:cpp (dict)
- "Add macros into the dictionary DICT based on the current c++ file.
+(defun srecode-semantic-handle-:c (dict)
+ "Add macros into the dictionary DICT based on the current c file.
Adds the following:
FILENAME_SYMBOL - filename converted into a C compat symbol.
HEADER - Shown section if in a header file."
@@ -76,6 +76,21 @@ HEADER - Shown section if in a header file."
)
)
+;;; :cpp ARGUMENT HANDLING
+;;
+;; When a :cpp argument is required, fill the dictionary with
+;; information about the current C++ file.
+;;
+;; Error if not in a C++ mode.
+;;;###autoload
+(defun srecode-semantic-handle-:cpp (dict)
+ "Add macros into the dictionary DICT based on the current c file.
+Calls `srecode-semantic-handle-:c.
+Also adds the following:
+ - nothing -"
+ (srecode-semantic-handle-:c dict)
+ )
+
(defun srecode-semantic-handle-:using-namespaces (dict)
"Add macros into the dictionary DICT based on used namespaces.
Adds the following:
@@ -94,10 +109,15 @@ PREFIX_NAMESPACE - for each NAMESPACE in `srecode-cpp-namespaces'."
)
(define-mode-local-override srecode-semantic-apply-tag-to-dict
- c++-mode (tag-wrapper dict)
- "Apply C++ specific features from TAG-WRAPPER into DICT.
+ c-mode (tag-wrapper dict)
+ "Apply C and C++ specific features from TAG-WRAPPER into DICT.
Calls `srecode-semantic-apply-tag-to-dict-default' first. Adds
-special behavior for tag of classes include, using and function."
+special behavior for tag of classes include, using and function.
+
+This function cannot be split into C and C++ specific variants, as
+the way the tags are created from the parser does not distinguish
+either. The side effect is that you could get some C++ tag properties
+specified in a C file."
;; Use default implementation to fill in the basic properties.
(srecode-semantic-apply-tag-to-dict-default tag-wrapper dict)
@@ -150,14 +170,20 @@ special behavior for tag of classes include, using and function."
(templates (semantic-tag-get-attribute tag :template))
(modifiers (semantic-tag-modifiers tag)))
- ;; Add modifiers into the dictionary
+ ;; Mark constructors and destructors as such.
+ (when (semantic-tag-function-constructor-p tag)
+ (srecode-dictionary-show-section dict "CONSTRUCTOR"))
+ (when (semantic-tag-function-destructor-p tag)
+ (srecode-dictionary-show-section dict "DESTRUCTOR"))
+
+ ;; Add modifiers into the dictionary.
(dolist (modifier modifiers)
(let ((modifier-dict (srecode-dictionary-add-section-dictionary
dict "MODIFIERS")))
(srecode-dictionary-set-value modifier-dict "NAME" modifier)))
;; Add templates into child dictionaries.
- (srecode-cpp-apply-templates dict templates)
+ (srecode-c-apply-templates dict templates)
;; When the function is a member function, it can have
;; additional modifiers.
@@ -171,8 +197,7 @@ special behavior for tag of classes include, using and function."
;; If the member function is pure virtual, add a dictionary
;; entry.
(when (semantic-tag-get-attribute tag :pure-virtual-flag)
- (srecode-dictionary-show-section dict "PURE"))
- )))
+ (srecode-dictionary-show-section dict "PURE")))))
;;
;; CLASS
@@ -184,7 +209,7 @@ special behavior for tag of classes include, using and function."
;; Add templates into child dictionaries.
(let ((templates (semantic-tag-get-attribute tag :template)))
- (srecode-cpp-apply-templates dict templates))))
+ (srecode-c-apply-templates dict templates))))
))
)
@@ -192,7 +217,7 @@ special behavior for tag of classes include, using and function."
;;; Helper functions
;;
-(defun srecode-cpp-apply-templates (dict templates)
+(defun srecode-c-apply-templates (dict templates)
"Add section dictionaries for TEMPLATES to DICT."
(when templates
(let ((templates-dict (srecode-dictionary-add-section-dictionary
diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el
index 5b65284660f..6262383c397 100644
--- a/lisp/cedet/srecode/dictionary.el
+++ b/lisp/cedet/srecode/dictionary.el
@@ -117,8 +117,8 @@ Makes sure that :value is compiled."
(cons (car fields) newfields))))
(setq fields (cdr (cdr fields))))
- (when (not state)
- (error "Cannot create compound variable without :state"))
+ ;;(when (not state)
+ ;; (error "Cannot create compound variable outside of sectiondictionary"))
(call-next-method this (nreverse newfields))
(when (not (slot-boundp this 'compiled))
@@ -220,7 +220,10 @@ associated with a buffer or parent."
"Insert into DICT the variables found in table TPL.
TPL is an object representing a compiled template file."
(when tpl
- (let ((tabs (oref tpl :tables)))
+ ;; Tables are sorted with highest priority first, useful for looking
+ ;; up templates, but this means we need to install the variables in
+ ;; reverse order so higher priority variables override lower ones.
+ (let ((tabs (reverse (oref tpl :tables))))
(require 'srecode/find) ; For srecode-template-table-in-project-p
(while tabs
(when (srecode-template-table-in-project-p (car tabs))
@@ -546,40 +549,6 @@ inserted with a new editable field.")
;;; Higher level dictionary functions
;;
-(defun srecode-create-section-dictionary (sectiondicts STATE)
- "Create a dictionary with section entries for a template.
-The format for SECTIONDICTS is what is emitted from the template parsers.
-STATE is the current compiler state."
- (when sectiondicts
- (let ((new (srecode-create-dictionary t)))
- ;; Loop over each section. The section is a macro w/in the
- ;; template.
- (while sectiondicts
- (let* ((sect (car (car sectiondicts)))
- (entries (cdr (car sectiondicts)))
- (subdict (srecode-dictionary-add-section-dictionary new sect))
- )
- ;; Loop over each entry. This is one variable in the
- ;; section dictionary.
- (while entries
- (let ((tname (semantic-tag-name (car entries)))
- (val (semantic-tag-variable-default (car entries))))
- (if (eq val t)
- (srecode-dictionary-show-section subdict tname)
- (cond
- ((and (stringp (car val))
- (= (length val) 1))
- (setq val (car val)))
- (t
- (setq val (srecode-dictionary-compound-variable
- tname :value val :state STATE))))
- (srecode-dictionary-set-value
- subdict tname val))
- (setq entries (cdr entries))))
- )
- (setq sectiondicts (cdr sectiondicts)))
- new)))
-
(defun srecode-create-dictionaries-from-tags (tags state)
"Create a dictionary with entries according to TAGS.
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index befdb4731c2..f621c5e82d5 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -220,32 +220,37 @@ tables that do not belong to an application will be searched."
(defvar srecode-read-template-name-history nil
"History for completing reads for template names.")
-(defun srecode-all-template-hash (&optional mode hash)
+(defun srecode-user-template-p (template)
+ "Non-nil if TEMPLATE is intended for user insertion.
+Templates not matching this predicate are used for code
+generation or other internal purposes."
+ t)
+
+(defun srecode-all-template-hash (&optional mode hash predicate)
"Create a hash table of all the currently available templates.
Optional argument MODE is the major mode to look for.
-Optional argument HASH is the hash table to fill in."
- (let* ((mhash (or hash (make-hash-table :test 'equal)))
- (mmode (or mode major-mode))
- (mp (get-mode-local-parent mmode))
- )
+Optional argument HASH is the hash table to fill in.
+Optional argument PREDICATE can be used to filter the returned
+templates."
+ (let* ((mhash (or hash (make-hash-table :test 'equal)))
+ (mmode (or mode major-mode))
+ (parent-mode (get-mode-local-parent mmode)))
;; Get the parent hash table filled into our current hash.
- (when (not (eq mode 'default))
- (if mp
- (srecode-all-template-hash mp mhash)
- (srecode-all-template-hash 'default mhash)))
+ (unless (eq mode 'default)
+ (srecode-all-template-hash (or parent-mode 'default) mhash))
+
;; Load up the hash table for our current mode.
- (let* ((mt (srecode-get-mode-table mmode))
- (tabs (when mt (oref mt :tables)))
- )
- (while tabs
+ (let* ((mt (srecode-get-mode-table mmode))
+ (tabs (when mt (oref mt :tables))))
+ (dolist (tab tabs)
;; Exclude templates for a particular application.
- (when (and (not (oref (car tabs) :application))
- (srecode-template-table-in-project-p (car tabs)))
+ (when (and (not (oref tab :application))
+ (srecode-template-table-in-project-p tab))
(maphash (lambda (key temp)
- (puthash key temp mhash)
- )
- (oref (car tabs) namehash)))
- (setq tabs (cdr tabs)))
+ (when (or (not predicate)
+ (funcall predicate temp))
+ (puthash key temp mhash)))
+ (oref tab namehash))))
mhash)))
(defun srecode-calculate-default-template-string (hash)
diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el
index 5155044e386..49d913a099a 100644
--- a/lisp/cedet/srecode/getset.el
+++ b/lisp/cedet/srecode/getset.el
@@ -298,10 +298,10 @@ Base selection on the field related to POINT."
(let* ((kids (semantic-find-tags-by-class
'variable (semantic-tag-type-members class)))
(sel (completing-read "Use Field: " kids))
- )
-
- (or (semantic-find-tags-by-name sel kids)
- sel)
+ (fields (semantic-find-tags-by-name sel kids)))
+ (if fields
+ (car fields)
+ sel)
))
(defun srecode-auto-choose-class (point)
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index 7d300614c08..726aa41cffd 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -195,6 +195,32 @@ Buffer based features related to change hooks is handled one level up."
;; area. Return value is not important.
))
+(defun srecode-insert-show-error-report (dictionary format &rest args)
+ "Display an error report based on DICTIONARY, FORMAT and ARGS.
+This is intended to diagnose problems with failed template
+insertions."
+ (with-current-buffer (data-debug-new-buffer "*SRECODE INSERTION ERROR*")
+ (erase-buffer)
+ ;; Insert the stack of templates that are currently being
+ ;; inserted.
+ (insert (propertize "Template Stack" 'face '(:weight bold))
+ (propertize " (most recent at bottom)" 'face '(:slant italic))
+ ":\n")
+ (data-debug-insert-stuff-list
+ (reverse (oref srecode-template active)) "> ")
+ ;; Show the current dictionary.
+ (insert (propertize "Dictionary" 'face '(:weight bold)) "\n")
+ (data-debug-insert-thing dictionary "" "> ")
+ ;; Show the error message.
+ (insert (propertize "Error" 'face '(:weight bold)) "\n")
+ (insert (apply #'format format args))
+ (pop-to-buffer (current-buffer))))
+
+(defun srecode-insert-report-error (dictionary format &rest args)
+ ;; TODO only display something when inside an interactive call?
+ (srecode-insert-show-error-report dictionary format args)
+ (apply #'error format args))
+
;;; TEMPLATE ARGUMENTS
;;
;; Some templates have arguments. Each argument is associated with
@@ -435,8 +461,10 @@ If SECONDNAME is nil, return VALUE."
(let ((srecode-inserter-variable-current-dictionary dictionary))
(funcall fcnpart value))
;; Else, warn.
- (error "Variable insertion second arg %s is not a function"
- secondname)))
+ (srecode-insert-report-error
+ dictionary
+ "Variable inserter %s: second argument `%s' is not a function"
+ (object-print sti) secondname)))
value))
(defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
@@ -467,19 +495,20 @@ If SECONDNAME is nil, return VALUE."
;; If the value returned is nil, then it may be a special
;; field inserter that requires us to set do-princ to nil.
(when (not val)
- (setq do-princ nil)
- )
- )
+ (setq do-princ nil)))
+
;; Dictionaries... not allowed in this style
((srecode-dictionary-child-p val)
- (error "Macro %s cannot insert a dictionary - use section macros instead"
- name))
+ (srecode-insert-report-error
+ dictionary
+ "Macro %s cannot insert a dictionary - use section macros instead"
+ name))
+
;; Other stuff... convert
(t
- (error "Macro %s cannot insert arbitrary data" name)
- ;;(if (and val (not (stringp val)))
- ;; (setq val (format "%S" val))))
- ))
+ (srecode-insert-report-error
+ dictionary
+ "Macro %s cannot insert arbitrary data" name)))
;; Output the dumb thing unless the type of thing specifically
;; did the inserting for us.
(when do-princ
@@ -559,19 +588,25 @@ Loop over the prompts to see if we have a match."
"Derive the default value for an askable inserter STI.
DICTIONARY is used to derive some values."
(let ((defaultfcn (oref sti :defaultfcn)))
- (cond ((stringp defaultfcn)
- defaultfcn)
- ((functionp defaultfcn)
- (funcall defaultfcn))
- ((and (listp defaultfcn)
- (eq (car defaultfcn) 'macro))
- (srecode-dictionary-lookup-name
- dictionary (cdr defaultfcn)))
- ((null defaultfcn)
- "")
- (t
- (error "Unknown default for prompt: %S"
- defaultfcn)))))
+ (cond
+ ((stringp defaultfcn)
+ defaultfcn)
+
+ ((functionp defaultfcn)
+ (funcall defaultfcn))
+
+ ((and (listp defaultfcn)
+ (eq (car defaultfcn) 'macro))
+ (srecode-dictionary-lookup-name
+ dictionary (cdr defaultfcn)))
+
+ ((null defaultfcn)
+ "")
+
+ (t
+ (srecode-insert-report-error
+ dictionary
+ "Unknown default for prompt: %S" defaultfcn)))))
(defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask)
dictionary)
@@ -647,26 +682,33 @@ spaces to the right.")
"For VALUE handle WIDTH behaviors for this variable inserter.
Return the result as a string.
By default, treat as a function name."
- (if width
- ;; Trim or pad to new length
- (let* ((split (split-string width ":"))
- (width (string-to-number (nth 0 split)))
- (second (nth 1 split))
- (pad (cond ((or (null second) (string= "right" second))
- 'right)
- ((string= "left" second)
- 'left)
- (t
- (error "Unknown pad type %s" second)))))
- (if (>= (length value) width)
- ;; Simple case - too long.
- (substring value 0 width)
- ;; We need to pad on one side or the other.
- (let ((padchars (make-string (- width (length value)) ? )))
- (if (eq pad 'left)
- (concat padchars value)
- (concat value padchars)))))
- (error "Width not specified for variable/width inserter")))
+ ;; Cannot work without width.
+ (unless width
+ (srecode-insert-report-error
+ dictionary
+ "Width not specified for variable/width inserter"))
+
+ ;; Trim or pad to new length
+ (let* ((split (split-string width ":"))
+ (width (string-to-number (nth 0 split)))
+ (second (nth 1 split))
+ (pad (cond
+ ((or (null second) (string= "right" second))
+ 'right)
+ ((string= "left" second)
+ 'left)
+ (t
+ (srecode-insert-report-error
+ dictionary
+ "Unknown pad type %s" second)))))
+ (if (>= (length value) width)
+ ;; Simple case - too long.
+ (substring value 0 width)
+ ;; We need to pad on one side or the other.
+ (let ((padchars (make-string (- width (length value)) ? )))
+ (if (eq pad 'left)
+ (concat padchars value)
+ (concat value padchars))))))
(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width)
escape-start escape-end)
@@ -758,13 +800,15 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
dict slot)
"Insert a subtemplate for the inserter STI with dictionary DICT."
- ;; make sure that only dictionaries are used.
- (when (not (srecode-dictionary-child-p dict))
- (error "Only section dictionaries allowed for %s"
- (object-name-string sti)))
+ ;; Make sure that only dictionaries are used.
+ (unless (srecode-dictionary-child-p dict)
+ (srecode-insert-report-error
+ dict
+ "Only section dictionaries allowed for `%s'"
+ (object-name-string sti)))
+
;; Output the code from the sub-template.
- (srecode-insert-method (slot-value sti slot) dict)
- )
+ (srecode-insert-method (slot-value sti slot) dict))
(defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate)
dictionary slot)
@@ -774,14 +818,18 @@ The template to insert is stored in SLOT."
(let ((dicts (srecode-dictionary-lookup-name
dictionary (oref sti :object-name))))
(when (not (listp dicts))
- (error "Cannot insert section %S from non-section variable."
- (oref sti :object-name)))
+ (srecode-insert-report-error
+ dictionary
+ "Cannot insert section %S from non-section variable."
+ (oref sti :object-name)))
;; If there is no section dictionary, then don't output anything
;; from this section.
(while dicts
(when (not (srecode-dictionary-p (car dicts)))
- (error "Cannot insert section %S from non-section variable."
- (oref sti :object-name)))
+ (srecode-insert-report-error
+ dictionary
+ "Cannot insert section %S from non-section variable."
+ (oref sti :object-name)))
(srecode-insert-subtemplate sti (car dicts) slot)
(setq dicts (cdr dicts)))))
@@ -876,11 +924,13 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
"For the template inserter STI, lookup the template to include.
Finds the template with this macro function part and stores it in
this template instance."
- (let* ((templatenamepart (oref sti :secondname))
- )
- ;; If there was no template name, throw an error
- (if (not templatenamepart)
- (error "Include macro %s needs a template name" (oref sti :object-name)))
+ (let ((templatenamepart (oref sti :secondname)))
+ ;; If there was no template name, throw an error.
+ (unless templatenamepart
+ (srecode-insert-report-error
+ dictionary
+ "Include macro `%s' needs a template name"
+ (oref sti :object-name)))
;; NOTE: We used to cache the template and not look it up a second time,
;; but changes in the template tables can change which template is
@@ -920,11 +970,12 @@ this template instance."
;; Store the found template into this object for later use.
(oset sti :includedtemplate tmpl))
- (if (not (oref sti includedtemplate))
- ;; @todo - Call into a debugger to help find the template in question.
- (error "No template \"%s\" found for include macro `%s'"
- templatenamepart (oref sti :object-name)))
- ))
+ (unless (oref sti includedtemplate)
+ ;; @todo - Call into a debugger to help find the template in question.
+ (srecode-insert-report-error
+ dictionary
+ "No template \"%s\" found for include macro `%s'"
+ templatenamepart (oref sti :object-name)))))
(defmethod srecode-insert-method ((sti srecode-template-inserter-include)
dictionary)
diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el
index 58d8efc41e2..3635a39d383 100644
--- a/lisp/cedet/srecode/java.el
+++ b/lisp/cedet/srecode/java.el
@@ -26,6 +26,10 @@
;;; Code:
(require 'srecode/dictionary)
+(require 'semantic/tag)
+
+(eval-when-compile
+ (require 'semantic/find))
;;;###autoload
(defun srecode-semantic-handle-:java (dict)
@@ -33,7 +37,7 @@
Adds the following:
FILENAME_AS_PACKAGE - file/dir converted into a java package name.
FILENAME_AS_CLASS - file converted to a Java class name."
- ;; A symbol representing
+ ;; Symbols needed by empty files.
(let* ((fsym (file-name-nondirectory (buffer-file-name)))
(fnox (file-name-sans-extension fsym))
(dir (file-name-directory (buffer-file-name)))
@@ -44,12 +48,18 @@ FILENAME_AS_CLASS - file converted to a Java class name."
(if (string-match "src/" dir)
(setq dir (substring dir (match-end 0)))
(setq dir (file-name-nondirectory (directory-file-name dir))))
+ (setq dir (directory-file-name dir))
(while (string-match "/" dir)
- (setq dir (replace-match "_" t t dir)))
- (srecode-dictionary-set-value dict "FILENAME_AS_PACKAGE"
- (concat dir "." fpak))
+ (setq dir (replace-match "." t t dir)))
+ (srecode-dictionary-set-value dict "FILENAME_AS_PACKAGE" dir)
(srecode-dictionary-set-value dict "FILENAME_AS_CLASS" fnox)
- ))
+ )
+ ;; Symbols needed for most other files with stuff in them.
+ (let ((pkg (semantic-find-tags-by-class 'package (current-buffer))))
+ (when pkg
+ (srecode-dictionary-set-value dict "CURRENT_PACKAGE" (semantic-tag-name (car pkg)))
+ ))
+ )
(provide 'srecode/java)
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index 3f891092d7d..d6613ee1b02 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -297,7 +297,7 @@ if that file is NEW, otherwise assume the mode has not changed."
(when (not srecode-current-map)
(condition-case nil
(setq srecode-current-map
- (eieio-persistent-read srecode-map-save-file))
+ (eieio-persistent-read srecode-map-save-file srecode-map))
(error
;; There was an error loading the old map. Create a new one.
(setq srecode-current-map
diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el
index e2c07a0863e..805e324a8bd 100644
--- a/lisp/cedet/srecode/mode.el
+++ b/lisp/cedet/srecode/mode.el
@@ -32,8 +32,11 @@
(require 'srecode/map)
(require 'semantic/decorate)
(require 'semantic/wisent)
+(require 'semantic/senator)
+(require 'semantic/wisent)
-(eval-when-compile (require 'semantic/find))
+(eval-when-compile
+ (require 'semantic/find))
;;; Code:
@@ -154,13 +157,22 @@ minor mode is enabled.
:keymap srecode-mode-map
;; If we are turning things on, make sure we have templates for
;; this mode first.
- (when srecode-minor-mode
- (when (not (apply
+ (if srecode-minor-mode
+ (if (not (apply
'append
(mapcar (lambda (map)
(srecode-map-entries-for-mode map major-mode))
(srecode-get-maps))))
- (setq srecode-minor-mode nil))))
+ (setq srecode-minor-mode nil)
+ ;; Else, we have success, do stuff
+ (add-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items nil t)
+ )
+ (remove-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items t)
+ )
+ ;; Run hooks if we are turning this on.
+ (when srecode-minor-mode
+ (run-hooks 'srecode-minor-mode-hook))
+ srecode-minor-mode)
;;;###autoload
(define-minor-mode global-srecode-minor-mode
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index 827979f786a..877f6796c76 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -351,6 +351,12 @@ as `function' will leave point where code might be inserted."
(setq temp (srecode-semantic-find-template
"variable-const" prototype ctxt))
)
+
+ ((and (semantic-tag-of-class-p tag 'include)
+ (semantic-tag-get-attribute tag :system-flag))
+ (setq temp (srecode-semantic-find-template
+ "system-include" prototype ctxt))
+ )
)
(when (not temp)
diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index 48eeab2408f..12fc08b90e4 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -70,13 +70,17 @@
(3 font-lock-builtin-face ))
("^\\(sectiondictionary\\)\\s-+\""
(1 font-lock-keyword-face))
+ ("^\\s\s*\\(section\\)\\s-+\""
+ (1 font-lock-keyword-face))
+ ("^\\s\s*\\(end\\)"
+ (1 font-lock-keyword-face))
("^\\(bind\\)\\s-+\""
(1 font-lock-keyword-face))
;; Variable type setting
- ("^\\(set\\)\\s-+\\(\\w+\\)\\s-+"
+ ("^\\s\s*\\(set\\)\\s-+\\(\\w+\\)\\s-+"
(1 font-lock-keyword-face)
(2 font-lock-variable-name-face))
- ("^\\(show\\)\\s-+\\(\\w+\\)\\s-*$"
+ ("^\\s\s*\\(show\\)\\s-+\\(\\w+\\)\\s-*$"
(1 font-lock-keyword-face)
(2 font-lock-variable-name-face))
("\\<\\(macro\\)\\s-+\""
diff --git a/lisp/cedet/srecode/srt-wy.el b/lisp/cedet/srecode/srt-wy.el
index 8beeb04940d..6f5d73aa312 100644
--- a/lisp/cedet/srecode/srt-wy.el
+++ b/lisp/cedet/srecode/srt-wy.el
@@ -24,6 +24,7 @@
;;; Code:
(require 'semantic/lex)
+(eval-when-compile (require 'semantic/bovine))
;;; Prologue
;;
@@ -38,6 +39,8 @@
("context" . CONTEXT)
("template" . TEMPLATE)
("sectiondictionary" . SECTIONDICTIONARY)
+ ("section" . SECTION)
+ ("end" . END)
("prompt" . PROMPT)
("default" . DEFAULT)
("defaultmacro" . DEFAULTMACRO)
@@ -48,6 +51,8 @@
("defaultmacro" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
("default" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
("prompt" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
+ ("end" summary "section ... end")
+ ("section" summary "section <name>\\n <dictionary entries>\\n end")
("sectiondictionary" summary "sectiondictionary <name>\\n <dictionary entries>")
("template" summary "template <name>\\n <template definition>")
("context" summary "context <name>")
@@ -73,6 +78,7 @@
'(("number" :declared t)
("string" :declared t)
("symbol" :declared t)
+ ("property" syntax ":\\(\\w\\|\\s_\\)*")
("property" :declared t)
("newline" :declared t)
("punctuation" syntax "\\s.+")
@@ -85,7 +91,7 @@
(eval-when-compile
(require 'semantic/wisent/comp))
(wisent-compile-grammar
- '((SET SHOW MACRO CONTEXT TEMPLATE SECTIONDICTIONARY PROMPT DEFAULT DEFAULTMACRO READ BIND newline TEMPLATE_BLOCK property symbol string number)
+ '((SET SHOW MACRO CONTEXT TEMPLATE SECTIONDICTIONARY SECTION END PROMPT DEFAULT DEFAULTMACRO READ BIND newline TEMPLATE_BLOCK property symbol string number)
nil
(template_file
((newline)
@@ -141,7 +147,7 @@
(cons 'macro
(read $2))))
(template
- ((TEMPLATE templatename opt-dynamic-arguments newline opt-string opt-section-dictionaries TEMPLATE_BLOCK newline opt-bind)
+ ((TEMPLATE templatename opt-dynamic-arguments newline opt-string section-dictionary-list TEMPLATE_BLOCK newline opt-bind)
(wisent-raw-tag
(semantic-tag-new-function $2 nil $3 :documentation $5 :code $7 :dictionaries $6 :binding $9))))
(templatename
@@ -162,26 +168,40 @@
((string newline)
(read $1))
(nil nil))
- (opt-section-dictionaries
- (nil nil)
- ((section-dictionary-list)))
(section-dictionary-list
- ((one-section-dictionary)
- (list $1))
- ((section-dictionary-list one-section-dictionary)
+ (nil nil)
+ ((section-dictionary-list flat-section-dictionary)
+ (append $1
+ (list $2)))
+ ((section-dictionary-list section-dictionary)
(append $1
(list $2))))
- (one-section-dictionary
- ((SECTIONDICTIONARY string newline variable-list)
+ (flat-section-dictionary
+ ((SECTIONDICTIONARY string newline flat-dictionary-entry-list)
+ (cons
+ (read $2)
+ $4)))
+ (flat-dictionary-entry-list
+ (nil nil)
+ ((flat-dictionary-entry-list flat-dictionary-entry)
+ (append $1 $2)))
+ (flat-dictionary-entry
+ ((variable)
+ (wisent-cook-tag $1)))
+ (section-dictionary
+ ((SECTION string newline dictionary-entry-list END newline)
(cons
(read $2)
$4)))
- (variable-list
+ (dictionary-entry-list
+ (nil nil)
+ ((dictionary-entry-list dictionary-entry)
+ (append $1 $2)))
+ (dictionary-entry
((variable)
(wisent-cook-tag $1))
- ((variable-list variable)
- (append $1
- (wisent-cook-tag $2))))
+ ((section-dictionary)
+ (list $1)))
(opt-bind
((BIND string newline)
(read $2))
@@ -205,12 +225,12 @@
;;; Analyzers
-
-(define-lex-string-type-analyzer srecode-template-wy--<punctuation>-string-analyzer
- "string analyzer for <punctuation> tokens."
- "\\s.+"
+;;
+(define-lex-regex-type-analyzer srecode-template-wy--<property>-regexp-analyzer
+ "regexp analyzer for <property> tokens."
+ ":\\(\\w\\|\\s_\\)*"
nil
- 'punctuation)
+ 'property)
(define-lex-regex-type-analyzer srecode-template-wy--<symbol>-regexp-analyzer
"regexp analyzer for <symbol> tokens."
@@ -224,6 +244,12 @@
nil
'number)
+(define-lex-string-type-analyzer srecode-template-wy--<punctuation>-string-analyzer
+ "string analyzer for <punctuation> tokens."
+ "\\s.+"
+ nil
+ 'punctuation)
+
(define-lex-sexp-type-analyzer srecode-template-wy--<string>-sexp-analyzer
"sexp analyzer for <string> tokens."
"\\s\""
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index fb7ce6bad2f..37403c4fb9e 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -68,6 +68,15 @@ If this is nil, then this template table belongs to a set of generic
templates that can be used with no additional dictionary values.
When it is non-nil, it is assumed the template macros need specialized
Emacs Lisp code to fill in the dictionary.")
+ (framework :initarg :framework
+ :type symbol
+ :documentation
+ "Tracks the name of the framework these templates belong to.
+If nil, then this template table belongs to any framework, or can be
+considered generic for all files of this language.
+A framework might be a specific library or build environment for which
+special templates are desired. OpenGL might be a framework that
+exists for multiple languages.")
(priority :initarg :priority
:type number
:documentation
@@ -113,23 +122,39 @@ Tracks various lookup hash tables.")
(major-mode :initarg :major-mode
:documentation
"Table of template tables for this major-mode.")
+ (modetables :initarg :modetables
+ :documentation
+ "All that tables unique to this major mode.")
(tables :initarg :tables
:documentation
- "All the tables that have been defined for this major mode.")
+ "All the tables that can be used for this major mode.")
)
"Track template tables for a particular major mode.
Tracks all the template-tables for a specific major mode.")
(defun srecode-get-mode-table (mode)
"Get the SRecoder mode table for the major mode MODE.
-Optional argument SOFT indicates to not make a new one if a table
-was not found."
- (let ((ans nil))
- (while (and (not ans) mode)
- (setq ans (eieio-instance-tracker-find
- mode 'major-mode 'srecode-mode-table-list)
- mode (get-mode-local-parent mode)))
- ans))
+This will find the mode table specific to MODE, and then
+calculate all inherited templates from parent modes."
+ (let ((table nil)
+ (tmptable nil))
+ (while mode
+ (setq tmptable (eieio-instance-tracker-find
+ mode 'major-mode 'srecode-mode-table-list)
+ mode (get-mode-local-parent mode))
+ (when tmptable
+ (if (not table)
+ (progn
+ ;; If this is the first, update tables to have
+ ;; all the mode specific tables in it.
+ (setq table tmptable)
+ (oset table tables (oref table modetables)))
+ ;; If there already is a table, then reset the tables
+ ;; slot to include all the tables belonging to this new child node.
+ (oset table tables (append (oref table modetables)
+ (oref tmptable modetables)))))
+ )
+ table))
(defun srecode-make-mode-table (mode)
"Get the SRecoder mode table for the major mode MODE."
@@ -140,6 +165,7 @@ was not found."
(let* ((ms (if (stringp mode) mode (symbol-name mode)))
(new (srecode-mode-table ms
:major-mode mode
+ :modetables nil
:tables nil)))
;; Save this new mode table in that mode's variable.
(eval `(setq-mode-local ,mode srecode-table ,new))
@@ -149,7 +175,7 @@ was not found."
(defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
"Look in the mode table MT for a template table from FILE.
Return nil if there was none."
- (object-assoc file 'file (oref mt tables)))
+ (object-assoc file 'file (oref mt modetables)))
(defun srecode-mode-table-new (mode file &rest init)
"Create a new template table for MODE in FILE.
@@ -166,16 +192,16 @@ INIT are the initialization parameters for the new template table."
init
)))
;; Whack the old table.
- (when old (object-remove-from-list mt 'tables old))
+ (when old (object-remove-from-list mt 'modetables old))
;; Add the new table
- (object-add-to-list mt 'tables new)
+ (object-add-to-list mt 'modetables new)
;; Sort the list in reverse order. When other routines
;; go front-to-back, the highest priority items are put
;; into the search table first, allowing lower priority items
;; to be the items found in the search table.
- (object-sort-list mt 'tables (lambda (a b)
- (> (oref a :priority)
- (oref b :priority))))
+ (object-sort-list mt 'modetables (lambda (a b)
+ (> (oref a :priority)
+ (oref b :priority))))
;; Return it.
new))
@@ -231,6 +257,9 @@ Use PREDICATE is the same as for the `sort' function."
(when (oref tab :application)
(princ "\nApplication: ")
(princ (oref tab :application)))
+ (when (oref tab :framework)
+ (princ "\nFramework: ")
+ (princ (oref tab :framework)))
(when (oref tab :project)
(require 'srecode/find) ; For srecode-template-table-in-project-p
(princ "\nProject Directory: ")
diff --git a/lisp/color.el b/lisp/color.el
index 94a98615d94..b915beacb0a 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -50,17 +50,17 @@ string (e.g. \"#ff12ec\").
Normally the return value is a list of three floating-point
numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive.
-Optional arg FRAME specifies the frame where the color is to be
+Optional argument FRAME specifies the frame where the color is to be
displayed. If FRAME is omitted or nil, use the selected frame.
If FRAME cannot display COLOR, return nil."
;; `colors-values' maximum value is either 65535 or 65280 depending on the
- ;; display system. So we use a white conversion to get the max value.
+ ;; display system. So we use a white conversion to get the max value.
(let ((valmax (float (car (color-values "#ffffff")))))
(mapcar (lambda (x) (/ x valmax)) (color-values color frame))))
(defun color-rgb-to-hex (red green blue)
"Return hexadecimal notation for the color RED GREEN BLUE.
-RED GREEN BLUE must be numbers between 0.0 and 1.0 inclusive."
+RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive."
(format "#%02x%02x%02x"
(* red 255) (* green 255) (* blue 255)))
@@ -76,7 +76,7 @@ a string specifying a color's RGB components (e.g. \"#ff12ec\")."
(defun color-gradient (start stop step-number)
"Return a list with STEP-NUMBER colors from START to STOP.
The color list builds a color gradient starting at color START to
-color STOP. It does not include the START and STOP color in the
+color STOP. It does not include the START and STOP color in the
resulting list."
(let* ((r (nth 0 start))
(g (nth 1 start))
@@ -93,8 +93,8 @@ resulting list."
(nreverse result)))
(defun color-hue-to-rgb (v1 v2 h)
- "Compute hue from V1 and V2 H. Internally used by
-`color-hsl-to-rgb'."
+ "Compute hue from V1 and V2 H.
+Used internally by `color-hsl-to-rgb'."
(cond
((< h (/ 1.0 6)) (+ v1 (* (- v2 v1) h 6.0)))
((< h 0.5) v2)
@@ -102,13 +102,10 @@ resulting list."
(t v1)))
(defun color-hsl-to-rgb (H S L)
- "Convert H S L (HUE, SATURATION, LUMINANCE) , where HUE is in
-radians and both SATURATION and LUMINANCE are between 0.0 and
-1.0, inclusive to their RGB representation.
-
-Return a list (RED, GREEN, BLUE) which each be numbers between
-0.0 and 1.0, inclusive."
-
+ "Convert hue, saturation and luminance to their RGB representation.
+H, S, and L should each be numbers between 0.0 and 1.0, inclusive.
+Return a list (RED GREEN BLUE), where each element is between 0.0 and 1.0,
+inclusive."
(if (= S 0.0)
(list L L L)
(let* ((m2 (if (<= L 0.5)
@@ -116,18 +113,18 @@ Return a list (RED, GREEN, BLUE) which each be numbers between
(- (+ L S) (* L S))))
(m1 (- (* 2.0 L) m2)))
(list
- (color-hue-to-rgb m1 m2 (+ H (/ 1.0 3)))
+ (color-hue-to-rgb m1 m2 (mod (+ H (/ 1.0 3)) 1))
(color-hue-to-rgb m1 m2 H)
- (color-hue-to-rgb m1 m2 (- H (/ 1.0 3)))))))
+ (color-hue-to-rgb m1 m2 (mod (- H (/ 1.0 3)) 1))))))
(defun color-complement-hex (color)
"Return the color that is the complement of COLOR, in hexadecimal format."
(apply 'color-rgb-to-hex (color-complement color)))
(defun color-rgb-to-hsv (red green blue)
- "Convert RED, GREEN, and BLUE color components to HSV.
+ "Convert RGB color components to HSV.
RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0,
-inclusive. Return a list (HUE, SATURATION, VALUE), where HUE is
+inclusive. Return a list (HUE SATURATION VALUE), where HUE is
in radians and both SATURATION and VALUE are between 0.0 and 1.0,
inclusive."
(let* ((r (float red))
@@ -155,13 +152,10 @@ inclusive."
(/ max 255.0)))))
(defun color-rgb-to-hsl (red green blue)
- "Convert RED GREEN BLUE colors to their HSL representation.
+ "Convert RGB colors to their HSL representation.
RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0,
-inclusive.
-
-Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians
-and both SATURATION and LUMINANCE are between 0.0 and 1.0,
-inclusive."
+inclusive. Return a list (HUE SATURATION LUMINANCE), where
+each element is between 0.0 and 1.0, inclusive."
(let* ((r red)
(g green)
(b blue)
@@ -187,7 +181,7 @@ inclusive."
(defun color-srgb-to-xyz (red green blue)
"Convert RED GREEN BLUE colors from the sRGB color space to CIE XYZ.
-RED, BLUE and GREEN must be between 0 and 1, inclusive."
+RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive."
(let ((r (if (<= red 0.04045)
(/ red 12.95)
(expt (/ (+ red 0.055) 1.055) 2.4)))
@@ -225,44 +219,44 @@ RED, BLUE and GREEN must be between 0 and 1, inclusive."
(defun color-xyz-to-lab (X Y Z &optional white-point)
"Convert CIE XYZ to CIE L*a*b*.
WHITE-POINT specifies the (X Y Z) white point for the
-conversion. If omitted or nil, use `color-d65-xyz'."
+conversion. If omitted or nil, use `color-d65-xyz'."
(pcase-let* ((`(,Xr ,Yr ,Zr) (or white-point color-d65-xyz))
(xr (/ X Xr))
- (yr (/ Y Yr))
- (zr (/ Z Zr))
- (fx (if (> xr color-cie-ε)
- (expt xr (/ 1 3.0))
- (/ (+ (* color-cie-κ xr) 16) 116.0)))
- (fy (if (> yr color-cie-ε)
- (expt yr (/ 1 3.0))
- (/ (+ (* color-cie-κ yr) 16) 116.0)))
- (fz (if (> zr color-cie-ε)
- (expt zr (/ 1 3.0))
- (/ (+ (* color-cie-κ zr) 16) 116.0))))
- (list
- (- (* 116 fy) 16) ; L
- (* 500 (- fx fy)) ; a
+ (yr (/ Y Yr))
+ (zr (/ Z Zr))
+ (fx (if (> xr color-cie-ε)
+ (expt xr (/ 1 3.0))
+ (/ (+ (* color-cie-κ xr) 16) 116.0)))
+ (fy (if (> yr color-cie-ε)
+ (expt yr (/ 1 3.0))
+ (/ (+ (* color-cie-κ yr) 16) 116.0)))
+ (fz (if (> zr color-cie-ε)
+ (expt zr (/ 1 3.0))
+ (/ (+ (* color-cie-κ zr) 16) 116.0))))
+ (list
+ (- (* 116 fy) 16) ; L
+ (* 500 (- fx fy)) ; a
(* 200 (- fy fz))))) ; b
(defun color-lab-to-xyz (L a b &optional white-point)
"Convert CIE L*a*b* to CIE XYZ.
WHITE-POINT specifies the (X Y Z) white point for the
-conversion. If omitted or nil, use `color-d65-xyz'."
+conversion. If omitted or nil, use `color-d65-xyz'."
(pcase-let* ((`(,Xr ,Yr ,Zr) (or white-point color-d65-xyz))
(fy (/ (+ L 16) 116.0))
- (fz (- fy (/ b 200.0)))
- (fx (+ (/ a 500.0) fy))
- (xr (if (> (expt fx 3.0) color-cie-ε)
- (expt fx 3.0)
- (/ (- (* fx 116) 16) color-cie-κ)))
- (yr (if (> L (* color-cie-κ color-cie-ε))
- (expt (/ (+ L 16) 116.0) 3.0)
- (/ L color-cie-κ)))
- (zr (if (> (expt fz 3) color-cie-ε)
- (expt fz 3.0)
- (/ (- (* 116 fz) 16) color-cie-κ))))
- (list (* xr Xr) ; X
- (* yr Yr) ; Y
+ (fz (- fy (/ b 200.0)))
+ (fx (+ (/ a 500.0) fy))
+ (xr (if (> (expt fx 3.0) color-cie-ε)
+ (expt fx 3.0)
+ (/ (- (* fx 116) 16) color-cie-κ)))
+ (yr (if (> L (* color-cie-κ color-cie-ε))
+ (expt (/ (+ L 16) 116.0) 3.0)
+ (/ L color-cie-κ)))
+ (zr (if (> (expt fz 3) color-cie-ε)
+ (expt fz 3.0)
+ (/ (- (* 116 fz) 16) color-cie-κ))))
+ (list (* xr Xr) ; X
+ (* yr Yr) ; Y
(* zr Zr)))) ; Z
(defun color-srgb-to-lab (red green blue)
@@ -349,17 +343,14 @@ returned by `color-srgb-to-lab' or `color-xyz-to-lab'."
(min 1.0 (max 0.0 value)))
(defun color-saturate-hsl (H S L percent)
- "Return a color PERCENT more saturated than the one defined in
-H S L color-space.
-
-Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians
-and both SATURATION and LUMINANCE are between 0.0 and 1.0,
-inclusive."
+ "Make a color more saturated by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT more
+saturated. Returns a list (HUE SATURATION LUMINANCE)."
(list H (color-clamp (+ S (/ percent 100.0))) L))
(defun color-saturate-name (name percent)
- "Short hand to saturate COLOR by PERCENT.
-
+ "Make a color with a specified NAME more saturated by PERCENT.
See `color-saturate-hsl'."
(apply 'color-rgb-to-hex
(apply 'color-hsl-to-rgb
@@ -370,32 +361,26 @@ See `color-saturate-hsl'."
(list percent))))))
(defun color-desaturate-hsl (H S L percent)
- "Return a color PERCENT less saturated than the one defined in
-H S L color-space.
-
-Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians
-and both SATURATION and LUMINANCE are between 0.0 and 1.0,
-inclusive."
+ "Make a color less saturated by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT less
+saturated. Returns a list (HUE SATURATION LUMINANCE)."
(color-saturate-hsl H S L (- percent)))
(defun color-desaturate-name (name percent)
- "Short hand to desaturate COLOR by PERCENT.
-
+ "Make a color with a specified NAME less saturated by PERCENT.
See `color-desaturate-hsl'."
(color-saturate-name name (- percent)))
(defun color-lighten-hsl (H S L percent)
- "Return a color PERCENT lighter than the one defined in
-H S L color-space.
-
-Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians
-and both SATURATION and LUMINANCE are between 0.0 and 1.0,
-inclusive."
+ "Make a color lighter by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT lighter.
+Returns a list (HUE SATURATION LUMINANCE)."
(list H S (color-clamp (+ L (/ percent 100.0)))))
(defun color-lighten-name (name percent)
- "Short hand to saturate COLOR by PERCENT.
-
+ "Make a color with a specified NAME lighter by PERCENT.
See `color-lighten-hsl'."
(apply 'color-rgb-to-hex
(apply 'color-hsl-to-rgb
@@ -406,17 +391,14 @@ See `color-lighten-hsl'."
(list percent))))))
(defun color-darken-hsl (H S L percent)
- "Return a color PERCENT darker than the one defined in
-H S L color-space.
-
-Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians
-and both SATURATION and LUMINANCE are between 0.0 and 1.0,
-inclusive."
+ "Make a color darker by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT darker.
+Returns a list (HUE SATURATION LUMINANCE)."
(color-lighten-hsl H S L (- percent)))
(defun color-darken-name (name percent)
- "Short hand to saturate COLOR by PERCENT.
-
+ "Make a color with a specified NAME darker by PERCENT.
See `color-darken-hsl'."
(color-lighten-name name (- percent)))
diff --git a/lisp/comint.el b/lisp/comint.el
index 638ef73d53d..080b12e0cdf 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -2783,11 +2783,8 @@ the load or compile."
(if (and buff
(buffer-modified-p buff)
(y-or-n-p (format "Save buffer %s first? " (buffer-name buff))))
- ;; save BUFF.
- (let ((old-buffer (current-buffer)))
- (set-buffer buff)
- (save-buffer)
- (set-buffer old-buffer)))))
+ (with-current-buffer buff
+ (save-buffer)))))
(defun comint-extract-string ()
"Return string around point, or nil."
@@ -3069,11 +3066,11 @@ Magic characters are those in `comint-file-name-quote-list'."
(defun comint-unquote-filename (filename)
"Return FILENAME with quoted characters unquoted."
+ (declare (obsolete nil "24.3"))
(if (null comint-file-name-quote-list)
filename
(save-match-data
(replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t))))
-(make-obsolete 'comint-unquote-filename nil "24.3")
(defun comint--requote-argument (upos qstr)
;; See `completion-table-with-quoting'.
@@ -3161,8 +3158,8 @@ See `completion-table-with-quoting' and `comint-unquote-function'.")
(complete-with-action action table string pred))))
(unless (zerop (length filesuffix))
(list :exit-function
- (lambda (_s finished)
- (when (memq finished '(sole finished))
+ (lambda (_s status)
+ (when (eq status 'finished)
(if (looking-at (regexp-quote filesuffix))
(goto-char (match-end 0))
(insert filesuffix)))))))))
@@ -3170,10 +3167,9 @@ See `completion-table-with-quoting' and `comint-unquote-function'.")
(defun comint-dynamic-complete-as-filename ()
"Dynamically complete at point as a filename.
See `comint-dynamic-complete-filename'. Returns t if successful."
+ (declare (obsolete comint-filename-completion "24.1"))
(let ((data (comint--complete-file-name-data)))
(completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))
-(make-obsolete 'comint-dynamic-complete-as-filename
- 'comint-filename-completion "24.1")
(defun comint-replace-by-expanded-filename ()
"Dynamically expand and complete the filename at point.
@@ -3204,6 +3200,7 @@ Return `partial' if completed as far as possible.
Return `listed' if a completion listing was shown.
See also `comint-dynamic-complete-filename'."
+ (declare (obsolete completion-in-region "24.1"))
(let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
(minibuffer-p (window-minibuffer-p (selected-window)))
(suffix (cond ((not comint-completion-addsuffix) "")
@@ -3246,8 +3243,6 @@ See also `comint-dynamic-complete-filename'."
(unless minibuffer-p
(message "Partially completed"))
'partial)))))))
-(make-obsolete 'comint-dynamic-simple-complete 'completion-in-region "24.1")
-
(defun comint-dynamic-list-filename-completions ()
"Display a list of possible completions for the filename at point."
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 86a19131569..8e06b16bd12 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -526,7 +526,10 @@ WIDGET is the widget to apply the filter entries of MENU on."
:type 'boolean)
(defcustom custom-unlispify-remove-prefixes nil
- "Non-nil means remove group prefixes from option names in buffer."
+ "Non-nil means remove group prefixes from option names in buffer.
+Discarding prefixes often leads to confusing names for options
+and faces in Customize buffers, so do not set this to a non-nil
+value unless you are sure you know what it does."
:group 'custom-menu
:group 'custom-buffer
:type 'boolean)
@@ -2225,9 +2228,9 @@ and `face'."
(setq widget nil)))))
(widget-setup))
-(make-obsolete 'custom-show "this widget type is no longer supported." "24.1")
(defun custom-show (widget value)
"Non-nil if WIDGET should be shown with VALUE by default."
+ (declare (obsolete "this widget type is no longer supported." "24.1"))
(let ((show (widget-get widget :custom-show)))
(if (functionp show)
(funcall show widget value)
@@ -4820,12 +4823,7 @@ if that value is non-nil."
(put 'Custom-mode 'mode-class 'special)
-;; backward-compatibility
-(defun custom-mode ()
- "Non-interactive variant of `Custom-mode'."
- (Custom-mode))
-(make-obsolete 'custom-mode 'Custom-mode "23.1")
-(put 'custom-mode 'mode-class 'special)
+(define-obsolete-function-alias 'custom-mode 'Custom-mode "23.1")
(add-to-list 'debug-ignored-errors "^Invalid face:? ")
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 0eb8b2d63c3..28c1d3e3026 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -422,7 +422,17 @@ since it could result in memory overflow and make Emacs crash."
(const :tag "Only on ttys" :value tty)
(other :tag "Always" t)) "23.1")
(window-combination-resize windows boolean "24.1")
- (window-combination-limit windows boolean "24.1")
+ (window-combination-limit
+ windows (choice
+ (const :tag "Never (nil)" :value nil)
+ (const :tag "For Temp Buffer Resize mode (temp-buffer-resize)"
+ :value temp-buffer-resize)
+ (const :tag "For temporary buffers (temp-buffer)"
+ :value temp-buffer)
+ (const :tag "For buffer display (display-buffer)"
+ :value display-buffer)
+ (other :tag "Always (t)" :value t))
+ "24.3")
;; xdisp.c
(show-trailing-whitespace whitespace-faces boolean nil
:safe booleanp)
@@ -433,7 +443,6 @@ since it could result in memory overflow and make Emacs crash."
(hscroll-step windows number "22.1")
(truncate-partial-width-windows display boolean "23.1")
(make-cursor-line-fully-visible windows boolean)
- (mode-line-inverse-video mode-line boolean)
(mode-line-in-non-selected-windows mode-line boolean "22.1")
(line-number-display-limit display
(choice integer
diff --git a/lisp/custom.el b/lisp/custom.el
index 01b0e6d1650..dc810e3c97d 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -350,68 +350,62 @@ FACE does not need to be quoted.
Third argument DOC is the face documentation.
-If FACE has been set with `custom-set-faces', set the face attributes
-as specified by that function, otherwise set the face attributes
-according to SPEC.
-
-The remaining arguments should have the form
-
- [KEYWORD VALUE]...
+If FACE has been set with `custom-set-faces', set the face
+attributes as specified by that function, otherwise set the face
+attributes according to SPEC.
+The remaining arguments should have the form [KEYWORD VALUE]...
For a list of valid keywords, see the common keywords listed in
`defcustom'.
-SPEC should be an alist of the form ((DISPLAY ATTS)...).
-
-In the first element, DISPLAY can be `default'. The ATTS in that
-element then act as defaults for all the following elements.
-
-Aside from that, DISPLAY specifies conditions to match some or
-all frames. For each frame, the first element of SPEC where the
-DISPLAY conditions are satisfied is the one that applies to that
-frame. The ATTRs in this element take effect, and the following
-elements are ignored, on that frame.
-
-In the last element, DISPLAY can be t. That element applies to a
-frame if none of the previous elements (except the `default' if
-any) did.
-
-ATTS is a list of face attributes followed by their values:
- (ATTR VALUE ATTR VALUE...)
-
-The possible attributes are `:family', `:width', `:height', `:weight',
-`:slant', `:underline', `:overline', `:strike-through', `:box',
-`:foreground', `:background', `:stipple', `:inverse-video', and `:inherit'.
-
-DISPLAY can be `default' (only in the first element), the symbol
-t (only in the last element) to match all frames, or an alist of
-conditions of the form \(REQ ITEM...). For such an alist to
-match a frame, each of the conditions must be satisfied, meaning
-that the REQ property of the frame must match one of the
-corresponding ITEMs. These are the defined REQ values:
-
-`type' (the value of `window-system')
- Under X, in addition to the values `window-system' can take,
- `motif', `lucid', `gtk' and `x-toolkit' are allowed, and match when
- the Motif toolkit, Lucid toolkit, GTK toolkit or any X toolkit is in use.
-
-`class' (the frame's color support)
- Should be one of `color', `grayscale', or `mono'.
-
-`background' (what color is used for the background text)
- Should be one of `light' or `dark'.
-
-`min-colors' (the minimum number of colors the frame should support)
- Should be an integer, it is compared with the result of
- `display-color-cells'.
-
-`supports' (only match frames that support the specified face attributes)
- Should be a list of face attributes. See the documentation for
- the function `display-supports-face-attributes-p' for more
- information on exactly how testing is done.
-
-See Info node `(elisp) Customization' in the Emacs Lisp manual
-for more information."
+SPEC should be an alist of the form
+
+ ((DISPLAY . ATTS)...)
+
+where DISPLAY is a form specifying conditions to match certain
+terminals and ATTS is a property list (ATTR VALUE ATTR VALUE...)
+specifying face attributes and values for frames on those
+terminals. On each terminal, the first element with a matching
+DISPLAY specification takes effect, and the remaining elements in
+SPEC are disregarded.
+
+As a special exception, in the first element of SPEC, DISPLAY can
+be the special value `default'. Then the ATTS in that element
+act as defaults for all the following elements.
+
+For backward compatibility, elements of SPEC can be written
+as (DISPLAY ATTS) instead of (DISPLAY . ATTS).
+
+Each DISPLAY can have the following values:
+ - `default' (only in the first element).
+ - The symbol t, which matches all terminals.
+ - An alist of conditions. Each alist element must have the form
+ (REQ ITEM...). A matching terminal must satisfy each
+ specified condition by matching one of its ITEMs. Each REQ
+ must be one of the following:
+ - `type' (the terminal type).
+ Each ITEM must be one of the values returned by
+ `window-system'. Under X, additional allowed values are
+ `motif', `lucid', `gtk' and `x-toolkit'.
+ - `class' (the terminal's color support).
+ Each ITEM should be one of `color', `grayscale', or `mono'.
+ - `background' (what color is used for the background text)
+ Each ITEM should be one of `light' or `dark'.
+ - `min-colors' (the minimum number of supported colors)
+ Each ITEM should be an integer, which is compared with the
+ result of `display-color-cells'.
+ - `supports' (match terminals supporting certain attributes).
+ Each ITEM should be a list of face attributes. See
+ `display-supports-face-attributes-p' for more information on
+ exactly how testing is done.
+
+In the ATTS property list, possible attributes are `:family',
+`:width', `:height', `:weight', `:slant', `:underline',
+`:overline', `:strike-through', `:box', `:foreground',
+`:background', `:stipple', `:inverse-video', and `:inherit'.
+
+See Info node `(elisp) Faces' in the Emacs Lisp manual for more
+information."
(declare (doc-string 3))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
@@ -1199,7 +1193,8 @@ Return t if THEME was successfully loaded, nil otherwise."
(expand-file-name "themes/" data-directory)))
(member hash custom-safe-themes)
(custom-theme-load-confirm hash))
- (let ((custom--inhibit-theme-enable t))
+ (let ((custom--inhibit-theme-enable t)
+ (buffer-file-name fn)) ;For load-history.
(eval-buffer))
;; Optimization: if the theme changes the `default' face, put that
;; entry first. This avoids some `frame-set-background-mode' rigmarole
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 75deb58b4d8..c8023bb43ed 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1045,11 +1045,10 @@ Using it may cause conflicts. Use it anyway? " owner)))))
(defun desktop-load-default ()
"Load the `default' start-up library manually.
Also inhibit further loading of it."
+ (declare (obsolete desktop-save-mode "22.1"))
(unless inhibit-default-init ; safety check
(load "default" t t)
(setq inhibit-default-init t)))
-(make-obsolete 'desktop-load-default
- 'desktop-save-mode "22.1")
;; ----------------------------------------------------------------------------
;;;###autoload
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index e5ca463e8d4..afa0e32b3af 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -54,30 +54,52 @@ into this list; they also should call `dired-log' to log the errors.")
;;;###autoload
(defun dired-diff (file &optional switches)
"Compare file at point with file FILE using `diff'.
-If called interactively, prompt for FILE; if the file at point
-has a backup file, use that as the default.
+If called interactively, prompt for FILE. If the file at point
+has a backup file, use that as the default. If the mark is active
+in Transient Mark mode, use the file at the mark as the default.
+\(That's the mark set by \\[set-mark-command], not by Dired's
+\\[dired-mark] command.)
-FILE is the first file given to `diff'.
-With prefix arg, prompt for second argument SWITCHES,
-which is the string of command switches for `diff'."
+FILE is the first file given to `diff'. The file at point
+is the second file given to `diff'.
+
+With prefix arg, prompt for second argument SWITCHES, which is
+the string of command switches for the third argument of `diff'."
(interactive
(let* ((current (dired-get-filename t))
- (oldf (file-newest-backup current))
- (dir (if oldf (file-name-directory oldf))))
- (list (read-file-name
- (format "Diff %s with%s: "
- (file-name-nondirectory current)
- (if oldf
- (concat " (default "
- (file-name-nondirectory oldf)
- ")")
- ""))
- dir oldf t)
- (if current-prefix-arg
- (read-string "Options for diff: "
- (if (stringp diff-switches)
- diff-switches
- (mapconcat 'identity diff-switches " ")))))))
+ ;; Get the latest existing backup file.
+ (oldf (diff-latest-backup-file current))
+ ;; Get the file at the mark.
+ (file-at-mark (if (and transient-mark-mode mark-active)
+ (save-excursion (goto-char (mark t))
+ (dired-get-filename t t))))
+ (default-file (or file-at-mark
+ (and oldf (file-name-nondirectory oldf))))
+ ;; Use it as default if it's not the same as the current file,
+ ;; and the target dir is current or there is a default file.
+ (default (if (and (not (equal default-file current))
+ (or (equal (dired-dwim-target-directory)
+ (dired-current-directory))
+ default-file))
+ default-file))
+ (target-dir (if default
+ (dired-current-directory)
+ (dired-dwim-target-directory)))
+ (defaults (dired-dwim-target-defaults (list current) target-dir)))
+ (list
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq minibuffer-default defaults))
+ (read-file-name
+ (format "Diff %s with%s: " current
+ (if default (format " (default %s)" default) ""))
+ target-dir default t))
+ (if current-prefix-arg
+ (read-string "Options for diff: "
+ (if (stringp diff-switches)
+ diff-switches
+ (mapconcat 'identity diff-switches " ")))))))
(let ((current (dired-get-filename t)))
(when (or (equal (expand-file-name file)
(expand-file-name current))
@@ -223,10 +245,17 @@ List has a form of (file-name full-file-name (attribute-list))."
;; OP-SYMBOL is the type of operation (for use in `dired-mark-pop-up').
;; ARG describes which files to use, as in `dired-get-marked-files'.
(let* ((files (dired-get-marked-files t arg))
- (default (and (eq op-symbol 'touch)
- (stringp (car files))
- (format-time-string "%Y%m%d%H%M.%S"
- (nth 5 (file-attributes (car files))))))
+ ;; The source of default file attributes is the file at point.
+ (default-file (dired-get-filename t t))
+ (default (when default-file
+ (cond ((eq op-symbol 'touch)
+ (format-time-string
+ "%Y%m%d%H%M.%S"
+ (nth 5 (file-attributes default-file))))
+ ((eq op-symbol 'chown)
+ (nth 2 (file-attributes default-file 'string)))
+ ((eq op-symbol 'chgrp)
+ (nth 3 (file-attributes default-file 'string))))))
(prompt (concat "Change " attribute-name " of %s to"
(if (eq op-symbol 'touch)
" (default now): "
@@ -263,11 +292,15 @@ List has a form of (file-name full-file-name (attribute-list))."
;;;###autoload
(defun dired-do-chmod (&optional arg)
"Change the mode of the marked (or next ARG) files.
-Symbolic modes like `g+w' are allowed."
+Symbolic modes like `g+w' are allowed.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(let* ((files (dired-get-marked-files t arg))
- (modestr (and (stringp (car files))
- (nth 8 (file-attributes (car files)))))
+ ;; The source of default file attributes is the file at point.
+ (default-file (dired-get-filename t t))
+ (modestr (when default-file
+ (nth 8 (file-attributes default-file))))
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
@@ -300,7 +333,9 @@ Symbolic modes like `g+w' are allowed."
;;;###autoload
(defun dired-do-chgrp (&optional arg)
- "Change the group of the marked (or next ARG) files."
+ "Change the group of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
(error "chgrp not supported on this system"))
@@ -308,7 +343,9 @@ Symbolic modes like `g+w' are allowed."
;;;###autoload
(defun dired-do-chown (&optional arg)
- "Change the owner of the marked (or next ARG) files."
+ "Change the owner of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
(error "chown not supported on this system"))
@@ -317,7 +354,9 @@ Symbolic modes like `g+w' are allowed."
;;;###autoload
(defun dired-do-touch (&optional arg)
"Change the timestamp of the marked (or next ARG) files.
-This calls touch."
+This calls touch.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index f176cf7dbe0..1237eef86cf 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -723,15 +723,13 @@ determine a default directory.")
(defun dired-default-directory ()
"Return the `dired-default-directory-alist' entry for the current major-mode.
If none, return `default-directory'."
+ ;; It looks like this was intended to be something of a "general"
+ ;; feature, but it only ever seems to have been used in
+ ;; dired-smart-shell-command, and doesn't seem worth keeping around.
+ (declare (obsolete nil "24.1"))
(or (eval (cdr (assq major-mode dired-default-directory-alist)))
default-directory))
-;; It looks like this was intended to be something of a "general" feature,
-;; but it only ever seems to have been used in dired-smart-shell-command,
-;; and does not seem worth keeping around (?).
-(make-obsolete 'dired-default-directory
- "this feature is due to be removed." "24.1")
-
(defun dired-smart-shell-command (command &optional output-buffer error-buffer)
"Like function `shell-command', but in the current Virtual Dired directory."
(interactive
@@ -782,6 +780,7 @@ See also `dired-enable-local-variables'."
(defun dired-hack-local-variables ()
"Evaluate local variables in `dired-local-variables-file' for dired buffer."
+ (declare (obsolete hack-dir-local-variables-non-file-buffer "24.1"))
(and (stringp dired-local-variables-file)
(file-exists-p dired-local-variables-file)
(let ((opoint (point-max))
@@ -803,14 +802,12 @@ See also `dired-enable-local-variables'."
;; Make sure that the mode line shows the proper information.
(dired-sort-set-mode-line))))
-(make-obsolete 'dired-hack-local-variables
- 'hack-dir-local-variables-non-file-buffer "24.1")
-
;; Does not seem worth a dedicated command.
;; See the more general features in files-x.el.
(defun dired-omit-here-always ()
"Create `dir-locals-file' setting `dired-omit-mode' to t in `dired-mode'.
If in a Dired buffer, reverts it."
+ (declare (obsolete add-dir-local-variable "24.1"))
(interactive)
(if (file-exists-p dired-local-variables-file)
(error "Old-style dired-local-variables-file `./%s' found;
@@ -830,8 +827,6 @@ replace it with a dir-locals-file `./%s'"
(dired-extra-startup)
(dired-revert))))
-(make-obsolete 'dired-omit-here-always 'add-dir-local-variable "24.1")
-
;;; GUESS SHELL COMMAND.
diff --git a/lisp/dired.el b/lisp/dired.el
index 54921a4ea66..a17e1805339 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -248,6 +248,10 @@ This is what the do-commands look for, and what the mark-commands store.")
;; I see no reason ever to make this nil -- rms.
;; (> baud-rate search-slow-speed)
"Non-nil means Dired shrinks the display buffer to fit the marked files.")
+(make-obsolete-variable 'dired-shrink-to-fit
+ "use the Customization interface to add a new rule
+to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\",
+action argument symbol is `window-height' and its value is nil." "24.3")
(defvar dired-file-version-alist)
@@ -1493,6 +1497,8 @@ 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 [remap read-only-mode] 'dired-toggle-read-only)
+ ;; `toggle-read-only' is an obsolete alias for `read-only-mode'
(define-key map [remap toggle-read-only] 'dired-toggle-read-only)
(define-key map "?" 'dired-summary)
(define-key map "\177" 'dired-unmark-backward)
@@ -1875,7 +1881,6 @@ for more info):
`dired-listing-switches'
`dired-trivial-filenames'
- `dired-shrink-to-fit'
`dired-marker-char'
`dired-del-marker'
`dired-keep-marker-rename'
@@ -1962,7 +1967,7 @@ Otherwise, call `toggle-read-only'."
(interactive)
(if (derived-mode-p 'dired-mode)
(wdired-change-to-wdired-mode)
- (call-interactively 'toggle-read-only)))
+ (read-only-mode 'toggle)))
(defun dired-next-line (arg)
"Move down lines then position at filename.
@@ -2938,6 +2943,7 @@ or \"* [3 files]\"."
(defun dired-pop-to-buffer (buf)
"Pop up buffer BUF in a way suitable for Dired."
+ (declare (obsolete dired-mark-pop-up "24.3"))
(let ((split-window-preferred-function
(lambda (window)
(or (and (let ((split-height-threshold 0))
@@ -2979,6 +2985,11 @@ BUFFER-OR-NAME; the default name being \" *Marked Files*\". The
window is not shown if there is just one file, `dired-no-confirm'
is t, or OP-SYMBOL is a member of the list in `dired-no-confirm'.
+By default, Dired shrinks the display buffer to fit the marked files.
+To disable this, use the Customization interface to add a new rule
+to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\",
+action argument symbol is `window-height' and its value is nil.
+
FILES is the list of marked files. It can also be (t FILENAME)
in the case of one marked file, to distinguish that from using
just the current file.
@@ -2995,7 +3006,8 @@ argument or confirmation)."
(let ((split-height-threshold 0))
(with-temp-buffer-window
buffer
- (cons 'display-buffer-below-selected nil)
+ (cons 'display-buffer-below-selected
+ '((window-height . fit-window-to-buffer)))
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
@@ -3097,21 +3109,37 @@ argument or confirmation)."
(defun dired-mark (arg)
"Mark the current (or next ARG) files.
If on a subdir headerline, mark all its files except `.' and `..'.
+If the region is active in Transient Mark mode, mark all files
+in the active region.
Use \\[dired-unmark-all-files] to remove all marks
and \\[dired-unmark] on a subdir to remove the marks in
this subdir."
(interactive "P")
- (if (dired-get-subdir)
- (save-excursion (dired-mark-subdir-files))
+ (cond
+ ;; Mark files in the active region.
+ ((and transient-mark-mode mark-active)
+ (save-excursion
+ (let ((beg (region-beginning))
+ (end (region-end)))
+ (dired-mark-files-in-region
+ (progn (goto-char beg) (line-beginning-position))
+ (progn (goto-char end) (line-beginning-position))))))
+ ;; Mark subdir files from the subdir headerline.
+ ((dired-get-subdir)
+ (save-excursion (dired-mark-subdir-files)))
+ ;; Mark the current (or next ARG) files.
+ (t
(let ((inhibit-read-only t))
(dired-repeat-over-lines
(prefix-numeric-value arg)
- (function (lambda () (delete-char 1) (insert dired-marker-char)))))))
+ (function (lambda () (delete-char 1) (insert dired-marker-char))))))))
(defun dired-unmark (arg)
"Unmark the current (or next ARG) files.
-If looking at a subdir, unmark all its files except `.' and `..'."
+If looking at a subdir, unmark all its files except `.' and `..'.
+If the region is active in Transient Mark mode, unmark all files
+in the active region."
(interactive "P")
(let ((dired-marker-char ?\040))
(dired-mark arg)))
@@ -3119,8 +3147,9 @@ If looking at a subdir, unmark all its files except `.' and `..'."
(defun dired-flag-file-deletion (arg)
"In Dired, flag the current line's file for deletion.
With prefix arg, repeat over several lines.
-
-If on a subdir headerline, mark all its files except `.' and `..'."
+If on a subdir headerline, flag all its files except `.' and `..'.
+If the region is active in Transient Mark mode, flag all files
+in the active region."
(interactive "P")
(let ((dired-marker-char dired-del-marker))
(dired-mark arg)))
@@ -3128,7 +3157,9 @@ If on a subdir headerline, mark all its files except `.' and `..'."
(defun dired-unmark-backward (arg)
"In Dired, move up lines and remove marks or deletion flags there.
Optional prefix ARG says how many lines to unmark/unflag; default
-is one line."
+is one line.
+If the region is active in Transient Mark mode, unmark all files
+in the active region."
(interactive "p")
(dired-unmark (- arg)))
@@ -3159,8 +3190,8 @@ As always, hidden subdirs are not affected."
(defvar dired-regexp-history nil
"History list of regular expressions used in Dired commands.")
-(defun dired-read-regexp (prompt)
- (read-from-minibuffer prompt nil nil nil 'dired-regexp-history))
+(defun dired-read-regexp (prompt &optional default history)
+ (read-regexp prompt default (or history 'dired-regexp-history)))
(defun dired-mark-files-regexp (regexp &optional marker-char)
"Mark all files matching REGEXP for use in later commands.
@@ -3744,17 +3775,22 @@ Ask means pop up a menu for the user to select one of copy, move or link."
;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command
;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown
;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff
-;;;;;; dired-diff) "dired-aux" "dired-aux.el" "3c768e470d5d053d0049e0286ce38da7")
+;;;;;; dired-diff) "dired-aux" "dired-aux.el" "244227ae609852d3dc10ab3fc40ba9ab")
;;; Generated autoloads from dired-aux.el
(autoload 'dired-diff "dired-aux" "\
Compare file at point with file FILE using `diff'.
-If called interactively, prompt for FILE; if the file at point
-has a backup file, use that as the default.
+If called interactively, prompt for FILE. If the file at point
+has a backup file, use that as the default. If the mark is active
+in Transient Mark mode, use the file at the mark as the default.
+\(That's the mark set by \\[set-mark-command], not by Dired's
+\\[dired-mark] command.)
+
+FILE is the first file given to `diff'. The file at point
+is the second file given to `diff'.
-FILE is the first file given to `diff'.
-With prefix arg, prompt for second argument SWITCHES,
-which is the string of command switches for `diff'.
+With prefix arg, prompt for second argument SWITCHES, which is
+the string of command switches for the third argument of `diff'.
\(fn FILE &optional SWITCHES)" t nil)
@@ -3798,22 +3834,30 @@ Examples of PREDICATE:
(autoload 'dired-do-chmod "dired-aux" "\
Change the mode of the marked (or next ARG) files.
Symbolic modes like `g+w' are allowed.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer.
\(fn &optional ARG)" t nil)
(autoload 'dired-do-chgrp "dired-aux" "\
Change the group of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer.
\(fn &optional ARG)" t nil)
(autoload 'dired-do-chown "dired-aux" "\
Change the owner of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer.
\(fn &optional ARG)" t nil)
(autoload 'dired-do-touch "dired-aux" "\
Change the timestamp of the marked (or next ARG) files.
This calls touch.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer.
\(fn &optional ARG)" t nil)
@@ -4234,7 +4278,7 @@ instead.
;;;***
;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump)
-;;;;;; "dired-x" "dired-x.el" "d2461aa6efb8c1d7de8f245728ab448e")
+;;;;;; "dired-x" "dired-x.el" "a4e6844421c2c5e6fde90e959fbcc26f")
;;; Generated autoloads from dired-x.el
(autoload 'dired-jump "dired-x" "\
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 72b36feb1d8..f8975a57b7b 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -3,8 +3,8 @@
;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;;
-;; Author: Tassilo Horn <tassilo@member.fsf.org>
-;; Maintainer: Tassilo Horn <tassilo@member.fsf.org>
+;; Author: Tassilo Horn <tsdh@gnu.org>
+;; Maintainer: Tassilo Horn <tsdh@gnu.org>
;; Keywords: files, pdf, ps, dvi
;; This file is part of GNU Emacs.
@@ -57,16 +57,21 @@
;; pages won't be displayed before conversion of the document finished
;; completely.
;;
-;; DocView lets you select a slice of the displayed pages. This slice will be
-;; remembered and applied to all pages of the current document. This enables
-;; you to cut away the margins of a document to save some space. To select a
-;; slice you can use `doc-view-set-slice' (bound to `s s') which will query you
-;; for the coordinates of the slice's top-left corner and its width and height.
-;; A much more convenient way to do the same is offered by the command
-;; `doc-view-set-slice-using-mouse' (bound to `s m'). After invocation you
-;; only have to press mouse-1 at the top-left corner and drag it to the
-;; bottom-right corner of the desired slice. To reset the slice use
-;; `doc-view-reset-slice' (bound to `s r').
+;; DocView lets you select a slice of the displayed pages. This slice
+;; will be remembered and applied to all pages of the current
+;; document. This enables you to cut away the margins of a document
+;; to save some space. To select a slice you can use
+;; `doc-view-set-slice' (bound to `s s') which will query you for the
+;; coordinates of the slice's top-left corner and its width and
+;; height. A much more convenient way to do the same is offered by
+;; the command `doc-view-set-slice-using-mouse' (bound to `s m').
+;; After invocation you only have to press mouse-1 at the top-left
+;; corner and drag it to the bottom-right corner of the desired slice.
+;; Even more accurate and convenient is to use
+;; `doc-view-set-slice-from-bounding-box' (bound to `s b') which uses
+;; the BoundingBox information of the current page to set an optimal
+;; slice. To reset the slice use `doc-view-reset-slice' (bound to `s
+;; r').
;;
;; You can also search within the document. The command `doc-view-search'
;; (bound to `C-s') queries for a search regexp and initializes a list of all
@@ -103,7 +108,6 @@
;; - share more code with image-mode.
;; - better menu.
;; - Bind slicing to a drag event.
-;; - doc-view-fit-doc-to-window and doc-view-fit-window-to-doc?
;; - zoom the region around the cursor (like xdvi).
;; - get rid of the silly arrow in the fringe.
;; - improve anti-aliasing (pdf-utils gets it better).
@@ -251,20 +255,23 @@ of the page moves to the previous page."
;;;; Internal Variables
(defun doc-view-new-window-function (winprops)
+ ;; (message "New window %s for buf %s" (car winprops) (current-buffer))
+ (cl-assert (or (eq t (car winprops))
+ (eq (window-buffer (car winprops)) (current-buffer))))
(let ((ol (image-mode-window-get 'overlay winprops)))
- (when (and ol (not (overlay-buffer ol)))
- ;; I've seen `ol' be a dead overlay. I do not yet know how this
- ;; happened, so maybe the bug is elsewhere, but in the mean time,
- ;; this seems like a safe approach.
- (setq ol nil))
(if ol
(progn
- (cl-assert (eq (overlay-buffer ol) (current-buffer)))
- (setq ol (copy-overlay ol)))
- (cl-assert (not (get-char-property (point-min) 'display)))
+ (setq ol (copy-overlay ol))
+ ;; `ol' might actually be dead.
+ (move-overlay ol (point-min) (point-max)))
(setq ol (make-overlay (point-min) (point-max) nil t))
(overlay-put ol 'doc-view t))
(overlay-put ol 'window (car winprops))
+ (unless (windowp (car winprops))
+ ;; It's a pseudo entry. Let's make sure it's not displayed (the
+ ;; `window' property is only effective if its value is a window).
+ (cl-assert (eq t (car winprops)))
+ (delete-overlay ol))
(image-mode-window-put 'overlay ol winprops)))
(defvar doc-view-current-files nil
@@ -340,6 +347,7 @@ Can be `dvi', `pdf', or `ps'.")
;; Slicing the image
(define-key map (kbd "s s") 'doc-view-set-slice)
(define-key map (kbd "s m") 'doc-view-set-slice-using-mouse)
+ (define-key map (kbd "s b") 'doc-view-set-slice-from-bounding-box)
(define-key map (kbd "s r") 'doc-view-reset-slice)
;; Searching
(define-key map (kbd "C-s") 'doc-view-search)
@@ -381,6 +389,7 @@ Can be `dvi', `pdf', or `ps'.")
)
"---"
["Set Slice" doc-view-set-slice-using-mouse]
+ ["Set Slice (BoundingBox)" doc-view-set-slice-from-bounding-box]
["Set Slice (manual)" doc-view-set-slice]
["Reset Slice" doc-view-reset-slice]
"---"
@@ -554,7 +563,8 @@ at the top edge of the page moves to the previous page."
"Kill the current converter process(es)."
(interactive)
(while (consp doc-view-current-converter-processes)
- (ignore-errors ;; Maybe it's dead already?
+ (ignore-errors ;; Some entries might not be processes, and maybe
+ ;; some are dead already?
(kill-process (pop doc-view-current-converter-processes))))
(when doc-view-current-timer
(cancel-timer doc-view-current-timer)
@@ -657,19 +667,21 @@ OpenDocument format)."
(defvar doc-view-shrink-factor 1.125)
(defun doc-view-enlarge (factor)
- "Enlarge the document."
+ "Enlarge the document by FACTOR."
(interactive (list doc-view-shrink-factor))
(if (eq (plist-get (cdr (doc-view-current-image)) :type)
'imagemagick)
- ;; ImageMagick supports on-the-fly-rescaling
- (progn
- (set (make-local-variable 'doc-view-image-width)
- (ceiling (* factor doc-view-image-width)))
- (doc-view-insert-image (plist-get (cdr (doc-view-current-image)) :file)
- :width doc-view-image-width))
- (set (make-local-variable 'doc-view-resolution)
- (ceiling (* factor doc-view-resolution)))
- (doc-view-reconvert-doc)))
+ ;; ImageMagick supports on-the-fly-rescaling.
+ (let ((new (ceiling (* factor doc-view-image-width))))
+ (unless (equal new doc-view-image-width)
+ (set (make-local-variable 'doc-view-image-width) new)
+ (doc-view-insert-image
+ (plist-get (cdr (doc-view-current-image)) :file)
+ :width doc-view-image-width)))
+ (let ((new (ceiling (* factor doc-view-resolution))))
+ (unless (equal new doc-view-resolution)
+ (set (make-local-variable 'doc-view-resolution) new)
+ (doc-view-reconvert-doc)))))
(defun doc-view-shrink (factor)
"Shrink the document."
@@ -737,12 +749,14 @@ min {(window-width / image-width), (window-height / image-height)} times."
(img-height (cdr (image-display-size
(image-get-display-property) t))))
(doc-view-enlarge (min (/ (float win-width) (float img-width))
- (/ (float (- win-height 1)) (float img-height)))))
+ (/ (float (- win-height 1))
+ (float img-height)))))
;; If slice is set
(let* ((slice-width (nth 2 slice))
(slice-height (nth 3 slice))
(scale-factor (min (/ (float win-width) (float slice-width))
- (/ (float (- win-height 1)) (float slice-height))))
+ (/ (float (- win-height 1))
+ (float slice-height))))
(new-slice (mapcar (lambda (x) (ceiling (* scale-factor x))) slice)))
(doc-view-enlarge scale-factor)
(setf (doc-view-current-slice) new-slice)
@@ -756,6 +770,7 @@ Should be invoked when the cached images aren't up-to-date."
;; Clear the old cached files
(when (file-exists-p (doc-view-current-cache-dir))
(delete-directory (doc-view-current-cache-dir) 'recursive))
+ (kill-local-variable 'doc-view-last-page-number)
(doc-view-initiate-display))
(defun doc-view-sentinel (proc event)
@@ -889,6 +904,11 @@ Start by converting PAGES, and then the rest."
(list "-raw" pdf txt)
callback))
+(defun doc-view-current-cache-doc-pdf ()
+ "Return the name of the doc.pdf in the current cache dir.
+ This file exists only if the current document isn't a PDF or PS file already."
+ (expand-file-name "doc.pdf" (doc-view-current-cache-dir)))
+
(defun doc-view-doc->txt (txt callback)
"Convert the current document to text and call CALLBACK when done."
(make-directory (doc-view-current-cache-dir) t)
@@ -899,22 +919,17 @@ Start by converting PAGES, and then the rest."
(`ps
;; Doc is a PS, so convert it to PDF (which will be converted to
;; TXT thereafter).
- (let ((pdf (expand-file-name "doc.pdf"
- (doc-view-current-cache-dir))))
+ (let ((pdf (doc-view-current-cache-doc-pdf)))
(doc-view-ps->pdf doc-view-buffer-file-name pdf
(lambda () (doc-view-pdf->txt pdf txt callback)))))
(`dvi
;; Doc is a DVI. This means that a doc.pdf already exists in its
;; cache subdirectory.
- (doc-view-pdf->txt (expand-file-name "doc.pdf"
- (doc-view-current-cache-dir))
- txt callback))
+ (doc-view-pdf->txt (doc-view-current-cache-doc-pdf) txt callback))
(`odf
;; Doc is some ODF (or MS Office) doc. This means that a doc.pdf
;; already exists in its cache subdirectory.
- (doc-view-pdf->txt (expand-file-name "doc.pdf"
- (doc-view-current-cache-dir))
- txt callback))
+ (doc-view-pdf->txt (doc-view-current-cache-doc-pdf) txt callback))
(_ (error "DocView doesn't know what to do"))))
(defun doc-view-ps->pdf (ps pdf callback)
@@ -954,13 +969,13 @@ Those files are saved in the directory given by the function
(`dvi
;; DVI files have to be converted to PDF before Ghostscript can process
;; it.
- (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)))
+ (let ((pdf (doc-view-current-cache-doc-pdf)))
(doc-view-dvi->pdf doc-view-buffer-file-name pdf
(lambda () (doc-view-pdf/ps->png pdf png-file)))))
(`odf
;; ODF files have to be converted to PDF before Ghostscript can
;; process it.
- (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))
+ (let ((pdf (doc-view-current-cache-doc-pdf))
(opdf (expand-file-name (concat (file-name-base doc-view-buffer-file-name)
".pdf")
doc-view-current-cache-dir))
@@ -991,8 +1006,9 @@ You can use this function to tell doc-view not to display the
margins of the document. It prompts for the top-left corner (X
and Y) of the slice to display and its WIDTH and HEIGHT.
-See `doc-view-set-slice-using-mouse' for a more convenient way to
-do that. To reset the slice use `doc-view-reset-slice'."
+See `doc-view-set-slice-using-mouse' and
+`doc-view-set-slice-from-bounding-box' for more convenient ways
+to do that. To reset the slice use `doc-view-reset-slice'."
(interactive
(let* ((size (image-size (doc-view-current-image) t))
(a (read-number (format "Top-left X (0..%d): " (car size))))
@@ -1023,6 +1039,82 @@ dragging it to its bottom-right corner. See also
(setq done t))))
(doc-view-set-slice x y w h)))
+(defun doc-view-get-bounding-box ()
+ "Get the BoundingBox information of the current page."
+ (let* ((page (doc-view-current-page))
+ (doc (let ((cache-doc (doc-view-current-cache-doc-pdf)))
+ (if (file-exists-p cache-doc)
+ cache-doc
+ doc-view-buffer-file-name)))
+ (o (shell-command-to-string
+ (concat doc-view-ghostscript-program
+ " -dSAFER -dBATCH -dNOPAUSE -q -sDEVICE=bbox "
+ (format "-dFirstPage=%s -dLastPage=%s %s"
+ page page doc)))))
+ (save-match-data
+ (when (string-match (concat "%%BoundingBox: "
+ "\\([[:digit:]]+\\) \\([[:digit:]]+\\) "
+ "\\([[:digit:]]+\\) \\([[:digit:]]+\\)") o)
+ (mapcar #'string-to-number
+ (list (match-string 1 o)
+ (match-string 2 o)
+ (match-string 3 o)
+ (match-string 4 o)))))))
+
+(defvar doc-view-paper-sizes
+ '((a4 595 842)
+ (a4-landscape 842 595)
+ (letter 612 792)
+ (letter-landscape 792 612)
+ (legal 612 1008)
+ (legal-landscape 1008 612)
+ (a3 842 1191)
+ (a3-landscape 1191 842)
+ (tabloid 792 1224)
+ (ledger 1224 792))
+ "An alist from paper size names to dimensions.")
+
+(defun doc-view-guess-paper-size (iw ih)
+ "Guess the paper size according to the aspect ratio."
+ (cl-labels ((div (x y)
+ (round (/ (* 100.0 x) y))))
+ (let ((ar (div iw ih))
+ (al (mapcar (lambda (l)
+ (list (div (nth 1 l) (nth 2 l)) (car l)))
+ doc-view-paper-sizes)))
+ (cadr (assoc ar al)))))
+
+(defun doc-view-scale-bounding-box (ps iw ih bb)
+ (list (/ (* (nth 0 bb) iw) (nth 1 (assoc ps doc-view-paper-sizes)))
+ (/ (* (nth 1 bb) ih) (nth 2 (assoc ps doc-view-paper-sizes)))
+ (/ (* (nth 2 bb) iw) (nth 1 (assoc ps doc-view-paper-sizes)))
+ (/ (* (nth 3 bb) ih) (nth 2 (assoc ps doc-view-paper-sizes)))))
+
+(defun doc-view-set-slice-from-bounding-box (&optional force-paper-size)
+ "Set the slice from the document's BoundingBox information.
+The result is that the margins are almost completely cropped,
+much more accurate than could be done manually using
+`doc-view-set-slice-using-mouse'."
+ (interactive "P")
+ (let ((bb (doc-view-get-bounding-box)))
+ (if (not bb)
+ (message "BoundingBox couldn't be determined")
+ (let* ((is (image-size (doc-view-current-image) t))
+ (iw (car is))
+ (ih (cdr is))
+ (ps (or (and (null force-paper-size) (doc-view-guess-paper-size iw ih))
+ (intern (completing-read "Paper size: "
+ (mapcar #'car doc-view-paper-sizes)
+ nil t))))
+ (bb (doc-view-scale-bounding-box ps iw ih bb))
+ (x1 (nth 0 bb))
+ (y1 (nth 1 bb))
+ (x2 (nth 2 bb))
+ (y2 (nth 3 bb)))
+ ;; We keep a 2 pixel margin.
+ (doc-view-set-slice (- x1 2) (- ih y2 2)
+ (+ (- x2 x1) 4) (+ (- y2 y1) 4))))))
+
(defun doc-view-reset-slice ()
"Reset the current slice.
After calling this function whole pages will be visible again."
@@ -1095,16 +1187,18 @@ have the page we want to view."
"page-[0-9]+\\.png" t)
'doc-view-sort))
(dolist (win (or (get-buffer-window-list buffer nil t)
- (list (selected-window))))
+ (list t)))
(let* ((page (doc-view-current-page win))
(pagefile (expand-file-name (format "page-%d.png" page)
(doc-view-current-cache-dir))))
(when (or force
(and (not (member pagefile prev-pages))
(member pagefile doc-view-current-files)))
- (with-selected-window win
- (cl-assert (eq (current-buffer) buffer))
- (doc-view-goto-page page))))))))
+ (if (windowp win)
+ (with-selected-window win
+ (cl-assert (eq (current-buffer) buffer) t)
+ (doc-view-goto-page page))
+ (doc-view-goto-page page))))))))
(defun doc-view-buffer-message ()
;; Only show this message initially, not when refreshing the buffer (in which
@@ -1148,6 +1242,10 @@ For now these keys are useful:
;;;;; Toggle between editing and viewing
+(defvar-local doc-view-saved-settings nil
+ "Doc-view settings saved while in some other mode.")
+(put 'doc-view-saved-settings 'permanent-local t)
+
(defun doc-view-toggle-display ()
"Toggle between editing a document as text or viewing it."
(interactive)
@@ -1400,13 +1498,16 @@ toggle between displaying the document or editing it as text.
;; returns nil for tar members.
(doc-view-fallback-mode)
- (let* ((prev-major-mode (if (eq major-mode 'doc-view-mode)
+ (let* ((prev-major-mode (if (derived-mode-p 'doc-view-mode)
doc-view-previous-major-mode
- (when (not (memq major-mode
- '(doc-view-mode fundamental-mode)))
+ (unless (eq major-mode 'fundamental-mode)
major-mode))))
(kill-all-local-variables)
- (set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode))
+ (set (make-local-variable 'doc-view-previous-major-mode)
+ prev-major-mode))
+
+ (dolist (var doc-view-saved-settings)
+ (set (make-local-variable (car var)) (cdr var)))
;; Figure out the document type.
(unless doc-view-doc-type
@@ -1480,13 +1581,20 @@ toggle between displaying the document or editing it as text.
(defun doc-view-fallback-mode ()
"Fallback to the previous or next best major mode."
- (if doc-view-previous-major-mode
- (funcall doc-view-previous-major-mode)
- (let ((auto-mode-alist (rassq-delete-all
- 'doc-view-mode-maybe
- (rassq-delete-all 'doc-view-mode
- (copy-alist auto-mode-alist)))))
- (normal-mode))))
+ (let ((vars (if (derived-mode-p 'doc-view-mode)
+ (mapcar (lambda (var) (cons var (symbol-value var)))
+ '(doc-view-resolution
+ image-mode-winprops-alist)))))
+ (if doc-view-previous-major-mode
+ (funcall doc-view-previous-major-mode)
+ (let ((auto-mode-alist
+ (rassq-delete-all
+ 'doc-view-mode-maybe
+ (rassq-delete-all 'doc-view-mode
+ (copy-alist auto-mode-alist)))))
+ (normal-mode)))
+ (when vars
+ (setq-local doc-view-saved-settings vars))))
;;;###autoload
(defun doc-view-mode-maybe ()
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index 281148d9cf6..a1bd4d65385 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -61,6 +61,8 @@
(defvar electric-help-map
(let ((map (make-keymap)))
+ ;; FIXME fragile. Should derive from help-mode-map in a smarter way.
+ (set-keymap-parent map button-buffer-map)
;; allow all non-self-inserting keys - search, scroll, etc, but
;; let M-x and C-x exit ehelp mode and retain buffer:
(suppress-keymap map)
@@ -102,7 +104,7 @@
(setq buffer-read-only t)
(setq electric-help-orig-major-mode major-mode)
(setq mode-name "Help")
- (setq major-mode 'help)
+ (setq major-mode 'help-mode)
(setq mode-line-buffer-identification '(" Help: %b"))
(use-local-map electric-help-map)
(add-hook 'mouse-leave-buffer-hook 'electric-help-retain)
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index e6e2d1e60e0..382e25f3121 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -153,7 +153,7 @@ expression, in which case we want to handle forms differently."
easy-mmode-define-minor-mode define-minor-mode
cl-defun defun* cl-defmacro defmacro*
define-overloadable-function))
- (let* ((macrop (memq car '(defmacro defmacro*)))
+ (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
(name (nth 1 form))
(args (pcase car
((or `defun `defmacro
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 93e890a20c9..d740574f1e4 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -253,7 +253,9 @@ convention was modified."
advertised-signature-table))
(defun make-obsolete (obsolete-name current-name &optional when)
- "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
+ "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
+OBSOLETE-NAME should be a function name or macro name (a symbol).
+
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message
\(it should end with a period, and not start with a capital).
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c42ae21aae5..4dd44bb6f22 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -846,7 +846,7 @@ CONST2 may be evaluated multiple times."
(defun byte-compile-cl-file-p (file)
"Return non-nil if FILE is one of the CL files."
(and (stringp file)
- (string-match "^cl\\>" (file-name-nondirectory file))))
+ (string-match "^cl\\.el" (file-name-nondirectory file))))
(defun byte-compile-eval (form)
"Eval FORM and mark the functions defined therein.
@@ -1005,13 +1005,20 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(defvar byte-compile-root-dir nil
"Directory relative to which file names in error messages are written.")
+;; FIXME: We should maybe extend abbreviate-file-name with an optional DIR
+;; argument to try and use a relative file-name.
+(defun byte-compile-abbreviate-file (file &optional dir)
+ (let ((f1 (abbreviate-file-name file))
+ (f2 (file-relative-name file dir)))
+ (if (< (length f2) (length f1)) f2 f1)))
+
;; This is used as warning-prefix for the compiler.
;; It is always called with the warnings buffer current.
(defun byte-compile-warning-prefix (level entry)
(let* ((inhibit-read-only t)
(dir (or byte-compile-root-dir default-directory))
(file (cond ((stringp byte-compile-current-file)
- (format "%s:" (file-relative-name
+ (format "%s:" (byte-compile-abbreviate-file
byte-compile-current-file dir)))
((bufferp byte-compile-current-file)
(format "Buffer %s:"
@@ -1019,7 +1026,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
;; We might be simply loading a file that
;; contains explicit calls to byte-compile functions.
((stringp load-file-name)
- (format "%s:" (file-relative-name load-file-name dir)))
+ (format "%s:" (byte-compile-abbreviate-file
+ load-file-name dir)))
(t "")))
(pos (if (and byte-compile-current-file
(integerp byte-compile-read-position))
@@ -1115,18 +1123,12 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
"Warn that SYMBOL (a variable or function) is obsolete."
(when (byte-compile-warning-enabled-p 'obsolete)
(let* ((funcp (get symbol 'byte-obsolete-info))
- (obsolete (or funcp (get symbol 'byte-obsolete-variable)))
- (instead (car obsolete))
- (asof (nth 2 obsolete)))
+ (msg (macroexp--obsolete-warning
+ symbol
+ (or funcp (get symbol 'byte-obsolete-variable))
+ (if funcp "function" "variable"))))
(unless (and funcp (memq symbol byte-compile-not-obsolete-funcs))
- (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
- (if funcp "function" "variable")
- (if asof (concat " (as of " asof ")") "")
- (cond ((stringp instead)
- (concat "; " instead))
- (instead
- (format "; use `%s' instead." instead))
- (t ".")))))))
+ (byte-compile-warn "%s" msg)))))
(defun byte-compile-report-error (error-info)
"Report Lisp error in compilation. ERROR-INFO is the error data."
@@ -1752,11 +1754,11 @@ The value is non-nil if there were no errors, nil if errors."
(if (with-current-buffer input-buffer no-byte-compile)
(progn
;; (message "%s not compiled because of `no-byte-compile: %s'"
- ;; (file-relative-name filename)
+ ;; (byte-compile-abbreviate-file filename)
;; (with-current-buffer input-buffer no-byte-compile))
(when (file-exists-p target-file)
(message "%s deleted because of `no-byte-compile: %s'"
- (file-relative-name target-file)
+ (byte-compile-abbreviate-file target-file)
(buffer-local-value 'no-byte-compile input-buffer))
(condition-case nil (delete-file target-file) (error nil)))
;; We successfully didn't compile this file.
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index ea5e1cf9beb..913ebf2015f 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -689,7 +689,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
;; Local variables:
;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 5749ff91b40..2eda628e262 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -745,7 +745,6 @@ If ALIST is non-nil, the new pairs are prepended to it."
;; Local variables:
;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
;; End:
;;; cl-lib.el ends here
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index c12e8ccacb1..e25ac5f9708 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -11,7 +11,7 @@
;;;;;; cl--map-overlays cl--map-intervals cl--map-keymap-recursively
;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan
;;;;;; cl-mapl cl-maplist cl-map cl--mapcar-many cl-equalp cl-coerce)
-;;;;;; "cl-extra" "cl-extra.el" "535a24c1cff55a16e3d51219498a7858")
+;;;;;; "cl-extra" "cl-extra.el" "1572ae52fa4fbd9c4bf89b49a068a865")
;;; Generated autoloads from cl-extra.el
(autoload 'cl-coerce "cl-extra" "\
@@ -260,7 +260,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
-;;;;;; "cl-macs" "cl-macs.el" "6d0676869af66e5b5a671f95ee069461")
+;;;;;; "cl-macs" "cl-macs.el" "6951d080daefb5194b1d21fe9b2deae4")
;;; Generated autoloads from cl-macs.el
(autoload 'cl--compiler-macro-list* "cl-macs" "\
@@ -657,8 +657,9 @@ copier, a `NAME-p' predicate, and slot accessors named `NAME-SLOT'.
You can use the accessors to set the corresponding slots, via `setf'.
NAME may instead take the form (NAME OPTIONS...), where each
-OPTION is either a single keyword or (KEYWORD VALUE).
-See Info node `(cl)Structures' for a list of valid keywords.
+OPTION is either a single keyword or (KEYWORD VALUE) where
+KEYWORD can be one of :conc-name, :constructor, :copier, :predicate,
+:type, :named, :initial-offset, :print-function, or :include.
Each SLOT may instead take the form (SLOT SLOT-OPTS...), where
SLOT-OPTS are keyword-value pairs for that slot. Currently, only
@@ -748,7 +749,7 @@ surrounded by (cl-block NAME ...).
;;;;;; cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if
;;;;;; cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not
;;;;;; cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove
-;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "b444601641dcbd14a23ca5182bc80ffa")
+;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "4c1e1191e82dc8d5449a5ec4d59efc10")
;;; Generated autoloads from cl-seq.el
(autoload 'cl-reduce "cl-seq" "\
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 16ac14f8fe9..99bae1944e8 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2154,8 +2154,9 @@ copier, a `NAME-p' predicate, and slot accessors named `NAME-SLOT'.
You can use the accessors to set the corresponding slots, via `setf'.
NAME may instead take the form (NAME OPTIONS...), where each
-OPTION is either a single keyword or (KEYWORD VALUE).
-See Info node `(cl)Structures' for a list of valid keywords.
+OPTION is either a single keyword or (KEYWORD VALUE) where
+KEYWORD can be one of :conc-name, :constructor, :copier, :predicate,
+:type, :named, :initial-offset, :print-function, or :include.
Each SLOT may instead take the form (SLOT SLOT-OPTS...), where
SLOT-OPTS are keyword-value pairs for that slot. Currently, only
@@ -2686,7 +2687,6 @@ surrounded by (cl-block NAME ...).
;; Local variables:
;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index b55f1df5ba5..1fa562e328a 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -1010,7 +1010,6 @@ Atoms are compared by `eql'; cons cells are compared recursively.
;; Local variables:
;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index ae0852d6c87..34beed0d9ef 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -452,7 +452,7 @@ definitions, or lack thereof).
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug cl-flet)
- (obsolete "Use either `cl-flet' or `cl-letf'." "24.3"))
+ (obsolete "use either `cl-flet' or `cl-letf'." "24.3"))
`(letf ,(mapcar
(lambda (x)
(if (or (and (fboundp (car x))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 774b4d3d600..6b308119abb 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -75,9 +75,9 @@ window previously showing the debugger buffer.
The value used here is passed to `quit-restore-window'."
:type '(choice
(const :tag "Keep alive" nil)
- (const :tag "Append" 'append)
- (const :tag "Bury" 'bury)
- (const :tag "Kill" 'kill))
+ (const :tag "Append" append)
+ (const :tag "Bury" bury)
+ (const :tag "Kill" kill))
:group 'debugger
:version "24.2")
@@ -166,6 +166,7 @@ first will be printed into the backtrace buffer."
(with-current-buffer (get-buffer "*Backtrace*")
(list major-mode (buffer-string)))))
(debugger-buffer (get-buffer-create "*Backtrace*"))
+ (debugger-old-buffer (current-buffer))
(debugger-window nil)
(debugger-step-after-exit nil)
(debugger-will-be-back nil)
@@ -265,13 +266,16 @@ first will be printed into the backtrace buffer."
;; Make sure we unbind buffer-read-only in the right buffer.
(save-excursion
(recursive-edit))))
- (when (and (window-live-p debugger-window)
+ (when (and (not debugger-will-be-back)
+ (window-live-p debugger-window)
(eq (window-buffer debugger-window) debugger-buffer))
;; Record height of debugger window.
(setq debugger-previous-window-height
(window-total-size debugger-window))
;; Unshow debugger-buffer.
- (quit-restore-window debugger-window debugger-bury-or-kill))
+ (quit-restore-window debugger-window debugger-bury-or-kill)
+ ;; Restore current buffer (Bug#12502).
+ (set-buffer debugger-old-buffer))
;; Restore previous state of debugger-buffer in case we were
;; in a recursive invocation of the debugger, otherwise just
;; erase the buffer and put it into fundamental mode.
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index ea72e9492f0..8c8d37b2194 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -276,10 +276,10 @@ A mode's class is the first ancestor which is NOT a derived mode.
Use the `derived-mode-parent' property of the symbol to trace backwards.
Since major-modes might all derive from `fundamental-mode', this function
is not very useful."
+ (declare (obsolete derived-mode-p "22.1"))
(while (get mode 'derived-mode-parent)
(setq mode (get mode 'derived-mode-parent)))
mode)
-(make-obsolete 'derived-mode-class 'derived-mode-p "22.1")
;;; PRIVATE
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index ee4e36a9eba..4951368aebe 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -90,12 +90,17 @@ MODE (you can override this with the :variable keyword, see below).
DOC is the documentation for the mode toggle command.
The defined mode command takes one optional (prefix) argument.
-Interactively with no prefix argument it toggles the mode.
-With a prefix argument, it enables the mode if the argument is
-positive and otherwise disables it. When called from Lisp, it
-enables the mode if the argument is omitted or nil, and toggles
-the mode if the argument is `toggle'. If DOC is nil this
-function adds a basic doc-string stating these facts.
+Interactively with no prefix argument, it toggles the mode.
+A prefix argument enables the mode if the argument is positive,
+and disables it otherwise.
+
+When called from Lisp, the mode command toggles the mode if the
+argument is `toggle', disables the mode if the argument is a
+non-positive integer, and enables the mode otherwise (including
+if the argument is omitted or nil or a positive integer).
+
+If DOC is nil, give the mode command a basic doc-string
+documenting what its argument does.
Optional INIT-VALUE is the initial value of the mode's variable.
Optional LIGHTER is displayed in the mode line when the mode is on.
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index d656dcf9526..18d1661e985 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -383,12 +383,9 @@ Return the result of the last expression in BODY."
;; All windows are dedicated or show `edebug-trace-buffer', split
;; selected one.
(t (split-window))))
- (select-window window)
(set-window-buffer window buffer)
- (set-window-hscroll window 0);; should this be??
- ;; Selecting the window does not set the buffer until command loop.
- ;;(set-buffer buffer)
- )
+ (select-window window)
+ (set-window-hscroll window 0)) ;; should this be??
(defun edebug-get-displayed-buffer-points ()
;; Return a list of buffer point pairs, for all displayed buffers.
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index b5600560cdd..69fe762887f 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -4,7 +4,6 @@
;;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.2
;; Keywords: OO, lisp
;; Package: eieio
@@ -225,8 +224,16 @@ a file. Optional argument NAME specifies a default file name."
))))
(oref this file))
-(defun eieio-persistent-read (filename)
- "Read a persistent object from FILENAME, and return it."
+(defun eieio-persistent-read (filename &optional class allow-subclass)
+ "Read a persistent object from FILENAME, and return it.
+Signal an error if the object in FILENAME is not a constructor
+for CLASS. Optional ALLOW-SUBCLASS says that it is ok for
+`eieio-persistent-read' to load in subclasses of class instead of
+being pedantic."
+ (unless class
+ (message "Unsafe call to `eieio-persistent-read'."))
+ (when (and class (not (class-p class)))
+ (signal 'wrong-type-argument (list 'class-p class)))
(let ((ret nil)
(buffstr nil))
(unwind-protect
@@ -239,13 +246,171 @@ a file. Optional argument NAME specifies a default file name."
;; so that any initialize-instance calls that depend on
;; the current buffer will work.
(setq ret (read buffstr))
- (if (not (child-of-class-p (car ret) 'eieio-persistent))
- (error "Corrupt object on disk"))
- (setq ret (eval ret))
+ (when (not (child-of-class-p (car ret) 'eieio-persistent))
+ (error "Corrupt object on disk: Unknown saved object"))
+ (when (and class
+ (not (or (eq (car ret) class ) ; same class
+ (and allow-subclass
+ (child-of-class-p (car ret) class)) ; subclasses
+ )))
+ (error "Corrupt object on disk: Invalid saved class"))
+ (setq ret (eieio-persistent-convert-list-to-object ret))
(oset ret file filename))
(kill-buffer " *tmp eieio read*"))
ret))
+(defun eieio-persistent-convert-list-to-object (inputlist)
+ "Convert the INPUTLIST, representing object creation to an object.
+While it is possible to just `eval' the INPUTLIST, this code instead
+validates the existing list, and explicitly creates objects instead of
+calling eval. This avoids the possibility of accidentally running
+malicious code.
+
+Note: This function recurses when a slot of :type of some object is
+identified, and needing more object creation."
+ (let ((objclass (nth 0 inputlist))
+ (objname (nth 1 inputlist))
+ (slots (nthcdr 2 inputlist))
+ (createslots nil))
+
+ ;; If OBJCLASS is an eieio autoload object, then we need to load it.
+ (eieio-class-un-autoload objclass)
+
+ (while slots
+ (let ((name (car slots))
+ (value (car (cdr slots))))
+
+ ;; Make sure that the value proposed for SLOT is valid.
+ ;; In addition, strip out quotes, list functions, and update
+ ;; object constructors as needed.
+ (setq value (eieio-persistent-validate/fix-slot-value
+ objclass name value))
+
+ (push name createslots)
+ (push value createslots)
+ )
+
+ (setq slots (cdr (cdr slots))))
+
+ (apply 'make-instance objclass objname (nreverse createslots))
+
+ ;;(eval inputlist)
+ ))
+
+(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value)
+ "Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix.
+A limited number of functions, such as quote, list, and valid object
+constructor functions are considered valid.
+Second, any text properties will be stripped from strings."
+ (cond ((consp proposed-value)
+ ;; Lists with something in them need special treatment.
+ (let ((slot-idx (eieio-slot-name-index class nil slot))
+ (type nil)
+ (classtype nil))
+ (setq slot-idx (- slot-idx 3))
+ (setq type (aref (aref (class-v class) class-public-type)
+ slot-idx))
+
+ (setq classtype (eieio-persistent-slot-type-is-class-p
+ type))
+
+ (cond ((eq (car proposed-value) 'quote)
+ (car (cdr proposed-value)))
+
+ ;; An empty list sometimes shows up as (list), which is dumb, but
+ ;; we need to support it for backward compat.
+ ((and (eq (car proposed-value) 'list)
+ (= (length proposed-value) 1))
+ nil)
+
+ ;; We have a slot with a single object that can be
+ ;; saved here. Recurse and evaluate that
+ ;; sub-object.
+ ((and classtype (class-p classtype)
+ (child-of-class-p (car proposed-value) classtype))
+ (eieio-persistent-convert-list-to-object
+ proposed-value))
+
+ ;; List of object constructors.
+ ((and (eq (car proposed-value) 'list)
+ ;; 2nd item is a list.
+ (consp (car (cdr proposed-value)))
+ ;; 1st elt of 2nd item is a class name.
+ (class-p (car (car (cdr proposed-value))))
+ )
+
+ ;; Check the value against the input class type.
+ ;; If something goes wrong, issue a smart warning
+ ;; about how a :type is needed for this to work.
+ (unless (and
+ ;; Do we have a type?
+ (consp classtype) (class-p (car classtype)))
+ (error "In save file, list of object constructors found, but no :type specified for slot %S"
+ slot))
+
+ ;; We have a predicate, but it doesn't satisfy the predicate?
+ (dolist (PV (cdr proposed-value))
+ (unless (child-of-class-p (car PV) (car classtype))
+ (error "Corrupt object on disk")))
+
+ ;; We have a list of objects here. Lets load them
+ ;; in.
+ (let ((objlist nil))
+ (dolist (subobj (cdr proposed-value))
+ (push (eieio-persistent-convert-list-to-object subobj)
+ objlist))
+ ;; return the list of objects ... reversed.
+ (nreverse objlist)))
+ (t
+ proposed-value))))
+
+ ((stringp proposed-value)
+ ;; Else, check for strings, remove properties.
+ (substring-no-properties proposed-value))
+
+ (t
+ ;; Else, just return whatever the constant was.
+ proposed-value))
+ )
+
+(defun eieio-persistent-slot-type-is-class-p (type)
+ "Return the class refered to in TYPE.
+If no class is referenced there, then return nil."
+ (cond ((class-p type)
+ ;; If the type is a class, then return it.
+ type)
+
+ ((and (symbolp type) (string-match "-child$" (symbol-name type))
+ (class-p (intern-soft (substring (symbol-name type) 0
+ (match-beginning 0)))))
+ ;; If it is the predicate ending with -child, then return
+ ;; that class. Unfortunately, in EIEIO, typep of just the
+ ;; class is the same as if we used -child, so no further work needed.
+ (intern-soft (substring (symbol-name type) 0
+ (match-beginning 0))))
+
+ ((and (symbolp type) (string-match "-list$" (symbol-name type))
+ (class-p (intern-soft (substring (symbol-name type) 0
+ (match-beginning 0)))))
+ ;; If it is the predicate ending with -list, then return
+ ;; that class and the predicate to use.
+ (cons (intern-soft (substring (symbol-name type) 0
+ (match-beginning 0)))
+ type))
+
+ ((and (consp type) (eq (car type) 'or))
+ ;; If type is a list, and is an or, it is possibly something
+ ;; like (or null myclass), so check for that.
+ (let ((ans nil))
+ (dolist (subtype (cdr type))
+ (setq ans (eieio-persistent-slot-type-is-class-p
+ subtype)))
+ ans))
+
+ (t
+ ;; No match, not a class.
+ nil)))
+
(defmethod object-write ((this eieio-persistent) &optional comment)
"Write persistent object THIS out to the current stream.
Optional argument COMMENT is a header line comment."
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index 59aeb161d8e..cab9caad108 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -332,6 +332,16 @@ Argument OBJ is the object that has been customized."
Optional argument GROUP is the sub-group of slots to display."
(eieio-customize-object obj group))
+(defvar eieio-custom-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map widget-keymap)
+ map)
+ "Keymap for EIEIO Custom mode")
+
+(define-derived-mode eieio-custom-mode fundamental-mode "EIEIO Custom"
+ "Major mode for customizing EIEIO objects.
+\\{eieio-custom-mode-map}")
+
(defmethod eieio-customize-object ((obj eieio-default-superclass)
&optional group)
"Customize OBJ in a specialized custom buffer.
@@ -347,6 +357,7 @@ These groups are specified with the `:group' slot flag."
(symbol-name g) "*")))
(setq buffer-read-only nil)
(kill-all-local-variables)
+ (eieio-custom-mode)
(erase-buffer)
(let ((all (overlay-lists)))
;; Delete all the overlays.
@@ -363,7 +374,6 @@ These groups are specified with the `:group' slot flag."
(widget-insert "\n")
(eieio-custom-object-apply-reset obj)
;; Now initialize the buffer
- (use-local-map widget-keymap)
(widget-setup)
;;(widget-minor-mode)
(goto-char (point-min))
@@ -461,8 +471,4 @@ Return the symbol for the group, or nil"
(provide 'eieio-custom)
-;; Local variables:
-;; generated-autoload-file: "eieio.el"
-;; End:
-
;;; eieio-custom.el ends here
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index b7f0deb0ee2..ec470d21bf3 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -92,12 +92,11 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
"Class: ")
;; Loop over all the public slots
(let ((publa (aref cv class-public-a))
- (publd (aref cv class-public-d))
)
(while publa
(if (slot-boundp obj (car publa))
- (let ((i (class-slot-initarg cl (car publa)))
- (v (eieio-oref obj (car publa))))
+ (let* ((i (class-slot-initarg cl (car publa)))
+ (v (eieio-oref obj (car publa))))
(data-debug-insert-thing
v prefix (concat
(if i (symbol-name i)
@@ -112,7 +111,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
" ")
'font-lock-keyword-face))
)
- (setq publa (cdr publa) publd (cdr publd))))))
+ (setq publa (cdr publa))))))
;;; Augment the Data debug thing display list.
(data-debug-add-specialized-thing (lambda (thing) (object-p thing))
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index a899839f68a..64b240b9d5d 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -4,7 +4,6 @@
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.2
;; Keywords: OO, lisp
;; Package: eieio
@@ -30,6 +29,9 @@
;;
(require 'eieio)
+(require 'button)
+(require 'help-mode)
+(require 'find-func)
;;; Code:
;;;###autoload
@@ -85,11 +87,16 @@ Optional HEADERFCN should be called to insert a few bits of info first."
(called-interactively-p 'interactive))
(when headerfcn (funcall headerfcn))
-
- (if (class-option class :abstract)
- (princ "Abstract "))
- (princ "Class ")
(prin1 class)
+ (princ " is a")
+ (if (class-option class :abstract)
+ (princ "n abstract"))
+ (princ " class")
+ ;; Print file location
+ (when (get class 'class-location)
+ (princ " in `")
+ (princ (file-name-nondirectory (get class 'class-location)))
+ (princ "'"))
(terpri)
;; Inheritance tree information
(let ((pl (class-parents class)))
@@ -251,8 +258,13 @@ Uses `eieio-describe-class' to describe the class being constructed."
(eieio-describe-class
fcn (lambda ()
;; Describe the constructor part.
- (princ "Object Constructor Function: ")
(prin1 fcn)
+ (princ " is an object constructor function")
+ ;; Print file location
+ (when (get fcn 'class-location)
+ (princ " in `")
+ (princ (file-name-nondirectory (get fcn 'class-location)))
+ (princ "'"))
(terpri)
(princ "Creates an object of class ")
(prin1 fcn)
@@ -262,6 +274,16 @@ Uses `eieio-describe-class' to describe the class being constructed."
))
)
+(defun eieio-build-class-list (class)
+ "Return a list of all classes that inherit from CLASS."
+ (if (class-p class)
+ (apply #'append
+ (mapcar
+ (lambda (c)
+ (append (list c) (eieio-build-class-list c)))
+ (class-children-fast class)))
+ (list class)))
+
(defun eieio-build-class-alist (&optional class instantiable-only buildlist)
"Return an alist of all currently active classes for completion purposes.
Optional argument CLASS is the class to start with.
@@ -270,8 +292,9 @@ are not abstract, otherwise allow all classes.
Optional argument BUILDLIST is more list to attach and is used internally."
(let* ((cc (or class eieio-default-superclass))
(sublst (aref (class-v cc) class-children)))
- (if (or (not instantiable-only) (not (class-abstract-p cc)))
- (setq buildlist (cons (cons (symbol-name cc) 1) buildlist)))
+ (unless (assoc (symbol-name cc) buildlist)
+ (when (or (not instantiable-only) (not (class-abstract-p cc)))
+ (setq buildlist (cons (cons (symbol-name cc) 1) buildlist))))
(while sublst
(setq buildlist (eieio-build-class-alist
(car sublst) instantiable-only buildlist))
@@ -342,10 +365,10 @@ Also extracts information about all methods specific to this generic."
(princ "Implementations:")
(terpri)
(terpri)
- (let ((i 3)
+ (let ((i 4)
(prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] ))
;; Loop over fanciful generics
- (while (< i 6)
+ (while (< i 7)
(let ((gm (aref (get generic 'eieio-method-tree) i)))
(when gm
(princ "Generic ")
@@ -357,8 +380,9 @@ Also extracts information about all methods specific to this generic."
(setq i (1+ i)))
(setq i 0)
;; Loop over defined class-specific methods
- (while (< i 3)
- (let ((gm (reverse (aref (get generic 'eieio-method-tree) i))))
+ (while (< i 4)
+ (let ((gm (reverse (aref (get generic 'eieio-method-tree) i)))
+ location)
(while gm
(princ "`")
(prin1 (car (car gm)))
@@ -375,6 +399,13 @@ Also extracts information about all methods specific to this generic."
;; 3 because of cdr
(princ (or (documentation (cdr (car gm)))
"Undocumented"))
+ ;; Print file location if available
+ (when (and (setq location (get generic 'method-locations))
+ (setq location (assoc (caar gm) location)))
+ (setq location (cadr location))
+ (princ "\n\nDefined in `")
+ (princ (file-name-nondirectory location))
+ (princ "'\n"))
(setq gm (cdr gm))
(terpri)
(terpri)))
@@ -554,7 +585,65 @@ Optional argument HISTORYVAR is the variable to use as history."
;;; HELP AUGMENTATION
;;
-;;;###autoload
+(define-button-type 'eieio-method-def
+ :supertype 'help-xref
+ 'help-function (lambda (class method file)
+ (eieio-help-find-method-definition class method file))
+ 'help-echo (purecopy "mouse-2, RET: find method's definition"))
+
+(define-button-type 'eieio-class-def
+ :supertype 'help-xref
+ 'help-function (lambda (class file)
+ (eieio-help-find-class-definition class file))
+ 'help-echo (purecopy "mouse-2, RET: find class definition"))
+
+(defun eieio-help-find-method-definition (class method file)
+ (let ((filename (find-library-name file))
+ location buf)
+ (when (null filename)
+ (error "Cannot find library %s" file))
+ (setq buf (find-file-noselect filename))
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (when
+ (re-search-forward
+ ;; Regexp for searching methods.
+ (concat "(defmethod[ \t\r\n]+" method
+ "\\([ \t\r\n]+:[a-zA-Z]+\\)?"
+ "[ \t\r\n]+(\\s-*(\\(\\sw\\|\\s_\\)+\\s-+"
+ class
+ "\\s-*)")
+ nil t)
+ (setq location (match-beginning 0))))
+ (if (null location)
+ (message "Unable to find location in file")
+ (pop-to-buffer buf)
+ (goto-char location)
+ (recenter)
+ (beginning-of-line))))
+
+(defun eieio-help-find-class-definition (class file)
+ (let ((filename (find-library-name file))
+ location buf)
+ (when (null filename)
+ (error "Cannot find library %s" file))
+ (setq buf (find-file-noselect filename))
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (when
+ (re-search-forward
+ ;; Regexp for searching a class.
+ (concat "(defclass[ \t\r\n]+" class "[ \t\r\n]+")
+ nil t)
+ (setq location (match-beginning 0))))
+ (if (null location)
+ (message "Unable to find location in file")
+ (pop-to-buffer buf)
+ (goto-char location)
+ (recenter)
+ (beginning-of-line))))
+
+
(defun eieio-help-mode-augmentation-maybee (&rest unused)
"For buffers thrown into help mode, augment for EIEIO.
Arguments UNUSED are not used."
@@ -597,6 +686,26 @@ Arguments UNUSED are not used."
(goto-char (point-min))
(while (re-search-forward "^\\(Private \\)?Slot:" nil t)
(put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
+ (goto-char (point-min))
+ (cond
+ ((looking-at "\\(.+\\) is a generic function")
+ (let ((mname (match-string 1))
+ cname)
+ (while (re-search-forward "^`\\(.+\\)'[^\0]+?Defined in `\\(.+\\)'" nil t)
+ (setq cname (match-string-no-properties 1))
+ (help-xref-button 2 'eieio-method-def cname
+ mname
+ (cadr (assoc (intern cname)
+ (get (intern mname)
+ 'method-locations)))))))
+ ((looking-at "\\(.+\\) is an object constructor function in `\\(.+\\)'")
+ (let ((cname (match-string-no-properties 1)))
+ (help-xref-button 2 'eieio-class-def cname
+ (get (intern cname) 'class-location))))
+ ((looking-at "\\(.+\\) is a\\(n abstract\\)? class in `\\(.+\\)'")
+ (let ((cname (match-string-no-properties 1)))
+ (help-xref-button 3 'eieio-class-def cname
+ (get (intern cname) 'class-location)))))
))))
;;; SPEEDBAR SUPPORT
@@ -698,8 +807,4 @@ INDENT is the current indentation level."
(provide 'eieio-opt)
-;; Local variables:
-;; generated-autoload-file: "eieio.el"
-;; End:
-
;;; eieio-opt.el ends here
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index f169e3f0cd2..327e5ced0e3 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -3,7 +3,6 @@
;; Copyright (C) 1999-2002, 2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.2
;; Keywords: OO, tools
;; Package: eieio
@@ -191,23 +190,24 @@ that path."
;;; DEFAULT SUPERCLASS baseline methods
;;
-;; First, define methods onto the superclass so all classes
-;; will have some minor support.
+;; First, define methods with no class defined. These will work as if
+;; on the default superclass. Specifying no class will allow these to be used
+;; when no other methods are found, allowing multiple inheritance to work
+;; reliably with eieio-speedbar.
-(defmethod eieio-speedbar-description ((object eieio-default-superclass))
+(defmethod eieio-speedbar-description (object)
"Return a string describing OBJECT."
(object-name-string object))
-(defmethod eieio-speedbar-derive-line-path ((object eieio-default-superclass))
+(defmethod eieio-speedbar-derive-line-path (object)
"Return the path which OBJECT has something to do with."
nil)
-(defmethod eieio-speedbar-object-buttonname ((object eieio-default-superclass))
+(defmethod eieio-speedbar-object-buttonname (object)
"Return a string to use as a speedbar button for OBJECT."
(object-name-string object))
-(defmethod eieio-speedbar-make-tag-line ((object eieio-default-superclass)
- depth)
+(defmethod eieio-speedbar-make-tag-line (object depth)
"Insert a tag line into speedbar at point for OBJECT.
By default, all objects appear as simple TAGS with no need to inherit from
the special `eieio-speedbar' classes. Child classes should redefine this
@@ -220,7 +220,7 @@ Argument DEPTH is the depth at which the tag line is inserted."
'speedbar-tag-face
depth))
-(defmethod eieio-speedbar-handle-click ((object eieio-default-superclass))
+(defmethod eieio-speedbar-handle-click (object)
"Handle a click action on OBJECT in speedbar.
Any object can be represented as a tag in SPEEDBAR without special
attributes. These default objects will be pulled up in a custom
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 9304f0e3918..7e64b42d9e4 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -94,21 +94,6 @@ default setting for optimization purposes.")
(defvar eieio-optimize-primary-methods-flag t
"Non-nil means to optimize the method dispatch on primary methods.")
-;; State Variables
-;; FIXME: These two constants below should have an `eieio-' prefix added!!
-(defvar this nil
- "Inside a method, this variable is the object in question.
-DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots.
-
-Note: Embedded methods are no longer supported. The variable THIS is
-still set for CLOS methods for the sake of routines like
-`call-next-method'.")
-
-(defvar scoped-class nil
- "This is set to a class when a method is running.
-This is so we know we are allowed to check private parts or how to
-execute a `call-next-method'. DO NOT SET THIS YOURSELF!")
-
(defvar eieio-initializing-object nil
"Set to non-nil while initializing an object.")
@@ -410,6 +395,7 @@ It creates an autoload function for CNAME's constructor."
(autoload cname filename doc nil nil)
(autoload (intern (concat (symbol-name cname) "-p")) filename "" nil nil)
(autoload (intern (concat (symbol-name cname) "-child-p")) filename "" nil nil)
+ (autoload (intern (concat (symbol-name cname) "-list-p")) filename "" nil nil)
))))
@@ -539,6 +525,23 @@ See `defclass' for more information."
(and (eieio-object-p obj)
(object-of-class-p obj ,cname))))
+ ;; Create a handy list of the class test too
+ (let ((csym (intern (concat (symbol-name cname) "-list-p"))))
+ (fset csym
+ `(lambda (obj)
+ ,(format
+ "Test OBJ to see if it a list of objects which are a child of type %s"
+ cname)
+ (when (listp obj)
+ (let ((ans t)) ;; nil is valid
+ ;; Loop over all the elements of the input list, test
+ ;; each to make sure it is a child of the desired object class.
+ (while (and obj ans)
+ (setq ans (and (eieio-object-p (car obj))
+ (object-of-class-p (car obj) ,cname)))
+ (setq obj (cdr obj)))
+ ans)))))
+
;; When using typep, (typep OBJ 'myclass) returns t for objects which
;; are subclasses of myclass. For our predicates, however, it is
;; important for EIEIO to be backwards compatible, where
@@ -781,6 +784,16 @@ See `defclass' for more information."
(put cname 'variable-documentation
(class-option-assoc options :documentation))
+ ;; Save the file location where this class is defined.
+ (let ((fname (if load-in-progress
+ load-file-name
+ buffer-file-name))
+ loc)
+ (when fname
+ (when (string-match "\\.elc$" fname)
+ (setq fname (substring fname 0 (1- (length fname)))))
+ (put cname 'class-location fname)))
+
;; We have a list of custom groups. Store them into the options.
(let ((g (class-option-assoc options :custom-groups)))
(mapc (lambda (cg) (add-to-list 'g cg)) groups)
@@ -1254,8 +1267,10 @@ IMPL is the symbol holding the method implementation."
(eieio-generic-call-methodname ',method)
(eieio-generic-call-arglst local-args)
)
- (apply #',impl local-args)
- ;;(,impl local-args)
+ ,(if (< emacs-major-version 24)
+ `(apply ,(list 'quote impl) local-args)
+ `(apply #',impl local-args))
+ ;(,impl local-args)
)))))))
(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
@@ -2008,13 +2023,13 @@ reverse-lookup that name, and recurse with the associated slot value."
((not (get fsym 'protection))
(+ 3 fsi))
((and (eq (get fsym 'protection) 'protected)
- scoped-class
+ (bound-and-true-p scoped-class)
(or (child-of-class-p class scoped-class)
(and (eieio-object-p obj)
(child-of-class-p class (object-class obj)))))
(+ 3 fsi))
((and (eq (get fsym 'protection) 'private)
- (or (and scoped-class
+ (or (and (bound-and-true-p scoped-class)
(eieio-slot-originating-class-p scoped-class slot))
eieio-initializing-object))
(+ 3 fsi))
@@ -2319,7 +2334,7 @@ If REPLACEMENT-ARGS is non-nil, then use them instead of
arguments passed in at the top level.
Use `next-method-p' to find out if there is a next method to call."
- (if (not scoped-class)
+ (if (not (bound-and-true-p scoped-class))
(error "`call-next-method' not called within a class specific method"))
(if (and (/= eieio-generic-call-key method-primary)
(/= eieio-generic-call-key method-static))
@@ -2403,6 +2418,18 @@ CLASS is the class this method is associated with."
(if (< key method-num-lists)
(let ((nsym (intern (symbol-name class) (aref emto key))))
(fset nsym method)))
+ ;; Save the defmethod file location in a symbol property.
+ (let ((fname (if load-in-progress
+ load-file-name
+ buffer-file-name))
+ loc)
+ (when fname
+ (when (string-match "\\.elc$" fname)
+ (setq fname (substring fname 0 (1- (length fname)))))
+ (setq loc (get method-name 'method-locations))
+ (add-to-list 'loc
+ (list class fname))
+ (put method-name 'method-locations loc)))
;; Now optimize the entire obarray
(if (< key method-num-lists)
(let ((eieiomt-optimizing-obarray (aref emto key)))
@@ -2807,9 +2834,9 @@ this object."
(princ (make-string (* eieio-print-depth 2) ? ))
(princ "(")
(princ (symbol-name (class-constructor (object-class this))))
- (princ " \"")
- (princ (object-name-string this))
- (princ "\"\n")
+ (princ " ")
+ (prin1 (object-name-string this))
+ (princ "\n")
;; Loop over all the public slots
(let ((publa (aref cv class-public-a))
(publd (aref cv class-public-d))
@@ -2876,7 +2903,6 @@ of `eq'."
)
-
;;; Obsolete backward compatibility functions.
;; Needed to run byte-code compiled with the EIEIO of Emacs-23.
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index a7916354c91..c3b8e5e10d4 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -7,18 +7,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; 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 this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index ad5e20cb8a4..ff00be7a237 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -7,18 +7,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; 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 this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 4caa0a73866..7858c183e4b 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -1,22 +1,25 @@
-;;; gv.el --- Generalized variables -*- lexical-binding: t -*-
+;;; gv.el --- generalized variables -*- lexical-binding: t -*-
;; Copyright (C) 2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions
+;; Package: emacs
-;; This program is free software; you can redistribute it and/or modify
+;; 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.
-;; This program is distributed in the hope that it will be useful,
+;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
@@ -266,7 +269,7 @@ The return value is the last VAL in the list.
;;;###autoload
(put 'gv-place 'edebug-form-spec 'edebug-match-form)
;; CL did the equivalent of:
-;;(gv-define-expand edebug-after (lambda (before index place) place))
+;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
(put 'edebug-after 'gv-expander
(lambda (do before index place)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 394225d697e..cab693fecac 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -100,17 +100,42 @@ each clause."
(error (message "Compiler-macro error for %S: %S" (car form) err)
form)))
-(defun macroexp--eval-if-compile (&rest _forms)
+(defun macroexp--funcall-if-compiled (_form)
"Pseudo function used internally by macroexp to delay warnings.
The purpose is to delay warnings to bytecomp.el, so they can use things
like `byte-compile-log-warning' to get better file-and-line-number data
and also to avoid outputting the warning during normal execution."
nil)
-(put 'macroexp--eval-if-compile 'byte-compile
+(put 'macroexp--funcall-if-compiled 'byte-compile
(lambda (form)
- (mapc (lambda (x) (funcall (eval x))) (cdr form))
+ (funcall (eval (cadr form)))
(byte-compile-constant nil)))
+(defun macroexp--warn-and-return (msg form)
+ (let ((when-compiled (lambda () (byte-compile-log-warning msg t))))
+ (cond
+ ((null msg) form)
+ ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this
+ ;; macro-expansion will be processed by the byte-compiler, we check
+ ;; circumstantial evidence.
+ ((member '(declare-function . byte-compile-macroexpand-declare-function)
+ macroexpand-all-environment)
+ `(progn
+ (macroexp--funcall-if-compiled ',when-compiled)
+ ,form))
+ (t
+ (message "%s" msg)
+ form))))
+
+(defun macroexp--obsolete-warning (fun obsolescence-data type)
+ (let ((instead (car obsolescence-data))
+ (asof (nth 2 obsolescence-data)))
+ (format "`%s' is an obsolete %s%s%s" fun type
+ (if asof (concat " (as of " asof ")") "")
+ (cond ((stringp instead) (concat "; " instead))
+ (instead (format "; use `%s' instead." instead))
+ (t ".")))))
+
(defun macroexp--expand-all (form)
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
@@ -130,9 +155,11 @@ Assumes the caller has bound `macroexpand-all-environment'."
(car-safe form)
(symbolp (car form))
(get (car form) 'byte-obsolete-info))
- `(progn (macroexp--eval-if-compile
- (lambda () (byte-compile-warn-obsolete ',(car form))))
- ,new-form)
+ (let* ((fun (car form))
+ (obsolete (get fun 'byte-obsolete-info)))
+ (macroexp--warn-and-return
+ (macroexp--obsolete-warning fun obsolete "macro")
+ new-form))
new-form)))
(pcase form
(`(cond . ,clauses)
@@ -175,26 +202,16 @@ Assumes the caller has bound `macroexpand-all-environment'."
;; First arg is a function:
(`(,(and fun (or `funcall `apply `mapcar `mapatoms `mapconcat `mapc))
',(and f `(lambda . ,_)) . ,args)
- (byte-compile-log-warning
+ (macroexp--warn-and-return
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
- t)
- ;; We don't use `macroexp--cons' since there's clearly a change.
- (cons fun
- (cons (macroexp--expand-all (list 'function f))
- (macroexp--all-forms args))))
+ (macroexp--expand-all `(,fun ,f . ,args))))
;; Second arg is a function:
(`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
- (byte-compile-log-warning
+ (macroexp--warn-and-return
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
- t)
- ;; We don't use `macroexp--cons' since there's clearly a change.
- (cons fun
- (cons (macroexp--expand-all arg1)
- (cons (macroexp--expand-all
- (list 'function f))
- (macroexp--all-forms args)))))
+ (macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
(`(,func . ,_)
;; Macro expand compiler macros. This cannot be delayed to
;; byte-optimize-form because the output of the compiler-macro can
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index 761d27a2e28..0b6fd277ae2 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -10,10 +10,10 @@
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; 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
@@ -21,9 +21,7 @@
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index b01cdbc7b8e..28d166271fb 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -9,10 +9,10 @@
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; 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
@@ -20,9 +20,7 @@
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Change Log:
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 09e47b69b91..1312fc3731d 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -517,6 +517,10 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--self-quoting-p (upat)
(or (keywordp upat) (numberp upat) (stringp upat)))
+(defsubst pcase--mark-used (sym)
+ ;; Exceptionally, `sym' may be a constant expression rather than a symbol.
+ (if (symbolp sym) (put sym 'pcase-used t)))
+
;; It's very tempting to use `pcase' below, tho obviously, it'd create
;; bootstrapping problems.
(defun pcase--u1 (matches code vars rest)
@@ -581,7 +585,7 @@ Otherwise, it defers to REST which is a list of branches of the form
((memq upat '(t _)) (pcase--u1 matches code vars rest))
((eq upat 'pcase--dontcare) :pcase--dontcare)
((memq (car-safe upat) '(guard pred))
- (if (eq (car upat) 'pred) (put sym 'pcase-used t))
+ (if (eq (car upat) 'pred) (pcase--mark-used sym))
(let* ((splitrest
(pcase--split-rest
sym (lambda (pat) (pcase--split-pred upat pat)) rest))
@@ -614,10 +618,10 @@ Otherwise, it defers to REST which is a list of branches of the form
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest))))
((pcase--self-quoting-p upat)
- (put sym 'pcase-used t)
+ (pcase--mark-used sym)
(pcase--q1 sym upat matches code vars rest))
((symbolp upat)
- (put sym 'pcase-used t)
+ (pcase--mark-used sym)
(if (not (assq upat vars))
(pcase--u1 matches code (cons (cons upat sym) vars) rest)
;; Non-linear pattern. Turn it into an `eq' test.
@@ -640,7 +644,7 @@ Otherwise, it defers to REST which is a list of branches of the form
(pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
code vars rest)))
((eq (car-safe upat) '\`)
- (put sym 'pcase-used t)
+ (pcase--mark-used sym)
(pcase--q1 sym (cadr upat) matches code vars rest))
((eq (car-safe upat) 'or)
(let ((all (> (length (cdr upat)) 1))
@@ -662,7 +666,7 @@ Otherwise, it defers to REST which is a list of branches of the form
sym (lambda (pat) (pcase--split-member elems pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
- (put sym 'pcase-used t)
+ (pcase--mark-used sym)
(pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest)))
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index 286c4937b5b..bceec296ad8 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -158,8 +158,14 @@ See the documentation for `list-load-path-shadows' for further information."
(eq 0 (call-process "cmp" nil nil nil "-s" f1 f2))))))))
(defvar load-path-shadows-font-lock-keywords
+ ;; The idea is that shadows of files supplied with Emacs are more
+ ;; serious than various versions of external packages shadowing each
+ ;; other.
`((,(format "hides \\(%s.*\\)"
- (file-name-directory (locate-library "simple.el")))
+ (file-name-directory
+ (or (locate-library "simple")
+ (file-name-as-directory
+ (expand-file-name "../lisp" data-directory)))))
. (1 font-lock-warning-face)))
"Keywords to highlight in `load-path-shadows-mode'.")
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index a56a7619ea9..8aa722521eb 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -7,10 +7,10 @@
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; 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
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 3999529f7ac..5fdc8c55a85 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -270,9 +270,9 @@ value, 'maybe if either is acceptable."
(setq id (nth 2 form))
(setcdr form (nthcdr 2 form))
(setq val (testcover-reinstrument (nth 2 form)))
- (if (eq val t)
- (setcar form 'testcover-1value)
- (setcar form 'testcover-after))
+ (setcar form (if (eq val t)
+ 'testcover-1value
+ 'testcover-after))
(when val
;;1-valued or potentially 1-valued
(aset testcover-vector id '1value))
@@ -359,9 +359,9 @@ value, 'maybe if either is acceptable."
,(nth 3 (cadr form))))
t)
(t
- (if (eq (car (cadr form)) 'edebug-after)
- (setq id (car (nth 3 (cadr form))))
- (setq id (car (cadr form))))
+ (setq id (car (if (eq (car (cadr form)) 'edebug-after)
+ (nth 3 (cadr form))
+ (cadr form))))
(let ((testcover-1value-functions
(cons id testcover-1value-functions)))
(testcover-reinstrument (cadr form))))))
@@ -379,9 +379,9 @@ value, 'maybe if either is acceptable."
,(nth 3 (cadr form))))
'maybe)
(t
- (if (eq (car (cadr form)) 'edebug-after)
- (setq id (car (nth 3 (cadr form))))
- (setq id (car (cadr form))))
+ (setq id (car (if (eq (car (cadr form)) 'edebug-after)
+ (nth 3 (cadr form))
+ (cadr form))))
(let ((testcover-noreturn-functions
(cons id testcover-noreturn-functions)))
(testcover-reinstrument (cadr form))))))
@@ -447,6 +447,12 @@ binding `testcover-vector' to the code-coverage vector for TESTCOVER-SYM
(defun testcover-after (idx val)
"Internal function for coverage testing. Returns VAL after installing it in
`testcover-vector' at offset IDX."
+ (declare (gv-expander (lambda (do)
+ (gv-letplace (getter setter) val
+ (funcall do getter
+ (lambda (store)
+ `(progn (testcover-after ,idx ,getter)
+ ,(funcall setter store))))))))
(cond
((eq (aref testcover-vector idx) 'unknown)
(aset testcover-vector idx val))
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 2248dde8c03..284c591fc61 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -146,14 +146,13 @@ TIME must be in the internal format returned by, e.g., `current-time'.
The microsecond count from TIME is ignored, and USECS is used instead.
If optional fourth argument DELTA is a positive number, make the timer
fire repeatedly that many seconds apart."
+ (declare (obsolete "use `timer-set-time' and `timer-inc-time' instead."
+ "22.1"))
(setf (timer--time timer) time)
(setf (timer--usecs timer) usecs)
(setf (timer--psecs timer) 0)
(setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta))
timer)
-(make-obsolete 'timer-set-time-with-usecs
- "use `timer-set-time' and `timer-inc-time' instead."
- "22.1")
(defun timer-set-function (timer function &optional args)
"Make TIMER call FUNCTION with optional ARGS when triggering."
@@ -205,12 +204,19 @@ timers). If nil, allocate a new cell."
"Insert TIMER into `timer-idle-list'.
This arranges to activate TIMER whenever Emacs is next idle.
If optional argument DONT-WAIT is non-nil, set TIMER to activate
-immediately, or at the right time, if Emacs is already idle.
+immediately \(see below\), or at the right time, if Emacs is
+already idle.
REUSE-CELL, if non-nil, is a cons cell to reuse when inserting
TIMER into `timer-idle-list' (usually a cell removed from that
list by `cancel-timer-internal'; using this reduces consing for
-repeat timers). If nil, allocate a new cell."
+repeat timers). If nil, allocate a new cell.
+
+Using non-nil DONT-WAIT is not recommended when activating an
+idle timer from an idle timer handler, if the timer being
+activated has an idleness time that is smaller or equal to
+the time of the current timer. That's because the activated
+timer will fire right away."
(timer--activate timer (not dont-wait) reuse-cell 'idle))
(defalias 'disable-timeout 'cancel-timer)
@@ -403,7 +409,9 @@ The action is to call FUNCTION with arguments ARGS.
SECS may be an integer, a floating point number, or the internal
time format returned by, e.g., `current-idle-time'.
If Emacs is currently idle, and has been idle for N seconds (N < SECS),
-then it will call FUNCTION in SECS - N seconds from now.
+then it will call FUNCTION in SECS - N seconds from now. Using
+SECS <= N is not recommended if this function is invoked from an idle
+timer, because FUNCTION will then be called immediately.
If REPEAT is non-nil, do the action each time Emacs has been idle for
exactly SECS seconds (that is, only once for each time Emacs becomes idle).
@@ -442,7 +450,7 @@ be detected.
(with-timeout-timers
(cons -with-timeout-timer- with-timeout-timers)))
(unwind-protect
- ,@body
+ (progn ,@body)
(cancel-timer -with-timeout-timer-))))))
;; It is tempting to avoid the `if' altogether and instead run
;; timeout-forms in the timer, just before throwing `timeout'.
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index 5343d499efb..b20ec13fa81 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -249,9 +249,9 @@ Other values are interpreted as usual."
(defun toggle-emacs-lock ()
"Toggle `emacs-lock-from-exiting' for the current buffer."
+ (declare (obsolete emacs-lock-mode "24.1"))
(interactive)
(call-interactively 'emacs-lock-mode))
-(make-obsolete 'toggle-emacs-lock 'emacs-lock-mode "24.1")
(provide 'emacs-lock)
diff --git a/lisp/emulation/crisp.el b/lisp/emulation/crisp.el
index c9822b7ec27..01d202f87b5 100644
--- a/lisp/emulation/crisp.el
+++ b/lisp/emulation/crisp.el
@@ -171,14 +171,14 @@
All the bindings are done here instead of globally to try and be
nice to the world.")
+(define-obsolete-variable-alias 'crisp-mode-modeline-string
+ 'crisp-mode-mode-line-string "24.3")
+
(defcustom crisp-mode-mode-line-string " *CRiSP*"
"String to display in the mode line when CRiSP emulation mode is enabled."
:type 'string
:group 'crisp)
-(define-obsolete-variable-alias 'crisp-mode-modeline-string
- 'crisp-mode-mode-line-string "24.3")
-
;;;###autoload
(defcustom crisp-mode nil
"Track status of CRiSP emulation mode.
diff --git a/lisp/epa.el b/lisp/epa.el
index b796f5fa77c..ecc27c4d299 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -585,8 +585,8 @@ If SECRET is non-nil, list secret keys instead of public keys."
(message "%s" info)))
(defun epa-display-verify-result (verify-result)
+ (declare (obsolete epa-display-info "23.1"))
(epa-display-info (epg-verify-result-to-string verify-result)))
-(make-obsolete 'epa-display-verify-result 'epa-display-info "23.1")
(defun epa-passphrase-callback-function (context key-id handback)
(if (eq key-id 'SYM)
diff --git a/lisp/epg.el b/lisp/epg.el
index 6529afb2d3c..b0e01bc3721 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1779,6 +1779,7 @@ This function is for internal use only."
(epg-context-set-result-for context 'import-status nil)))
(defun epg-passphrase-callback-function (context key-id _handback)
+ (declare (obsolete epa-passphrase-callback-function "23.1"))
(if (eq key-id 'SYM)
(read-passwd "Passphrase for symmetric encryption: "
(eq (epg-context-operation context) 'encrypt))
@@ -1790,9 +1791,6 @@ This function is for internal use only."
(format "Passphrase for %s %s: " key-id (cdr entry))
(format "Passphrase for %s: " key-id)))))))
-(make-obsolete 'epg-passphrase-callback-function
- 'epa-passphrase-callback-function "23.1")
-
(defun epg--list-keys-1 (context name mode)
(let ((args (append (if epg-gpg-home-directory
(list "--homedir" epg-gpg-home-directory))
@@ -2562,6 +2560,7 @@ If you use this function, you will need to wait for the completion of
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-sign-keys' instead."
+ (declare (obsolete nil "23.1"))
(epg-context-set-operation context 'sign-keys)
(epg-context-set-result context nil)
(epg--start context (cons (if local
@@ -2572,10 +2571,10 @@ If you are unsure, use synchronous version of this function
(epg-sub-key-id
(car (epg-key-sub-key-list key))))
keys))))
-(make-obsolete 'epg-start-sign-keys "do not use." "23.1")
(defun epg-sign-keys (context keys &optional local)
"Sign KEYS from the key ring."
+ (declare (obsolete nil "23.1"))
(unwind-protect
(progn
(epg-start-sign-keys context keys local)
@@ -2586,7 +2585,6 @@ If you are unsure, use synchronous version of this function
(list "Sign keys failed"
(epg-errors-to-string errors))))))
(epg-reset context)))
-(make-obsolete 'epg-sign-keys "do not use." "23.1")
(defun epg-start-generate-key (context parameters)
"Initiate a key generation.
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index 674a6c97eec..8b4df6099bc 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,7 +1,39 @@
-2012-09-17 Chong Yidong <cyd@gnu.org>
+2012-10-07 Deniz Dogan <deniz@dogan.se>
+
+ * erc-log.el (erc-generate-log-file-name-function):
+ Clarify tags for various choices. (Bug#11186)
+
+2012-10-07 Glenn Morris <rgm@gnu.org>
+
+ * erc-button.el (erc-button-alist): Remove "finger". (Bug#4443)
+
+2012-10-07 Antoine Levitt <antoine.levitt@gmail.com>
+
+ * erc-stamp.el (erc-format-timestamp): Don't apply intangible
+ property to invisible stamps. (Bug#11706)
+
+2012-10-07 Glenn Morris <rgm@gnu.org>
+
+ * erc-backend.el (NICK): Handle pre-existing buffers. (Bug#12002)
- * erc-page.el (erc-page-function):
+2012-10-06 Glenn Morris <rgm@gnu.org>
+
+ * erc.el (erc-lurker):
+ * erc-desktop-notifications.el (erc-notifications):
+ Add missing group :version tags.
+
+2012-10-04 Julien Danjou <julien@danjou.info>
+
+ * erc-desktop-notifications.el: Rename from erc-notifications to
+ avoid clash with 8+3 filename format and erc-notify.el.
+
+2012-09-25 Chong Yidong <cyd@gnu.org>
+
+ * erc.el (erc-send-command): Use define-obsolete-function-alias.
+
+2012-09-17 Chong Yidong <cyd@gnu.org>
+ * erc-page.el (erc-page-function):
* erc-stamp.el (erc-stamp): Doc fix.
2012-08-21 Josh Feinstein <jlf@foxtail.org>
@@ -94,7 +126,7 @@
(erc-autojoin-after-ident): Ditto.
(erc-autojoin-channels-alist): Mention auth-source.
-2012-04-10 Deniz Dogan <deniz@dogan.se> (tiny change)
+2012-04-10 Deniz Dogan <deniz@dogan.se>
* erc.el (erc-display-prompt): Adds the field text property to the
ERC prompt. This allows users to use `kill-whole-line' to kill
diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el
index ab429a12589..fd9ac69aa3a 100644
--- a/lisp/erc/erc-autoaway.el
+++ b/lisp/erc/erc-autoaway.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
+;; Maintainer: FSF
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcAutoAway
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 5da3009c854..20ccd071b95 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -4,6 +4,7 @@
;; Filename: erc-backend.el
;; Author: Lawrence Mitchell <wence@gmx.li>
+;; Maintainer: FSF
;; Created: 2004-05-7
;; Keywords: IRC chat client internet
@@ -1315,7 +1316,7 @@ add things to `%s' instead."
(when (equal (erc-default-target) nick)
(setq erc-default-recipients
(cons nn (cdr erc-default-recipients)))
- (rename-buffer nn)
+ (rename-buffer nn t) ; bug#12002
(erc-update-mode-line)
(add-to-list 'bufs (current-buffer)))))
(erc-update-user-nick nick nn host nil nil login)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index a0593dcb743..433ffc05340 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -3,6 +3,7 @@
;; Copyright (C) 1996-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
+;; Maintainer: FSF
;; Keywords: irc, button, url, regexp
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcButton
@@ -134,7 +135,7 @@ longer than `erc-fill-column'."
'(('nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
(erc-button-url-regexp 0 t browse-url 0)
("<URL: *\\([^<> ]+\\) *>" 0 t browse-url 1)
- ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
+;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
;; emacs internal
("[`]\\([a-zA-Z][-a-zA-Z_0-9]+\\)[']" 1 t erc-button-describe-symbol 1)
;; pseudo links
@@ -182,6 +183,7 @@ PAR is a number of a regexp grouping whose text will be passed to
'nicknames, these are ignored, and CALLBACK will be called with
the nickname matched as the argument."
:group 'erc-button
+ :version "24.3" ; remove finger (bug#4443)
:type '(repeat
(list :tag "Button"
(choice :tag "Matches"
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index c7103d6dc61..08b9c67f6c0 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -2,6 +2,10 @@
;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
+;; Maintainer: FSF
+
+; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 1fb3930091e..1e299407fe9 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2003, 2005-2012 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
+;; Maintainer: FSF
;; URL: http://www.emacswiki.org/cgi-bin/wiki/ERC
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 4d0534d3d5e..ed8440315eb 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -6,7 +6,7 @@
;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
;; Noah Friedman <friedman@prep.ai.mit.edu>
;; Per Persson <pp@sno.pp.se>
-;; Maintainer: mlang@delysid.org
+;; Maintainer: FSF
;; Keywords: comm, processes
;; Created: 1994-01-23
diff --git a/lisp/erc/erc-notifications.el b/lisp/erc/erc-desktop-notifications.el
index 4faffc913c5..2cc3c80a8ea 100644
--- a/lisp/erc/erc-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -1,4 +1,4 @@
-;; erc-notifications.el -- Send notification on PRIVMSG or mentions
+;; erc-desktop-notifications.el -- Send notification on PRIVMSG or mentions
;; Copyright (C) 2012 Free Software Foundation, Inc.
@@ -35,6 +35,7 @@
(defgroup erc-notifications nil
"Send notifications on PRIVMSG or mentions."
+ :version "24.3"
:group 'erc)
(defvar erc-notifications-last-notification nil
@@ -75,7 +76,7 @@ This will replace the last notification sent with this function."
(member nick erc-track-exclude)))
(erc-notifications-notify nick msg)))))
-;;;###autoload(autoload 'erc-notifications-mode "erc-notifications" "" t)
+;;;###autoload(autoload 'erc-notifications-mode "erc-desktop-notifications" "" t)
(define-erc-module notifications nil
"Send notifications on private message reception and mentions."
;; Enable
@@ -85,6 +86,6 @@ This will replace the last notification sent with this function."
((remove-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG)
(remove-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match)))
-(provide 'erc-notifications)
+(provide 'erc-desktop-notifications)
-;;; erc-notifications.el ends here
+;;; erc-desktop-notifications.el ends here
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el
index f40eaa8c549..5e5d6c2c188 100644
--- a/lisp/erc/erc-ezbounce.el
+++ b/lisp/erc/erc-ezbounce.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002, 2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
+;; Maintainer: FSF
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 2422ca10d0a..35e14eb0e29 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -4,6 +4,7 @@
;; Author: Andreas Fuchs <asf@void.at>
;; Mario Lang <mlang@delysid.org>
+;; Maintainer: FSF
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcFilling
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 49820b78ff6..892f82e2eba 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
+;; Maintainer: FSF
;; Most code is taken verbatim from erc.el, see there for the original
;; authors.
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index 1a713009c85..d1e74fd4c54 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002, 2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
+;; Maintainer: FSF
;; Keywords: comm
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcIbuffer
diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el
index aee808c0921..9586dd698a0 100644
--- a/lisp/erc/erc-identd.el
+++ b/lisp/erc/erc-identd.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2003, 2006-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
+;; Maintainer: FSF
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el
index 53dc9e7abf2..7346fca1b8a 100644
--- a/lisp/erc/erc-imenu.el
+++ b/lisp/erc/erc-imenu.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2001-2002, 2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
+;; Maintainer: FSF
;; Keywords: comm
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcImenu
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index ae7f90003a6..ac6b311a0c4 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
+;; Maintainer: FSF
;; Keywords: irc
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcAutoJoin
diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el
index 11384a25885..2d7f555971e 100644
--- a/lisp/erc/erc-lang.el
+++ b/lisp/erc/erc-lang.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002, 2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Alex Schroeder <alex@gnu.org>
+;; Maintainer: FSF
;; Version: 1.0.0
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcLang
;; Keywords: comm languages processes
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el
index f7d33ffbc28..19afe2e79ee 100644
--- a/lisp/erc/erc-list.el
+++ b/lisp/erc/erc-list.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
+;; Maintainer: FSF
;; Version: 0.1
;; Keywords: comm
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index eefe51ae706..b3f3f5865a1 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Lawrence Mitchell <wence@gmx.li>
+;; Maintainer: FSF
;; Keywords: IRC, chat, client, Internet, logging
;; Created 2003-04-26
@@ -113,11 +114,13 @@ If you want to write logs into different directories, make a
custom function which returns the directory part and set
`erc-log-channels-directory' to its name."
:group 'erc-log
- :type '(choice (const :tag "Long style" erc-generate-log-file-name-long)
- (const :tag "Long, but with network name rather than server"
+ :type '(choice (const :tag "#channel!nick@server:port.txt"
+ erc-generate-log-file-name-long)
+ (const :tag "#channel!nick@network.txt"
erc-generate-log-file-name-network)
- (const :tag "Short" erc-generate-log-file-name-short)
- (const :tag "With date" erc-generate-log-file-name-with-date)
+ (const :tag "#channel.txt" erc-generate-log-file-name-short)
+ (const :tag "#channel@date.txt"
+ erc-generate-log-file-name-with-date)
(function :tag "Other function")))
(defcustom erc-truncate-buffer-on-save nil
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index de7f2137197..8dcdcb9e2e6 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
+;; Maintainer: FSF
;; Keywords: comm, faces
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcMatch
diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el
index 5d96fc4d487..1aec2ad417f 100644
--- a/lisp/erc/erc-menu.el
+++ b/lisp/erc/erc-menu.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2001-2002, 2004-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
+;; Maintainer: FSF
;; Keywords: comm, processes, menu
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el
index 355b345492c..fc4aeb10c84 100644
--- a/lisp/erc/erc-netsplit.el
+++ b/lisp/erc/erc-netsplit.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
+;; Maintainer: FSF
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 9a3c562f0a6..89372555ccc 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002, 2004-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@lexx.delysid.org>
+;; Maintainer: FSF
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index 3bf82c13f19..0b5e99180d6 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@lexx.delysid.org>
+;; Maintainer: FSF
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el
index 51ddc33e1c0..8eae6c83d15 100644
--- a/lisp/erc/erc-page.el
+++ b/lisp/erc/erc-page.el
@@ -2,6 +2,8 @@
;; Copyright (C) 2002, 2004, 2006-2012 Free Software Foundation, Inc.
+;; Maintainer: FSF
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index d3cbe8a5804..bb30fd90066 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Sacha Chua <sacha@free.net.ph>
+;; Maintainer: FSF
;; Keywords: comm, convenience
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el
index 6c5804c62a4..3d4a5d311b1 100644
--- a/lisp/erc/erc-replace.el
+++ b/lisp/erc/erc-replace.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2001-2002, 2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
-;; Maintainer: Mario Lang (mlang@delysid.org)
+;; Maintainer: FSF
;; Keywords: IRC, client, Internet
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el
index 94af8a09200..6b3f3e3c3aa 100644
--- a/lisp/erc/erc-ring.el
+++ b/lisp/erc/erc-ring.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2001-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
+;; Maintainer: FSF
;; Keywords: comm
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcHistory
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 5986d81efed..b3b80a5f851 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -2,6 +2,8 @@
;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc.
+;; Maintainer: FSF
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el
index 8b44cb5146c..55336a68cfe 100644
--- a/lisp/erc/erc-sound.el
+++ b/lisp/erc/erc-sound.el
@@ -2,6 +2,8 @@
;; Copyright (C) 2002-2003, 2006-2012 Free Software Foundation, Inc.
+;; Maintainer: FSF
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index 1e028e22642..4b98cf173be 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -4,6 +4,7 @@
;; Author: Mario Lang <mlang@delysid.org>
;; Contributor: Eric M. Ludlam <eric@siege-engine.com>
+;; Maintainer: FSF
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el
index 441e3536e19..5f40cc39e89 100644
--- a/lisp/erc/erc-spelling.el
+++ b/lisp/erc/erc-spelling.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
+;; Maintainer: FSF
;; Keywords: irc
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcSpelling
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 4ce2f18e041..4fa3f9f5915 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
+;; Maintainer: FSF
;; Keywords: comm, processes, timestamp
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcStamp
@@ -352,8 +353,9 @@ Return the empty string if FORMAT is nil."
'isearch-open-invisible 'timestamp ts)
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
- (when erc-timestamp-intangible
- (erc-put-text-property 0 (length ts) 'intangible t ts))
+ (and erc-timestamp-intangible
+ (not erc-hide-timestamps) ; bug#11706
+ (erc-put-text-property 0 (length ts) 'intangible t ts))
ts)
""))
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 88a3285730d..a204584b400 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
+;; Maintainer: FSF
;; Keywords: comm, faces
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcChannelTracking
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index dd47c601ea8..8a219500ecb 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2003-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
+;; Maintainer: FSF
;; Keywords: IRC, chat, client, Internet, logging
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el
index 0328c407aa0..85356b39033 100644
--- a/lisp/erc/erc-xdcc.el
+++ b/lisp/erc/erc-xdcc.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2003-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
+;; Maintainer: FSF
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index feef75940f3..bbd9dad4310 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -9,7 +9,7 @@
;; Andreas Fuchs (afs@void.at)
;; Gergely Nagy (algernon@midgard.debian.net)
;; David Edmondson (dme@dme.org)
-;; Maintainer: Michael Olson (mwolson@gnu.org)
+;; Maintainer: FSF
;; Keywords: IRC, chat, client, Internet
;; Version: 5.3
@@ -102,6 +102,7 @@
(defgroup erc-lurker nil
"Hide specified message types sent by lurkers"
+ :version "24.3"
:group 'erc-ignore)
(defgroup erc-query nil
@@ -139,8 +140,8 @@
(message (concat "ERC: The function `defvaralias' is not bound. See the "
"NEWS file for variable name changes since ERC 5.0.4.")))
-(defalias 'erc-send-command 'erc-server-send)
-(erc-make-obsolete 'erc-send-command 'erc-server-send "ERC 5.1")
+(define-obsolete-function-alias 'erc-send-command
+ 'erc-server-send "ERC 5.1")
;; tunable connection and authentication parameters
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
index 37fa939cc10..ef59f6d1d35 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -63,10 +63,13 @@ which commands are considered visual in nature."
:type '(repeat string)
:group 'eshell-term)
-(defcustom eshell-term-name "eterm"
+;; If you change this from term-term-name, you need to ensure that the
+;; value you choose exists in the system's terminfo database. (Bug#12485)
+(defcustom eshell-term-name term-term-name
"Name to use for the TERM variable when running visual commands.
See `term-term-name' in term.el for more information on how this is
used."
+ :version "24.3" ; eterm -> term-term-name = eterm-color
:type 'string
:group 'eshell-term)
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 515a23f81d7..5a10721387b 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -1216,11 +1216,12 @@ COMMAND may result in an alias being executed, or a plain command."
(let* ((sym (intern-soft (concat "eshell/" name)))
(file (symbol-file sym 'defun)))
;; If the function exists, but is defined in an eshell module
- ;; that's not currently enabled, don't report it as found
+ ;; that's not currently enabled, don't report it as found.
(if (and file
- (string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file))
+ (setq file (file-name-base file))
+ (string-match "\\`\\(em\\|esh\\)-\\([[:alnum:]]+\\)\\'" file))
(let ((module-sym
- (intern (file-name-base (concat "eshell-" (match-string 2 file))))))
+ (intern (concat "eshell-" (match-string 2 file)))))
(if (and (functionp sym)
(or (null module-sym)
(eshell-using-module module-sym)
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 8a9107e5470..673632400f2 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -193,14 +193,14 @@ This is used by `eshell-watch-for-password-prompt'."
:type '(choice (const nil) function)
:group 'eshell-mode)
+(define-obsolete-variable-alias 'eshell-status-in-modeline
+ 'eshell-status-in-mode-line "24.3")
+
(defcustom eshell-status-in-mode-line t
"If non-nil, let the user know a command is running in the mode line."
:type 'boolean
:group 'eshell-mode)
-(define-obsolete-variable-alias 'eshell-status-in-modeline
- 'eshell-status-in-mode-line "24.3")
-
(defvar eshell-first-time-p t
"A variable which is non-nil the first time Eshell is loaded.")
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index fa0336232f9..01df5fced62 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -275,6 +275,7 @@ Prepend remote identification of `default-directory', if any."
(defmacro eshell-for (for-var for-list &rest forms)
"Iterate through a list."
+ (declare (obsolete dolist "24.1"))
(declare (indent 2))
`(let ((list-iter ,for-list))
(while list-iter
@@ -282,9 +283,6 @@ Prepend remote identification of `default-directory', if any."
,@forms)
(setq list-iter (cdr list-iter)))))
-
-(make-obsolete 'eshell-for 'dolist "24.1")
-
(defun eshell-flatten-list (args)
"Flatten any lists within ARGS, so that there are no sublists."
(let ((new-list (list t)))
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index c663de3f40d..a9a854221a4 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -243,16 +243,14 @@ shells such as bash, zsh, rc, 4dos."
(defun eshell-add-to-window-buffer-names ()
"Add `eshell-buffer-name' to `same-window-buffer-names'."
+ (declare (obsolete nil "24.3"))
(add-to-list 'same-window-buffer-names eshell-buffer-name))
-(make-obsolete 'eshell-add-to-window-buffer-names
- "no longer needed." "24.3")
(defun eshell-remove-from-window-buffer-names ()
"Remove `eshell-buffer-name' from `same-window-buffer-names'."
+ (declare (obsolete nil "24.3"))
(setq same-window-buffer-names
(delete eshell-buffer-name same-window-buffer-names)))
-(make-obsolete 'eshell-remove-from-window-buffer-names
- "no longer needed." "24.3")
(defcustom eshell-load-hook nil
"A hook run once Eshell has been loaded."
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index bcef25eb893..88b9ddc7f54 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -464,7 +464,8 @@ These special properties include `invisible', `intangible' and `read-only'."
`(rgb-dist . COLOR)' sorts by the RGB distance to the specified color.
`hsv' sorts by hue, saturation, value.
`(hsv-dist . COLOR)' sorts by the HSV distance to the specified color
-and excludes grayscale colors."
+and excludes grayscale colors.
+`luminance' sorts by relative luminance in the CIE XYZ color space."
:type '(choice (const :tag "Unsorted" nil)
(const :tag "Color Name" name)
(const :tag "Red-Green-Blue" rgb)
@@ -474,7 +475,8 @@ and excludes grayscale colors."
(const :tag "Hue-Saturation-Value" hsv)
(cons :tag "Distance on HSV cylinder"
(const :tag "Distance from Color" hsv-dist)
- (color :tag "Source Color Name")))
+ (color :tag "Source Color Name"))
+ (const :tag "Luminance" luminance))
:group 'facemenu
:version "24.1")
@@ -504,7 +506,12 @@ filter out the color from the output."
(+ (expt (- 180 (abs (- 180 (abs (- (nth 0 c-hsv) ; wrap hue
(nth 0 o-hsv)))))) 2)
(expt (- (nth 1 c-hsv) (nth 1 o-hsv)) 2)
- (expt (- (nth 2 c-hsv) (nth 2 o-hsv)) 2)))))))
+ (expt (- (nth 2 c-hsv) (nth 2 o-hsv)) 2)))))
+ ((eq list-colors-sort 'luminance)
+ (let ((c-rgb (color-name-to-rgb color)))
+ (+ (* (nth 0 c-rgb) 0.21266729)
+ (* (nth 1 c-rgb) 0.7151522)
+ (* (nth 2 c-rgb) 0.0721750))))))
(defun list-colors-display (&optional list buffer-name callback)
"Display names of defined colors, and show what they look like.
diff --git a/lisp/faces.el b/lisp/faces.el
index d004ae650cb..08aa800c067 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1867,6 +1867,7 @@ Return nil if it has no specified face."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare-function x-parse-geometry "frame.c" (string))
+(defvar x-display-name)
(defun x-handle-named-frame-geometry (parameters)
"Add geometry parameters for a named frame to parameter list PARAMETERS.
@@ -2271,8 +2272,6 @@ terminal type to a different value."
:version "21.1"
:group 'mode-line-faces
:group 'basic-faces)
-;; No need to define aliases of this form for new faces.
-(define-obsolete-face-alias 'modeline 'mode-line "21.1")
(defface mode-line-inactive
'((default
diff --git a/lisp/files.el b/lisp/files.el
index 289f5c6b0b6..e030aff0ae2 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -22,7 +22,7 @@
;;; Commentary:
-;; Defines most of Emacs'ss file- and directory-handling functions,
+;; Defines most of Emacs's file- and directory-handling functions,
;; including basic file visiting, backup generation, link handling,
;; ITS-id version control, load- and write-hook handling, and the like.
@@ -821,10 +821,10 @@ one or more of those symbols."
(defun locate-file-completion (string path-and-suffixes action)
"Do completion for file names passed to `locate-file'.
PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
+ (declare (obsolete locate-file-completion-table "23.1"))
(locate-file-completion-table (car path-and-suffixes)
(cdr path-and-suffixes)
string nil action))
-(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1")
(defvar locate-dominating-stop-dir-regexp
(purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'")
@@ -2326,6 +2326,8 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
("\\.js\\'" . javascript-mode)
("\\.json\\'" . javascript-mode)
("\\.[ds]?vh?\\'" . verilog-mode)
+ ("\\.by\\'" . bovine-grammar-mode)
+ ("\\.wy\\'" . wisent-grammar-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
@@ -6714,7 +6716,7 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
(define-key ctl-x-map "\C-c" 'save-buffers-kill-terminal)
-(define-key ctl-x-map "\C-q" 'toggle-read-only)
+(define-key ctl-x-map "\C-q" 'read-only-mode)
(define-key ctl-x-4-map "f" 'find-file-other-window)
(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 6404af7703a..78760c015ff 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -340,8 +340,8 @@ This can be an \"!\" or the \"n\" in \"ifndef\".")
(defvar font-lock-preprocessor-face 'font-lock-preprocessor-face
"Face name to use for preprocessor directives.")
-(defvar font-lock-reference-face 'font-lock-constant-face)
-(make-obsolete-variable 'font-lock-reference-face 'font-lock-constant-face "20.3")
+(define-obsolete-variable-alias
+ 'font-lock-reference-face 'font-lock-constant-face "20.3")
;; Fontification variables:
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index a97c5649c95..ce1599b9010 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1531,15 +1531,15 @@ like an INI file. You can add this hook to `find-file-hook'."
'("#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)"
1 font-lock-string-face)
'("#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
- (1 font-lock-reference-face)
+ (1 font-lock-constant-face)
(2 font-lock-variable-name-face nil t))
;; indirect string constants
'("\\(@[A-Za-z][A-Za-z0-9_]+\\)" 1 font-lock-builtin-face)
;; gotos
- '("[ \t]*\\(\\sw+:\\)" 1 font-lock-reference-face)
+ '("[ \t]*\\(\\sw+:\\)" 1 font-lock-constant-face)
'("\\<\\(goto\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-keyword-face)
- (2 font-lock-reference-face nil t))
+ (2 font-lock-constant-face nil t))
;; system variables
(generic-make-keywords-list
installshield-system-variables-list
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 69f0025b524..f79353ebfb3 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,28 @@
+2012-10-06 Glenn Morris <rgm@gnu.org>
+
+ * gnus-notifications.el (gnus-notifications):
+ Add missing group :version tag.
+ * gnus-msg.el (gnus-gcc-pre-body-encode-hook)
+ (gnus-gcc-post-body-encode-hook):
+ * gnus-sync.el (gnus-sync-lesync-name)
+ (gnus-sync-lesync-install-topics): Add missing custom :version tags.
+
+2012-09-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-delete-temp-files): Never ask again
+ a user about whether to delete temp files if once a user answered as n.
+
+2012-09-17 Richard Stallman <rms@gnu.org>
+
+ * message.el (message-in-body-p): Don't set mark or modify buffer.
+
+ * mml.el (mml-attach-file): Doc fix.
+ (mml-attach-external, mml-attach-buffer, mml-attach-file):
+ Set mail-encode-mml when in Mail mode.
+ Simplify code to set HEAD and move back to HEAD.
+ (mml-insert-multipart, mml-insert-part):
+ Set mail-encode-mml when in Mail mode.
+
2012-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-util.el (gnus-timer--function): New function.
diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2
index 5a3612c4d1c..e75506956bb 100644
--- a/lisp/gnus/ChangeLog.2
+++ b/lisp/gnus/ChangeLog.2
@@ -11974,7 +11974,7 @@
2001-12-18 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el:
+ * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el:
* gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el:
* mml1991.el, nnultimate.el: Add `coding'.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 7dcbd61316f..6c827e070cb 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2760,11 +2760,12 @@ summary buffer."
(or how (setq how gnus-article-browse-delete-temp))
(if (eq how 'ask)
(let ((files (length gnus-article-browse-html-temp-list)))
- (gnus-y-or-n-p
- (if (= files 1)
- "Delete the temporary HTML file? "
- (format "Delete all %s temporary HTML files? "
- files))))
+ (or (gnus-y-or-n-p
+ (if (= files 1)
+ "Delete the temporary HTML file? "
+ (format "Delete all %s temporary HTML files? "
+ files)))
+ (setq gnus-article-browse-html-temp-list nil)))
how)))
(dolist (file gnus-article-browse-html-temp-list)
(cond ((file-directory-p file)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index c2f79e70d1e..77bb6281bc4 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -319,6 +319,7 @@ The current buffer (when the hook is run) contains the message
including the message header. Changes made to the message will
only affect the Gcc copy, but not the original message."
:group 'gnus-message
+ :version "24.3"
:type 'hook)
(defcustom gnus-gcc-post-body-encode-hook nil
@@ -327,6 +328,7 @@ The current buffer (when the hook is run) contains the message
including the message header. Changes made to the message will
only affect the Gcc copy, but not the original message."
:group 'gnus-message
+ :version "24.3"
:type 'hook)
(autoload 'gnus-message-citation-mode "gnus-cite" nil t)
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index 5104a56c6e7..3848dee8d4f 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/gnus-notifications.el
@@ -42,6 +42,7 @@
(defgroup gnus-notifications nil
"Send notifications on new message in Gnus."
+ :version "24.3"
:group 'gnus)
(defcustom gnus-notifications-use-google-contacts t
diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el
index ca8662ff936..b5f8379e367 100644
--- a/lisp/gnus/gnus-sync.el
+++ b/lisp/gnus/gnus-sync.el
@@ -134,11 +134,13 @@ and `gnus-topic-alist'. Also see `gnus-variable-list'."
(defcustom gnus-sync-lesync-name (system-name)
"The LeSync name for this machine."
:group 'gnus-sync
+ :version "24.3"
:type 'string)
-(defcustom gnus-sync-lesync-install-topics 'ask
+(defcustom gnus-sync-lesync-install-topics 'ask
"Should LeSync install the recorded topics?"
:group 'gnus-sync
+ :version "24.3"
:type '(choice (const :tag "Never Install" nil)
(const :tag "Always Install" t)
(const :tag "Ask Me Once" ask)))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 42911ce0648..5360f008432 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -3160,8 +3160,12 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
(defun message-in-body-p ()
"Return t if point is in the message body."
- (let ((body (save-excursion (message-goto-body))))
- (>= (point) body)))
+ (>= (point)
+ (save-excursion
+ (goto-char (point-min))
+ (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
+ (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))
+ (point))))
(defun message-goto-eoh ()
"Move point to the end of the headers."
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index cc1aedf1b97..a72962aae0d 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1305,7 +1305,8 @@ to specify options."
(defun mml-attach-file (file &optional type description disposition)
"Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with
-`\\[message-send-and-exit]' or `\\[message-send]'.
+`\\[message-send-and-exit]' or `\\[message-send]' in Message mode,
+or `\\[mail-send-and-exit]' or `\\[mail-send]' in Mail mode.
FILE is the name of the file to attach. TYPE is its
content-type, a string of the form \"type/subtype\". DESCRIPTION
@@ -1319,11 +1320,9 @@ body) or \"attachment\" (separate from the body)."
(description (mml-minibuffer-read-description))
(disposition (mml-minibuffer-read-disposition type nil file)))
(list file type description disposition)))
- ;; Don't move point if this command is invoked inside the message header.
- (let ((head (unless (message-in-body-p)
- (prog1
- (point)
- (goto-char (point-max))))))
+ ;; If in the message header, attach at the end and leave point unchanged.
+ (let ((head (unless (message-in-body-p) (point))))
+ (if head (goto-char (point-max)))
(mml-insert-empty-tag 'part
'type type
;; icicles redefines read-file-name and returns a
@@ -1331,12 +1330,15 @@ body) or \"attachment\" (separate from the body)."
'filename (mm-substring-no-properties file)
'disposition (or disposition "attachment")
'description description)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(when head
- (unless (prog1
- (pos-visible-in-window-p)
- (goto-char head))
+ (unless (pos-visible-in-window-p)
(message "The file \"%s\" has been attached at the end of the message"
- (file-name-nondirectory file))))))
+ (file-name-nondirectory file)))
+ (goto-char head))))
(defun mml-dnd-attach-file (uri action)
"Attach a drag and drop file.
@@ -1372,21 +1374,22 @@ BUFFER is the name of the buffer to attach. See
(description (mml-minibuffer-read-description))
(disposition (mml-minibuffer-read-disposition type nil)))
(list buffer type description disposition)))
- ;; Don't move point if this command is invoked inside the message header.
- (let ((head (unless (message-in-body-p)
- (prog1
- (point)
- (goto-char (point-max))))))
+ ;; If in the message header, attach at the end and leave point unchanged.
+ (let ((head (unless (message-in-body-p) (point))))
+ (if head (goto-char (point-max)))
(mml-insert-empty-tag 'part 'type type 'buffer buffer
'disposition disposition
'description description)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(when head
- (unless (prog1
- (pos-visible-in-window-p)
- (goto-char head))
+ (unless (pos-visible-in-window-p)
(message
"The buffer \"%s\" has been attached at the end of the message"
- buffer)))))
+ buffer))
+ (goto-char head))))
(defun mml-attach-external (file &optional type description)
"Attach an external file into the buffer.
@@ -1397,19 +1400,20 @@ TYPE is the MIME type to use."
(type (mml-minibuffer-read-type file))
(description (mml-minibuffer-read-description)))
(list file type description)))
- ;; Don't move point if this command is invoked inside the message header.
- (let ((head (unless (message-in-body-p)
- (prog1
- (point)
- (goto-char (point-max))))))
+ ;; If in the message header, attach at the end and leave point unchanged.
+ (let ((head (unless (message-in-body-p) (point))))
+ (if head (goto-char (point-max)))
(mml-insert-empty-tag 'external 'type type 'name file
'disposition "attachment" 'description description)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(when head
- (unless (prog1
- (pos-visible-in-window-p)
- (goto-char head))
+ (unless (pos-visible-in-window-p)
(message "The file \"%s\" has been attached at the end of the message"
- (file-name-nondirectory file))))))
+ (file-name-nondirectory file)))
+ (goto-char head))))
(defun mml-insert-multipart (&optional type)
(interactive (if (message-in-body-p)
@@ -1422,12 +1426,20 @@ TYPE is the MIME type to use."
(or type
(setq type "mixed"))
(mml-insert-empty-tag "multipart" 'type type)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(forward-line -1))
(defun mml-insert-part (&optional type)
(interactive (if (message-in-body-p)
(list (mml-minibuffer-read-type ""))
(error "Use this command in the message body")))
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(mml-insert-tag 'part 'type type 'disposition "inline"))
(declare-function message-subscribed-p "message" ())
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index fa0484ff4e5..ef482f8f0e9 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -488,13 +488,16 @@ suitable file is found, return nil."
(insert "'.\n"))))
(defun help-fns--obsolete (function)
- (let* ((obsolete (and
- ;; `function' might be a lambda construct.
- (symbolp function)
- (get function 'byte-obsolete-info)))
+ ;; Ignore lambda constructs, keyboard macros, etc.
+ (let* ((obsolete (and (symbolp function)
+ (get function 'byte-obsolete-info)))
(use (car obsolete)))
(when obsolete
- (insert "\nThis function is obsolete")
+ (insert "\nThis "
+ (if (eq (car-safe (symbol-function function)) 'macro)
+ "macro"
+ "function")
+ " is obsolete")
(when (nth 2 obsolete)
(insert (format " since %s" (nth 2 obsolete))))
(insert (cond ((stringp use) (concat ";\n" use))
@@ -611,7 +614,7 @@ FILE is the file where FUNCTION was probably defined."
(fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
(point)))
(terpri)(terpri)
-
+
(let* ((doc-raw (condition-case err
(documentation function t)
(error (format "No Doc! %S" err))))
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 112c72778bc..63ae02eb90d 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -69,6 +69,10 @@
(require 'backquote)
+;; This needs to be autoloaded because it is used in the
+;; make-help-screen macro. Using (bound-and-true-p three-step-help)
+;; is not an acceptable alternative, because nothing loads help-macro
+;; in a normal session, so any user customization would never be applied.
;;;###autoload
(defcustom three-step-help nil
"Non-nil means give more info about Help command in three steps.
diff --git a/lisp/help.el b/lisp/help.el
index da11389d87c..0df9c607f69 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -981,15 +981,6 @@ function is called, the window to be resized is selected."
:group 'help
:version "24.2")
-(defcustom temp-buffer-resize-frames nil
- "Non-nil means `temp-buffer-resize-mode' can resize frames.
-A frame can be resized if and only if its root window is a live
-window. The height of the root window is subject to the values of
-`temp-buffer-max-height' and `window-min-height'."
- :type 'boolean
- :version "24.2"
- :group 'help)
-
(define-minor-mode temp-buffer-resize-mode
"Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode).
With a prefix argument ARG, enable Temp Buffer Resize mode if ARG
@@ -1001,6 +992,11 @@ show a temporary buffer are automatically resized in height to
fit the buffer's contents, but never more than
`temp-buffer-max-height' nor less than `window-min-height'.
+A window is resized only if it has been specially created for the
+buffer. Windows that have shown another buffer before are not
+resized. A frame is resized only if `fit-frame-to-buffer' is
+non-nil.
+
This mode is used by `help', `apropos' and `completion' buffers,
and some others."
:global t :group 'help
@@ -1019,25 +1015,26 @@ smaller than `window-min-height'. Do nothing if WINDOW is not
vertically combined or some of its contents are scrolled out of
view."
(setq window (window-normalize-window window t))
- (let ((height (if (functionp temp-buffer-max-height)
- (with-selected-window window
- (funcall temp-buffer-max-height (window-buffer)))
- temp-buffer-max-height)))
- (cond
- ((and (pos-visible-in-window-p (point-min) window)
- (window-combined-p window))
- (fit-window-to-buffer window height))
- ((and temp-buffer-resize-frames
- (eq window (frame-root-window window))
- (memq (car (window-parameter window 'quit-restore))
- ;; If 'same is too strong, we might additionally check
- ;; whether the second element is 'frame.
- '(same frame)))
- (let ((frame (window-frame window)))
- (fit-frame-to-buffer
- frame (+ (frame-height frame)
- (- (window-total-size window))
- height)))))))
+ (let ((buffer-name (buffer-name (window-buffer window))))
+ (let ((height (if (functionp temp-buffer-max-height)
+ (with-selected-window window
+ (funcall temp-buffer-max-height (window-buffer)))
+ temp-buffer-max-height))
+ (quit-cadr (cadr (window-parameter window 'quit-restore))))
+ (cond
+ ;; Don't resize WINDOW if it showed another buffer before.
+ ((and (eq quit-cadr 'window)
+ (pos-visible-in-window-p (point-min) window)
+ (window-combined-p window))
+ (fit-window-to-buffer window height))
+ ((and fit-frame-to-buffer
+ (eq quit-cadr 'frame)
+ (eq window (frame-root-window window)))
+ (let ((frame (window-frame window)))
+ (fit-frame-to-buffer
+ frame (+ (frame-height frame)
+ (- (window-total-size window))
+ height))))))))
;;; Help windows.
(defcustom help-window-select 'other
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index f92e2ab0af2..59743124cc5 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -444,8 +444,8 @@ updated as you type."
;;;###autoload
(defun hi-lock-face-phrase-buffer (regexp &optional face)
"Set face of each match of phrase REGEXP to FACE.
-Whitespace in REGEXP converted to arbitrary whitespace and initial
-lower-case letters made case insensitive.
+If called interactively, replaces whitespace in REGEXP with
+arbitrary whitespace and makes initial lower-case letters case-insensitive.
If Font Lock mode is enabled in the buffer, it is used to
highlight REGEXP. If Font Lock mode is disabled, overlays are
@@ -544,9 +544,15 @@ be found in variable `hi-lock-interactive-patterns'."
Blanks in PHRASE replaced by regexp that matches arbitrary whitespace
and initial lower-case letters made case insensitive."
(let ((mod-phrase nil))
+ ;; FIXME fragile; better to just bind case-fold-search? (Bug#7161)
(setq mod-phrase
(replace-regexp-in-string
- "\\<[a-z]" (lambda (m) (format "[%s%s]" (upcase m) m)) phrase))
+ "\\(^\\|\\s-\\)\\([a-z]\\)"
+ (lambda (m) (format "%s[%s%s]"
+ (match-string 1 m)
+ (upcase (match-string 2 m))
+ (match-string 2 m))) phrase))
+ ;; FIXME fragile; better to use search-spaces-regexp?
(setq mod-phrase
(replace-regexp-in-string
"\\s-+" "[ \t\n]+" mod-phrase nil t))))
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index f787319fb0c..2f0a6e3af59 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -199,7 +199,6 @@
(defvar he-search-window ())
-;;;###autoload
(defcustom hippie-expand-try-functions-list
'(try-complete-file-name-partially
try-complete-file-name
@@ -217,31 +216,26 @@ or insert functions in this list."
:type '(repeat function)
:group 'hippie-expand)
-;;;###autoload
(defcustom hippie-expand-verbose t
"Non-nil makes `hippie-expand' output which function it is trying."
:type 'boolean
:group 'hippie-expand)
-;;;###autoload
(defcustom hippie-expand-dabbrev-skip-space nil
"Non-nil means tolerate trailing spaces in the abbreviation to expand."
:group 'hippie-expand
:type 'boolean)
-;;;###autoload
(defcustom hippie-expand-dabbrev-as-symbol t
"Non-nil means expand as symbols, i.e. syntax `_' is considered a letter."
:group 'hippie-expand
:type 'boolean)
-;;;###autoload
(defcustom hippie-expand-no-restriction t
"Non-nil means that narrowed buffers are widened during search."
:group 'hippie-expand
:type 'boolean)
-;;;###autoload
(defcustom hippie-expand-max-buffers ()
"The maximum number of buffers (apart from the current) searched.
If nil, all buffers are searched."
@@ -249,15 +243,13 @@ If nil, all buffers are searched."
integer)
:group 'hippie-expand)
-;;;###autoload
-(defcustom hippie-expand-ignore-buffers (list (purecopy "^ \\*.*\\*$") 'dired-mode)
+(defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
"A list specifying which buffers not to search (if not current).
Can contain both regexps matching buffer names (as strings) and major modes
\(as atoms)"
:type '(repeat (choice regexp (symbol :tag "Major Mode")))
:group 'hippie-expand)
-;;;###autoload
(defcustom hippie-expand-only-buffers ()
"A list specifying the only buffers to search (in addition to current).
Can contain both regexps matching buffer names (as strings) and major modes
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index fbf7a672ff6..b0bc5b6b3b3 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1052,8 +1052,6 @@ haven't encountered them yet. Returns a `hfy-style-assoc'."
(hfy-face-attr-for-class fn hfy-display-class))
((and (symbolp fn)
(facep (symbol-value fn)))
- ;; Obsolete faces like `font-lock-reference-face' are defined as
- ;; aliases for another face.
(hfy-face-attr-for-class (symbol-value fn) hfy-display-class))
(t nil)))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 97df90a65af..ee5bd0f357a 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -755,10 +755,16 @@ They are removed from `ibuffer-saved-filter-groups'."
The value from `ibuffer-saved-filter-groups' is used."
(interactive
(list
- (if (null ibuffer-saved-filter-groups)
- (error "No saved filters")
- (completing-read "Switch to saved filter group: "
- ibuffer-saved-filter-groups nil t))))
+ (cond ((null ibuffer-saved-filter-groups)
+ (error "No saved filters"))
+ ;; `ibuffer-saved-filter-groups' is a user variable that defaults
+ ;; to nil. We assume that with one element in this list the user
+ ;; knows what she wants. See bug#12331.
+ ((null (cdr ibuffer-saved-filter-groups))
+ (caar ibuffer-saved-filter-groups))
+ (t
+ (completing-read "Switch to saved filter group: "
+ ibuffer-saved-filter-groups nil t)))))
(setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups))
ibuffer-hidden-filter-groups nil)
(ibuffer-update nil t))
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 77461469044..c9dcff41618 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -1283,7 +1283,7 @@ With optional ARG, make read-only only if ARG is not negative."
(:opstring "toggled read only status in"
:interactive "P"
:modifier-p t)
- (call-interactively 'toggle-read-only))
+ (read-only-mode 'toggle))
(define-ibuffer-op ibuffer-do-delete ()
"Kill marked buffers as with `kill-this-buffer'."
@@ -2641,7 +2641,7 @@ will be inserted before the group at point."
;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group
;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group
;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode
-;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "c255d1ebe80ccabd8385f40bdd0b5451")
+;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "f03bae226325c7320d41ddb78896665a")
;;; Generated autoloads from ibuf-ext.el
(autoload 'ibuffer-auto-mode "ibuf-ext" "\
diff --git a/lisp/ido.el b/lisp/ido.el
index 2100def1992..4ab183b3207 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -493,6 +493,18 @@ as first char even if `ido-enable-prefix' is nil."
:type 'boolean
:group 'ido)
+;; See http://debbugs.gnu.org/2042 for more info.
+(defcustom ido-buffer-disable-smart-matches t
+ "Non-nil means not to re-order matches for buffer switching.
+By default, ido arranges matches in the following order:
+
+ full-matches > suffix matches > prefix matches > remaining matches
+
+which can get in the way for buffer switching."
+ :version "24.3"
+ :type 'boolean
+ :group 'ido)
+
(defcustom ido-confirm-unique-completion nil
"Non-nil means that even a unique completion must be confirmed.
This means that \\[ido-complete] must always be followed by \\[ido-exit-minibuffer]
@@ -702,7 +714,7 @@ See also `ido-dir-file-cache' and `ido-save-directory-list-file'."
:type 'integer
:group 'ido)
-(defcustom ido-max-directory-size 30000
+(defcustom ido-max-directory-size nil
"Maximum size (in bytes) for directories to use ido completion.
If you enter a directory with a size larger than this size, ido will
not provide the normal completion. To show the completions, use C-a."
@@ -1708,7 +1720,7 @@ This function also adds a hook to the minibuffer."
(ido-final-slash dir)
(not (ido-is-unc-host dir))
(file-directory-p dir)
- (> (nth 7 (file-attributes dir)) ido-max-directory-size))))
+ (> (nth 7 (file-attributes (file-truename dir))) ido-max-directory-size))))
(defun ido-set-current-directory (dir &optional subdir no-merge)
;; Set ido's current directory to DIR or DIR/SUBDIR
@@ -3688,10 +3700,17 @@ This is to make them appear as if they were \"virtual buffers\"."
(rex0 (if ido-enable-regexp text (regexp-quote text)))
(rexq (concat rex0 (if slash ".*/" "")))
(re (if ido-enable-prefix (concat "\\`" rexq) rexq))
- (full-re (and do-full (not ido-enable-regexp) (not (string-match "\$\\'" rex0))
+ (full-re (and do-full
+ (not (and (eq ido-cur-item 'buffer)
+ ido-buffer-disable-smart-matches))
+ (not ido-enable-regexp)
+ (not (string-match "\$\\'" rex0))
(concat "\\`" rex0 (if slash "/" "") "\\'")))
(suffix-re (and do-full slash
- (not ido-enable-regexp) (not (string-match "\$\\'" rex0))
+ (not (and (eq ido-cur-item 'buffer)
+ ido-buffer-disable-smart-matches))
+ (not ido-enable-regexp)
+ (not (string-match "\$\\'" rex0))
(concat rex0 "/\\'")))
(prefix-re (and full-re (not ido-enable-prefix)
(concat "\\`" rexq)))
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index fabc12c0219..4ac62fbb6fc 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -1,4 +1,4 @@
-;;; image-mode.el --- support for visiting image files
+;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*-
;;
;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;;
@@ -31,6 +31,11 @@
;; resulting buffer file is saved to another name it will correctly save
;; the image data to the new file.
+;; Todo:
+
+;; Consolidate with doc-view to make them work on directories of images or on
+;; image files containing various "pages".
+
;;; Code:
(require 'image)
@@ -38,8 +43,7 @@
;;; Image mode window-info management.
-(defvar image-mode-winprops-alist t)
-(make-variable-buffer-local 'image-mode-winprops-alist)
+(defvar-local image-mode-winprops-alist t)
(defvar image-mode-new-window-functions nil
"Special hook run when image data is requested in a new window.
@@ -47,9 +51,13 @@ It is called with one argument, the initial WINPROPS.")
(defun image-mode-winprops (&optional window cleanup)
"Return winprops of WINDOW.
-A winprops object has the shape (WINDOW . ALIST)."
+A winprops object has the shape (WINDOW . ALIST).
+WINDOW defaults to `selected-window' if it displays the current buffer, and
+otherwise it defaults to t, used for times when the buffer is not displayed."
(cond ((null window)
- (setq window (selected-window)))
+ (setq window
+ (if (eq (current-buffer) (window-buffer)) (selected-window) t)))
+ ((eq window t))
((not (windowp window))
(error "Not a window: %s" window)))
(when cleanup
diff --git a/lisp/image.el b/lisp/image.el
index 99c0a74a512..72dc654757a 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -346,7 +346,7 @@ Optional DATA-P non-nil means SOURCE is a string containing image data."
"Return non-nil if image type TYPE is available.
Image types are symbols like `xbm' or `jpeg'."
(and (fboundp 'init-image-library)
- (init-image-library type dynamic-library-alist)))
+ (init-image-library type)))
;;;###autoload
diff --git a/lisp/imenu.el b/lisp/imenu.el
index c2a80d69675..47a2f1e3b40 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -326,6 +326,7 @@ PREVPOS is the variable in which we store the last position displayed."
(defun imenu-example--name-and-position ()
"Return the current/previous sexp and its (beginning) location.
Don't move point."
+ (declare (obsolete "use your own function instead." "23.2"))
(save-excursion
(forward-sexp -1)
;; [ydi] modified for imenu-use-markers
@@ -333,8 +334,6 @@ Don't move point."
(end (progn (forward-sexp) (point))))
(cons (buffer-substring beg end)
beg))))
-(make-obsolete 'imenu-example--name-and-position
- "use your own function instead." "23.2")
;;;
;;; Lisp
@@ -343,6 +342,7 @@ Don't move point."
(defun imenu-example--lisp-extract-index-name ()
;; Example of a candidate for `imenu-extract-index-name-function'.
;; This will generate a flat index of definitions in a lisp file.
+ (declare (obsolete nil "23.2"))
(save-match-data
(and (looking-at "(def")
(condition-case nil
@@ -353,11 +353,11 @@ Don't move point."
(end (progn (forward-sexp -1) (point))))
(buffer-substring beg end)))
(error nil)))))
-(make-obsolete 'imenu-example--lisp-extract-index-name "your own" "23.2")
(defun imenu-example--create-lisp-index ()
;; Example of a candidate for `imenu-create-index-function'.
;; It will generate a nested index of definitions.
+ (declare (obsolete nil "23.2"))
(let ((index-alist '())
(index-var-alist '())
(index-type-alist '())
@@ -401,7 +401,6 @@ Don't move point."
(push (cons "Syntax-unknown" index-unknown-alist)
index-alist))
index-alist))
-(make-obsolete 'imenu-example--create-lisp-index "your own" "23.2")
;; Regular expression to find C functions
(defvar imenu-example--function-name-regexp-c
@@ -414,6 +413,7 @@ Don't move point."
))
(defun imenu-example--create-c-index (&optional regexp)
+ (declare (obsolete nil "23.2"))
(let ((index-alist '())
char)
(goto-char (point-min))
@@ -430,7 +430,6 @@ Don't move point."
(if (not (eq char ?\;))
(push (imenu-example--name-and-position) index-alist))))
(nreverse index-alist)))
-(make-obsolete 'imenu-example--create-c-index "your own" "23.2")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index c75ca8106ac..0a51c324d61 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -226,7 +226,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2821 #x287E)
(let ((chars '(?ー ?ã‚› ?ã‚œ ?ヽ ?ヾ ?ã‚ ?ã‚ž ?〃 ?ä» ?々 ?〆 ?〇)))
(dolist (elt chars)
- (modify-syntax-entry (car chars) "w")))
+ (modify-syntax-entry elt "w")))
(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?A #x2321 #x237E)
(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?H #x2421 #x247E)
@@ -234,12 +234,6 @@ with L, LRE, or LRO Unicode bidi character type.")
(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?G #x2621 #x267E)
(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?Y #x2721 #x277E)
(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?C #x3021 #x7E7E)
-(modify-category-entry ?ー ?K)
-(let ((chars '(?゛ ?゜)))
- (while chars
- (modify-category-entry (car chars) ?K)
- (modify-category-entry (car chars) ?H)
- (setq chars (cdr chars))))
(let ((chars '(?ä» ?々 ?〆 ?〇)))
(while chars
(modify-category-entry (car chars) ?C)
diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el
index 964f01c982c..5041f45ba97 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -202,8 +202,8 @@ character set: `latin-2', `hebrew' etc."
(and char (char-displayable-p char))))
;; Backwards compatibility.
-(defalias 'latin1-char-displayable-p 'char-displayable-p)
-(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "22.1")
+(define-obsolete-function-alias 'latin1-char-displayable-p
+ 'char-displayable-p "22.1")
(defun latin1-display-setup (set &optional force)
"Set up Latin-1 display for characters in the given SET.
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 177ac8eaa91..58dd24ec8ea 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2058,9 +2058,9 @@ See `set-language-info-alist' for use in programs."
(defun princ-list (&rest args)
"Print all arguments with `princ', then print \"\\n\"."
+ (declare (obsolete "use mapc and princ instead." "23.3"))
(mapc #'princ args)
(princ "\n"))
-(make-obsolete 'princ-list "use mapc and princ instead" "23.3")
(put 'describe-specified-language-support 'apropos-inhibit t)
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 4647b778e59..11207b0b78d 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1458,7 +1458,8 @@ for decoding and encoding files, process I/O, etc."
:flags '(ascii-at-eol ascii-at-cntl long-form
designation locking-shift single-shift)
:post-read-conversion 'ctext-post-read-conversion
- :pre-write-conversion 'ctext-pre-write-conversion)
+ :pre-write-conversion 'ctext-pre-write-conversion
+ :mime-charset 'x-ctext)
(define-coding-system-alias
'x-ctext-with-extensions 'compound-text-with-extensions)
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index bd7257bbc0f..43af785cc2f 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -208,8 +208,8 @@ Character sets for defining other charsets, or for backward compatibility
"Decode a character that has code CODE in CODEPAGE.
Return a decoded character string. Each CODEPAGE corresponds to a
coding system cpCODEPAGE."
+ (declare (obsolete decode-char "23.1"))
(decode-char (intern (format "cp%d" codepage)) code))
-(make-obsolete 'decode-codepage-char 'decode-char "23.1")
;; A variable to hold charset input history.
(defvar charset-history nil)
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index 7b152a47727..3dc0b54421a 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -34,39 +34,6 @@
;;; characters.
;;;###autoload
-(defun string-to-sequence (string type)
- "Convert STRING to a sequence of TYPE which contains characters in STRING.
-TYPE should be `list' or `vector'."
-;;; (let ((len (length string))
-;;; (i 0)
-;;; val)
- (cond ((eq type 'list)
- ;; Applicable post-Emacs 20.2 and asymptotically ~10 times
- ;; faster than the code below:
- (append string nil))
-;;; (setq val (make-list len 0))
-;;; (let ((l val))
-;;; (while (< i len)
-;;; (setcar l (aref string i))
-;;; (setq l (cdr l) i (1+ i))))))
- ((eq type 'vector)
- ;; As above.
- (vconcat string))
-;;; (setq val (make-vector len 0))
-;;; (while (< i len)
-;;; (aset val i (aref string i))
-;;; (setq i (1+ i))))
- (t
- (error "Invalid type: %s" type)))
-;;; val)
-)
-
-;;;###autoload
-(make-obsolete 'string-to-sequence
- "use `string-to-list' or `string-to-vector'."
- "22.1")
-
-;;;###autoload
(defsubst string-to-list (string)
"Return a list of characters in STRING."
(append string nil))
@@ -330,10 +297,9 @@ operations such as `find-coding-systems-region'."
"Detect a coding system of the text between FROM and TO with PRIORITY-LIST.
PRIORITY-LIST is an alist of coding categories vs the corresponding
coding systems ordered by priority."
+ (declare (obsolete with-coding-priority "23.1"))
`(with-coding-priority (mapcar #'cdr ,priority-list)
(detect-coding-region ,from ,to)))
-(make-obsolete 'detect-coding-with-priority
- "use `with-coding-priority' and `detect-coding-region'." "23.1")
;;;###autoload
(defun detect-coding-with-language-environment (from to lang-env)
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 4d567a6e9d8..e6e3f045a9e 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -409,13 +409,13 @@ PLIST (property list) may contain any type of information a user
(defun charset-id (charset)
"Always return 0. This is provided for backward compatibility."
+ (declare (obsolete nil "23.1"))
0)
-(make-obsolete 'charset-id "do not use it." "23.1")
(defmacro charset-bytes (charset)
"Always return 0. This is provided for backward compatibility."
+ (declare (obsolete nil "23.1"))
0)
-(make-obsolete 'charset-bytes "do not use it." "23.1")
(defun get-charset-property (charset propname)
"Return the value of CHARSET's PROPNAME property.
@@ -464,8 +464,8 @@ Return -1 if charset isn't an ISO 2022 one."
(defun charset-list ()
"Return list of all charsets ever defined."
+ (declare (obsolete charset-list "23.1"))
charset-list)
-(make-obsolete 'charset-list "use variable `charset-list'." "23.1")
;;; CHARACTER
@@ -473,8 +473,8 @@ Return -1 if charset isn't an ISO 2022 one."
(defun generic-char-p (char)
"Always return nil. This is provided for backward compatibility."
+ (declare (obsolete nil "23.1"))
nil)
-(make-obsolete 'generic-char-p "generic characters no longer exist." "23.1")
(defun make-char-internal (charset-id &optional code1 code2)
(let ((charset (aref emacs-mule-charset-table charset-id)))
@@ -1012,6 +1012,7 @@ Value is a list of transformed arguments."
eol-type)
"Define a new coding system CODING-SYSTEM (symbol).
This function is provided for backward compatibility."
+ (declare (obsolete define-coding-system "23.1"))
;; For compatibility with XEmacs, we check the type of TYPE. If it
;; is a symbol, perhaps, this function is called with XEmacs-style
;; arguments. Here, try to transform that kind of arguments to
@@ -1104,8 +1105,6 @@ This function is provided for backward compatibility."
(apply 'define-coding-system coding-system doc-string properties))
-(make-obsolete 'make-coding-system 'define-coding-system "23.1")
-
(defun merge-coding-systems (first second)
"Fill in any unspecified aspects of coding system FIRST from SECOND.
Return the resulting coding system."
@@ -1449,9 +1448,9 @@ This setting is effective for the next communication only."
ARG is a list of coding categories ordered by priority.
This function is provided for backward compatibility."
+ (declare (obsolete set-coding-system-priority "23.1"))
(apply 'set-coding-system-priority
(mapcar #'(lambda (x) (symbol-value x)) arg)))
-(make-obsolete 'set-coding-priority 'set-coding-system-priority "23.1")
;;; X selections
@@ -2356,9 +2355,6 @@ Analogous to `define-translation-table', but updates
(setq ignore-relative-composition
(make-char-table 'ignore-relative-composition))
-(make-obsolete 'set-char-table-default
- "generic characters no longer exist." "23.1")
-
;;; Built-in auto-coding-functions:
(defun sgml-xml-auto-coding-function (size)
diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el
index 0dfabdd65da..ba1bd436b23 100644
--- a/lisp/international/uni-bidi.el
+++ b/lisp/international/uni-bidi.el
@@ -5,7 +5,7 @@
(define-char-code-property 'bidi-class #^[1 nil char-code-property-table
#^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] #^^[1 0 #^^[2 0
#^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] "Â…š„„ƒÂ…—Ÿˆ" 1 1 1 "¹‡ÂŽÂŽÂ…‰‘" "ð„ˆ" "„î‰" 1 "ƒ‡ö" 1 "Š„­¸" "Â…‹°•ŠƒÂ" "Ö‡†„Š†" "ÂŽž›³" "¦‹ÂŽ«‰„†" "–„‰ƒÂ…«ƒ¤" " ‹·›" "ƒ·„ˆ„ƒ‡ŠÂœ" "º„„ˆ”ÂŽ‡„" "¹„„ƒƒžƒŠ" "¹„Â…„”ÂÂŽ" "º„ˆˆ‹Âœ" "½ÂŒÂ¥†Â…" "¾ƒÂ…ƒ„‡‹”‡" "¼Â”Âœ" "Ĉ”Âœ" "ʇƒ©" "±‡„‡ˆ±" "±†‹†²" "˜›„³ÂŽ" "Â…Â…‹¤‰¹"] #^^[2 4096 "­„†™„ƒÂ„‹" "†Ââ" 1 1 1 1 "à" "Šæ" "ÿ" 1 1 1 1 "šã" "Â’ƒÂƒÂžÂŒ" "´‡ˆ‹‡Â’Š†" "‹ƒñ" "©Ö" " ƒ„‰†ƒ„ƒº" "Þ¢" "—½‡ˆ†Š" 1 "„°Â…Â…¨‰ÂŒ" " „ºƒƒÂŽ" "¬ˆÈ" "Ç„†‹" 1 "À§•„" 1 1 1 "½ƒ‹ƒÂƒÂƒÂ"] #^^[2 8192 "‹ƒ˜
- …š……†ƒ† ƒ" "Š ƒ‘š–¡Â" "„ŠƒÂ…†„‹„Â…Â…„ " "‰†ð" "Â’ ì" 19 "¶Ã…Â…" "•ÞÂŒ" "§™‹• " "ˆ”ÃŽ–" 19 19 19 "¬Ó" "ÿ" 19 1 1 19 19 19 19 "ʦ" 1 1 "Ã¥†„ƒ‡‡" "ÿ" "à " "¼Ä" "šÙÂŒ" 19 "֚Œ„"] #^^[2 12288 "„ƒ™‰„Â…Â…ƒÀ" "™ƒÚ„" 1 "À¤Âœ" "±ÂÂœƒ" "±ÂÂŒ„°" "÷„Â…" "ÞŸ" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "ÀÀ" 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+ …š……†ƒ† ƒ" "Š ƒ‘›•¡Â" "„ŠƒÂ…†„‹„Â…Â…„ " "‰†ð" "Â’ ì" 19 "¶Ã…Â…" "•ÞÂŒ" "§™‹• " "ˆ”ÃŽ–" 19 19 19 "¬Ó" "ÿ" 19 1 1 19 19 19 19 "ʦ" 1 1 "Ã¥†„ƒ‡‡" "ÿ" "à " "¼Ä" "šÙÂŒ" 19 "֚Œ„"] #^^[2 12288 "„ƒ™‰„Â…Â…ƒÀ" "™ƒÚ„" 1 "À¤Âœ" "±ÂÂœƒ" "±ÂÂŒ„°" "÷„Â…" "ÞŸ" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "ÀÀ" 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
#^^[3 40832 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[2 40960 1 1 1 1 1 1 1 1 1 "·¹" 1 1 "ƒ߄Š" "ŸÃÂŽ" "¢Þ" "ˆ÷" "ƒ„™„ÂŒº„ˆ" "쒎" "¦ˆ™‹®" "ƒ°„Ã" "©†ÂŒˆ³" "°ƒÂ…ªˆ‰" 1 "Ã¥„Â’" 1 1 1 1 1 1 1 1] 1 1 #^^[2 53248 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 61440 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "Š ¦°" 7 7 7 "¾À" "ý" "Š†‡‰ ‰ ƒ„Â" "ÿ" "ƒÂ…  Š†š†š‹š" "àƒ‡ŠÂ…"]] #^^[1 65536 #^^[2 65536 1 1 "¾À" "‹Â…ÂŒá" 1 1 1 1 1 1 1 1 1 1 1 1 2 2 "Ÿà" 2 "ƒÂ…„¨ƒ„À" 2 "¹‡À" 2 2 2 2 2 "àŸ" 2 2 2] #^^[2 69632 "¶Â‹”š" "±„Ã…" "ƒ¤Â…ˆË" "´‰Ã" 1 1 1 1 1 1 1 1 1 "«†È" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 73728 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 77824 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 #^^[2 90112 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "„í"] 1 1 1 1 #^^[2 110592 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 118784 1 1 "烉ˆÂ…" "ƒ‡ž„Ã’" "ƒº" 1 "ש" 1 1 1 1 1 1 "Û¤" "•¹°" "‰¹Š²" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 122880 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 "„›Š„†„ƒ„‡„„" "Š‘Â…ƒÂ…‘´ÂŽ" 2 2] #^^[2 126976 "¬„Ã" "”ŒŽ " "‹ß”" 1 1 1 "¡Â†Æƒ" "”Œ¥…•‘Â" "¿¾" "ø„ƒ" "¾„ÂŒ˜˜" "ûÂ…" "Ä‹°" "ƺ" "ôÂŒ" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[1 131072 1 1 1 1 1 1 1 1 1 1 #^^[2 172032 1 1 1 1 1 1 1 1 1 1 1 1 1
#^^[3 173696 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 176128 1 1 1 1 1 1 1 1 1 1 1 1 1 1
#^^[3 177920 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1
diff --git a/lisp/international/uni-category.el b/lisp/international/uni-category.el
index f0ccde477cc..75ebc04c98f 100644
--- a/lisp/international/uni-category.el
+++ b/lisp/international/uni-category.el
@@ -5,7 +5,7 @@
(define-char-code-property 'general-category #^[30 nil char-code-property-table
#^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] #^^[1 0 #^^[2 0
#^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] " „   ƒ—‡˜ˆ" "" "ƒ„ƒƒƒƒ„ƒ" "‡„±" "”›Â’„ŒŽ…‡‘" "ðƒ" "„ƒ‘‰£ƒƒÂ…ƒ" "°°" "Â…" "‰¦†Ÿ" "ˆ „­ ˆ›Â…ƒ‹" "Â…ƒ‹ Š• Š„Â" "Ô‡†„ Šƒ" "ÂŽž›³" "¦‹ÂŽ Š¡‰ƒÂ…" "–„‰ƒÂ…™ƒ¡" " ‹·›" "ƒ¶ƒˆ„‡Š Š†‡" "ˆ–‡ƒ„ƒ„ˆ„ƒ Š †„" "†„–‡ƒ„ƒƒ‡„‡ ŠƒŠ" "‰ƒ–‡Â…ƒÂ… ŠÂŽ" "ˆ–‡Â…„ˆ„ƒ Š †ˆ" "†ƒƒ„ƒƒƒƒƒÂŒ„ƒƒƒ†ÂŽ Š ƒ†Â…" "ƒˆƒ—ŠÂ…ƒƒ„ƒ„‡† Šˆ ‡" "ˆƒ—ŠÂ…Â…‡‡ ŠÂ" "ˆƒ©ƒ„ƒƒˆˆ Š †ƒ†" "Â’ƒ˜‰‡ƒ„ƒƒˆÂ’‹" "°‡„†ˆ Š¤" "†„‡ƒ„†Â…† Š„ " "ƒÂƒ† Š Šˆ¤„ÂŽ" "Â…Â…‹¤ˆ†Â…„Â¥"] #^^[2 4096 "«„† Š††„ƒƒ‡ƒ„‹" "† Šƒ¦Â…«ƒ" 5 5 "É„‡„ " "‰„¡„‡„¨" "‘„É ”ƒ" "Š†Õ‹" " ÿ" 5 5 5 "í‘" "šƒËƒ
-ƒÂ" "„ƒ‹Â’ƒ‰Â’ŒƒŒ" "´‡ˆ‹ƒƒ Š† Š†" "† „ƒ Š†£´ˆ" "©Â…ÆŠ" "ƒƒ„ƒ„†ƒ„ƒ ŠžÂ…‹" "¬„‘‡† Š ƒ¢" "—ƒµ‡ˆ†Š" " Š† Š†‡†Ã’" "„¯Â…Â…‡„ Š‡Š‰‰ƒ" "ž„ Š¬ƒƒˆ„" "¤ˆˆƒÂ… Šƒƒ Šž†" "ÀˆˆƒÂ‡„„‰" "¬¿Â‡" "›Â¥§•„" "" "‰" "ˆˆ††ˆˆˆˆ††ˆˆˆÂŽ" "ˆˆˆˆˆˆÂ…„ƒƒ„ƒ„„ƒˆÂ…ƒƒ„"] #^^[2 8192 "‹Â… †ˆÂ…‰„ ƒ‹ ŠÂ…Â…†  †ƒ" " ŠƒÂƒš–„ƒÂŒÂ" "„ƒƒÂ…†„„„Â…„ Â
+ƒÂ" "„ƒ‹Â’ƒ‰Â’ŒƒŒ" "´‡ˆ‹ƒƒ Š† Š†" "† „ƒ Š†£´ˆ" "©Â…ÆŠ" "ƒƒ„ƒ„†ƒ„ƒ ŠžÂ…‹" "¬„‘‡† Š ƒ¢" "—ƒµ‡ˆ†Š" " Š† Š†‡†Ã’" "„¯Â…Â…‡„ Š‡Š‰‰ƒ" "ž„ Š¬ƒƒˆ„" "¤ˆˆƒÂ… Šƒƒ Šž†" "ÀˆˆƒÂ‡„„‰" "¬¿Â‡" "›Â¥§•„" "" "‰" "ˆˆ††ˆˆˆˆ††ˆˆˆÂŽ" "ˆˆˆˆˆˆÂ…„ƒƒ„ƒ„„ƒˆÂ…ƒƒ„"] #^^[2 8192 "‹Â… †ˆÂ…‰„ ƒ‹ ŠÂ…Â…†  †ƒ" " ŠƒÂƒ›•Â„ƒÂŒÂ" "„ƒƒÂ…†„„„Â…„ Â
 " "
ƒ
„ †Â…Â…„‡ŸŸÂŒ" 19 19 "ˆ„”‡Ñƒ" "›™¨†Â’ÂŒ" "§™‹•  " " œÎ –" 22 "·‰¶ˆ" "ïÂ" 22 "ç Š" " ”¬Â…ŸÂ" 22 22 19 "ƒ¿ " 19 19 "°•†ƒŠ¦" 30 "¯¯ƒ„†" "†ƒÂ…„ " "¦Â…¸‡ÂŽ" "—‰‡‡‡‡‡‡‡‡ " "ƒ‰  Â…Š Ä" "šÙÂŒ" 22 "֚Œ„"] #^^[2 12288 "ƒ
diff --git a/lisp/international/uni-name.el b/lisp/international/uni-name.el
index 458957ef366..cf37db39b48 100644
--- a/lisp/international/uni-name.el
+++ b/lisp/international/uni-name.el
Binary files differ
diff --git a/lisp/international/uni-numeric.el b/lisp/international/uni-numeric.el
index 9f0d3079259..7c0be5b438a 100644
--- a/lisp/international/uni-numeric.el
+++ b/lisp/international/uni-numeric.el
Binary files differ
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 04f5a7acc2c..37993767013 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1649,9 +1649,9 @@ characters in that string."
(isearch-done nil t)
(isearch-clean-overlays)
(let ((default (car occur-collect-regexp-history)))
- (read-string
+ (read-regexp
(format "Regexp to collect (default %s): " default)
- nil 'occur-collect-regexp-history default)))
+ default 'occur-collect-regexp-history)))
;; Otherwise normal occur takes numerical prefix argument.
(when current-prefix-arg
(prefix-numeric-value current-prefix-arg))))))
diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el
index 624c3500939..13ab41cf83a 100644
--- a/lisp/iswitchb.el
+++ b/lisp/iswitchb.el
@@ -527,33 +527,6 @@ selected.")
;;; FUNCTIONS
-;;; ISWITCHB KEYMAP
-(defun iswitchb-define-mode-map ()
- "Set up the keymap for `iswitchb-buffer'."
- (interactive)
- (let (map)
- ;; generated every time so that it can inherit new functions.
- ;;(or iswitchb-mode-map
-
- (setq map (copy-keymap minibuffer-local-map))
- (define-key map "?" 'iswitchb-completion-help)
- (define-key map "\C-s" 'iswitchb-next-match)
- (define-key map "\C-r" 'iswitchb-prev-match)
- (define-key map "\t" 'iswitchb-complete)
- (define-key map "\C-j" 'iswitchb-select-buffer-text)
- (define-key map "\C-t" 'iswitchb-toggle-regexp)
- (define-key map "\C-x\C-f" 'iswitchb-find-file)
- (define-key map "\C-n" 'iswitchb-toggle-ignore)
- (define-key map "\C-c" 'iswitchb-toggle-case)
- (define-key map "\C-k" 'iswitchb-kill-buffer)
- (define-key map "\C-m" 'iswitchb-exit-minibuffer)
- (setq iswitchb-mode-map map)
- (run-hooks 'iswitchb-define-mode-map-hook)))
-
-(make-obsolete 'iswitchb-define-mode-map
- "use M-x iswitchb-mode or customize the variable `iswitchb-mode'."
- "21.1")
-
;;; MAIN FUNCTION
(defun iswitchb ()
"Switch to buffer matching a substring.
@@ -619,14 +592,25 @@ If START is a string, the selection process is started with that
string.
If MATCHES-SET is non-nil, the buflist is not updated before
the selection process begins. Used by isearchb.el."
- (let
- (
- buf-sel
- iswitchb-final-text
- (icomplete-mode nil) ;; prevent icomplete starting up
- )
-
- (iswitchb-define-mode-map)
+ ;; The map is generated every time so that it can inherit new
+ ;; functions.
+ (let ((map (copy-keymap minibuffer-local-map))
+ buf-sel iswitchb-final-text map
+ icomplete-mode) ; prevent icomplete starting up
+ (define-key map "?" 'iswitchb-completion-help)
+ (define-key map "\C-s" 'iswitchb-next-match)
+ (define-key map "\C-r" 'iswitchb-prev-match)
+ (define-key map "\t" 'iswitchb-complete)
+ (define-key map "\C-j" 'iswitchb-select-buffer-text)
+ (define-key map "\C-t" 'iswitchb-toggle-regexp)
+ (define-key map "\C-x\C-f" 'iswitchb-find-file)
+ (define-key map "\C-n" 'iswitchb-toggle-ignore)
+ (define-key map "\C-c" 'iswitchb-toggle-case)
+ (define-key map "\C-k" 'iswitchb-kill-buffer)
+ (define-key map "\C-m" 'iswitchb-exit-minibuffer)
+ (setq iswitchb-mode-map map)
+ (run-hooks 'iswitchb-define-mode-map-hook)
+
(setq iswitchb-exit nil)
(setq iswitchb-default
(if (bufferp default)
diff --git a/lisp/json.el b/lisp/json.el
index f1ee3a52032..8167bfe93f2 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -311,13 +311,13 @@ representation will be parsed correctly."
(setq char (json-encode-char0 char 'ucs))
(let ((control-char (car (rassoc char json-special-chars))))
(cond
- ;; Special JSON character (\n, \r, etc.)
+ ;; Special JSON character (\n, \r, etc.).
(control-char
(format "\\%c" control-char))
- ;; ASCIIish printable character
- ((and (> char 31) (< char 161))
+ ;; ASCIIish printable character.
+ ((and (> char 31) (< char 127))
(format "%c" char))
- ;; Fallback: UCS code point in \uNNNN form
+ ;; Fallback: UCS code point in \uNNNN form.
(t
(format "\\u%04x" char)))))
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 7b515a69a1c..a16d69c6cc2 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -68,7 +68,7 @@ should return a grid vector array that is the new solution.
;;;***
;;;### (autoloads (ada-mode ada-add-extensions) "ada-mode" "progmodes/ada-mode.el"
-;;;;;; (20427 14766 970343 0))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from progmodes/ada-mode.el
(autoload 'ada-add-extensions "ada-mode" "\
@@ -253,7 +253,7 @@ old-style time formats for entries are supported.
;;;### (autoloads (defadvice ad-activate ad-add-advice ad-disable-advice
;;;;;; ad-enable-advice ad-default-compilation-action ad-redefinition-action)
-;;;;;; "advice" "emacs-lisp/advice.el" (20497 6436 957082 0))
+;;;;;; "advice" "emacs-lisp/advice.el" (20563 51044 242568 0))
;;; Generated autoloads from emacs-lisp/advice.el
(defvar ad-redefinition-action 'warn "\
@@ -398,7 +398,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
;;;### (autoloads (align-newline-and-indent align-unhighlight-rule
;;;;;; align-highlight-rule align-current align-entire align-regexp
-;;;;;; align) "align" "align.el" (20515 36389 544939 0))
+;;;;;; align) "align" "align.el" (20566 63671 243798 0))
;;; Generated autoloads from align.el
(autoload 'align "align" "\
@@ -489,7 +489,7 @@ A replacement function for `newline-and-indent', aligning as it goes.
;;;### (autoloads (outlineify-sticky allout-mode allout-mode-p allout-auto-activation
;;;;;; allout-setup allout-auto-activation-helper) "allout" "allout.el"
-;;;;;; (20523 62082 997685 0))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from allout.el
(autoload 'allout-auto-activation-helper "allout" "\
@@ -910,7 +910,7 @@ outline hot-spot navigation (see `allout-mode').
;;;***
;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp"
-;;;;;; "net/ange-ftp.el" (20501 3499 284800 0))
+;;;;;; "net/ange-ftp.el" (20566 63671 243798 0))
;;; Generated autoloads from net/ange-ftp.el
(defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
@@ -965,7 +965,7 @@ the buffer *Birthday-Present-for-Name*.
;;;***
;;;### (autoloads (ansi-color-process-output ansi-color-for-comint-mode-on)
-;;;;;; "ansi-color" "ansi-color.el" (20523 30501 603360 0))
+;;;;;; "ansi-color" "ansi-color.el" (20577 33959 40183 0))
;;; Generated autoloads from ansi-color.el
(autoload 'ansi-color-for-comint-mode-on "ansi-color" "\
@@ -991,7 +991,7 @@ This is a good function to put in `comint-output-filter-functions'.
;;;***
;;;### (autoloads (antlr-set-tabs antlr-mode antlr-show-makefile-rules)
-;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20427 14766 970343
+;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20566 63671 243798
;;;;;; 0))
;;; Generated autoloads from progmodes/antlr-mode.el
@@ -1160,8 +1160,8 @@ Returns list of symbols and documentation found.
;;;***
-;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20387
-;;;;;; 44199 24128 0))
+;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20585
+;;;;;; 28088 480237 0))
;;; Generated autoloads from arc-mode.el
(autoload 'archive-mode "arc-mode" "\
@@ -1573,7 +1573,7 @@ Major mode for editing Autoconf configure.ac files.
;;;***
;;;### (autoloads (auto-insert-mode define-auto-insert auto-insert)
-;;;;;; "autoinsert" "autoinsert.el" (20458 56750 651721 0))
+;;;;;; "autoinsert" "autoinsert.el" (20566 63671 243798 0))
;;; Generated autoloads from autoinsert.el
(autoload 'auto-insert "autoinsert" "\
@@ -1830,7 +1830,7 @@ seconds.
;;;***
;;;### (autoloads (benchmark benchmark-run-compiled benchmark-run)
-;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20355 10021 546955
+;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20557 48712 315579
;;;;;; 0))
;;; Generated autoloads from emacs-lisp/benchmark.el
@@ -1845,6 +1845,8 @@ See also `benchmark-run-compiled'.
\(fn &optional REPETITIONS &rest FORMS)" nil t)
+(put 'benchmark-run 'lisp-indent-function '1)
+
(autoload 'benchmark-run-compiled "benchmark" "\
Time execution of compiled version of FORMS.
This is like `benchmark-run', but what is timed is a funcall of the
@@ -1853,6 +1855,8 @@ result. The overhead of the `lambda's is accounted for.
\(fn &optional REPETITIONS &rest FORMS)" nil t)
+(put 'benchmark-run-compiled 'lisp-indent-function '1)
+
(autoload 'benchmark "benchmark" "\
Print the time taken for REPETITIONS executions of FORM.
Interactively, REPETITIONS is taken from the prefix arg.
@@ -1864,7 +1868,7 @@ For non-interactive use see also `benchmark-run' and
;;;***
;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize)
-;;;;;; "bibtex" "textmodes/bibtex.el" (20439 5925 915283 0))
+;;;;;; "bibtex" "textmodes/bibtex.el" (20576 13095 881042 0))
;;; Generated autoloads from textmodes/bibtex.el
(autoload 'bibtex-initialize "bibtex" "\
@@ -1989,8 +1993,8 @@ Binhex decode region between START and END.
;;;***
-;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (20545
-;;;;;; 57511 257469 0))
+;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (20551
+;;;;;; 9899 283417 0))
;;; Generated autoloads from play/blackbox.el
(autoload 'blackbox "blackbox" "\
@@ -2113,7 +2117,7 @@ a reflection.
;;;;;; bookmark-save bookmark-write bookmark-delete bookmark-insert
;;;;;; bookmark-rename bookmark-insert-location bookmark-relocate
;;;;;; bookmark-jump-other-window bookmark-jump bookmark-set) "bookmark"
-;;;;;; "bookmark.el" (20514 15527 107017 0))
+;;;;;; "bookmark.el" (20585 28088 480237 0))
;;; Generated autoloads from bookmark.el
(define-key ctl-x-r-map "b" 'bookmark-jump)
(define-key ctl-x-r-map "m" 'bookmark-set)
@@ -2314,7 +2318,7 @@ Incremental search of bookmarks, hiding the non-matches as we go.
;;;;;; browse-url-xdg-open browse-url-at-mouse browse-url-at-point
;;;;;; browse-url browse-url-of-region browse-url-of-dired-file
;;;;;; browse-url-of-buffer browse-url-of-file browse-url-browser-function)
-;;;;;; "browse-url" "net/browse-url.el" (20478 3673 653810 0))
+;;;;;; "browse-url" "net/browse-url.el" (20566 63671 243798 0))
;;; Generated autoloads from net/browse-url.el
(defvar browse-url-browser-function 'browse-url-default-browser "\
@@ -2630,7 +2634,7 @@ from `browse-url-elinks-wrapper'.
;;;***
;;;### (autoloads (bs-show bs-customize bs-cycle-previous bs-cycle-next)
-;;;;;; "bs" "bs.el" (20520 54308 826101 0))
+;;;;;; "bs" "bs.el" (20576 13095 881042 0))
;;; Generated autoloads from bs.el
(autoload 'bs-cycle-next "bs" "\
@@ -2670,8 +2674,8 @@ name of buffer configuration.
;;;***
-;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20478 3673
-;;;;;; 653810 0))
+;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from play/bubbles.el
(autoload 'bubbles "bubbles" "\
@@ -2717,7 +2721,7 @@ Like `bug-reference-mode', but only buttonize in comments and strings.
;;;;;; batch-byte-compile-if-not-done display-call-tree byte-compile
;;;;;; compile-defun byte-compile-file byte-recompile-directory
;;;;;; byte-force-recompile byte-compile-enable-warning byte-compile-disable-warning)
-;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20522 38631 876994 556000))
+;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20585 28088 480237 0))
;;; Generated autoloads from emacs-lisp/bytecomp.el
(put 'byte-compile-dynamic 'safe-local-variable 'booleanp)
(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
@@ -2876,8 +2880,8 @@ from the cursor position.
;;;### (autoloads (defmath calc-embedded-activate calc-embedded calc-grab-rectangle
;;;;;; calc-grab-region full-calc-keypad calc-keypad calc-eval quick-calc
-;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20504
-;;;;;; 23200 130482 0))
+;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20572
+;;;;;; 16038 402143 0))
;;; Generated autoloads from calc/calc.el
(define-key ctl-x-map "*" 'calc-dispatch)
@@ -2984,8 +2988,8 @@ See the documentation for `calculator-mode' for more information.
;;;***
-;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20457
-;;;;;; 35879 688143 0))
+;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20577
+;;;;;; 33959 40183 0))
;;; Generated autoloads from calendar/calendar.el
(autoload 'calendar "calendar" "\
@@ -3022,7 +3026,7 @@ Runs the following hooks:
generating a calendar, if today's date is visible or not, respectively
`calendar-initial-window-hook' - after first creating a calendar
-This function is suitable for execution in a .emacs file.
+This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
@@ -3094,7 +3098,7 @@ Obsoletes `c-forward-into-nomenclature'.
;;;***
;;;### (autoloads (c-guess-basic-syntax) "cc-engine" "progmodes/cc-engine.el"
-;;;;;; (20486 36135 22104 0))
+;;;;;; (20557 48712 315579 0))
;;; Generated autoloads from progmodes/cc-engine.el
(autoload 'c-guess-basic-syntax "cc-engine" "\
@@ -3384,7 +3388,7 @@ Key bindings:
;;;***
;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles"
-;;;;;; "progmodes/cc-styles.el" (20355 10021 546955 0))
+;;;;;; "progmodes/cc-styles.el" (20566 63671 243798 0))
;;; Generated autoloads from progmodes/cc-styles.el
(autoload 'c-set-style "cc-styles" "\
@@ -3401,8 +3405,8 @@ might get set too.
If DONT-OVERRIDE is neither nil nor t, style variables whose default values
have been set (more precisely, whose default values are not the symbol
`set-from-style') will not be changed. This avoids overriding global settings
-done in ~/.emacs. It is useful to call c-set-style from a mode hook in this
-way.
+done in your init file. It is useful to call c-set-style from a mode hook
+in this way.
If DONT-OVERRIDE is t, style variables that already have values (i.e., whose
values are not the symbol `set-from-style') will not be overridden. CC Mode
@@ -4129,8 +4133,8 @@ For example, the function `case' has an indent property
;;;***
-;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (20541 60450
-;;;;;; 834170 0))
+;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (20582 12953
+;;;;;; 724727 481000))
;;; Generated autoloads from emacs-lisp/cl-lib.el
(define-obsolete-variable-alias 'custom-print-functions 'cl-custom-print-functions "24.3")
@@ -4158,7 +4162,7 @@ a future Emacs interpreter will be able to use it.")
;;;***
;;;### (autoloads (c-macro-expand) "cmacexp" "progmodes/cmacexp.el"
-;;;;;; (20495 51111 757560 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from progmodes/cmacexp.el
(autoload 'c-macro-expand "cmacexp" "\
@@ -4222,7 +4226,7 @@ If FRAME cannot display COLOR, return nil.
;;;### (autoloads (comint-redirect-results-list-from-process comint-redirect-results-list
;;;;;; comint-redirect-send-command-to-process comint-redirect-send-command
;;;;;; comint-run make-comint make-comint-in-buffer) "comint" "comint.el"
-;;;;;; (20523 62082 997685 0))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from comint.el
(defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\
@@ -4359,8 +4363,8 @@ on third call it again advances points to the next difference and so on.
;;;;;; compilation-shell-minor-mode compilation-mode compilation-start
;;;;;; compile compilation-disable-input compile-command compilation-search-path
;;;;;; compilation-ask-about-save compilation-window-height compilation-start-hook
-;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20543
-;;;;;; 15782 195452 0))
+;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20576
+;;;;;; 42138 697312 0))
;;; Generated autoloads from progmodes/compile.el
(defvar compilation-mode-hook nil "\
@@ -5147,7 +5151,7 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings.
;;;;;; customize-mode customize customize-push-and-save customize-save-variable
;;;;;; customize-set-variable customize-set-value custom-menu-sort-alphabetically
;;;;;; custom-buffer-sort-alphabetically custom-browse-sort-alphabetically)
-;;;;;; "cus-edit" "cus-edit.el" (20523 62082 997685 0))
+;;;;;; "cus-edit" "cus-edit.el" (20577 33959 40183 0))
;;; Generated autoloads from cus-edit.el
(defvar custom-browse-sort-alphabetically nil "\
@@ -5504,8 +5508,8 @@ Mode used for cvs status output.
;;;***
-;;;### (autoloads (global-cwarn-mode turn-on-cwarn-mode cwarn-mode)
-;;;;;; "cwarn" "progmodes/cwarn.el" (20478 3673 653810 0))
+;;;### (autoloads (global-cwarn-mode cwarn-mode) "cwarn" "progmodes/cwarn.el"
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from progmodes/cwarn.el
(autoload 'cwarn-mode "cwarn" "\
@@ -5523,13 +5527,7 @@ if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
-(autoload 'turn-on-cwarn-mode "cwarn" "\
-Turn on CWarn mode.
-
-This function is designed to be added to hooks, for example:
- (add-hook 'c-mode-hook 'turn-on-cwarn-mode)
-
-\(fn)" nil nil)
+(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1")
(defvar global-cwarn-mode nil "\
Non-nil if Global-Cwarn mode is enabled.
@@ -5784,7 +5782,7 @@ There is some minimal font-lock support (see vars
;;;***
;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug"
-;;;;;; "emacs-lisp/debug.el" (20497 6436 957082 0))
+;;;;;; "emacs-lisp/debug.el" (20572 16038 402143 0))
;;; Generated autoloads from emacs-lisp/debug.el
(setq debugger 'debug)
@@ -5828,7 +5826,7 @@ To specify a nil argument interactively, exit with an empty minibuffer.
;;;***
;;;### (autoloads (decipher-mode decipher) "decipher" "play/decipher.el"
-;;;;;; (20478 3673 653810 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from play/decipher.el
(autoload 'decipher "decipher" "\
@@ -5965,7 +5963,7 @@ any selection.
;;;***
;;;### (autoloads (derived-mode-init-mode-variables define-derived-mode)
-;;;;;; "derived" "emacs-lisp/derived.el" (20437 50597 545250 0))
+;;;;;; "derived" "emacs-lisp/derived.el" (20577 33959 40183 0))
;;; Generated autoloads from emacs-lisp/derived.el
(autoload 'define-derived-mode "derived" "\
@@ -6069,7 +6067,7 @@ relevant to POS.
;;;### (autoloads (desktop-revert desktop-save-in-desktop-dir desktop-change-dir
;;;;;; desktop-load-default desktop-read desktop-remove desktop-save
;;;;;; desktop-clear desktop-locals-to-save desktop-save-mode) "desktop"
-;;;;;; "desktop.el" (20497 6436 957082 0))
+;;;;;; "desktop.el" (20577 33959 40183 0))
;;; Generated autoloads from desktop.el
(defvar desktop-save-mode nil "\
@@ -6234,6 +6232,8 @@ Also inhibit further loading of it.
\(fn)" nil nil)
+(make-obsolete 'desktop-load-default 'desktop-save-mode "22.1")
+
(autoload 'desktop-change-dir "desktop" "\
Change to desktop saved in DIRNAME.
Kill the desktop as specified by variables `desktop-save-mode' and
@@ -6289,14 +6289,14 @@ Deuglify broken Outlook (Express) articles and redisplay.
;;;***
;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib"
-;;;;;; "calendar/diary-lib.el" (20530 32124 97707 678000))
+;;;;;; "calendar/diary-lib.el" (20576 42138 697312 0))
;;; Generated autoloads from calendar/diary-lib.el
(autoload 'diary "diary-lib" "\
Generate the diary window for ARG days starting with the current date.
If no argument is provided, the number of days of diary entries is governed
by the variable `diary-number-of-entries'. A value of ARG less than 1
-does nothing. This function is suitable for execution in a `.emacs' file.
+does nothing. This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
@@ -6307,8 +6307,8 @@ Mail is sent to the address specified by `diary-mail-addr'.
Here is an example of a script to call `diary-mail-entries',
suitable for regular scheduling using cron (or at). Note that
-since `emacs -script' does not load your `.emacs' file, you
-should ensure that all relevant variables are set.
+since `emacs -script' does not load your init file, you should
+ensure that all relevant variables are set.
#!/usr/bin/emacs -script
;; diary-rem.el - run the Emacs diary-reminder
@@ -6331,8 +6331,9 @@ Major mode for editing the diary file.
;;;***
-;;;### (autoloads (diff-buffer-with-file diff-backup diff diff-command
-;;;;;; diff-switches) "diff" "vc/diff.el" (20476 31768 298871 0))
+;;;### (autoloads (diff-buffer-with-file diff-latest-backup-file
+;;;;;; diff-backup diff diff-command diff-switches) "diff" "vc/diff.el"
+;;;;;; (20570 60708 993668 0))
;;; Generated autoloads from vc/diff.el
(defvar diff-switches (purecopy "-c") "\
@@ -6367,6 +6368,11 @@ With prefix arg, prompt for diff switches.
\(fn FILE &optional SWITCHES)" t nil)
+(autoload 'diff-latest-backup-file "diff" "\
+Return the latest existing backup of FILE, or nil.
+
+\(fn FN)" nil nil)
+
(autoload 'diff-buffer-with-file "diff" "\
View the differences between BUFFER and its associated file.
This requires the external program `diff' to be in your `exec-path'.
@@ -6376,7 +6382,7 @@ This requires the external program `diff' to be in your `exec-path'.
;;;***
;;;### (autoloads (diff-minor-mode diff-mode) "diff-mode" "vc/diff-mode.el"
-;;;;;; (20523 62082 997685 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from vc/diff-mode.el
(autoload 'diff-mode "diff-mode" "\
@@ -6420,8 +6426,8 @@ Optional arguments are passed to `dig-invoke'.
;;;***
;;;### (autoloads (dired-mode dired-noselect dired-other-frame dired-other-window
-;;;;;; dired dired-listing-switches) "dired" "dired.el" (20539 18737
-;;;;;; 159373 0))
+;;;;;; dired dired-listing-switches) "dired" "dired.el" (20584 7212
+;;;;;; 455152 0))
;;; Generated autoloads from dired.el
(defvar dired-listing-switches (purecopy "-al") "\
@@ -6777,8 +6783,8 @@ Locate SOA record and increment the serial field.
;;;***
;;;### (autoloads (doc-view-bookmark-jump doc-view-minor-mode doc-view-mode-maybe
-;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20476
-;;;;;; 31768 298871 0))
+;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20581
+;;;;;; 31014 234484 0))
;;; Generated autoloads from doc-view.el
(autoload 'doc-view-mode-p "doc-view" "\
@@ -6865,7 +6871,7 @@ Switch to *dungeon* buffer and start game.
;;;### (autoloads (easy-mmode-defsyntax easy-mmode-defmap easy-mmode-define-keymap
;;;;;; define-globalized-minor-mode define-minor-mode) "easy-mmode"
-;;;;;; "emacs-lisp/easy-mmode.el" (20459 40320 865360 0))
+;;;;;; "emacs-lisp/easy-mmode.el" (20574 57775 217760 0))
;;; Generated autoloads from emacs-lisp/easy-mmode.el
(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
@@ -6877,12 +6883,17 @@ MODE (you can override this with the :variable keyword, see below).
DOC is the documentation for the mode toggle command.
The defined mode command takes one optional (prefix) argument.
-Interactively with no prefix argument it toggles the mode.
-With a prefix argument, it enables the mode if the argument is
-positive and otherwise disables it. When called from Lisp, it
-enables the mode if the argument is omitted or nil, and toggles
-the mode if the argument is `toggle'. If DOC is nil this
-function adds a basic doc-string stating these facts.
+Interactively with no prefix argument, it toggles the mode.
+A prefix argument enables the mode if the argument is positive,
+and disables it otherwise.
+
+When called from Lisp, the mode command toggles the mode if the
+argument is `toggle', disables the mode if the argument is a
+non-positive integer, and enables the mode otherwise (including
+if the argument is omitted or nil or a positive integer).
+
+If DOC is nil, give the mode command a basic doc-string
+documenting what its argument does.
Optional INIT-VALUE is the initial value of the mode's variable.
Optional LIGHTER is displayed in the mode line when the mode is on.
@@ -6995,8 +7006,8 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
;;;***
;;;### (autoloads (easy-menu-change easy-menu-create-menu easy-menu-do-define
-;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20437
-;;;;;; 50597 545250 0))
+;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20563
+;;;;;; 1062 543283 0))
;;; Generated autoloads from emacs-lisp/easymenu.el
(autoload 'easy-menu-define "easymenu" "\
@@ -7150,7 +7161,7 @@ To implement dynamic menus, either call this from
;;;;;; ebnf-eps-file ebnf-eps-directory ebnf-spool-region ebnf-spool-buffer
;;;;;; ebnf-spool-file ebnf-spool-directory ebnf-print-region ebnf-print-buffer
;;;;;; ebnf-print-file ebnf-print-directory ebnf-customize) "ebnf2ps"
-;;;;;; "progmodes/ebnf2ps.el" (20495 51111 757560 0))
+;;;;;; "progmodes/ebnf2ps.el" (20566 63671 243798 0))
;;; Generated autoloads from progmodes/ebnf2ps.el
(autoload 'ebnf-customize "ebnf2ps" "\
@@ -7424,8 +7435,8 @@ See `ebnf-style-database' documentation.
;;;;;; ebrowse-tags-find-declaration-other-window ebrowse-tags-find-definition
;;;;;; ebrowse-tags-view-definition ebrowse-tags-find-declaration
;;;;;; ebrowse-tags-view-declaration ebrowse-member-mode ebrowse-electric-choose-tree
-;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20478
-;;;;;; 3673 653810 0))
+;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20561
+;;;;;; 18280 338092 0))
;;; Generated autoloads from progmodes/ebrowse.el
(autoload 'ebrowse-tree-mode "ebrowse" "\
@@ -7657,7 +7668,7 @@ an EDE controlled project.
;;;### (autoloads (edebug-all-forms edebug-all-defs edebug-eval-top-level-form
;;;;;; edebug-basic-spec edebug-all-forms edebug-all-defs) "edebug"
-;;;;;; "emacs-lisp/edebug.el" (20523 62082 997685 0))
+;;;;;; "emacs-lisp/edebug.el" (20563 1062 543283 0))
;;; Generated autoloads from emacs-lisp/edebug.el
(defvar edebug-all-defs nil "\
@@ -7987,7 +7998,7 @@ Display Ediff's registry.
;;;***
;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe)
-;;;;;; "ediff-util" "vc/ediff-util.el" (20355 10021 546955 0))
+;;;;;; "ediff-util" "vc/ediff-util.el" (20584 7212 455152 0))
;;; Generated autoloads from vc/ediff-util.el
(autoload 'ediff-toggle-multiframe "ediff-util" "\
@@ -8057,7 +8068,7 @@ or nil, use a compact 80-column format.
;;;***
;;;### (autoloads (edt-emulation-on edt-set-scroll-margins) "edt"
-;;;;;; "emulation/edt.el" (20448 20900 17488 0))
+;;;;;; "emulation/edt.el" (20566 63671 243798 0))
;;; Generated autoloads from emulation/edt.el
(autoload 'edt-set-scroll-margins "edt" "\
@@ -8075,7 +8086,7 @@ Turn on EDT Emulation.
;;;***
;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20561 18280 338092 0))
;;; Generated autoloads from ehelp.el
(autoload 'with-electric-help "ehelp" "\
@@ -8319,7 +8330,7 @@ displayed.
;;;***
;;;### (autoloads (emacs-lock-mode) "emacs-lock" "emacs-lock.el"
-;;;;;; (20523 62082 997685 0))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from emacs-lock.el
(autoload 'emacs-lock-mode "emacs-lock" "\
@@ -8347,7 +8358,7 @@ Other values are interpreted as usual.
;;;***
;;;### (autoloads (report-emacs-bug-query-existing-bugs report-emacs-bug)
-;;;;;; "emacsbug" "mail/emacsbug.el" (20523 62082 997685 0))
+;;;;;; "emacsbug" "mail/emacsbug.el" (20576 13095 881042 0))
;;; Generated autoloads from mail/emacsbug.el
(autoload 'report-emacs-bug "emacsbug" "\
@@ -8368,7 +8379,7 @@ The result is an alist with items of the form (URL SUBJECT NO).
;;;;;; emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote
;;;;;; emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor
;;;;;; emerge-buffers emerge-files-with-ancestor emerge-files) "emerge"
-;;;;;; "vc/emerge.el" (20355 10021 546955 0))
+;;;;;; "vc/emerge.el" (20576 42138 697312 0))
;;; Generated autoloads from vc/emerge.el
(autoload 'emerge-files "emerge" "\
@@ -8469,8 +8480,8 @@ Commands:
;;;;;; epa-sign-region epa-verify-cleartext-in-region epa-verify-region
;;;;;; epa-decrypt-armor-in-region epa-decrypt-region epa-encrypt-file
;;;;;; epa-sign-file epa-verify-file epa-decrypt-file epa-select-keys
-;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20434
-;;;;;; 17809 692608 0))
+;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20577
+;;;;;; 33959 40183 0))
;;; Generated autoloads from epa.el
(autoload 'epa-list-keys "epa" "\
@@ -8697,7 +8708,7 @@ Encrypt marked files.
;;;### (autoloads (epa-global-mail-mode epa-mail-import-keys epa-mail-encrypt
;;;;;; epa-mail-sign epa-mail-verify epa-mail-decrypt epa-mail-mode)
-;;;;;; "epa-mail" "epa-mail.el" (20355 10021 546955 0))
+;;;;;; "epa-mail" "epa-mail.el" (20566 63671 243798 0))
;;; Generated autoloads from epa-mail.el
(autoload 'epa-mail-mode "epa-mail" "\
@@ -8767,8 +8778,8 @@ if ARG is omitted or nil.
;;;***
-;;;### (autoloads (epg-make-context) "epg" "epg.el" (20355 10021
-;;;;;; 546955 0))
+;;;### (autoloads (epg-make-context) "epg" "epg.el" (20577 33959
+;;;;;; 40183 0))
;;; Generated autoloads from epg.el
(autoload 'epg-make-context "epg" "\
@@ -8800,7 +8811,7 @@ Look at CONFIG and try to expand GROUP.
;;;***
;;;### (autoloads (erc-handle-irc-url erc-tls erc erc-select-read-args)
-;;;;;; "erc" "erc/erc.el" (20530 32114 546307 0))
+;;;;;; "erc" "erc/erc.el" (20577 33959 40183 0))
;;; Generated autoloads from erc/erc.el
(autoload 'erc-select-read-args "erc" "\
@@ -8855,15 +8866,15 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;***
-;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20434 17809
-;;;;;; 692608 0))
+;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from erc/erc-button.el
(autoload 'erc-button-mode "erc-button" nil t)
;;;***
-;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20355 10021
-;;;;;; 546955 0))
+;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from erc/erc-capab.el
(autoload 'erc-capab-identify-mode "erc-capab" nil t)
@@ -9065,7 +9076,7 @@ You can save every individual message by putting this function on
;;;### (autoloads (erc-delete-dangerous-host erc-add-dangerous-host
;;;;;; erc-delete-keyword erc-add-keyword erc-delete-fool erc-add-fool
;;;;;; erc-delete-pal erc-add-pal) "erc-match" "erc/erc-match.el"
-;;;;;; (20531 24613 995935 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from erc/erc-match.el
(autoload 'erc-match-mode "erc-match")
@@ -9119,7 +9130,7 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'.
;;;***
;;;### (autoloads (erc-cmd-WHOLEFT) "erc-netsplit" "erc/erc-netsplit.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from erc/erc-netsplit.el
(autoload 'erc-netsplit-mode "erc-netsplit")
@@ -9174,7 +9185,7 @@ with args, toggle notify status of people.
;;;***
-;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20355 10021 546955
+;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20566 63671 243798
;;;;;; 0))
;;; Generated autoloads from erc/erc-page.el
(autoload 'erc-page-mode "erc-page")
@@ -9188,8 +9199,8 @@ with args, toggle notify status of people.
;;;***
-;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20355 10021
-;;;;;; 546955 0))
+;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from erc/erc-replace.el
(autoload 'erc-replace-mode "erc-replace")
@@ -9247,15 +9258,15 @@ This will add a speedbar major display mode.
;;;***
-;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20434 17809
-;;;;;; 692608 0))
+;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from erc/erc-stamp.el
(autoload 'erc-timestamp-mode "erc-stamp" nil t)
;;;***
;;;### (autoloads (erc-track-minor-mode) "erc-track" "erc/erc-track.el"
-;;;;;; (20427 14766 970343 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from erc/erc-track.el
(defvar erc-track-minor-mode nil "\
@@ -9315,7 +9326,7 @@ Add a file to `erc-xdcc-files'.
;;;### (autoloads (ert-describe-test ert-run-tests-interactively
;;;;;; ert-run-tests-batch-and-exit ert-run-tests-batch ert-deftest)
-;;;;;; "ert" "emacs-lisp/ert.el" (20355 10021 546955 0))
+;;;;;; "ert" "emacs-lisp/ert.el" (20576 42138 697312 0))
;;; Generated autoloads from emacs-lisp/ert.el
(autoload 'ert-deftest "ert" "\
@@ -9381,7 +9392,7 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test).
;;;***
;;;### (autoloads (ert-kill-all-test-buffers) "ert-x" "emacs-lisp/ert-x.el"
-;;;;;; (20364 28960 773408 688000))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from emacs-lisp/ert-x.el
(put 'ert-with-test-buffer 'lisp-indent-function 1)
@@ -9407,7 +9418,7 @@ Emacs shell interactive mode.
;;;***
;;;### (autoloads (eshell-command-result eshell-command eshell) "eshell"
-;;;;;; "eshell/eshell.el" (20523 62082 997685 0))
+;;;;;; "eshell/eshell.el" (20577 33959 40183 0))
;;; Generated autoloads from eshell/eshell.el
(autoload 'eshell "eshell" "\
@@ -10177,8 +10188,8 @@ This is used only in conjunction with `expand-add-abbrevs'.
;;;***
-;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20461 32935
-;;;;;; 300400 0))
+;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from progmodes/f90.el
(autoload 'f90-mode "f90" "\
@@ -10408,8 +10419,8 @@ Besides the choice of face, it is the same as `buffer-face-mode'.
;;;### (autoloads (feedmail-queue-reminder feedmail-run-the-queue
;;;;;; feedmail-run-the-queue-global-prompt feedmail-run-the-queue-no-prompts
-;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20501 3499
-;;;;;; 284800 0))
+;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from mail/feedmail.el
(autoload 'feedmail-send-it "feedmail" "\
@@ -10464,7 +10475,7 @@ you can set `feedmail-queue-reminder-alist' to nil.
;;;### (autoloads (ffap-bindings ffap-guess-file-name-at-point dired-at-point
;;;;;; ffap-at-mouse ffap-menu find-file-at-point ffap-next) "ffap"
-;;;;;; "ffap.el" (20542 46798 773957 0))
+;;;;;; "ffap.el" (20566 63671 243798 0))
;;; Generated autoloads from ffap.el
(autoload 'ffap-next "ffap" "\
@@ -10656,8 +10667,8 @@ Copy directory-local variables to the -*- line.
;;;***
-;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20476
-;;;;;; 31768 298871 0))
+;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from filesets.el
(autoload 'filesets-init "filesets" "\
@@ -11028,7 +11039,7 @@ Find packages matching a given keyword.
;;;***
;;;### (autoloads (enable-flow-control-on enable-flow-control) "flow-ctrl"
-;;;;;; "flow-ctrl.el" (20355 10021 546955 0))
+;;;;;; "flow-ctrl.el" (20566 63671 243798 0))
;;; Generated autoloads from flow-ctrl.el
(autoload 'enable-flow-control "flow-ctrl" "\
@@ -11066,8 +11077,8 @@ to get the effect of a C-q.
;;;***
;;;### (autoloads (flymake-find-file-hook flymake-mode-off flymake-mode-on
-;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20482 39076
-;;;;;; 289170 0))
+;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20551 9899
+;;;;;; 283417 0))
;;; Generated autoloads from progmodes/flymake.el
(autoload 'flymake-mode "flymake" "\
@@ -11097,7 +11108,7 @@ Turn flymake mode off.
;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off
;;;;;; turn-off-flyspell turn-on-flyspell flyspell-mode flyspell-prog-mode)
-;;;;;; "flyspell" "textmodes/flyspell.el" (20434 17809 692608 0))
+;;;;;; "flyspell" "textmodes/flyspell.el" (20566 63671 243798 0))
;;; Generated autoloads from textmodes/flyspell.el
(autoload 'flyspell-prog-mode "flyspell" "\
@@ -11133,7 +11144,7 @@ invoking `ispell-change-dictionary'.
Consider using the `ispell-parser' to check your text. For instance
consider adding:
\(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))
-in your .emacs file.
+in your init file.
\\[flyspell-region] checks all words inside a region.
\\[flyspell-buffer] checks the whole buffer.
@@ -11651,8 +11662,8 @@ DEFAULT-MAP specifies the default key map for ICON-LIST.
;;;***
;;;### (autoloads (gnus gnus-other-frame gnus-slave gnus-no-server
-;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20503 45225
-;;;;;; 529939 0))
+;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20552 30761
+;;;;;; 207103 0))
;;; Generated autoloads from gnus/gnus.el
(when (fboundp 'custom-autoload)
(custom-autoload 'gnus-select-method "gnus"))
@@ -11796,7 +11807,7 @@ If CLEAN, obsolete (ignore).
;;;***
;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el"
-;;;;;; (20522 9637 465791 0))
+;;;;;; (20578 54821 719276 0))
;;; Generated autoloads from gnus/gnus-art.el
(autoload 'gnus-article-prepare-display "gnus-art" "\
@@ -11951,8 +11962,8 @@ Reminder user if there are unsent drafts.
;;;### (autoloads (gnus-convert-png-to-face gnus-convert-face-to-png
;;;;;; gnus-face-from-file gnus-x-face-from-file gnus-insert-random-x-face-header
-;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (20495
-;;;;;; 51111 757560 0))
+;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (20549
+;;;;;; 54573 979353 0))
;;; Generated autoloads from gnus/gnus-fun.el
(autoload 'gnus-random-x-face "gnus-fun" "\
@@ -12016,7 +12027,7 @@ If gravatars are already displayed, remove them.
;;;***
;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group)
-;;;;;; "gnus-group" "gnus/gnus-group.el" (20495 51111 757560 0))
+;;;;;; "gnus-group" "gnus/gnus-group.el" (20553 51627 169867 0))
;;; Generated autoloads from gnus/gnus-group.el
(autoload 'gnus-fetch-group "gnus-group" "\
@@ -12218,7 +12229,7 @@ Like `message-reply'.
;;;***
;;;### (autoloads (gnus-notifications) "gnus-notifications" "gnus/gnus-notifications.el"
-;;;;;; (20544 36659 880486 0))
+;;;;;; (20559 4008 701730 0))
;;; Generated autoloads from gnus/gnus-notifications.el
(autoload 'gnus-notifications "gnus-notifications" "\
@@ -12482,8 +12493,8 @@ Use \\[describe-mode] for more info.
;;;***
;;;### (autoloads (goto-address-prog-mode goto-address-mode goto-address
-;;;;;; goto-address-at-point) "goto-addr" "net/goto-addr.el" (20355
-;;;;;; 10021 546955 0))
+;;;;;; goto-address-at-point) "goto-addr" "net/goto-addr.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from net/goto-addr.el
(define-obsolete-function-alias 'goto-address-at-mouse 'goto-address-at-point "22.1")
@@ -12543,8 +12554,8 @@ Retrieve MAIL-ADDRESS gravatar and returns it.
;;;### (autoloads (zrgrep rgrep lgrep grep-find grep grep-mode grep-compute-defaults
;;;;;; grep-process-setup grep-setup-hook grep-find-command grep-command
-;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20369 14251
-;;;;;; 85829 0))
+;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20572 16038
+;;;;;; 402143 0))
;;; Generated autoloads from progmodes/grep.el
(defvar grep-window-height nil "\
@@ -12813,7 +12824,7 @@ it if ARG is omitted or nil.
;;;### (autoloads (setf gv-define-simple-setter gv-define-setter
;;;;;; gv--defun-declaration gv-define-expander gv-letplace gv-get)
-;;;;;; "gv" "emacs-lisp/gv.el" (20542 46798 773957 0))
+;;;;;; "gv" "emacs-lisp/gv.el" (20580 10161 446444 0))
;;; Generated autoloads from emacs-lisp/gv.el
(autoload 'gv-get "gv" "\
@@ -12902,8 +12913,8 @@ The return value is the last VAL in the list.
;;;***
-;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20355
-;;;;;; 10021 546955 0))
+;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from play/handwrite.el
(autoload 'handwrite "handwrite" "\
@@ -13126,7 +13137,7 @@ different regions. With numeric argument ARG, behaves like
;;;### (autoloads (doc-file-to-info doc-file-to-man describe-categories
;;;;;; describe-syntax describe-variable variable-at-point describe-function-1
;;;;;; find-lisp-object-file-name help-C-file-name describe-function)
-;;;;;; "help-fns" "help-fns.el" (20532 45476 981297 0))
+;;;;;; "help-fns" "help-fns.el" (20584 7212 455152 0))
;;; Generated autoloads from help-fns.el
(autoload 'describe-function "help-fns" "\
@@ -13205,21 +13216,6 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file.
;;;***
-;;;### (autoloads (three-step-help) "help-macro" "help-macro.el"
-;;;;;; (20355 10021 546955 0))
-;;; Generated autoloads from help-macro.el
-
-(defvar three-step-help nil "\
-Non-nil means give more info about Help command in three steps.
-The three steps are simple prompt, prompt with all options, and
-window listing and describing the options.
-A value of nil means skip the middle step, so that \\[help-command] \\[help-command]
-gives the window that lists the options.")
-
-(custom-autoload 'three-step-help "help-macro" t)
-
-;;;***
-
;;;### (autoloads (help-bookmark-jump help-xref-on-pp help-insert-xref-button
;;;;;; help-xref-button help-make-xrefs help-buffer help-setup-xref
;;;;;; help-mode-finish help-mode-setup help-mode) "help-mode" "help-mode.el"
@@ -13436,7 +13432,7 @@ This discards the buffer's undo information.
;;;### (autoloads (hi-lock-write-interactive-patterns hi-lock-unface-buffer
;;;;;; hi-lock-face-phrase-buffer hi-lock-face-buffer hi-lock-line-face-buffer
;;;;;; global-hi-lock-mode hi-lock-mode) "hi-lock" "hi-lock.el"
-;;;;;; (20522 9637 465791 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from hi-lock.el
(autoload 'hi-lock-mode "hi-lock" "\
@@ -13628,7 +13624,7 @@ Several variables affect how the hiding is done:
;;;***
;;;### (autoloads (turn-off-hideshow hs-minor-mode) "hideshow" "progmodes/hideshow.el"
-;;;;;; (20541 6907 775259 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from progmodes/hideshow.el
(defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil))) "\
@@ -13826,61 +13822,10 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode.
;;;***
-;;;### (autoloads (make-hippie-expand-function hippie-expand hippie-expand-only-buffers
-;;;;;; hippie-expand-ignore-buffers hippie-expand-max-buffers hippie-expand-no-restriction
-;;;;;; hippie-expand-dabbrev-as-symbol hippie-expand-dabbrev-skip-space
-;;;;;; hippie-expand-verbose hippie-expand-try-functions-list) "hippie-exp"
-;;;;;; "hippie-exp.el" (20495 51111 757560 0))
+;;;### (autoloads (make-hippie-expand-function hippie-expand) "hippie-exp"
+;;;;;; "hippie-exp.el" (20584 7212 455152 0))
;;; Generated autoloads from hippie-exp.el
-(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\
-The list of expansion functions tried in order by `hippie-expand'.
-To change the behavior of `hippie-expand', remove, change the order of,
-or insert functions in this list.")
-
-(custom-autoload 'hippie-expand-try-functions-list "hippie-exp" t)
-
-(defvar hippie-expand-verbose t "\
-Non-nil makes `hippie-expand' output which function it is trying.")
-
-(custom-autoload 'hippie-expand-verbose "hippie-exp" t)
-
-(defvar hippie-expand-dabbrev-skip-space nil "\
-Non-nil means tolerate trailing spaces in the abbreviation to expand.")
-
-(custom-autoload 'hippie-expand-dabbrev-skip-space "hippie-exp" t)
-
-(defvar hippie-expand-dabbrev-as-symbol t "\
-Non-nil means expand as symbols, i.e. syntax `_' is considered a letter.")
-
-(custom-autoload 'hippie-expand-dabbrev-as-symbol "hippie-exp" t)
-
-(defvar hippie-expand-no-restriction t "\
-Non-nil means that narrowed buffers are widened during search.")
-
-(custom-autoload 'hippie-expand-no-restriction "hippie-exp" t)
-
-(defvar hippie-expand-max-buffers nil "\
-The maximum number of buffers (apart from the current) searched.
-If nil, all buffers are searched.")
-
-(custom-autoload 'hippie-expand-max-buffers "hippie-exp" t)
-
-(defvar hippie-expand-ignore-buffers (list (purecopy "^ \\*.*\\*$") 'dired-mode) "\
-A list specifying which buffers not to search (if not current).
-Can contain both regexps matching buffer names (as strings) and major modes
-\(as atoms)")
-
-(custom-autoload 'hippie-expand-ignore-buffers "hippie-exp" t)
-
-(defvar hippie-expand-only-buffers nil "\
-A list specifying the only buffers to search (in addition to current).
-Can contain both regexps matching buffer names (as strings) and major modes
-\(as atoms). If non-nil, this variable overrides the variable
-`hippie-expand-ignore-buffers'.")
-
-(custom-autoload 'hippie-expand-only-buffers "hippie-exp" t)
-
(autoload 'hippie-expand "hippie-exp" "\
Try to expand text before point, using multiple methods.
The expansion functions in `hippie-expand-try-functions-list' are
@@ -13956,7 +13901,7 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and
;;;;;; holiday-bahai-holidays holiday-islamic-holidays holiday-christian-holidays
;;;;;; holiday-hebrew-holidays holiday-other-holidays holiday-local-holidays
;;;;;; holiday-oriental-holidays holiday-general-holidays) "holidays"
-;;;;;; "calendar/holidays.el" (20530 32124 107724 973000))
+;;;;;; "calendar/holidays.el" (20566 63671 243798 0))
;;; Generated autoloads from calendar/holidays.el
(define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1")
@@ -14031,7 +13976,7 @@ See the documentation for `calendar-holidays' for details.")
(define-obsolete-variable-alias 'christian-holidays 'holiday-christian-holidays "23.1")
-(defvar holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") (holiday-julian 12 25 "Eastern Orthodox Christmas") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) "\
+(defvar holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") (holiday-julian 12 25 "Christmas (Julian calendar)") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) "\
Christian holidays.
See the documentation for `calendar-holidays' for details.")
@@ -14074,7 +14019,7 @@ See the documentation for `calendar-holidays' for details.")
(autoload 'holidays "holidays" "\
Display the holidays for last month, this month, and next month.
If called with an optional prefix argument ARG, prompts for month and year.
-This function is suitable for execution in a .emacs file.
+This function is suitable for execution in a init file.
\(fn &optional ARG)" t nil)
@@ -14116,7 +14061,7 @@ Convert HTML to plain text in the current buffer.
;;;***
;;;### (autoloads (htmlfontify-copy-and-link-dir htmlfontify-buffer)
-;;;;;; "htmlfontify" "htmlfontify.el" (20355 10021 546955 0))
+;;;;;; "htmlfontify" "htmlfontify.el" (20577 33959 40183 0))
;;; Generated autoloads from htmlfontify.el
(autoload 'htmlfontify-buffer "htmlfontify" "\
@@ -14239,7 +14184,7 @@ bound to the current value of the filter.
;;;***
;;;### (autoloads (ibuffer ibuffer-other-window ibuffer-list-buffers)
-;;;;;; "ibuffer" "ibuffer.el" (20542 46798 773957 0))
+;;;;;; "ibuffer" "ibuffer.el" (20576 13312 649004 817000))
;;; Generated autoloads from ibuffer.el
(autoload 'ibuffer-list-buffers "ibuffer" "\
@@ -14280,7 +14225,7 @@ FORMATS is the value to use for `ibuffer-formats'.
;;;### (autoloads (icalendar-import-buffer icalendar-import-file
;;;;;; icalendar-export-region icalendar-export-file) "icalendar"
-;;;;;; "calendar/icalendar.el" (20434 17809 692608 0))
+;;;;;; "calendar/icalendar.el" (20577 33959 40183 0))
;;; Generated autoloads from calendar/icalendar.el
(autoload 'icalendar-export-file "icalendar" "\
@@ -14397,7 +14342,7 @@ with no args, if that value is non-nil.
;;;***
;;;### (autoloads (idlwave-shell) "idlw-shell" "progmodes/idlw-shell.el"
-;;;;;; (20427 14766 970343 0))
+;;;;;; (20572 16038 402143 0))
;;; Generated autoloads from progmodes/idlw-shell.el
(autoload 'idlwave-shell "idlw-shell" "\
@@ -14423,7 +14368,7 @@ See also the variable `idlwave-shell-prompt-pattern'.
;;;***
;;;### (autoloads (idlwave-mode) "idlwave" "progmodes/idlwave.el"
-;;;;;; (20458 56750 651721 0))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from progmodes/idlwave.el
(autoload 'idlwave-mode "idlwave" "\
@@ -14557,8 +14502,8 @@ The main features of this mode are
;;;;;; ido-find-alternate-file ido-find-file-other-window ido-find-file
;;;;;; ido-find-file-in-dir ido-switch-buffer-other-frame ido-insert-buffer
;;;;;; ido-kill-buffer ido-display-buffer ido-switch-buffer-other-window
-;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20495
-;;;;;; 51111 757560 0))
+;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20585
+;;;;;; 28088 480237 0))
;;; Generated autoloads from ido.el
(defvar ido-mode nil "\
@@ -14817,7 +14762,7 @@ DEF, if non-nil, is the default value.
;;;***
-;;;### (autoloads (ielm) "ielm" "ielm.el" (20355 10021 546955 0))
+;;;### (autoloads (ielm) "ielm" "ielm.el" (20566 63671 243798 0))
;;; Generated autoloads from ielm.el
(autoload 'ielm "ielm" "\
@@ -14850,7 +14795,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
;;;;;; create-image image-type-auto-detected-p image-type-available-p
;;;;;; image-type image-type-from-file-name image-type-from-file-header
;;;;;; image-type-from-buffer image-type-from-data) "image" "image.el"
-;;;;;; (20523 62082 997685 0))
+;;;;;; (20574 57775 217760 0))
;;; Generated autoloads from image.el
(autoload 'image-type-from-data "image" "\
@@ -15251,7 +15196,7 @@ An image file is one whose name has an extension in
;;;***
;;;### (autoloads (image-bookmark-jump image-mode-as-text image-minor-mode
-;;;;;; image-mode) "image-mode" "image-mode.el" (20476 31768 298871
+;;;;;; image-mode) "image-mode" "image-mode.el" (20580 10161 446444
;;;;;; 0))
;;; Generated autoloads from image-mode.el
@@ -15297,7 +15242,7 @@ on these modes.
;;;***
;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar
-;;;;;; imenu-sort-function) "imenu" "imenu.el" (20511 39332 974340
+;;;;;; imenu-sort-function) "imenu" "imenu.el" (20577 33959 40183
;;;;;; 0))
;;; Generated autoloads from imenu.el
@@ -15468,56 +15413,10 @@ Convert old Emacs Devanagari characters to UCS.
;;;***
-;;;### (autoloads (inferior-lisp inferior-lisp-prompt inferior-lisp-load-command
-;;;;;; inferior-lisp-program inferior-lisp-filter-regexp) "inf-lisp"
-;;;;;; "progmodes/inf-lisp.el" (20355 10021 546955 0))
+;;;### (autoloads (inferior-lisp) "inf-lisp" "progmodes/inf-lisp.el"
+;;;;;; (20584 7212 455152 0))
;;; Generated autoloads from progmodes/inf-lisp.el
-(defvar inferior-lisp-filter-regexp (purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'") "\
-What not to save on inferior Lisp's input history.
-Input matching this regexp is not saved on the input history in Inferior Lisp
-mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
-\(as in :a, :c, etc.)")
-
-(custom-autoload 'inferior-lisp-filter-regexp "inf-lisp" t)
-
-(defvar inferior-lisp-program (purecopy "lisp") "\
-Program name for invoking an inferior Lisp in Inferior Lisp mode.")
-
-(custom-autoload 'inferior-lisp-program "inf-lisp" t)
-
-(defvar inferior-lisp-load-command (purecopy "(load \"%s\")\n") "\
-Format-string for building a Lisp expression to load a file.
-This format string should use `%s' to substitute a file name
-and should result in a Lisp expression that will command the inferior Lisp
-to load that file. The default works acceptably on most Lisps.
-The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\"
-produces cosmetically superior output for this application,
-but it works only in Common Lisp.")
-
-(custom-autoload 'inferior-lisp-load-command "inf-lisp" t)
-
-(defvar inferior-lisp-prompt (purecopy "^[^> \n]*>+:? *") "\
-Regexp to recognize prompts in the Inferior Lisp mode.
-Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl,
-and franz. This variable is used to initialize `comint-prompt-regexp' in the
-Inferior Lisp buffer.
-
-This variable is only used if the variable
-`comint-use-prompt-regexp' is non-nil.
-
-More precise choices:
-Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
-franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
-kcl: \"^>+ *\"
-
-This is a fine thing to set in your .emacs file or through Custom.")
-
-(custom-autoload 'inferior-lisp-prompt "inf-lisp" t)
-
-(defvar inferior-lisp-mode-hook 'nil "\
-Hook for customizing Inferior Lisp mode.")
-
(autoload 'inferior-lisp "inf-lisp" "\
Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
If there is a process already running in `*inferior-lisp*', just switch
@@ -15537,7 +15436,7 @@ of `inferior-lisp-program'). Runs the hooks from
;;;;;; Info-goto-emacs-key-command-node Info-goto-emacs-command-node
;;;;;; Info-mode info-finder info-apropos Info-index Info-directory
;;;;;; Info-on-current-buffer info-standalone info-emacs-bug info-emacs-manual
-;;;;;; info info-other-window) "info" "info.el" (20540 39589 424586
+;;;;;; info info-other-window) "info" "info.el" (20561 18280 338092
;;;;;; 0))
;;; Generated autoloads from info.el
@@ -16067,7 +15966,7 @@ Add submenus to the File menu, to convert to and from various formats.
;;;;;; ispell-complete-word ispell-continue ispell-buffer ispell-comments-and-strings
;;;;;; ispell-region ispell-change-dictionary ispell-kill-ispell
;;;;;; ispell-help ispell-pdict-save ispell-word ispell-personal-dictionary)
-;;;;;; "ispell" "textmodes/ispell.el" (20458 56750 651721 0))
+;;;;;; "ispell" "textmodes/ispell.el" (20566 63671 243798 0))
;;; Generated autoloads from textmodes/ispell.el
(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive))))
@@ -16280,7 +16179,7 @@ use the `x' command. (Any subsequent regions will be checked.)
The `X' command aborts sending the message so that you can edit the buffer.
To spell-check whenever a message is sent, include the appropriate lines
-in your .emacs file:
+in your init file:
(add-hook 'message-send-hook 'ispell-message) ;; GNUS 5
(add-hook 'news-inews-hook 'ispell-message) ;; GNUS 4
(add-hook 'mail-send-hook 'ispell-message)
@@ -16294,8 +16193,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to
;;;***
-;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20495
-;;;;;; 51111 757560 0))
+;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20577
+;;;;;; 33959 40183 0))
;;; Generated autoloads from iswitchb.el
(defvar iswitchb-mode nil "\
@@ -16773,8 +16672,8 @@ coding system names is determined from `latex-inputenc-coding-alist'.
;;;***
;;;### (autoloads (latin1-display-ucs-per-lynx latin1-display latin1-display)
-;;;;;; "latin1-disp" "international/latin1-disp.el" (20355 10021
-;;;;;; 546955 0))
+;;;;;; "latin1-disp" "international/latin1-disp.el" (20577 33959
+;;;;;; 40183 0))
;;; Generated autoloads from international/latin1-disp.el
(defvar latin1-display nil "\
@@ -16840,19 +16739,10 @@ generations (this defaults to 1).
;;;***
-;;;### (autoloads (global-linum-mode linum-mode linum-format) "linum"
-;;;;;; "linum.el" (20355 10021 546955 0))
+;;;### (autoloads (global-linum-mode linum-mode) "linum" "linum.el"
+;;;;;; (20580 10161 446444 0))
;;; Generated autoloads from linum.el
-(defvar linum-format 'dynamic "\
-Format used to display line numbers.
-Either a format string like \"%7d\", `dynamic' to adapt the width
-as needed, or a function that is called with a line number as its
-argument and should evaluate to a string to be shown on that line.
-See also `linum-before-numbering-hook'.")
-
-(custom-autoload 'linum-format "linum" t)
-
(autoload 'linum-mode "linum" "\
Toggle display of line numbers in the left margin (Linum mode).
With a prefix argument ARG, enable Linum mode if ARG is positive,
@@ -16919,7 +16809,7 @@ something strange, such as redefining an Emacs function.
;;;***
;;;### (autoloads (locate-with-filter locate locate-ls-subdir-switches)
-;;;;;; "locate" "locate.el" (20355 10021 546955 0))
+;;;;;; "locate" "locate.el" (20566 63671 243798 0))
;;; Generated autoloads from locate.el
(defvar locate-ls-subdir-switches (purecopy "-al") "\
@@ -16971,8 +16861,8 @@ except that FILTER is not optional.
;;;***
-;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20477 21160
-;;;;;; 227853 0))
+;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20584 7212
+;;;;;; 455152 0))
;;; Generated autoloads from vc/log-edit.el
(autoload 'log-edit "log-edit" "\
@@ -17149,14 +17039,14 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).")
;;;***
-;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (20355
-;;;;;; 10021 546955 0))
+;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from calendar/lunar.el
(autoload 'lunar-phases "lunar" "\
Display the quarters of the moon for last month, this month, and next month.
If called with an optional prefix argument ARG, prompts for month and year.
-This function is suitable for execution in a .emacs file.
+This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
@@ -17175,20 +17065,6 @@ A major mode to edit m4 macro files.
;;;***
-;;;### (autoloads (macroexpand-all) "macroexp" "emacs-lisp/macroexp.el"
-;;;;;; (20497 6436 957082 0))
-;;; Generated autoloads from emacs-lisp/macroexp.el
-
-(autoload 'macroexpand-all "macroexp" "\
-Return result of expanding macros at all levels in FORM.
-If no macros are expanded, FORM is returned unchanged.
-The second optional arg ENVIRONMENT specifies an environment of macro
-definitions to shadow the loaded ones for use in file byte-compilation.
-
-\(fn FORM &optional ENVIRONMENT)" nil nil)
-
-;;;***
-
;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro
;;;;;; name-last-kbd-macro) "macros" "macros.el" (20355 10021 546955
;;;;;; 0))
@@ -17312,7 +17188,7 @@ Convert mail domain DOMAIN to the country it corresponds to.
;;;### (autoloads (mail-hist-put-headers-into-history mail-hist-keep-history
;;;;;; mail-hist-enable mail-hist-define-keys) "mail-hist" "mail/mail-hist.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from mail/mail-hist.el
(autoload 'mail-hist-define-keys "mail-hist" "\
@@ -17419,8 +17295,8 @@ matches may be returned from the message body.
;;;***
;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup
-;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20387
-;;;;;; 44199 24128 0))
+;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from mail/mailabbrev.el
(defvar mail-abbrevs-mode nil "\
@@ -17471,7 +17347,7 @@ double-quotes.
;;;### (autoloads (mail-complete mail-completion-at-point-function
;;;;;; define-mail-alias expand-mail-aliases mail-complete-style)
-;;;;;; "mailalias" "mail/mailalias.el" (20355 10021 546955 0))
+;;;;;; "mailalias" "mail/mailalias.el" (20577 33959 40183 0))
;;; Generated autoloads from mail/mailalias.el
(defvar mail-complete-style 'angles "\
@@ -17520,6 +17396,8 @@ current header, calls `mail-complete-function' and passes prefix ARG if any.
\(fn ARG)" t nil)
+(make-obsolete 'mail-complete 'mail-completion-at-point-function "24.1")
+
;;;***
;;;### (autoloads (mailclient-send-it) "mailclient" "mail/mailclient.el"
@@ -17779,7 +17657,7 @@ recursion depth in the minibuffer prompt. This is only useful if
;;;;;; message-forward-make-body message-forward message-recover
;;;;;; message-supersede message-cancel-news message-followup message-wide-reply
;;;;;; message-reply message-news message-mail message-mode) "message"
-;;;;;; "gnus/message.el" (20545 57511 257469 0))
+;;;;;; "gnus/message.el" (20567 23165 75548 0))
;;; Generated autoloads from gnus/message.el
(define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)
@@ -18224,7 +18102,7 @@ to its second argument TM.
;;;***
;;;### (autoloads (minibuffer-electric-default-mode) "minibuf-eldef"
-;;;;;; "minibuf-eldef.el" (20355 10021 546955 0))
+;;;;;; "minibuf-eldef.el" (20580 10161 446444 0))
;;; Generated autoloads from minibuf-eldef.el
(defvar minibuffer-electric-default-mode nil "\
@@ -18366,7 +18244,7 @@ whose file names match the specified wildcard.
;;;***
;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from progmodes/mixal-mode.el
(autoload 'mixal-mode "mixal-mode" "\
@@ -18458,7 +18336,7 @@ Assume text has been decoded if DECODED is non-nil.
;;;***
;;;### (autoloads (mml-attach-file mml-to-mime) "mml" "gnus/mml.el"
-;;;;;; (20458 56750 651721 0))
+;;;;;; (20567 23165 75548 0))
;;; Generated autoloads from gnus/mml.el
(autoload 'mml-to-mime "mml" "\
@@ -18469,7 +18347,8 @@ Translate the current buffer from MML to MIME.
(autoload 'mml-attach-file "mml" "\
Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with
-`\\[message-send-and-exit]' or `\\[message-send]'.
+`\\[message-send-and-exit]' or `\\[message-send]' in Message mode,
+or `\\[mail-send-and-exit]' or `\\[mail-send]' in Mail mode.
FILE is the name of the file to attach. TYPE is its
content-type, a string of the form \"type/subtype\". DESCRIPTION
@@ -18609,7 +18488,7 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text.
;;;***
;;;### (autoloads (mouse-drag-drag mouse-drag-throw) "mouse-drag"
-;;;;;; "mouse-drag.el" (20355 10021 546955 0))
+;;;;;; "mouse-drag.el" (20566 63671 243798 0))
;;; Generated autoloads from mouse-drag.el
(autoload 'mouse-drag-throw "mouse-drag" "\
@@ -18707,7 +18586,7 @@ different buffer menu using the function `msb'.
;;;;;; describe-current-coding-system describe-current-coding-system-briefly
;;;;;; describe-coding-system describe-character-set list-charset-chars
;;;;;; read-charset list-character-sets) "mule-diag" "international/mule-diag.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from international/mule-diag.el
(autoload 'list-character-sets "mule-diag" "\
@@ -18843,19 +18722,10 @@ The default is 20. If LIMIT is negative, do not limit the listing.
;;;;;; detect-coding-with-priority with-coding-priority coding-system-translation-table-for-encode
;;;;;; coding-system-translation-table-for-decode coding-system-pre-write-conversion
;;;;;; coding-system-post-read-conversion lookup-nested-alist set-nested-alist
-;;;;;; truncate-string-to-width store-substring string-to-sequence)
-;;;;;; "mule-util" "international/mule-util.el" (20355 10021 546955
-;;;;;; 0))
+;;;;;; truncate-string-to-width store-substring) "mule-util" "international/mule-util.el"
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from international/mule-util.el
-(autoload 'string-to-sequence "mule-util" "\
-Convert STRING to a sequence of TYPE which contains characters in STRING.
-TYPE should be `list' or `vector'.
-
-\(fn STRING TYPE)" nil nil)
-
-(make-obsolete 'string-to-sequence "use `string-to-list' or `string-to-vector'." "22.1")
-
(defsubst string-to-list (string) "\
Return a list of characters in STRING." (append string nil))
@@ -18964,6 +18834,8 @@ coding systems ordered by priority.
\(fn FROM TO PRIORITY-LIST)" nil t)
+(make-obsolete 'detect-coding-with-priority 'with-coding-priority "23.1")
+
(autoload 'detect-coding-with-language-environment "mule-util" "\
Detect a coding system for the text between FROM and TO with LANG-ENV.
The detection takes into account the coding system priorities for the
@@ -19185,7 +19057,7 @@ STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality.
;;;***
;;;### (autoloads (newsticker-start newsticker-running-p) "newst-backend"
-;;;;;; "net/newst-backend.el" (20355 10021 546955 0))
+;;;;;; "net/newst-backend.el" (20577 33959 40183 0))
;;; Generated autoloads from net/newst-backend.el
(autoload 'newsticker-running-p "newst-backend" "\
@@ -19251,7 +19123,7 @@ running already.
;;;***
;;;### (autoloads (newsticker-treeview) "newst-treeview" "net/newst-treeview.el"
-;;;;;; (20434 17809 692608 0))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from net/newst-treeview.el
(autoload 'newsticker-treeview "newst-treeview" "\
@@ -19311,7 +19183,7 @@ Generate NOV databases in all nnml directories.
;;;***
;;;### (autoloads (disable-command enable-command disabled-command-function)
-;;;;;; "novice" "novice.el" (20478 3673 653810 0))
+;;;;;; "novice" "novice.el" (20566 63671 243798 0))
;;; Generated autoloads from novice.el
(define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1")
@@ -19336,8 +19208,8 @@ to future sessions.
(autoload 'disable-command "novice" "\
Require special confirmation to execute COMMAND from now on.
COMMAND must be a symbol.
-This command alters the user's .emacs file so that this will apply
-to future sessions.
+This command alters your init file so that this choice applies to
+future sessions.
\(fn COMMAND)" t nil)
@@ -19458,7 +19330,7 @@ the variable `nxml-enabled-unicode-blocks'.
;;;;;; org-babel-pop-to-session-maybe org-babel-load-in-session-maybe
;;;;;; org-babel-expand-src-block-maybe org-babel-view-src-block-info
;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob"
-;;;;;; "org/ob.el" (20417 65331 139825 0))
+;;;;;; "org/ob.el" (20585 28088 480237 0))
;;; Generated autoloads from org/ob.el
(autoload 'org-babel-execute-safely-maybe "ob" "\
@@ -19546,13 +19418,13 @@ session.
Initiate session for current code block.
If called with a prefix argument then resolve any variable
references in the header arguments and assign these variables in
-the session. Copy the body of the code block to the kill ring.
+the session. Copy the body of the code block to the kill ring.
\(fn &optional ARG INFO)" t nil)
(autoload 'org-babel-switch-to-session "ob" "\
Switch to the session of the current code block.
-Uses `org-babel-initiate-session' to start the session. If called
+Uses `org-babel-initiate-session' to start the session. If called
with a prefix argument then this is passed on to
`org-babel-initiate-session'.
@@ -19674,7 +19546,7 @@ With optional prefix argument ARG, jump backward ARG many source blocks.
\(fn &optional ARG)" t nil)
(autoload 'org-babel-mark-block "ob" "\
-Mark current src block
+Mark current src block.
\(fn)" t nil)
@@ -19692,8 +19564,8 @@ Describe all keybindings behind `org-babel-key-prefix'.
;;;***
;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe
-;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (20355 10021
-;;;;;; 546955 0))
+;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (20585 28088
+;;;;;; 480237 0))
;;; Generated autoloads from org/ob-lob.el
(autoload 'org-babel-lob-ingest "ob-lob" "\
@@ -19718,7 +19590,7 @@ Return a Library of Babel function call as a string.
;;;### (autoloads (org-babel-tangle org-babel-tangle-file org-babel-load-file
;;;;;; org-babel-tangle-lang-exts) "ob-tangle" "org/ob-tangle.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/ob-tangle.el
(defvar org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "\
@@ -19783,7 +19655,7 @@ startup file, `~/.emacs-octave'.
;;;***
;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el"
-;;;;;; (20388 65061 302484 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from progmodes/octave-mod.el
(autoload 'octave-mode "octave-mod" "\
@@ -19844,12 +19716,12 @@ Variables you can use to customize Octave mode
Turning on Octave mode runs the hook `octave-mode-hook'.
To begin using this mode for all `.m' files that you edit, add the
-following lines to your `.emacs' file:
+following lines to your init file:
(add-to-list 'auto-mode-alist '(\"\\\\.m\\\\'\" . octave-mode))
To automatically turn on the abbrev and auto-fill features,
-add the following lines to your `.emacs' file as well:
+add the following lines to your init file as well:
(add-hook 'octave-mode-hook
(lambda ()
@@ -19865,13 +19737,16 @@ including a reproducible test case and send the message.
;;;***
-;;;### (autoloads (org-customize org-reload org-require-autoloaded-modules
-;;;;;; org-submit-bug-report org-cycle-agenda-files org-switchb
-;;;;;; org-map-entries org-open-link-from-string org-open-at-point-global
-;;;;;; org-insert-link-global org-store-link org-run-like-in-org-mode
-;;;;;; turn-on-orgstruct++ turn-on-orgstruct orgstruct-mode org-global-cycle
-;;;;;; org-mode org-version org-babel-do-load-languages) "org" "org/org.el"
-;;;;;; (20420 41510 996439 0))
+;;;### (autoloads (org-unindent-buffer org-transpose-element org-narrow-to-element
+;;;;;; org-mark-element org-drag-element-forward org-drag-element-backward
+;;;;;; org-up-element org-backward-element org-forward-element org-customize
+;;;;;; org-reload org-require-autoloaded-modules org-submit-bug-report
+;;;;;; org-cycle-agenda-files org-switchb org-map-entries org-update-all-dblocks
+;;;;;; org-open-link-from-string org-open-at-point-global org-insert-link-global
+;;;;;; org-store-link org-run-like-in-org-mode turn-on-orgstruct++
+;;;;;; turn-on-orgstruct orgstruct-mode org-global-cycle org-mode
+;;;;;; org-version org-babel-do-load-languages) "org" "org/org.el"
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org.el
(autoload 'org-babel-do-load-languages "org" "\
@@ -19881,9 +19756,11 @@ Load the languages defined in `org-babel-load-languages'.
(autoload 'org-version "org" "\
Show the org-mode version in the echo area.
-With prefix arg HERE, insert it at point.
+With prefix argument HERE, insert it at point.
+When FULL is non-nil, use a verbose version string.
+When MESSAGE is non-nil, display a message with the version.
-\(fn &optional HERE)" t nil)
+\(fn &optional HERE FULL MESSAGE)" t nil)
(autoload 'org-mode "org" "\
Outline-based notes management and organizer, alias
@@ -19987,6 +19864,12 @@ Open a link in the string S, as if it was in Org-mode.
\(fn S &optional ARG REFERENCE-BUFFER)" t nil)
+(autoload 'org-update-all-dblocks "org" "\
+Update all dynamic blocks in the buffer.
+This function can be used in a hook.
+
+\(fn)" t nil)
+
(autoload 'org-map-entries "org" "\
Call FUNC at each headline selected by MATCH in SCOPE.
@@ -20098,16 +19981,77 @@ Call the customize function with org as argument.
\(fn)" t nil)
+(autoload 'org-forward-element "org" "\
+Move forward by one element.
+Move to the next element at the same level, when possible.
+
+\(fn)" t nil)
+
+(autoload 'org-backward-element "org" "\
+Move backward by one element.
+Move to the previous element at the same level, when possible.
+
+\(fn)" t nil)
+
+(autoload 'org-up-element "org" "\
+Move to upper element.
+
+\(fn)" t nil)
+
+(defvar org-element-greater-elements)
+
+(autoload 'org-drag-element-backward "org" "\
+Move backward element at point.
+
+\(fn)" t nil)
+
+(autoload 'org-drag-element-forward "org" "\
+Move forward element at point.
+
+\(fn)" t nil)
+
+(autoload 'org-mark-element "org" "\
+Put point at beginning of this element, mark at end.
+
+Interactively, if this command is repeated or (in Transient Mark
+mode) if the mark is active, it marks the next element after the
+ones already marked.
+
+\(fn)" t nil)
+
+(autoload 'org-narrow-to-element "org" "\
+Narrow buffer to current element.
+
+\(fn)" t nil)
+
+(autoload 'org-transpose-element "org" "\
+Transpose current and previous elements, keeping blank lines between.
+Point is moved after both elements.
+
+\(fn)" t nil)
+
+(autoload 'org-unindent-buffer "org" "\
+Un-indent the visible part of the buffer.
+Relative indentation (between items, inside blocks, etc.) isn't
+modified.
+
+\(fn)" t nil)
+
;;;***
;;;### (autoloads (org-agenda-to-appt org-calendar-goto-agenda org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list
;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views
;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda
-;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (20420 41510
-;;;;;; 996439 0))
+;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org/org-agenda.el"
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-agenda.el
+(autoload 'org-toggle-sticky-agenda "org-agenda" "\
+Toggle `org-agenda-sticky'.
+
+\(fn &optional ARG)" t nil)
+
(autoload 'org-agenda "org-agenda" "\
Dispatch agenda commands to collect entries to the agenda buffer.
Prompts for a command to execute. Any prefix arg will be passed
@@ -20123,6 +20067,7 @@ M Like `m', but select only TODO entries, no ordinary headlines.
L Create a timeline for the current buffer.
e Export views to associated files.
s Search entries for keywords.
+S Search entries for keywords, only with TODO keywords.
/ Multi occur across all agenda files and also files listed
in `org-agenda-text-search-extra-files'.
< Restrict agenda commands to buffer, subtree, or region.
@@ -20142,7 +20087,7 @@ first press `<' once to indicate that the agenda should be temporarily
Pressing `<' twice means to restrict to the current subtree or region
\(if active).
-\(fn &optional ARG KEYS RESTRICTION)" t nil)
+\(fn &optional ARG ORG-KEYS RESTRICTION)" t nil)
(autoload 'org-batch-agenda "org-agenda" "\
Run an agenda command in batch mode and send the result to STDOUT.
@@ -20268,7 +20213,7 @@ the list to these. When using \\[universal-argument], you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords-1'.
-\(fn ARG)" t nil)
+\(fn &optional ARG)" t nil)
(autoload 'org-tags-view "org-agenda" "\
Show all headlines for all `org-agenda-files' matching a TAGS criterion.
@@ -20285,7 +20230,7 @@ of what a project is and how to check if it stuck, customize the variable
\(fn &rest IGNORE)" t nil)
(autoload 'org-diary "org-agenda" "\
-Return diary information from org-files.
+Return diary information from org files.
This function can be used in a \"sexp\" diary entry in the Emacs calendar.
It accesses org files and extracts information from those files to be
listed in the diary. The function accepts arguments specifying what
@@ -20353,13 +20298,16 @@ By default `org-agenda-to-appt' will use :deadline, :scheduled
and :timestamp entries. See the docstring of `org-diary' for
details and examples.
+If an entry as a APPT_WARNTIME property, its value will be used
+to override `appt-message-warning-time'.
+
\(fn &optional REFRESH FILTER &rest ARGS)" t nil)
;;;***
;;;### (autoloads (org-archive-subtree-default-with-confirmation
;;;;;; org-archive-subtree-default) "org-archive" "org/org-archive.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-archive.el
(autoload 'org-archive-subtree-default "org-archive" "\
@@ -20379,8 +20327,8 @@ This command is set with the variable `org-archive-default-command'.
;;;### (autoloads (org-export-as-ascii org-export-region-as-ascii
;;;;;; org-replace-region-by-ascii org-export-as-ascii-to-buffer
;;;;;; org-export-as-utf8-to-buffer org-export-as-utf8 org-export-as-latin1-to-buffer
-;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (20355
-;;;;;; 10021 546955 0))
+;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (20585
+;;;;;; 28088 480237 0))
;;; Generated autoloads from org/org-ascii.el
(autoload 'org-export-as-latin1 "org-ascii" "\
@@ -20453,8 +20401,8 @@ publishing directory.
;;;***
-;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (20355
-;;;;;; 10021 546955 0))
+;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (20585
+;;;;;; 28088 480237 0))
;;; Generated autoloads from org/org-attach.el
(autoload 'org-attach "org-attach" "\
@@ -20466,7 +20414,7 @@ Shows a list of commands and prompts for another key to execute a command.
;;;***
;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org/org-bbdb.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-bbdb.el
(autoload 'org-bbdb-anniversaries "org-bbdb" "\
@@ -20477,10 +20425,12 @@ Extract anniversaries from BBDB for display in the agenda.
;;;***
;;;### (autoloads (org-capture-import-remember-templates org-capture-insert-template-here
-;;;;;; org-capture) "org-capture" "org/org-capture.el" (20355 10021
-;;;;;; 546955 0))
+;;;;;; org-capture) "org-capture" "org/org-capture.el" (20585 28088
+;;;;;; 480237 0))
;;; Generated autoloads from org/org-capture.el
+(defvar org-capture-initial nil)
+
(autoload 'org-capture "org-capture" "\
Capture something.
\\<org-capture-mode-map>
@@ -20497,9 +20447,12 @@ stored.
When called with a `C-0' (zero) prefix, insert a template at point.
-Lisp programs can set KEYS to a string associated with a template in
-`org-capture-templates'. In this case, interactive selection will be
-bypassed.
+Lisp programs can set KEYS to a string associated with a template
+in `org-capture-templates'. In this case, interactive selection
+will be bypassed.
+
+If `org-capture-use-agenda-date' is non-nil, capturing from the
+agenda will use the date at point as the default date.
\(fn &optional GOTO KEYS)" t nil)
@@ -20515,10 +20468,24 @@ Set org-capture-templates to be similar to `org-remember-templates'.
;;;***
-;;;### (autoloads (org-clock-persistence-insinuate org-get-clocktable)
-;;;;;; "org-clock" "org/org-clock.el" (20427 14766 970343 0))
+;;;### (autoloads (org-clock-persistence-insinuate org-get-clocktable
+;;;;;; org-clock-in-last) "org-clock" "org/org-clock.el" (20585
+;;;;;; 28088 480237 0))
;;; Generated autoloads from org/org-clock.el
+(autoload 'org-clock-in-last "org-clock" "\
+Clock in the last closed clocked item.
+When already clocking in, send an warning.
+With a universal prefix argument, select the task you want to
+clock in from the last clocked in tasks.
+With two universal prefix arguments, start clocking using the
+last clock-out time, if any.
+With three universal prefix arguments, interactively prompt
+for a todo state to switch to, overriding the existing value
+`org-clock-in-switch-to-state'.
+
+\(fn &optional ARG)" t nil)
+
(autoload 'org-get-clocktable "org-clock" "\
Get a formatted clocktable with parameters according to PROPS.
The table is created in a temporary buffer, fully formatted and
@@ -20533,8 +20500,19 @@ Set up hooks for clock persistence.
;;;***
+;;;### (autoloads (org-check-version) "org-compat" "org/org-compat.el"
+;;;;;; (20585 28088 480237 0))
+;;; Generated autoloads from org/org-compat.el
+
+(autoload 'org-check-version "org-compat" "\
+Try very hard to provide sensible version strings.
+
+\(fn)" nil t)
+
+;;;***
+
;;;### (autoloads (org-datetree-find-date-create) "org-datetree"
-;;;;;; "org/org-datetree.el" (20355 10021 546955 0))
+;;;;;; "org/org-datetree.el" (20585 28088 480237 0))
;;; Generated autoloads from org/org-datetree.el
(autoload 'org-datetree-find-date-create "org-datetree" "\
@@ -20550,7 +20528,7 @@ tree can be found.
;;;### (autoloads (org-export-as-docbook org-export-as-docbook-pdf-and-open
;;;;;; org-export-as-docbook-pdf org-export-region-as-docbook org-replace-region-by-docbook
;;;;;; org-export-as-docbook-to-buffer org-export-as-docbook-batch)
-;;;;;; "org-docbook" "org/org-docbook.el" (20355 10021 546955 0))
+;;;;;; "org-docbook" "org/org-docbook.el" (20585 28088 480237 0))
;;; Generated autoloads from org/org-docbook.el
(autoload 'org-export-as-docbook-batch "org-docbook" "\
@@ -20625,9 +20603,67 @@ publishing directory.
;;;***
+;;;### (autoloads (org-element-context org-element-at-point org-element-interpret-data)
+;;;;;; "org-element" "org/org-element.el" (20585 28088 480237 0))
+;;; Generated autoloads from org/org-element.el
+
+(autoload 'org-element-interpret-data "org-element" "\
+Interpret DATA as Org syntax.
+
+DATA is a parse tree, an element, an object or a secondary string
+to interpret.
+
+Optional argument PARENT is used for recursive calls. It contains
+the element or object containing data, or nil.
+
+Return Org syntax as a string.
+
+\(fn DATA &optional PARENT)" nil nil)
+
+(autoload 'org-element-at-point "org-element" "\
+Determine closest element around point.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+of the element and PROPS a plist of properties associated to the
+element.
+
+Possible types are defined in `org-element-all-elements'.
+Properties depend on element or object type, but always
+include :begin, :end, :parent and :post-blank properties.
+
+As a special case, if point is at the very beginning of a list or
+sub-list, returned element will be that list instead of the first
+item. In the same way, if point is at the beginning of the first
+row of a table, returned element will be the table instead of the
+first row.
+
+If optional argument KEEP-TRAIL is non-nil, the function returns
+a list of of elements leading to element at point. The list's
+CAR is always the element at point. Following positions contain
+element's siblings, then parents, siblings of parents, until the
+first element of current section.
+
+\(fn &optional KEEP-TRAIL)" nil nil)
+
+(autoload 'org-element-context "org-element" "\
+Return closest element or object around point.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+of the element or object and PROPS a plist of properties
+associated to it.
+
+Possible types are defined in `org-element-all-elements' and
+`org-element-all-objects'. Properties depend on element or
+object type, but always include :begin, :end, :parent
+and :post-blank properties.
+
+\(fn)" nil nil)
+
+;;;***
+
;;;### (autoloads (org-insert-export-options-template org-export-as-org
;;;;;; org-export-visible org-export) "org-exp" "org/org-exp.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-exp.el
(autoload 'org-export "org-exp" "\
@@ -20688,8 +20724,8 @@ Insert into the buffer a template with information for exporting.
;;;***
;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update
-;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (20355
-;;;;;; 10021 546955 0))
+;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (20585
+;;;;;; 28088 480237 0))
;;; Generated autoloads from org/org-feed.el
(autoload 'org-feed-update-all "org-feed" "\
@@ -20717,7 +20753,7 @@ Show the raw feed buffer of a feed.
;;;***
;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote"
-;;;;;; "org/org-footnote.el" (20378 29222 722320 0))
+;;;;;; "org/org-footnote.el" (20585 28088 480237 0))
;;; Generated autoloads from org/org-footnote.el
(autoload 'org-footnote-action "org-footnote" "\
@@ -20768,7 +20804,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;;;### (autoloads (org-freemind-to-org-mode org-freemind-from-org-sparse-tree
;;;;;; org-freemind-from-org-mode org-freemind-from-org-mode-node
;;;;;; org-freemind-show org-export-as-freemind) "org-freemind"
-;;;;;; "org/org-freemind.el" (20355 10021 546955 0))
+;;;;;; "org/org-freemind.el" (20585 28088 480237 0))
;;; Generated autoloads from org/org-freemind.el
(autoload 'org-export-as-freemind "org-freemind" "\
@@ -20829,7 +20865,7 @@ Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE.
;;;### (autoloads (org-export-htmlize-generate-css org-export-as-html
;;;;;; org-export-region-as-html org-replace-region-by-html org-export-as-html-to-buffer
;;;;;; org-export-as-html-batch org-export-as-html-and-open) "org-html"
-;;;;;; "org/org-html.el" (20355 10021 546955 0))
+;;;;;; "org/org-html.el" (20585 28088 480237 0))
;;; Generated autoloads from org/org-html.el
(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
@@ -20923,7 +20959,7 @@ that uses these same face definitions.
;;;### (autoloads (org-export-icalendar-combine-agenda-files org-export-icalendar-all-agenda-files
;;;;;; org-export-icalendar-this-file) "org-icalendar" "org/org-icalendar.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-icalendar.el
(autoload 'org-export-icalendar-this-file "org-icalendar" "\
@@ -20951,7 +20987,7 @@ The file is stored under the name `org-combined-agenda-icalendar-file'.
;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-find
;;;;;; org-id-goto org-id-get-with-outline-drilling org-id-get-with-outline-path-completion
;;;;;; org-id-get org-id-copy org-id-get-create) "org-id" "org/org-id.el"
-;;;;;; (20545 57511 257469 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-id.el
(autoload 'org-id-get-create "org-id" "\
@@ -21020,7 +21056,7 @@ Store a link to the current entry, using its ID.
;;;***
;;;### (autoloads (org-indent-mode) "org-indent" "org/org-indent.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-indent.el
(autoload 'org-indent-mode "org-indent" "\
@@ -21038,7 +21074,7 @@ during idle time.
;;;***
;;;### (autoloads (org-irc-store-link) "org-irc" "org/org-irc.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-irc.el
(autoload 'org-irc-store-link "org-irc" "\
@@ -21051,7 +21087,7 @@ Dispatch to the appropriate function to store a link to an IRC session.
;;;### (autoloads (org-export-as-pdf-and-open org-export-as-pdf org-export-as-latex
;;;;;; org-export-region-as-latex org-replace-region-by-latex org-export-as-latex-to-buffer
;;;;;; org-export-as-latex-batch) "org-latex" "org/org-latex.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-latex.el
(autoload 'org-export-as-latex-batch "org-latex" "\
@@ -21132,7 +21168,7 @@ Export as LaTeX, then process through to PDF, and open.
;;;### (autoloads (org-lparse-region org-replace-region-by org-lparse-to-buffer
;;;;;; org-lparse-batch org-lparse-and-open) "org-lparse" "org/org-lparse.el"
-;;;;;; (20417 65331 139825 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-lparse.el
(autoload 'org-lparse-and-open "org-lparse" "\
@@ -21189,8 +21225,8 @@ in a window. A non-interactive call will only return the buffer.
;;;***
;;;### (autoloads (org-mobile-create-sumo-agenda org-mobile-pull
-;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (20355
-;;;;;; 10021 546955 0))
+;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (20585
+;;;;;; 28088 480237 0))
;;; Generated autoloads from org/org-mobile.el
(autoload 'org-mobile-push "org-mobile" "\
@@ -21216,9 +21252,11 @@ Create a file that contains all custom agenda views.
;;;### (autoloads (org-export-as-odf-and-open org-export-as-odf org-export-odt-convert
;;;;;; org-export-as-odt org-export-as-odt-batch org-export-as-odt-and-open)
-;;;;;; "org-odt" "org/org-odt.el" (20417 65331 139825 0))
+;;;;;; "org-odt" "org/org-odt.el" (20585 28088 480237 0))
;;; Generated autoloads from org/org-odt.el
+(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp)
+
(autoload 'org-export-as-odt-and-open "org-odt" "\
Export the outline as ODT and immediately open it with a browser.
If there is an active region, export only the region.
@@ -21286,7 +21324,7 @@ formula file.
;;;***
;;;### (autoloads (org-plot/gnuplot) "org-plot" "org/org-plot.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-plot.el
(autoload 'org-plot/gnuplot "org-plot" "\
@@ -21300,7 +21338,7 @@ line directly before or after the table.
;;;### (autoloads (org-publish-current-project org-publish-current-file
;;;;;; org-publish-all org-publish) "org-publish" "org/org-publish.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-publish.el
(defalias 'org-publish-project 'org-publish)
@@ -21334,7 +21372,7 @@ the project.
;;;### (autoloads (org-remember-handler org-remember org-remember-apply-template
;;;;;; org-remember-annotation org-remember-insinuate) "org-remember"
-;;;;;; "org/org-remember.el" (20420 41510 996439 0))
+;;;;;; "org/org-remember.el" (20585 28088 480237 0))
;;; Generated autoloads from org/org-remember.el
(autoload 'org-remember-insinuate "org-remember" "\
@@ -21409,10 +21447,21 @@ See also the variable `org-reverse-note-order'.
;;;***
-;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl)
-;;;;;; "org-table" "org/org-table.el" (20417 65331 139825 0))
+;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl org-table-iterate-buffer-tables
+;;;;;; org-table-recalculate-buffer-tables) "org-table" "org/org-table.el"
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-table.el
+(autoload 'org-table-recalculate-buffer-tables "org-table" "\
+Recalculate all tables in the current buffer.
+
+\(fn)" t nil)
+
+(autoload 'org-table-iterate-buffer-tables "org-table" "\
+Iterate all tables in the buffer, to converge inter-table dependencies.
+
+\(fn)" t nil)
+
(autoload 'turn-on-orgtbl "org-table" "\
Unconditionally turn on `orgtbl-mode'.
@@ -21434,7 +21483,7 @@ The table is taken from the parameter TXT, or from the buffer at point.
;;;***
;;;### (autoloads (org-export-as-taskjuggler-and-open org-export-as-taskjuggler)
-;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (20355 10021 546955
+;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (20585 28088 480237
;;;;;; 0))
;;; Generated autoloads from org/org-taskjuggler.el
@@ -21442,12 +21491,12 @@ The table is taken from the parameter TXT, or from the buffer at point.
Export parts of the current buffer as a TaskJuggler file.
The exporter looks for a tree with tag, property or todo that
matches `org-export-taskjuggler-project-tag' and takes this as
-the tasks for this project. The first node of this tree defines
+the tasks for this project. The first node of this tree defines
the project properties such as project name and project period.
If there is a tree with tag, property or todo that matches
`org-export-taskjuggler-resource-tag' this three is taken as
-resources for the project. If no resources are specified, a
-default resource is created and allocated to the project. Also
+resources for the project. If no resources are specified, a
+default resource is created and allocated to the project. Also
the taskjuggler project will be created with default reports as
defined in `org-export-taskjuggler-default-reports'.
@@ -21462,8 +21511,8 @@ with the TaskJuggler GUI.
;;;***
;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region
-;;;;;; org-timer org-timer-start) "org-timer" "org/org-timer.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; org-timer org-timer-stop org-timer-pause-or-continue org-timer-start)
+;;;;;; "org-timer" "org/org-timer.el" (20585 28088 480237 0))
;;; Generated autoloads from org/org-timer.el
(autoload 'org-timer-start "org-timer" "\
@@ -21479,6 +21528,17 @@ the region 0:00:00.
\(fn &optional OFFSET)" t nil)
+(autoload 'org-timer-pause-or-continue "org-timer" "\
+Pause or continue the relative timer.
+With prefix arg STOP, stop it entirely.
+
+\(fn &optional STOP)" t nil)
+
+(autoload 'org-timer-stop "org-timer" "\
+Stop the relative timer.
+
+\(fn)" t nil)
+
(autoload 'org-timer "org-timer" "\
Insert a H:MM:SS string from the timer into the buffer.
The first time this command is used, the timer is started. When used with
@@ -21523,8 +21583,29 @@ replace any running timer.
;;;***
+;;;### (autoloads (org-git-version org-release) "org-version" "org/org-version.el"
+;;;;;; (20585 28088 480237 0))
+;;; Generated autoloads from org/org-version.el
+
+(autoload 'org-release "org-version" "\
+The release version of org-mode.
+ Inserted by installing org-mode or when a release is made.
+
+\(fn)" nil nil)
+
+(autoload 'org-git-version "org-version" "\
+The Git version of org-mode.
+ Inserted by installing org-mode or when a release is made.
+
+\(fn)" nil nil)
+
+(defconst org-odt-data-dir "/usr/share/emacs/etc/org" "\
+The location of ODT styles.")
+
+;;;***
+
;;;### (autoloads (org-export-as-xoxo) "org-xoxo" "org/org-xoxo.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from org/org-xoxo.el
(autoload 'org-export-as-xoxo "org-xoxo" "\
@@ -21600,7 +21681,7 @@ See the command `outline-mode' for more information on this mode.
;;;### (autoloads (list-packages describe-package package-initialize
;;;;;; package-refresh-contents package-install-file package-install-from-buffer
;;;;;; package-install package-enable-at-startup) "package" "emacs-lisp/package.el"
-;;;;;; (20440 26788 208175 0))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from emacs-lisp/package.el
(defvar package-enable-at-startup t "\
@@ -21765,8 +21846,7 @@ no args, if that value is non-nil.
;;;***
;;;### (autoloads (password-in-cache-p password-cache-expiry password-cache)
-;;;;;; "password-cache" "password-cache.el" (20355 10021 546955
-;;;;;; 0))
+;;;;;; "password-cache" "password-cache.el" (20577 33959 40183 0))
;;; Generated autoloads from password-cache.el
(defvar password-cache t "\
@@ -21788,7 +21868,7 @@ Check if KEY is in the cache.
;;;***
;;;### (autoloads (pcase-let pcase-let* pcase) "pcase" "emacs-lisp/pcase.el"
-;;;;;; (20497 6436 957082 0))
+;;;;;; (20582 12914 894781 0))
;;; Generated autoloads from emacs-lisp/pcase.el
(autoload 'pcase "pcase" "\
@@ -21861,7 +21941,7 @@ Completion rules for the `cvs' command.
;;;***
;;;### (autoloads (pcomplete/tar pcomplete/make pcomplete/bzip2 pcomplete/gzip)
-;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20355 10021 546955 0))
+;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20572 16038 402143 0))
;;; Generated autoloads from pcmpl-gnu.el
(autoload 'pcomplete/gzip "pcmpl-gnu" "\
@@ -21980,8 +22060,8 @@ Includes files as well as host names followed by a colon.
;;;### (autoloads (pcomplete-shell-setup pcomplete-comint-setup pcomplete-list
;;;;;; pcomplete-help pcomplete-expand pcomplete-continue pcomplete-expand-and-complete
-;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (20523
-;;;;;; 62082 997685 0))
+;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (20582
+;;;;;; 12914 894781 0))
;;; Generated autoloads from pcomplete.el
(autoload 'pcomplete "pcomplete" "\
@@ -22040,7 +22120,7 @@ Setup `shell-mode' to use pcomplete.
;;;### (autoloads (cvs-dired-use-hook cvs-dired-action cvs-status
;;;;;; cvs-update cvs-examine cvs-quickdir cvs-checkout) "pcvs"
-;;;;;; "vc/pcvs.el" (20476 31768 298871 0))
+;;;;;; "vc/pcvs.el" (20584 7212 455152 0))
;;; Generated autoloads from vc/pcvs.el
(autoload 'cvs-checkout "pcvs" "\
@@ -22115,8 +22195,8 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d
;;;***
-;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20476 31768
-;;;;;; 298871 0))
+;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20576 42138
+;;;;;; 697312 0))
;;; Generated autoloads from vc/pcvs-defs.el
(defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m)) "\
@@ -22125,7 +22205,7 @@ Global menu used by PCL-CVS.")
;;;***
;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el"
-;;;;;; (20523 62082 997685 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from progmodes/perl-mode.el
(put 'perl-indent-level 'safe-local-variable 'integerp)
(put 'perl-continued-statement-offset 'safe-local-variable 'integerp)
@@ -22187,7 +22267,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'.
;;;***
;;;### (autoloads (picture-mode) "picture" "textmodes/picture.el"
-;;;;;; (20373 11301 906925 0))
+;;;;;; (20551 9899 283417 0))
;;; Generated autoloads from textmodes/picture.el
(autoload 'picture-mode "picture" "\
@@ -22394,7 +22474,7 @@ Ignores leading comment characters.
;;;;;; pr-ps-buffer-print pr-ps-buffer-using-ghostscript pr-ps-buffer-preview
;;;;;; pr-ps-directory-ps-print pr-ps-directory-print pr-ps-directory-using-ghostscript
;;;;;; pr-ps-directory-preview pr-interface) "printing" "printing.el"
-;;;;;; (20501 3499 284800 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from printing.el
(autoload 'pr-interface "printing" "\
@@ -22981,7 +23061,7 @@ are both set to t.
;;;***
-;;;### (autoloads (proced) "proced" "proced.el" (20511 39332 974340
+;;;### (autoloads (proced) "proced" "proced.el" (20576 13095 881042
;;;;;; 0))
;;; Generated autoloads from proced.el
@@ -23000,8 +23080,38 @@ Proced buffers.
;;;***
+;;;### (autoloads (profiler-find-profile-other-frame profiler-find-profile-other-window
+;;;;;; profiler-find-profile profiler-start) "profiler" "profiler.el"
+;;;;;; (20585 28088 480237 0))
+;;; Generated autoloads from profiler.el
+
+(autoload 'profiler-start "profiler" "\
+Start/restart profilers.
+MODE can be one of `cpu', `mem', or `cpu+mem'.
+If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
+Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started.
+
+\(fn MODE)" t nil)
+
+(autoload 'profiler-find-profile "profiler" "\
+Open profile FILENAME.
+
+\(fn FILENAME)" t nil)
+
+(autoload 'profiler-find-profile-other-window "profiler" "\
+Open profile FILENAME.
+
+\(fn FILENAME)" t nil)
+
+(autoload 'profiler-find-profile-other-frame "profiler" "\
+Open profile FILENAME.
+
+\(fn FILENAME)" t nil)
+
+;;;***
+
;;;### (autoloads (run-prolog mercury-mode prolog-mode) "prolog"
-;;;;;; "progmodes/prolog.el" (20397 45851 446679 0))
+;;;;;; "progmodes/prolog.el" (20576 42138 697312 0))
;;; Generated autoloads from progmodes/prolog.el
(autoload 'prolog-mode "prolog" "\
@@ -23048,8 +23158,8 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").")
;;;***
-;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (20355
-;;;;;; 10021 546955 0))
+;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (20576
+;;;;;; 42138 697312 0))
;;; Generated autoloads from progmodes/ps-mode.el
(autoload 'ps-mode "ps-mode" "\
@@ -23100,8 +23210,8 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number
;;;;;; ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer
;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces
;;;;;; ps-print-buffer ps-print-customize ps-print-color-p ps-paper-type
-;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (20355
-;;;;;; 10021 546955 0))
+;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from ps-print.el
(defvar ps-page-dimensions-database (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") (list 'legal (* 72 8.5) (* 72 14.0) "Legal") (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall") (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid") (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger") (list 'statement (* 72 5.5) (* 72 8.5) "Statement") (list 'executive (* 72 7.5) (* 72 10.0) "Executive") (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small") (list 'b4 (* 72 10.125) (* 72 14.33) "B4") (list 'b5 (* 72 7.16) (* 72 10.125) "B5") '(addresslarge 236.0 99.0 "AddressLarge") '(addresssmall 236.0 68.0 "AddressSmall") '(cuthanging13 90.0 222.0 "CutHanging13") '(cuthanging15 90.0 114.0 "CutHanging15") '(diskette 181.0 136.0 "Diskette") '(eurofilefolder 139.0 112.0 "EuropeanFilefolder") '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow") '(eurofolderwide 526.0 136.0 "EuroFolderWide") '(euronamebadge 189.0 108.0 "EuroNameBadge") '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge") '(filefolder 230.0 37.0 "FileFolder") '(jewelry 76.0 136.0 "Jewelry") '(mediabadge 180.0 136.0 "MediaBadge") '(multipurpose 126.0 68.0 "MultiPurpose") '(retaillabel 90.0 104.0 "RetailLabel") '(shipping 271.0 136.0 "Shipping") '(slide35mm 26.0 104.0 "Slide35mm") '(spine8mm 187.0 26.0 "Spine8mm") '(topcoated 425.19685 136.0 "TopCoatedPaper") '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") '(zipdisk 156.0 136.0 "ZipDisk"))) "\
@@ -23298,7 +23408,7 @@ If EXTENSION is any other symbol, it is ignored.
;;;***
;;;### (autoloads (python-mode run-python) "python" "progmodes/python.el"
-;;;;;; (20523 62082 997685 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from progmodes/python.el
(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
@@ -23334,7 +23444,7 @@ if that value is non-nil.
;;;***
;;;### (autoloads (quoted-printable-decode-region) "qp" "gnus/qp.el"
-;;;;;; (20544 36659 880486 0))
+;;;;;; (20557 48712 315579 0))
;;; Generated autoloads from gnus/qp.el
(autoload 'quoted-printable-decode-region "qp" "\
@@ -23588,8 +23698,8 @@ of each directory.
;;;### (autoloads (quickurl-list quickurl-list-mode quickurl-edit-urls
;;;;;; quickurl-browse-url-ask quickurl-browse-url quickurl-add-url
-;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20478
-;;;;;; 3673 653810 0))
+;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from net/quickurl.el
(defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\
@@ -23601,7 +23711,7 @@ To make use of this do something like:
(setq quickurl-postfix quickurl-reread-hook-postfix)
-in your ~/.emacs (after loading/requiring quickurl).")
+in your init file (after loading/requiring quickurl).")
(autoload 'quickurl "quickurl" "\
Insert a URL based on LOOKUP.
@@ -23917,8 +24027,8 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead.
;;;***
;;;### (autoloads (reftex-reset-scanning-information reftex-mode
-;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20507 42276
-;;;;;; 222255 0))
+;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20585 28088
+;;;;;; 480237 0))
;;; Generated autoloads from textmodes/reftex.el
(autoload 'turn-on-reftex "reftex" "\
@@ -23927,13 +24037,7 @@ Turn on RefTeX mode.
\(fn)" nil nil)
(autoload 'reftex-mode "reftex" "\
-Toggle RefTeX mode.
-With a prefix argument ARG, enable RefTeX mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-RefTeX mode is a buffer-local minor mode with distinct support
-for \\label, \\ref and \\cite in LaTeX.
+Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX.
\\<reftex-mode-map>A Table of Contents of the entire (multifile) document with browsing
capabilities is available with `\\[reftex-toc]'.
@@ -23974,7 +24078,7 @@ This enforces rescanning the buffer on next use.
;;;***
;;;### (autoloads (reftex-citation) "reftex-cite" "textmodes/reftex-cite.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from textmodes/reftex-cite.el
(autoload 'reftex-citation "reftex-cite" "\
@@ -24004,7 +24108,7 @@ While entering the regexp, completion on knows citation keys is possible.
;;;***
;;;### (autoloads (reftex-isearch-minor-mode) "reftex-global" "textmodes/reftex-global.el"
-;;;;;; (20427 14766 970343 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from textmodes/reftex-global.el
(autoload 'reftex-isearch-minor-mode "reftex-global" "\
@@ -24021,7 +24125,7 @@ With no argument, this command toggles
;;;***
;;;### (autoloads (reftex-index-phrases-mode) "reftex-index" "textmodes/reftex-index.el"
-;;;;;; (20399 35365 4050 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from textmodes/reftex-index.el
(autoload 'reftex-index-phrases-mode "reftex-index" "\
@@ -24054,7 +24158,7 @@ Here are all local bindings.
;;;***
;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from textmodes/reftex-parse.el
(autoload 'reftex-all-document-files "reftex-parse" "\
@@ -24066,8 +24170,8 @@ of master file.
;;;***
-;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20507
-;;;;;; 42276 222255 0))
+;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20585
+;;;;;; 28088 480237 0))
;;; Generated autoloads from textmodes/reftex-vars.el
(put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
(put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
@@ -24139,15 +24243,15 @@ Extract diary entries from the region.
;;;***
-;;;### (autoloads (repeat) "repeat" "repeat.el" (20388 65061 302484
+;;;### (autoloads (repeat) "repeat" "repeat.el" (20574 57775 217760
;;;;;; 0))
;;; Generated autoloads from repeat.el
(autoload 'repeat "repeat" "\
Repeat most recently executed command.
-With prefix arg, apply new prefix arg to that command; otherwise,
-use the prefix arg that was used before (if any).
-This command is like the `.' command in the vi editor.
+If REPEAT-ARG is non-nil (interactively, with a prefix argument),
+supply a prefix argument to that command. Otherwise, give the
+command the same prefix argument it was given before, if any.
If this command is invoked by a multi-character key sequence, it
can then be repeated by repeating the final character of that
@@ -24323,8 +24427,8 @@ variable.
;;;;;; rmail-secondary-file-directory rmail-primary-inbox-list rmail-highlighted-headers
;;;;;; rmail-retry-ignored-headers rmail-displayed-headers rmail-ignored-headers
;;;;;; rmail-user-mail-address-regexp rmail-movemail-variant-p rmail-spool-directory
-;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20526 43809 637014
-;;;;;; 858000))
+;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20568 19013 9762
+;;;;;; 342000))
;;; Generated autoloads from mail/rmail.el
(defvar rmail-file-name (purecopy "~/RMAIL") "\
@@ -24744,7 +24848,7 @@ Toggle the use of ROT13 encoding for the current window.
;;;***
;;;### (autoloads (rst-minor-mode rst-mode) "rst" "textmodes/rst.el"
-;;;;;; (20523 62082 997685 0))
+;;;;;; (20576 13095 881042 0))
;;; Generated autoloads from textmodes/rst.el
(add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode)))
@@ -24775,7 +24879,7 @@ for modes derived from Text mode, like Mail mode.
;;;***
;;;### (autoloads (ruby-mode) "ruby-mode" "progmodes/ruby-mode.el"
-;;;;;; (20522 38650 757441 0))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from progmodes/ruby-mode.el
(autoload 'ruby-mode "ruby-mode" "\
@@ -25126,8 +25230,8 @@ enclosed in `(and ...)'.
;;;***
-;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20523
-;;;;;; 62082 997685 0))
+;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20577
+;;;;;; 33959 40183 0))
;;; Generated autoloads from savehist.el
(defvar savehist-mode nil "\
@@ -25320,7 +25424,7 @@ Semantic mode.
;;;;;; mail-personal-alias-file mail-default-reply-to mail-archive-file-name
;;;;;; mail-header-separator send-mail-function mail-interactive
;;;;;; mail-self-blind mail-specify-envelope-from mail-from-style)
-;;;;;; "sendmail" "mail/sendmail.el" (20501 3499 284800 0))
+;;;;;; "sendmail" "mail/sendmail.el" (20577 33959 40183 0))
;;; Generated autoloads from mail/sendmail.el
(defvar mail-from-style 'default "\
@@ -25602,8 +25706,8 @@ Like `mail' command, but display mail buffer in another frame.
;;;***
;;;### (autoloads (server-save-buffers-kill-terminal server-mode
-;;;;;; server-force-delete server-start) "server" "server.el" (20545
-;;;;;; 57511 257469 0))
+;;;;;; server-force-delete server-start) "server" "server.el" (20584
+;;;;;; 7212 455152 0))
;;; Generated autoloads from server.el
(put 'server-host 'risky-local-variable t)
@@ -25670,7 +25774,7 @@ only these files will be asked to be saved.
;;;***
-;;;### (autoloads (ses-mode) "ses" "ses.el" (20493 9382 687578 0))
+;;;### (autoloads (ses-mode) "ses" "ses.el" (20553 51627 169867 0))
;;; Generated autoloads from ses.el
(autoload 'ses-mode "ses" "\
@@ -25689,7 +25793,7 @@ These are active only in the minibuffer, when entering or editing a formula:
;;;***
;;;### (autoloads (html-mode sgml-mode) "sgml-mode" "textmodes/sgml-mode.el"
-;;;;;; (20478 3673 653810 0))
+;;;;;; (20580 10161 446444 0))
;;; Generated autoloads from textmodes/sgml-mode.el
(autoload 'sgml-mode "sgml-mode" "\
@@ -25703,7 +25807,7 @@ the next N words. In Transient Mark mode, when the mark is active,
N defaults to -1, which means to wrap it around the current region.
If you like upcased tags, put (setq sgml-transformation-function 'upcase)
-in your `.emacs' file.
+in your init file.
Use \\[sgml-validate] to validate your document with an SGML parser.
@@ -25755,7 +25859,7 @@ To work around that, do:
;;;***
;;;### (autoloads (sh-mode) "sh-script" "progmodes/sh-script.el"
-;;;;;; (20541 6907 775259 0))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from progmodes/sh-script.el
(put 'sh-shell 'safe-local-variable 'symbolp)
@@ -25819,7 +25923,7 @@ with your script for an edit-interpret-debug cycle.
;;;***
;;;### (autoloads (list-load-path-shadows) "shadow" "emacs-lisp/shadow.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20572 16038 402143 0))
;;; Generated autoloads from emacs-lisp/shadow.el
(autoload 'list-load-path-shadows "shadow" "\
@@ -25909,7 +26013,7 @@ Set up file shadowing.
;;;***
;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el"
-;;;;;; (20478 3673 653810 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from shell.el
(defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\
@@ -26176,7 +26280,7 @@ symmetrical ones, and the same character twice for the others.
;;;***
;;;### (autoloads (smerge-start-session smerge-mode smerge-ediff)
-;;;;;; "smerge-mode" "vc/smerge-mode.el" (20523 62082 997685 0))
+;;;;;; "smerge-mode" "vc/smerge-mode.el" (20585 28088 480237 0))
;;; Generated autoloads from vc/smerge-mode.el
(autoload 'smerge-ediff "smerge-mode" "\
@@ -26222,7 +26326,7 @@ interactively. If there's no argument, do it at the current buffer.
;;;***
;;;### (autoloads (smtpmail-send-queued-mail smtpmail-send-it) "smtpmail"
-;;;;;; "mail/smtpmail.el" (20402 11562 85788 0))
+;;;;;; "mail/smtpmail.el" (20551 9899 283417 0))
;;; Generated autoloads from mail/smtpmail.el
(autoload 'smtpmail-send-it "smtpmail" "\
@@ -26262,7 +26366,7 @@ Snake mode keybindings:
;;;***
;;;### (autoloads (snmpv2-mode snmp-mode) "snmp-mode" "net/snmp-mode.el"
-;;;;;; (20478 3673 653810 0))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from net/snmp-mode.el
(autoload 'snmp-mode "snmp-mode" "\
@@ -26291,8 +26395,8 @@ then `snmpv2-mode-hook'.
;;;***
-;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (20355
-;;;;;; 10021 546955 0))
+;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from calendar/solar.el
(autoload 'sunrise-sunset "solar" "\
@@ -26301,7 +26405,7 @@ If called with an optional prefix argument ARG, prompt for date.
If called with an optional double prefix argument, prompt for
longitude, latitude, time zone, and date, and always use standard time.
-This function is suitable for execution in a .emacs file.
+This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
@@ -26595,7 +26699,7 @@ Spam reports will be queued with the method used when
;;;***
;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar"
-;;;;;; "speedbar.el" (20497 6436 957082 0))
+;;;;;; "speedbar.el" (20566 63671 243798 0))
;;; Generated autoloads from speedbar.el
(defalias 'speedbar 'speedbar-frame-mode)
@@ -26639,7 +26743,7 @@ Return a vector containing the lines from `spook-phrases-file'.
;;;;;; sql-ms sql-ingres sql-solid sql-mysql sql-sqlite sql-informix
;;;;;; sql-sybase sql-oracle sql-product-interactive sql-connect
;;;;;; sql-mode sql-help sql-add-product-keywords) "sql" "progmodes/sql.el"
-;;;;;; (20480 38535 248706 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from progmodes/sql.el
(autoload 'sql-add-product-keywords "sql" "\
@@ -26719,8 +26823,8 @@ For information on how to create multiple SQLi buffers, see
`sql-interactive-mode'.
Note that SQL doesn't have an escape character unless you specify
-one. If you specify backslash as escape character in SQL,
-you must tell Emacs. Here's how to do that in your `~/.emacs' file:
+one. If you specify backslash as escape character in SQL, you
+must tell Emacs. Here's how to do that in your init file:
\(add-hook 'sql-mode-hook
(lambda ()
@@ -27175,8 +27279,8 @@ GnuTLS requires a port number.
;;;;;; strokes-mode strokes-list-strokes strokes-load-user-strokes
;;;;;; strokes-help strokes-describe-stroke strokes-do-complex-stroke
;;;;;; strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke
-;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20523
-;;;;;; 62082 997685 0))
+;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from strokes.el
(autoload 'strokes-global-set-stroke "strokes" "\
@@ -27367,7 +27471,7 @@ See `subword-mode' for more information on Subword mode.
;;;***
;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from mail/supercite.el
(autoload 'sc-cite-original "supercite" "\
@@ -27464,7 +27568,7 @@ The variable `tab-width' controls the spacing of tab stops.
;;;;;; table-recognize table-insert-row-column table-insert-column
;;;;;; table-insert-row table-insert table-point-left-cell-hook
;;;;;; table-point-entered-cell-hook table-load-hook table-cell-map-hook)
-;;;;;; "table" "textmodes/table.el" (20434 17809 692608 0))
+;;;;;; "table" "textmodes/table.el" (20566 63671 243798 0))
;;; Generated autoloads from textmodes/table.el
(defvar table-cell-map-hook nil "\
@@ -28068,8 +28172,8 @@ Connect to the Emacs talk group from the current X display or tty frame.
;;;***
-;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20522 9637
-;;;;;; 465791 0))
+;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20585 28088
+;;;;;; 480237 0))
;;; Generated autoloads from tar-mode.el
(autoload 'tar-mode "tar-mode" "\
@@ -28093,7 +28197,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
;;;***
;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl"
-;;;;;; "progmodes/tcl.el" (20355 10021 546955 0))
+;;;;;; "progmodes/tcl.el" (20580 10161 446444 0))
;;; Generated autoloads from progmodes/tcl.el
(autoload 'tcl-mode "tcl" "\
@@ -28168,7 +28272,7 @@ Normally input is edited in Emacs and sent a line at a time.
;;;***
;;;### (autoloads (serial-term ansi-term term make-term) "term" "term.el"
-;;;;;; (20478 3673 653810 0))
+;;;;;; (20580 10161 446444 0))
;;; Generated autoloads from term.el
(autoload 'make-term "term" "\
@@ -28248,7 +28352,7 @@ subprocess started.
;;;***
;;;### (autoloads (testcover-this-defun) "testcover" "emacs-lisp/testcover.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20580 10161 446444 0))
;;; Generated autoloads from emacs-lisp/testcover.el
(autoload 'testcover-this-defun "testcover" "\
@@ -28290,7 +28394,7 @@ tetris-mode keybindings:
;;;;;; tex-start-commands tex-start-options slitex-run-command latex-run-command
;;;;;; tex-run-command tex-offer-save tex-main-file tex-first-line-header-regexp
;;;;;; tex-directory tex-shell-file-name) "tex-mode" "textmodes/tex-mode.el"
-;;;;;; (20523 62082 997685 0))
+;;;;;; (20584 7212 455152 0))
;;; Generated autoloads from textmodes/tex-mode.el
(defvar tex-shell-file-name nil "\
@@ -28948,7 +29052,7 @@ This function performs no refilling of the changed text.
;;;### (autoloads (emacs-init-time emacs-uptime display-time-world
;;;;;; display-time-mode display-time display-time-day-and-date)
-;;;;;; "time" "time.el" (20387 44199 24128 0))
+;;;;;; "time" "time.el" (20561 45732 920134 0))
;;; Generated autoloads from time.el
(defvar display-time-day-and-date nil "\
@@ -29128,7 +29232,7 @@ This function does not work for SECONDS greater than `most-positive-fixnum'.
;;;***
;;;### (autoloads (time-stamp-toggle-active time-stamp) "time-stamp"
-;;;;;; "time-stamp.el" (20355 10021 546955 0))
+;;;;;; "time-stamp.el" (20566 63671 243798 0))
;;; Generated autoloads from time-stamp.el
(put 'time-stamp-format 'safe-local-variable 'stringp)
(put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p)
@@ -29142,7 +29246,7 @@ This function does not work for SECONDS greater than `most-positive-fixnum'.
(autoload 'time-stamp "time-stamp" "\
Update the time stamp string(s) in the buffer.
A template in a file can be automatically updated with a new time stamp
-every time you save the file. Add this line to your .emacs file:
+every time you save the file. Add this line to your init file:
(add-hook 'before-save-hook 'time-stamp)
or customize `before-save-hook' through Custom.
Normally the template must appear in the first 8 lines of a file and
@@ -29172,7 +29276,7 @@ With ARG, turn time stamping on if and only if arg is positive.
;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out
;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in
;;;;;; timeclock-mode-line-display) "timeclock" "calendar/timeclock.el"
-;;;;;; (20523 62082 997685 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from calendar/timeclock.el
(autoload 'timeclock-mode-line-display "timeclock" "\
@@ -29466,7 +29570,7 @@ holds a keymap.
;;;***
;;;### (autoloads (tpu-edt-on tpu-edt-mode) "tpu-edt" "emulation/tpu-edt.el"
-;;;;;; (20399 35365 4050 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from emulation/tpu-edt.el
(defvar tpu-edt-mode nil "\
@@ -29496,7 +29600,7 @@ Turn on TPU/edt emulation.
;;;***
;;;### (autoloads (tpu-mapper) "tpu-mapper" "emulation/tpu-mapper.el"
-;;;;;; (20355 10021 546955 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from emulation/tpu-mapper.el
(autoload 'tpu-mapper "tpu-mapper" "\
@@ -29512,7 +29616,7 @@ Finally, you will be prompted for the name of the file to store the key
definitions. If you chose the default, TPU-edt will find it and load it
automatically. If you specify a different file name, you will need to
set the variable ``tpu-xkeys-file'' before starting TPU-edt. Here's how
-you might go about doing that in your .emacs file.
+you might go about doing that in your init file.
(setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\"))
(tpu-edt)
@@ -29582,7 +29686,7 @@ BUFFER defaults to `trace-buffer'.
;;;### (autoloads (tramp-unload-tramp tramp-completion-handle-file-name-completion
;;;;;; tramp-completion-handle-file-name-all-completions tramp-unload-file-name-handlers
;;;;;; tramp-file-name-handler tramp-syntax tramp-mode) "tramp"
-;;;;;; "net/tramp.el" (20530 32114 546307 0))
+;;;;;; "net/tramp.el" (20561 18280 338092 0))
;;; Generated autoloads from net/tramp.el
(defvar tramp-mode t "\
@@ -29725,8 +29829,8 @@ Discard Tramp from loading remote files.
;;;***
-;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20518
-;;;;;; 12580 46478 0))
+;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20584
+;;;;;; 7212 455152 0))
;;; Generated autoloads from tutorial.el
(autoload 'help-with-tutorial "tutorial" "\
@@ -29762,7 +29866,7 @@ resumed later.
;;;***
;;;### (autoloads (2C-split 2C-associate-buffer 2C-two-columns) "two-column"
-;;;;;; "textmodes/two-column.el" (20364 31990 752722 691000))
+;;;;;; "textmodes/two-column.el" (20566 63671 243798 0))
;;; Generated autoloads from textmodes/two-column.el
(autoload '2C-command "two-column" () t 'keymap)
(global-set-key "\C-x6" '2C-command)
@@ -29810,71 +29914,19 @@ First column's text sSs Second column's text
;;;***
;;;### (autoloads (type-break-guesstimate-keystroke-threshold type-break-statistics
-;;;;;; type-break type-break-mode type-break-keystroke-threshold
-;;;;;; type-break-good-break-interval type-break-good-rest-interval
-;;;;;; type-break-interval type-break-mode) "type-break" "type-break.el"
-;;;;;; (20545 57511 257469 0))
+;;;;;; type-break type-break-mode) "type-break" "type-break.el"
+;;;;;; (20582 12914 894781 0))
;;; Generated autoloads from type-break.el
(defvar type-break-mode nil "\
-Toggle typing break mode.
-See the docstring for the `type-break-mode' command for more information.
+Non-nil if Type-Break mode is enabled.
+See the command `type-break-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
-use either \\[customize] or the function `type-break-mode'.")
+either customize it (see the info node `Easy Customization')
+or call the function `type-break-mode'.")
(custom-autoload 'type-break-mode "type-break" nil)
-(defvar type-break-interval (* 60 60) "\
-Number of seconds between scheduled typing breaks.")
-
-(custom-autoload 'type-break-interval "type-break" t)
-
-(defvar type-break-good-rest-interval (/ type-break-interval 6) "\
-Number of seconds of idle time considered to be an adequate typing rest.
-
-When this variable is non-nil, Emacs checks the idle time between
-keystrokes. If this idle time is long enough to be considered a \"good\"
-rest from typing, then the next typing break is simply rescheduled for later.
-
-If a break is interrupted before this much time elapses, the user will be
-asked whether or not really to interrupt the break.")
-
-(custom-autoload 'type-break-good-rest-interval "type-break" t)
-
-(defvar type-break-good-break-interval nil "\
-Number of seconds considered to be an adequate explicit typing rest.
-
-When this variable is non-nil, its value is considered to be a \"good\"
-length (in seconds) for a break initiated by the command `type-break',
-overriding `type-break-good-rest-interval'. This provides querying of
-break interruptions when `type-break-good-rest-interval' is nil.")
-
-(custom-autoload 'type-break-good-break-interval "type-break" t)
-
-(defvar type-break-keystroke-threshold (let* ((wpm 35) (avg-word-length 5) (upper (* wpm avg-word-length (/ type-break-interval 60))) (lower (/ upper 5))) (cons lower upper)) "\
-Upper and lower bound on number of keystrokes for considering typing break.
-This structure is a pair of numbers (MIN . MAX).
-
-The first number is the minimum number of keystrokes that must have been
-entered since the last typing break before considering another one, even if
-the scheduled time has elapsed; the break is simply rescheduled until later
-if the minimum threshold hasn't been reached. If this first value is nil,
-then there is no minimum threshold; as soon as the scheduled time has
-elapsed, the user will always be queried.
-
-The second number is the maximum number of keystrokes that can be entered
-before a typing break is requested immediately, pre-empting the originally
-scheduled break. If this second value is nil, then no pre-emptive breaks
-will occur; only scheduled ones will.
-
-Keys with bucky bits (shift, control, meta, etc) are counted as only one
-keystroke even though they really require multiple keys to generate them.
-
-The command `type-break-guesstimate-keystroke-threshold' can be used to
-guess a reasonably good pair of values for this variable.")
-
-(custom-autoload 'type-break-keystroke-threshold "type-break" t)
-
(autoload 'type-break-mode "type-break" "\
Enable or disable typing-break mode.
This is a minor mode, but it is global to all buffers by default.
@@ -29949,7 +30001,7 @@ across Emacs sessions. This provides recovery of the break status between
sessions and after a crash. Manual changes to the file may result in
problems.
-\(fn &optional PREFIX)" t nil)
+\(fn &optional ARG)" t nil)
(autoload 'type-break "type-break" "\
Take a typing break.
@@ -29995,8 +30047,8 @@ FRAC should be the inverse of the fractional value; for example, a value of
;;;***
-;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (20355 10021
-;;;;;; 546955 0))
+;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from mail/uce.el
(autoload 'uce-reply-to-uce "uce" "\
@@ -30323,7 +30375,7 @@ Might do a non-blocking connection; use `process-status' to check.
;;;### (autoloads (url-insert-file-contents url-file-local-copy url-copy-file
;;;;;; url-file-handler url-handler-mode) "url-handlers" "url/url-handlers.el"
-;;;;;; (20440 54677 388705 0))
+;;;;;; (20584 7212 455152 0))
;;; Generated autoloads from url/url-handlers.el
(defvar url-handler-mode nil "\
@@ -30581,7 +30633,7 @@ Fetch a data URL (RFC 2397).
;;;***
;;;### (autoloads (url-generic-parse-url url-recreate-url) "url-parse"
-;;;;;; "url/url-parse.el" (20523 62082 997685 0))
+;;;;;; "url/url-parse.el" (20577 33959 40183 0))
;;; Generated autoloads from url/url-parse.el
(autoload 'url-recreate-url "url-parse" "\
@@ -30664,8 +30716,8 @@ The variable `url-queue-timeout' sets a timeout.
;;;;;; url-percentage url-display-percentage url-pretty-length url-strip-leading-spaces
;;;;;; url-eat-trailing-space url-get-normalized-date url-lazy-message
;;;;;; url-normalize-url url-insert-entities-in-string url-parse-args
-;;;;;; url-debug url-debug) "url-util" "url/url-util.el" (20520
-;;;;;; 54308 826101 0))
+;;;;;; url-debug url-debug) "url-util" "url/url-util.el" (20584
+;;;;;; 7212 455152 0))
;;; Generated autoloads from url/url-util.el
(defvar url-debug nil "\
@@ -30691,8 +30743,8 @@ If a list, it is a list of the types of messages to be logged.")
(autoload 'url-insert-entities-in-string "url-util" "\
Convert HTML markup-start characters to entity references in STRING.
Also replaces the \" character, so that the result may be safely used as
- an attribute value in a tag. Returns a new string with the result of the
- conversion. Replaces these characters as follows:
+an attribute value in a tag. Returns a new string with the result of the
+conversion. Replaces these characters as follows:
& ==> &amp;
< ==> &lt;
> ==> &gt;
@@ -30767,7 +30819,19 @@ Given a QUERY in the form:
(key2 val2)
(key3 val1 val2)
(key4)
- (key5
+ (key5 \"\"))
+
+\(This is the same format as produced by `url-parse-query-string')
+
+This will return a string
+\"key1=val1&key2=val2&key3=val1&key3=val2&key4&key5\". Keys may
+be strings or symbols; if they are symbols, the symbol name will
+be used.
+
+When SEMICOLONS is given, the separator will be \";\".
+
+When KEEP-EMPTY is given, empty values will show as \"key=\"
+instead of just \"key\" as in the example above.
\(fn QUERY &optional SEMICOLONS KEEP-EMPTY)" nil nil)
@@ -30827,7 +30891,7 @@ This uses `url-current-object', set locally to the buffer.
;;;***
;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock)
-;;;;;; "userlock" "userlock.el" (20490 33188 850375 0))
+;;;;;; "userlock" "userlock.el" (20555 6946 859539 0))
;;; Generated autoloads from userlock.el
(autoload 'ask-user-about-lock "userlock" "\
@@ -30925,8 +30989,8 @@ If FILE-NAME is non-nil, save the result to FILE-NAME.
;;;;;; vc-print-log vc-retrieve-tag vc-create-tag vc-merge vc-insert-headers
;;;;;; vc-revision-other-window vc-root-diff vc-ediff vc-version-ediff
;;;;;; vc-diff vc-version-diff vc-register vc-next-action vc-before-checkin-hook
-;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20542
-;;;;;; 46798 773957 0))
+;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20580
+;;;;;; 10161 446444 0))
;;; Generated autoloads from vc/vc.el
(defvar vc-checkout-hook nil "\
@@ -31252,7 +31316,7 @@ mode-specific menu. `vc-annotate-color-map' and
;;;***
-;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20489 12324 656827
+;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20584 7212 455152
;;;;;; 0))
;;; Generated autoloads from vc/vc-bzr.el
@@ -31330,7 +31394,7 @@ case, and the process object in the asynchronous case.
;;;***
-;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20495 51111 757560
+;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20566 63671 243798
;;;;;; 0))
;;; Generated autoloads from vc/vc-git.el
(defun vc-git-registered (file)
@@ -31370,7 +31434,7 @@ Name of the monotone directory's format file.")
;;;***
;;;### (autoloads (vc-rcs-master-templates) "vc-rcs" "vc/vc-rcs.el"
-;;;;;; (20478 3673 653810 0))
+;;;;;; (20584 7212 455152 0))
;;; Generated autoloads from vc/vc-rcs.el
(defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\
@@ -31384,7 +31448,7 @@ For a description of possible values, see `vc-check-master-templates'.")
;;;***
;;;### (autoloads (vc-sccs-master-templates) "vc-sccs" "vc/vc-sccs.el"
-;;;;;; (20430 41939 815258 390000))
+;;;;;; (20584 7212 455152 0))
;;; Generated autoloads from vc/vc-sccs.el
(defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\
@@ -31392,7 +31456,8 @@ Where to look for SCCS master files.
For a description of possible values, see `vc-check-master-templates'.")
(custom-autoload 'vc-sccs-master-templates "vc-sccs" t)
- (defun vc-sccs-registered(f) (vc-default-registered 'SCCS f))
+
+(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f))
(defun vc-sccs-search-project-dir (dirname basename) "\
Return the name of a master file in the SCCS project directory.
@@ -31416,7 +31481,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir)
;;;***
;;;### (autoloads (vera-mode) "vera-mode" "progmodes/vera-mode.el"
-;;;;;; (20434 17809 692608 0))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from progmodes/vera-mode.el
(add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode))
@@ -31474,7 +31539,7 @@ Key bindings:
;;;***
;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el"
-;;;;;; (20420 41510 996439 0))
+;;;;;; (20581 31014 234484 0))
;;; Generated autoloads from progmodes/verilog-mode.el
(autoload 'verilog-mode "verilog-mode" "\
@@ -31613,7 +31678,7 @@ Key bindings specific to `verilog-mode-map' are:
;;;***
;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el"
-;;;;;; (20495 51111 757560 0))
+;;;;;; (20584 7212 455152 0))
;;; Generated autoloads from progmodes/vhdl-mode.el
(autoload 'vhdl-mode "vhdl-mode" "\
@@ -32167,7 +32232,7 @@ Key bindings:
;;;***
-;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20355 10021 546955
+;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20566 63671 243798
;;;;;; 0))
;;; Generated autoloads from emulation/vi.el
@@ -32271,7 +32336,7 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics.
;;;;;; view-mode view-buffer-other-frame view-buffer-other-window
;;;;;; view-buffer view-file-other-frame view-file-other-window
;;;;;; view-file kill-buffer-if-not-modified view-remove-frame-by-deleting)
-;;;;;; "view" "view.el" (20355 10021 546955 0))
+;;;;;; "view" "view.el" (20577 33959 40183 0))
;;; Generated autoloads from view.el
(defvar view-remove-frame-by-deleting t "\
@@ -32501,6 +32566,8 @@ entry for the selected window, purge that entry from
\(fn BUFFER &optional ITEM)" nil nil)
+(make-obsolete 'view-return-to-alist-update '"this function has no effect." "24.1")
+
(autoload 'view-mode-enter "view" "\
Enter View mode and set up exit from view mode depending on optional arguments.
Optional argument QUIT-RESTORE if non-nil must specify a valid
@@ -32542,7 +32609,7 @@ Turn on VIP emulation of VI.
;;;***
;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "emulation/viper.el"
-;;;;;; (20501 3499 284800 0))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from emulation/viper.el
(autoload 'toggle-viper-mode "viper" "\
@@ -32666,8 +32733,8 @@ See `wdired-mode'.
;;;***
-;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20355 10021
-;;;;;; 546955 0))
+;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from net/webjump.el
(autoload 'webjump "webjump" "\
@@ -32683,16 +32750,13 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke
;;;***
-;;;### (autoloads (which-function-mode which-func-mode) "which-func"
-;;;;;; "progmodes/which-func.el" (20523 62082 997685 0))
+;;;### (autoloads (which-function-mode) "which-func" "progmodes/which-func.el"
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from progmodes/which-func.el
(put 'which-func-format 'risky-local-variable t)
(put 'which-func-current 'risky-local-variable t)
-(autoload 'which-func-mode "which-func" "\
-
-
-\(fn &optional ARG)" nil nil)
+(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1")
(defvar which-function-mode nil "\
Non-nil if Which-Function mode is enabled.
@@ -33194,8 +33258,8 @@ Setup current buffer so editing string widgets works.
;;;***
;;;### (autoloads (windmove-default-keybindings windmove-down windmove-right
-;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20495
-;;;;;; 51111 757560 0))
+;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from windmove.el
(autoload 'windmove-left "windmove" "\
@@ -33247,20 +33311,25 @@ Default MODIFIER is 'shift.
;;;***
-;;;### (autoloads (winner-mode winner-mode) "winner" "winner.el"
-;;;;;; (20478 3673 653810 0))
+;;;### (autoloads (winner-mode) "winner" "winner.el" (20584 7212
+;;;;;; 455152 0))
;;; Generated autoloads from winner.el
(defvar winner-mode nil "\
-Toggle Winner mode.
+Non-nil if Winner mode is enabled.
+See the command `winner-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
-use either \\[customize] or the function `winner-mode'.")
+either customize it (see the info node `Easy Customization')
+or call the function `winner-mode'.")
(custom-autoload 'winner-mode "winner" nil)
(autoload 'winner-mode "winner" "\
-Toggle Winner mode.
-With arg, turn Winner mode on if and only if arg is positive.
+Toggle Winner mode on or off.
+With a prefix argument ARG, enable Winner mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
+\\{winner-mode-map}
\(fn &optional ARG)" t nil)
@@ -33729,25 +33798,26 @@ Zone out, completely.
;;;;;; "gnus/nntp.el" "gnus/nnvirtual.el" "gnus/nnweb.el" "gnus/registry.el"
;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2104.el"
;;;;;; "gnus/rfc2231.el" "gnus/rtree.el" "gnus/shr-color.el" "gnus/sieve-manage.el"
-;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "hex-util.el"
-;;;;;; "hfy-cmap.el" "ibuf-ext.el" "international/cp51932.el" "international/eucjp-ms.el"
-;;;;;; "international/fontset.el" "international/iso-ascii.el" "international/ja-dic-cnv.el"
-;;;;;; "international/ja-dic-utl.el" "international/ogonek.el" "international/uni-bidi.el"
-;;;;;; "international/uni-category.el" "international/uni-combining.el"
-;;;;;; "international/uni-comment.el" "international/uni-decimal.el"
-;;;;;; "international/uni-decomposition.el" "international/uni-digit.el"
-;;;;;; "international/uni-lowercase.el" "international/uni-mirrored.el"
-;;;;;; "international/uni-name.el" "international/uni-numeric.el"
-;;;;;; "international/uni-old-name.el" "international/uni-titlecase.el"
-;;;;;; "international/uni-uppercase.el" "json.el" "kermit.el" "language/hanja-util.el"
-;;;;;; "language/thai-word.el" "ldefs-boot.el" "loadup.el" "mail/blessmail.el"
-;;;;;; "mail/mailheader.el" "mail/mspools.el" "mail/rfc2368.el"
-;;;;;; "mail/rfc822.el" "mail/rmail-spam-filter.el" "mail/rmailedit.el"
-;;;;;; "mail/rmailkwd.el" "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el"
-;;;;;; "mail/rmailsum.el" "mail/undigest.el" "md4.el" "mh-e/mh-acros.el"
-;;;;;; "mh-e/mh-alias.el" "mh-e/mh-buffers.el" "mh-e/mh-compat.el"
-;;;;;; "mh-e/mh-funcs.el" "mh-e/mh-gnus.el" "mh-e/mh-identity.el"
-;;;;;; "mh-e/mh-inc.el" "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.el"
+;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "help-macro.el"
+;;;;;; "hex-util.el" "hfy-cmap.el" "ibuf-ext.el" "international/cp51932.el"
+;;;;;; "international/eucjp-ms.el" "international/fontset.el" "international/iso-ascii.el"
+;;;;;; "international/ja-dic-cnv.el" "international/ja-dic-utl.el"
+;;;;;; "international/ogonek.el" "international/uni-bidi.el" "international/uni-category.el"
+;;;;;; "international/uni-combining.el" "international/uni-comment.el"
+;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el"
+;;;;;; "international/uni-digit.el" "international/uni-lowercase.el"
+;;;;;; "international/uni-mirrored.el" "international/uni-name.el"
+;;;;;; "international/uni-numeric.el" "international/uni-old-name.el"
+;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el"
+;;;;;; "json.el" "kermit.el" "language/hanja-util.el" "language/thai-word.el"
+;;;;;; "ldefs-boot.el" "loadup.el" "mail/blessmail.el" "mail/mailheader.el"
+;;;;;; "mail/mspools.el" "mail/rfc2368.el" "mail/rfc822.el" "mail/rmail-spam-filter.el"
+;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el"
+;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el"
+;;;;;; "mail/undigest.el" "md4.el" "mh-e/mh-acros.el" "mh-e/mh-alias.el"
+;;;;;; "mh-e/mh-buffers.el" "mh-e/mh-compat.el" "mh-e/mh-funcs.el"
+;;;;;; "mh-e/mh-gnus.el" "mh-e/mh-identity.el" "mh-e/mh-inc.el"
+;;;;;; "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.el"
;;;;;; "mh-e/mh-loaddefs.el" "mh-e/mh-mime.el" "mh-e/mh-print.el"
;;;;;; "mh-e/mh-scan.el" "mh-e/mh-search.el" "mh-e/mh-seq.el" "mh-e/mh-show.el"
;;;;;; "mh-e/mh-speed.el" "mh-e/mh-thread.el" "mh-e/mh-tool-bar.el"
@@ -33770,47 +33840,47 @@ Zone out, completely.
;;;;;; "org/ob-awk.el" "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el"
;;;;;; "org/ob-css.el" "org/ob-ditaa.el" "org/ob-dot.el" "org/ob-emacs-lisp.el"
;;;;;; "org/ob-eval.el" "org/ob-exp.el" "org/ob-fortran.el" "org/ob-gnuplot.el"
-;;;;;; "org/ob-haskell.el" "org/ob-java.el" "org/ob-js.el" "org/ob-latex.el"
-;;;;;; "org/ob-ledger.el" "org/ob-lilypond.el" "org/ob-lisp.el"
-;;;;;; "org/ob-matlab.el" "org/ob-maxima.el" "org/ob-mscgen.el"
+;;;;;; "org/ob-haskell.el" "org/ob-io.el" "org/ob-java.el" "org/ob-js.el"
+;;;;;; "org/ob-latex.el" "org/ob-ledger.el" "org/ob-lilypond.el"
+;;;;;; "org/ob-lisp.el" "org/ob-matlab.el" "org/ob-maxima.el" "org/ob-mscgen.el"
;;;;;; "org/ob-ocaml.el" "org/ob-octave.el" "org/ob-org.el" "org/ob-perl.el"
;;;;;; "org/ob-picolisp.el" "org/ob-plantuml.el" "org/ob-python.el"
-;;;;;; "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el" "org/ob-scheme.el"
-;;;;;; "org/ob-screen.el" "org/ob-sh.el" "org/ob-shen.el" "org/ob-sql.el"
-;;;;;; "org/ob-sqlite.el" "org/ob-table.el" "org/org-beamer.el"
-;;;;;; "org/org-bibtex.el" "org/org-colview.el" "org/org-compat.el"
-;;;;;; "org/org-crypt.el" "org/org-ctags.el" "org/org-docview.el"
-;;;;;; "org/org-entities.el" "org/org-eshell.el" "org/org-exp-blocks.el"
-;;;;;; "org/org-faces.el" "org/org-gnus.el" "org/org-habit.el" "org/org-info.el"
-;;;;;; "org/org-inlinetask.el" "org/org-install.el" "org/org-jsinfo.el"
-;;;;;; "org/org-list.el" "org/org-mac-message.el" "org/org-macs.el"
-;;;;;; "org/org-mew.el" "org/org-mhe.el" "org/org-mks.el" "org/org-mouse.el"
-;;;;;; "org/org-pcomplete.el" "org/org-protocol.el" "org/org-rmail.el"
-;;;;;; "org/org-special-blocks.el" "org/org-src.el" "org/org-vm.el"
-;;;;;; "org/org-w3m.el" "org/org-wl.el" "play/gamegrid.el" "play/gametree.el"
-;;;;;; "play/meese.el" "progmodes/ada-prj.el" "progmodes/cc-align.el"
-;;;;;; "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el" "progmodes/cc-cmds.el"
-;;;;;; "progmodes/cc-defs.el" "progmodes/cc-fonts.el" "progmodes/cc-langs.el"
-;;;;;; "progmodes/cc-menus.el" "progmodes/ebnf-abn.el" "progmodes/ebnf-bnf.el"
-;;;;;; "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el" "progmodes/ebnf-iso.el"
-;;;;;; "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" "progmodes/idlw-complete-structtag.el"
-;;;;;; "progmodes/idlw-help.el" "progmodes/idlw-toolbar.el" "progmodes/mantemp.el"
-;;;;;; "progmodes/xscheme.el" "ps-def.el" "ps-mule.el" "ps-samp.el"
-;;;;;; "saveplace.el" "sb-image.el" "scroll-bar.el" "select.el"
-;;;;;; "soundex.el" "subdirs.el" "tempo.el" "textmodes/bib-mode.el"
-;;;;;; "textmodes/makeinfo.el" "textmodes/page-ext.el" "textmodes/refbib.el"
-;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el"
-;;;;;; "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" "textmodes/reftex-toc.el"
-;;;;;; "textmodes/texnfo-upd.el" "timezone.el" "tooltip.el" "tree-widget.el"
-;;;;;; "uniquify.el" "url/url-about.el" "url/url-cookie.el" "url/url-dired.el"
-;;;;;; "url/url-domsuf.el" "url/url-expand.el" "url/url-ftp.el"
-;;;;;; "url/url-future.el" "url/url-history.el" "url/url-imap.el"
-;;;;;; "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el"
-;;;;;; "url/url-vars.el" "vc/ediff-diff.el" "vc/ediff-init.el" "vc/ediff-merg.el"
-;;;;;; "vc/ediff-ptch.el" "vc/ediff-vers.el" "vc/ediff-wind.el"
-;;;;;; "vc/pcvs-info.el" "vc/pcvs-parse.el" "vc/pcvs-util.el" "vc/vc-dav.el"
-;;;;;; "vcursor.el" "vt-control.el" "vt100-led.el" "w32-fns.el"
-;;;;;; "w32-vars.el" "x-dnd.el") (20545 57718 475744 538000))
+;;;;;; "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el" "org/ob-scala.el"
+;;;;;; "org/ob-scheme.el" "org/ob-screen.el" "org/ob-sh.el" "org/ob-shen.el"
+;;;;;; "org/ob-sql.el" "org/ob-sqlite.el" "org/ob-table.el" "org/org-beamer.el"
+;;;;;; "org/org-bibtex.el" "org/org-colview.el" "org/org-crypt.el"
+;;;;;; "org/org-ctags.el" "org/org-docview.el" "org/org-entities.el"
+;;;;;; "org/org-eshell.el" "org/org-exp-blocks.el" "org/org-faces.el"
+;;;;;; "org/org-gnus.el" "org/org-habit.el" "org/org-info.el" "org/org-inlinetask.el"
+;;;;;; "org/org-install.el" "org/org-jsinfo.el" "org/org-list.el"
+;;;;;; "org/org-mac-message.el" "org/org-macs.el" "org/org-mew.el"
+;;;;;; "org/org-mhe.el" "org/org-mks.el" "org/org-mouse.el" "org/org-pcomplete.el"
+;;;;;; "org/org-protocol.el" "org/org-rmail.el" "org/org-special-blocks.el"
+;;;;;; "org/org-src.el" "org/org-vm.el" "org/org-w3m.el" "org/org-wl.el"
+;;;;;; "play/gamegrid.el" "play/gametree.el" "play/meese.el" "progmodes/ada-prj.el"
+;;;;;; "progmodes/cc-align.el" "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el"
+;;;;;; "progmodes/cc-cmds.el" "progmodes/cc-defs.el" "progmodes/cc-fonts.el"
+;;;;;; "progmodes/cc-langs.el" "progmodes/cc-menus.el" "progmodes/ebnf-abn.el"
+;;;;;; "progmodes/ebnf-bnf.el" "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el"
+;;;;;; "progmodes/ebnf-iso.el" "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el"
+;;;;;; "progmodes/idlw-complete-structtag.el" "progmodes/idlw-help.el"
+;;;;;; "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" "progmodes/xscheme.el"
+;;;;;; "ps-def.el" "ps-mule.el" "ps-samp.el" "saveplace.el" "sb-image.el"
+;;;;;; "scroll-bar.el" "select.el" "soundex.el" "subdirs.el" "tempo.el"
+;;;;;; "textmodes/bib-mode.el" "textmodes/makeinfo.el" "textmodes/page-ext.el"
+;;;;;; "textmodes/refbib.el" "textmodes/refer.el" "textmodes/reftex-auc.el"
+;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el"
+;;;;;; "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el" "timezone.el"
+;;;;;; "tooltip.el" "tree-widget.el" "uniquify.el" "url/url-about.el"
+;;;;;; "url/url-cookie.el" "url/url-dired.el" "url/url-domsuf.el"
+;;;;;; "url/url-expand.el" "url/url-ftp.el" "url/url-future.el"
+;;;;;; "url/url-history.el" "url/url-imap.el" "url/url-methods.el"
+;;;;;; "url/url-nfs.el" "url/url-proxy.el" "url/url-vars.el" "vc/ediff-diff.el"
+;;;;;; "vc/ediff-init.el" "vc/ediff-merg.el" "vc/ediff-ptch.el"
+;;;;;; "vc/ediff-vers.el" "vc/ediff-wind.el" "vc/pcvs-info.el" "vc/pcvs-parse.el"
+;;;;;; "vc/pcvs-util.el" "vc/vc-dav.el" "vcursor.el" "vt-control.el"
+;;;;;; "vt100-led.el" "w32-fns.el" "w32-vars.el" "x-dnd.el") (20585
+;;;;;; 28294 985050 730000))
;;;***
diff --git a/lisp/linum.el b/lisp/linum.el
index 162dc19f437..3c278dbbf3b 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -44,7 +44,6 @@
"Show line numbers in the left margin."
:group 'convenience)
-;;;###autoload
(defcustom linum-format 'dynamic
"Format used to display line numbers.
Either a format string like \"%7d\", `dynamic' to adapt the width
@@ -52,7 +51,9 @@ as needed, or a function that is called with a line number as its
argument and should evaluate to a string to be shown on that line.
See also `linum-before-numbering-hook'."
:group 'linum
- :type 'sexp)
+ :type '(choice (string :tag "Format string")
+ (const :tag "Dynamic width" dynamic)
+ (function :tag "Function")))
(defface linum
'((t :inherit (shadow default)))
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 6ee3c7898c5..0066847e995 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -248,6 +248,13 @@ usually do not have translators for other languages.\n\n")))
"', version "
(mapconcat 'number-to-string (x-server-version) ".") "\n")
(error t)))
+ (let ((lsb (with-temp-buffer
+ (if (eq 0 (ignore-errors
+ (call-process "lsb_release" nil '(t nil)
+ nil "-d")))
+ (buffer-string)))))
+ (if (stringp lsb)
+ (insert "System " lsb "\n")))
(when (and system-configuration-options
(not (equal system-configuration-options "")))
(insert "Configured using:\n `configure "
@@ -308,9 +315,14 @@ usually do not have translators for other languages.\n\n")))
(insert "\n"))
(insert "\n")
(insert "Load-path shadows:\n")
- (message "Checking for load-path shadows...")
- (let ((shadows (list-load-path-shadows t)))
- (message "Checking for load-path shadows...done")
+ (let* ((msg "Checking for load-path shadows...")
+ (result "done")
+ (shadows (progn (message "%s" msg)
+ (condition-case nil (list-load-path-shadows t)
+ (error
+ (setq result "error")
+ "Error during checking")))))
+ (message "%s%s" msg result)
(insert (if (zerop (length shadows))
"None found.\n"
shadows)))
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index 0b55fe42e42..c7943fe40c8 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -427,6 +427,7 @@ For use on `completion-at-point-functions'."
"Perform completion on header field or word preceding point.
Completable headers are according to `mail-complete-alist'. If none matches
current header, calls `mail-complete-function' and passes prefix ARG if any."
+ (declare (obsolete mail-completion-at-point-function "24.1"))
(interactive "P")
;; Read the defaults first, if we have not done so.
(sendmail-sync-aliases)
@@ -439,7 +440,6 @@ current header, calls `mail-complete-function' and passes prefix ARG if any."
(if data
(apply #'completion-in-region data)
(funcall mail-complete-function arg))))
-(make-obsolete 'mail-complete 'mail-completion-at-point-function "24.1")
(defun mail-completion-expand (table)
"Build new completion table that expands aliases.
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index d88862b2d47..c75a1989e8e 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -4068,6 +4068,13 @@ The variable `rmail-retry-ignored-headers' is a regular expression
specifying headers which should not be copied into the new message."
(interactive)
(require 'mail-utils)
+ (if rmail-enable-mime
+ (with-current-buffer rmail-buffer
+ (if (rmail-mime-message-p)
+ (let ((rmail-mime-mbox-buffer rmail-view-buffer)
+ (rmail-mime-view-buffer rmail-buffer))
+ (rmail-mime-toggle-raw 'raw)))))
+
(let ((rmail-this-buffer (current-buffer))
(msgnum rmail-current-message)
bounce-start bounce-end bounce-indent resending
@@ -4543,7 +4550,7 @@ encoded string (and the same mask) will decode the string."
;;; Start of automatically extracted autoloads.
;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el"
-;;;;;; "7d558f958574f6003fa474ce2f3c80a8")
+;;;;;; "78b8b7d5c679935c118d595d473d7c5e")
;;; Generated autoloads from rmailedit.el
(autoload 'rmail-edit-current-message "rmailedit" "\
@@ -4598,7 +4605,7 @@ With prefix argument N moves forward N messages with these labels.
;;;***
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "cd7656f82944d0b92b0d093a5f3a4c36")
+;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "f1937f85a1258de8880a089fa5ae5621")
;;; Generated autoloads from rmailmm.el
(autoload 'rmail-mime "rmailmm" "\
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index 0b837a43d94..e4e066bd642 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -111,6 +111,8 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
;; Even if the message is in `raw' state, boundaries etc
;; are still missing. All we can do is insert the real
;; raw message. (Bug#9840)
+ ;; FIXME? Since the 2012-09-17 changes to rmail-mime,
+ ;; can we just use that function now?
(when (and entity
(not (equal "text/plain"
(car (rmail-mime-entity-type entity)))))
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 67b2e62275f..11bccd59765 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -389,13 +389,13 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode."
;; Enter the raw mode.
(rmail-mime-raw-mode entity)
;; Enter the shown mode.
- (rmail-mime-shown-mode entity))
- (let ((inhibit-read-only t)
- (modified (buffer-modified-p)))
- (save-excursion
- (goto-char (aref segment 1))
- (rmail-mime-insert entity)
- (restore-buffer-modified-p modified)))))
+ (rmail-mime-shown-mode entity)
+ (let ((inhibit-read-only t)
+ (modified (buffer-modified-p)))
+ (save-excursion
+ (goto-char (aref segment 1))
+ (rmail-mime-insert entity)
+ (restore-buffer-modified-p modified))))))
(defun rmail-mime-toggle-hidden ()
"Hide or show the body of the MIME-entity at point."
@@ -832,7 +832,7 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
(let ((boundary (cdr (assq 'boundary content-type)))
(subtype (cadr (split-string (car content-type) "/")))
(index 0)
- beg end next entities truncated)
+ beg end next entities truncated last)
(unless boundary
(rmail-mm-get-boundary-error-message
"No boundary defined" content-type content-disposition
@@ -867,7 +867,13 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
;; Handle the rest of the truncated message
;; (if it isn't empty) by pretending that the boundary
;; appears at the end of the message.
- (and (save-excursion
+ ;; We use `last' to distinguish this from the more
+ ;; likely situation of there being an epilogue
+ ;; after the last boundary, which should be ignored.
+ ;; See rmailmm-test-multipart-handler for an example,
+ ;; and also bug#10101.
+ (and (not last)
+ (save-excursion
(skip-chars-forward "\n")
(> (point-max) (point)))
(setq truncated t end (point-max))))
@@ -875,7 +881,8 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
;; epilogue, else hide the boundary only. Use a marker for
;; `next' because `rmail-mime-show' may change the buffer.
(cond ((looking-at "--[ \t]*$")
- (setq next (point-max-marker)))
+ (setq next (point-max-marker)
+ last t))
((looking-at "[ \t]*\n")
(setq next (copy-marker (match-end 0) t)))
(truncated
@@ -1212,7 +1219,7 @@ available."
(if (rmail-mime-display-header current)
(delete-char (- (aref segment 2) (aref segment 1))))
(insert-buffer-substring rmail-mime-mbox-buffer
- (aref header 0) (aref header 1)))
+ (aref header 0) (aref header 1)))
;; tagline
(if (rmail-mime-display-tagline current)
(delete-char (- (aref segment 3) (aref segment 2))))
@@ -1261,14 +1268,17 @@ The arguments ARG and STATE have no effect in this case."
(interactive (list current-prefix-arg nil))
(if rmail-enable-mime
(with-current-buffer rmail-buffer
- (if (rmail-mime-message-p)
- (let ((rmail-mime-mbox-buffer rmail-view-buffer)
- (rmail-mime-view-buffer rmail-buffer)
- (entity (get-text-property
- (progn
- (or arg (goto-char (point-min)))
- (point)) 'rmail-mime-entity)))
- (if (or (not arg) entity) (rmail-mime-toggle-raw state)))
+ (if (or (rmail-mime-message-p)
+ (get-text-property (point-min) 'rmail-mime-hidden))
+ (let* ((hidden (get-text-property (point-min) 'rmail-mime-hidden))
+ (desired-hidden (if state (eq state 'raw) (not hidden))))
+ (unless (eq hidden desired-hidden)
+ (if (not desired-hidden)
+ (rmail-show-message rmail-current-message)
+ (let ((rmail-enable-mime nil)
+ (inhibit-read-only t))
+ (rmail-show-message rmail-current-message)
+ (add-text-properties (point-min) (point-max) '(rmail-mime-hidden t))))))
(message "Not a MIME message, just toggling headers")
(rmail-toggle-header)))
(let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index b75841489c9..331754fb1b5 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1414,6 +1414,7 @@ just append to the file, in Babyl format if necessary."
(defun mail-sent-via ()
"Make a Sent-via header line from each To or CC header line."
+ (declare (obsolete "nobody can remember what it is for." "24.1"))
(interactive)
(save-excursion
;; put a marker at the end of the header
@@ -1433,9 +1434,6 @@ just append to the file, in Babyl format if necessary."
(point)))))
;; Insert a copy, with altered header field name.
(insert-before-markers "Sent-via:" to-line))))))
-
-(make-obsolete 'mail-sent-via "nobody can remember what it is for." "24.1")
-
(defun mail-to ()
"Move point to end of To field, creating it if necessary."
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index d10b073eb12..99e5df82bef 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -506,8 +506,6 @@ string."
;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; end user configuration variables
-(define-obsolete-variable-alias 'sc-version 'emacs-version "23.1")
-
(defvar sc-mail-info nil
"Alist of mail header information gleaned from reply buffer.")
(defvar sc-attributions nil
@@ -559,10 +557,8 @@ string."
(define-key map "r" 'sc-recite-region)
(define-key map "\C-p" 'sc-raw-mode-toggle)
(define-key map "u" 'sc-uncite-region)
- (define-key map "v" 'sc-version)
(define-key map "w" 'sc-insert-reference)
(define-key map "\C-t" sc-T-keymap)
- (define-key map "\C-b" 'sc-submit-bug-report)
(define-key map "?" 'sc-describe)
map)
"Keymap for Supercite quasi-mode.")
@@ -1969,29 +1965,11 @@ cited."
(insert (sc-mail-field "sc-citation"))
(error "Line is already cited"))))
-;; The argument logic here is crazy.
-(defun sc-version (message)
- "Return the current Supercite version.
-If MESSAGE is non-nil (interactively, with no prefix argument),
-echoes the version in the minibuffer. Otherwise, inserts the
-version at point."
- (interactive (list (not current-prefix-arg)))
- (let ((verstr (format "Using Supercite.el %s" emacs-version)))
- (if message
- (message verstr)
- (insert "`sc-version' says: " verstr))))
-
-(make-obsolete 'sc-version 'emacs-version "23.1")
-
(defun sc-describe ()
"Read the Supercite info node."
(interactive)
(info "(SC)top"))
-(make-obsolete 'sc-describe "read the SC manual using `info'." "23.1")
-
-(define-obsolete-function-alias 'sc-submit-bug-report 'report-emacs-bug "23.1")
-
;; useful stuff
(provide 'supercite)
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 010b4edfb05..88e59eff86b 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1812,9 +1812,14 @@ for the definition of the menu frame."
When called in the minibuffer, get out of the minibuffer
using `abort-recursive-edit'."
(interactive)
- (if (menu-bar-non-minibuffer-window-p)
- (kill-buffer (current-buffer))
- (abort-recursive-edit)))
+ (cond
+ ;; Don't do anything when `menu-frame' is not alive or visible
+ ;; (Bug#8184).
+ ((not (menu-bar-menu-frame-live-and-visible-p)))
+ ((menu-bar-non-minibuffer-window-p)
+ (kill-buffer (current-buffer)))
+ (t
+ (abort-recursive-edit))))
(defun kill-this-buffer-enabled-p ()
"Return non-nil if the `kill-this-buffer' menu item should be enabled."
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index 15b7380b737..eb60392c32c 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -10930,7 +10930,7 @@
* mh-utils.el (mh-prompt-for-folder): Exit with error if no folder
specified, otherwise mh-refile-msg may try to create a folder with
- empty name, and this creates problems; even mh-undo can't handle
+ empty name, and this creates problems; even mh-undo can't handle
it (Closes SF #476824).
* mh-comp.el (mh-letter-tool-bar-map): Info button needed to
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index 4387fc625c6..92d5ec821b0 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -1,4 +1,4 @@
-;;; minibuf-eldef.el --- Only show defaults in prompts when applicable
+;;; minibuf-eldef.el --- Only show defaults in prompts when applicable -*- lexical-binding: t -*-
;;
;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;;
@@ -33,16 +33,22 @@
;;; Code:
+(defvar minibuffer-eldef-shorten-default nil
+ "If non-nil, shorten \"(default ...)\" to \"[...]\" in minibuffer prompts.")
+
(defvar minibuffer-default-in-prompt-regexps
- '(("\\( (default\\>.*)\\):? \\'" . 1) ("\\( \\[.*\\]\\):? *\\'" . 1))
+ `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'"
+ 1 ,(if minibuffer-eldef-shorten-default " [\\2]"))
+ ("\\( \\[.*\\]\\):? *\\'" 1))
"A list of regexps matching the parts of minibuffer prompts showing defaults.
When `minibuffer-electric-default-mode' is active, these regexps are
used to identify the portions of prompts to elide.
-Each entry is either a string, which should be a regexp matching the
-default portion of the prompt, or a cons cell, who's car is a regexp
-matching the default part of the prompt, and who's cdr indicates the
-regexp subexpression that matched.")
+Each entry is of the form (REGEXP MATCH-NUM &optional REWRITE),
+where REGEXP should match the default part of the prompt,
+MATCH-NUM is the subgroup that matched the actual default indicator,
+and REWRITE, if present, is a string to pass to `replace-match' that
+should be displayed in its place.")
;;; Internal variables
@@ -79,21 +85,42 @@ The prompt and initial input should already have been inserted."
(inhibit-point-motion-hooks t))
(save-excursion
(save-restriction
- ;; Narrow to only the prompt
+ ;; Narrow to only the prompt.
(goto-char (point-min))
(narrow-to-region (point) (minibuffer-prompt-end))
- ;; See the prompt contains a default input indicator
+ ;; See if the prompt contains a default input indicator.
(while regexps
(setq match (pop regexps))
- (if (re-search-forward (if (stringp match) match (car match)) nil t)
- (setq regexps nil)
- (setq match nil)))))
+ (cond
+ ((not (re-search-forward (if (stringp match) match (car match))
+ nil t))
+ ;; No match yet, try the next rule.
+ (setq match nil))
+ ((and (consp (cdr-safe match)) (nth 2 match))
+ ;; Matched a replacement rule.
+ (let* ((inhibit-read-only t)
+ (buffer-undo-list t)
+ (submatch (nth 1 match))
+ (replacement (nth 2 match))
+ (props (text-properties-at (match-beginning submatch))))
+ (replace-match replacement nil nil nil submatch)
+ (set-text-properties (match-beginning submatch)
+ (match-end submatch)
+ props)
+ ;; Replacement done, now keep trying with subsequent rules.
+ (setq match nil)
+ (goto-char (point-min))))
+ ;; Matched a non-replacement (i.e. electric hide) rule, no need to
+ ;; keep trying.
+ (t (setq regexps nil))))))
(if (not match)
- ;; Nope, so just make sure our post-command-hook isn't left around.
+ ;; No match for electric hiding, so just make sure our
+ ;; post-command-hook isn't left around.
(remove-hook 'post-command-hook #'minibuf-eldef-update-minibuffer t)
;; Yup; set things up so we can frob the prompt as the state of
;; the input string changes.
(setq match (if (consp match) (cdr match) 0))
+ (setq match (if (consp match) (car match) match))
(setq minibuf-eldef-overlay
(make-overlay (match-beginning match) (match-end match)))
(setq minibuf-eldef-showing-default-in-prompt t)
@@ -124,10 +151,6 @@ been set up by `minibuf-eldef-setup-minibuffer'."
(overlay-put minibuf-eldef-overlay 'intangible t)))))
-;;; Note this definition must be at the end of the file, because
-;;; `define-minor-mode' actually calls the mode-function if the
-;;; associated variable is non-nil, which requires that all needed
-;;; functions be already defined. [This is arguably a bug in d-m-m]
;;;###autoload
(define-minor-mode minibuffer-electric-default-mode
"Toggle Minibuffer Electric Default mode.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 27c53744d54..a9be1749423 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -632,6 +632,7 @@ That is what completion commands operate on."
(defun delete-minibuffer-contents ()
"Delete all user input in a minibuffer.
If the current buffer is not a minibuffer, erase its entire contents."
+ (interactive)
;; We used to do `delete-field' here, but when file name shadowing
;; is on, the field doesn't cover the entire minibuffer contents.
(delete-region (minibuffer-prompt-end) (point-max)))
@@ -2332,7 +2333,7 @@ and `read-file-name-function'."
(modify-syntax-entry c "." table))
'(?/ ?: ?\\))
table)
- "Syntax table to be used in minibuffer for reading file name.")
+ "Syntax table used when reading a file name in the minibuffer.")
;; minibuffer-completing-file-name is a variable used internally in minibuf.c
;; to determine whether to use minibuffer-local-filename-completion-map or
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 14e69c9f34d..fa5c69281de 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -284,23 +284,24 @@ not it is actually displayed."
(defun mouse-major-mode-menu (event &optional prefix)
"Pop up a mode-specific menu of mouse commands.
Default to the Edit menu if the major mode doesn't define a menu."
+ (declare (obsolete mouse-menu-major-mode-map "23.1"))
(interactive "@e\nP")
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(popup-menu (mouse-menu-major-mode-map) event prefix))
-(make-obsolete 'mouse-major-mode-menu 'mouse-menu-major-mode-map "23.1")
(defun mouse-popup-menubar (event prefix)
"Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
The contents are the items that would be in the menu bar whether or
not it is actually displayed."
+ (declare (obsolete mouse-menu-bar-map "23.1"))
(interactive "@e \nP")
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix))
-(make-obsolete 'mouse-popup-menubar 'mouse-menu-bar-map "23.1")
(defun mouse-popup-menubar-stuff (event prefix)
"Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
Use the former if the menu bar is showing, otherwise the latter."
+ (declare (obsolete nil "23.1"))
(interactive "@e\nP")
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(popup-menu
@@ -308,7 +309,6 @@ Use the former if the menu bar is showing, otherwise the latter."
(mouse-menu-bar-map)
(mouse-menu-major-mode-map))
event prefix))
-(make-obsolete 'mouse-popup-menubar-stuff nil "23.1")
;; Commands that operate on windows.
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index 9d160fe319d..42b618815f5 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -166,18 +166,18 @@ The record is filtered according to `eudc-bbdb-current-return-attributes'"
(symbol-name attr)))
'record))))
(t
- (setq val "Unknown BBDB attribute")))
- (if val
- (cond
- ((memq attr '(phones addresses))
- (setq eudc-rec (append val eudc-rec)))
- ((and (listp val)
- (= 1 (length val)))
- (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
- ((> (length val) 0)
- (setq eudc-rec (cons (cons attr val) eudc-rec)))
- (t
- (error "Unexpected attribute value")))))
+ (error "Unknown BBDB attribute")))
+ (cond
+ ((or (not val) (equal val ""))) ; do nothing
+ ((memq attr '(phones addresses))
+ (setq eudc-rec (append val eudc-rec)))
+ ((and (listp val)
+ (= 1 (length val)))
+ (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
+ ((> (length val) 0)
+ (setq eudc-rec (cons (cons attr val) eudc-rec)))
+ (t
+ (error "Unexpected attribute value"))))
(nreverse eudc-rec)))
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index c78249ced0f..bc6fd38f713 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -421,7 +421,7 @@ headline after it has been retrieved for the first time."
"Name of the newsticker cache file."
:type 'string
:group 'newsticker-miscellaneous)
-(make-obsolete 'newsticker-cache-filename 'newsticker-dir "23.1")
+(make-obsolete-variable 'newsticker-cache-filename 'newsticker-dir "23.1")
(defcustom newsticker-dir
(locate-user-emacs-file "newsticker/" ".newsticker/")
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index b44f1f9c86d..0bc7d6ad6ea 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -128,7 +128,7 @@ Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
"Name of the newsticker groups settings file."
:type 'string
:group 'newsticker-treeview)
-(make-obsolete 'newsticker-groups-filename 'newsticker-dir "23.1")
+(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
;; ======================================================================
;;; internal variables
@@ -1722,7 +1722,7 @@ return a nested list."
(defun newsticker-group-move-feed (name group-name &optional no-update)
"Move feed NAME to group GROUP-NAME.
-Update teeview afterwards unless NO-UPDATE is non-nil."
+Update treeview afterwards unless NO-UPDATE is non-nil."
(interactive
(let ((completion-ignore-case t))
(list (completing-read "Feed Name: "
diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el
index c155d53b6d0..217f9dc8b30 100644
--- a/lisp/net/snmp-mode.el
+++ b/lisp/net/snmp-mode.el
@@ -175,9 +175,9 @@ This is used during Tempo template completion."
(defvar snmp-font-lock-keywords-3
(append
'(("\\([^\n]+\\)[ \t]+::=[ \t]+\\(SEQUENCE\\)[ \t]+{"
- (1 font-lock-reference-face) (2 font-lock-keyword-face))
+ (1 font-lock-constant-face) (2 font-lock-keyword-face))
("::=[ \t]*{[ \t]*\\([a-z0-9].*[ \t]+\\)?\\([0-9]+\\)[ \t]*}"
- (1 font-lock-reference-face nil t) (2 font-lock-variable-name-face)))
+ (1 font-lock-constant-face nil t) (2 font-lock-variable-name-face)))
snmp-font-lock-keywords-2)
"Gaudy SNMP MIB mode expression highlighting.")
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 019ab1eef0f..b1532eb2ae4 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -403,6 +403,7 @@ interpreted as a regular expression which always matches."
(defcustom tramp-save-ad-hoc-proxies nil
"Whether to save ad-hoc proxies persistently."
:group 'tramp
+ :version "24.3"
:type 'boolean)
(defcustom tramp-restricted-shell-hosts-alist
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index a7fedf20f53..6d2eed71948 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -327,8 +327,8 @@ terminated by the end of line (i.e. `comment-end' is empty)."
;;;###autoload
(defun comment-normalize-vars (&optional noerror)
"Check and setup the variables needed by other commenting functions.
-Functions autoloaded from newcomment.el, being entry points, should call
-this function before any other, so the rest of the code can assume that
+Any command calling functions from newcomment.el, being entry points, should
+call this function before any other, so the rest of the code can assume that
the variables are properly set."
(unless (and (not comment-start) noerror)
(unless comment-start
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog
index 152af5f43ed..ef40c9316cf 100644
--- a/lisp/org/ChangeLog
+++ b/lisp/org/ChangeLog
@@ -1,3 +1,3021 @@
+2012-09-30 Abdó Roig-Maranges <abdo.roig@gmail.com>
+
+ * org-html.el (org-export-html-preprocess)
+ (org-export-html-format-image): Use
+ `org-latex-preview-ltxpng-directory'.
+
+ * org-odt.el (org-export-odt-do-preprocess-latex-fragments):
+ Ditto.
+
+ * org.el (org-latex-preview-ltxpng-directory): New option.
+ (org-preview-latex-fragment): Store LaTeX preview images in
+ `org-latex-preview-ltxpng-directory'.
+
+2012-09-30 Achim Gratz <Stromeko@Stromeko.DE>
+
+ * ob-R.el (org-babel-R-initiate-session): Protect against use of
+ unbound variable `ess-ask-for-ess-directory´. The default for this
+ variable is true, so act accordingly if it is found unbound.
+
+ * ob-R.el: Remove initialization with `nil´ from
+ `ess-ask-for-ess-directory´ and `ess-local-process-name´. Remove
+ second declaration for `ess-local-process-name´.
+
+ * org-gnus.el: Add a missing require for gnus-util.
+
+ * org-compat.el: Rename utils to make throughout.
+
+ * org.el: Move check for outline-mode-keymap after (require
+ 'outline).
+
+ * org-element.el: New file. Do not (require 'org).
+
+ * org-agenda.el: Remove duplicate requires.
+
+ * org.el (org-mode-map): Add keybindings to
+ `org-element-transpose' and `org-narrow-to-element'.
+ (org-metaup): Fall back on `org-element-drag-backward'.
+ (org-metadown): Fall back on `org-element-drag-forward'. Also
+ move chunks of declarations and require statements to get rid of
+ compiler warnings.
+
+ * org-exp-blocks.el (org): Don't require org. Add declarations.
+
+ * org-clock.el (org): Don't require org.
+
+ * ob-exp.el (org-list-forbidden-blocks): Add declarations.
+
+ * ob.el (org-babel-exeext): New defconst to hold extension for
+ executables or nil if none. Should be ".exe" for both Windows and
+ Cygwin.
+
+ * ob-C.el (org-babel-C-execute): Use org-babel-exeext when
+ constructing the target file name for the compiled executable.
+
+ * ob-fortran.el (org-babel-execute:fortran): Add org-babel-exeext
+ when constructing the target file name for the compiled
+ executable.
+
+ * org-version.el: New file.
+
+ * org-compat.el (org-check-version): New macro. Check if
+ org-version.el exists and provide autoloads to that. Otherwise
+ check if org-fixup.el exists and use it to provide definitions.
+ Finally if nothing worked, complain about a botched installation
+ and provide fallback definitions.
+
+ * org.el: Use org-check-version.
+
+ * org.el: Fix a subtle error resulting in version functions
+ sometimes not being defined and byte-compiling failing. Always
+ compile in fallback definitions into org.elc -- org-fixup either
+ provides re-definitions at compile-time or checks org-version.el
+ and then the git work tree when run uncompiled. So the fallback
+ definitions will only come into effect when org-fixup is not
+ available.
+
+ * org.el (org-version): Make org-version more robust, e.g. when
+ byte-compiling single files with 'make compile-dirty'.
+
+ * org.el (org-reload): Revert an undesirable change in org-reload.
+ Do not prepend org-dir to babel-files, which prevents the files
+ from being found in load-path.
+
+ * org.el (org-version): Add optional parameters 'full and 'message
+ to optionally return the full version string and echo to message
+ area in non-interactive calls.
+
+ * org.el (org-submit-bug-report): Add optional parameter 'full to
+ call of (org-version) so that the bug report has all version
+ information.
+
+ * org.el (org-reload): Simplify file-re (orgtbl-*.el files do not
+ exist anymore). Keep org-*.el at the end of the files list.
+ Explicitely load org-version.el (since it doesn't provide feature
+ 'org-version) at the very end, but ignore errors when it doesn't
+ exist. Add parameters 'full and 'message to the call of
+ (org-version) so that after reload the full version information is
+ displayed in the message area again.
+
+ * org-agenda.el: Replace with-no-warnings with org-no-warnings
+ (defined in org-macs.el).
+
+ * org-bbdb.el: Replace with-no-warnings with org-no-warnings
+ (defined in org-macs.el).
+
+ * org-clock.el: Replace with-no-warnings with org-no-warnings
+ (defined in org-macs.el).
+
+ * org.el: Replace with-no-warnings with org-no-warnings (defined
+ in org-macs.el).
+
+ * org.el: Add with-not-warnings around call of (org-fixup).
+
+ * org-compat.el (org-find-library-dir): Rename
+ org-find-library-name (misleading) and implement with a function
+ that exists identically in Emacs/XEmacs.
+
+ * org-exp-blocks.el: Change calls to org-find-library-dir.
+
+ * org.el: change calls to org-find-library-dir. Make require for
+ noutline fail silently because it is missing from XEmacs.
+
+ * org.el (org-version): Use functions instead of global variables
+ to get the version strings and remove the defvaralias to
+ org-version. Warn when encountering a mixed installation (org and
+ org-install.el should be found in the same directory).
+
+ * org.el: Add with-no-warning to defvar for two unprefixed global
+ variables from calendar.el (there's nothing else we can do inside
+ org until it is fixed in calendar.el).
+
+ * org.el: Require find-func and remove declare-function for
+ find-library-name, otherwise autoloaded org-version doesn't show
+ all info correctly.
+
+ * org.el (org-version): Show the full path to org-install.el in
+ the version string to avoid confusion if multiple installations
+ exist or a previously loaded org-install.el has already defined a
+ version string that is now out of date.
+
+ * org.el (org-version): Remove determination of version
+ information, show "N/A" if the information is not provided via
+ org-install.el.
+
+ * org.el (org-git-version): Placeholder for recording the Git
+ version of org during install
+
+ * org.el (org-version): Initialize local git-version with
+ placeholder and fall through using it when org is not installed in
+ a Git repository
+
+2012-09-30 Adam Spiers <orgmode@adamspiers.org> (tiny change)
+
+ * org-html.el: Add hyperlink to http://orgmode.org/ from export
+ footer.
+
+ * org-clock.el (org-clock-modify-effort-estimate): Display a
+ message when no clock is currently active.
+
+2012-09-30 Andrew Hyatt <ahyatt@gmail.com> (tiny change)
+
+ * org-archive.el (org-archive-subtree): Allow archiving to a
+ datetree.
+
+ * org.el (org-archive-location): Ditto.
+
+2012-09-30 Bastien Guerry <bzg@gnu.org>
+
+ * ob-io.el: New file.
+
+ * ob-scala.el: New file.
+
+ * org.el (org-url-hexify-p, org-doi-server-url)
+ (org-latex-preview-ltxpng-directory, org-custom-properties)
+ (org-sparse-tree-default-date-type): Add :version "24.3".
+
+ * org-agenda.el (org-agenda-sticky)
+ (org-agenda-custom-commands-contexts): Ditto.
+
+ * org-capture.el (org-capture-bookmark)
+ (org-capture-templates-contexts) (org-capture-use-agenda-date):
+ Ditto.
+
+ * org-latex.el (org-export-latex-hyperref-options-format)
+ (org-export-latex-link-with-unknown-path-format): Ditto.
+
+ * org-id.el (org-id-link-to-org-use-id): Ditto.
+
+ * org-datetree.el (org-datetree-add-timestamp): Ditto.
+
+ * org.el (org-make-link-description-function): Enhance docstring.
+ (org-insert-link): Fall back on interactive prompt when
+ `org-make-link-description-function' fails.
+
+ * org-agenda.el (org-todo-list): Fix redoing of todo agenda when
+ `org-agenda-sticky' is non-nil.
+
+ * org-agenda.el (org-agenda-quit): Delete last indirect buffer.
+ (org-agenda-pre-follow-window-conf): New variable.
+ (org-agenda-tree-to-indirect-buffer): Fix bug: don't split agenda
+ window when there an indirect buffer is already displayed.
+
+ * org-agenda.el (org-agenda-manipulate-query)
+ (org-agenda-goto-date, org-agenda-goto-today)
+ (org-agenda-find-same-or-today-or-agenda, )
+ (org-agenda-later, org-agenda-change-time-span)
+ (org-agenda-change-all-lines)
+ (org-agenda-execute-calendar-command)
+ (org-agenda-goto-calendar, org-agenda-convert-date): Make sure to
+ get a property from (1- (point-max)), not (point-max)).
+
+ * ob-dot.el (org-babel-execute:dot): Throw an error when there is
+ no :file parameter.
+
+ * org-table.el (org-table-eval-formula): Convert time-stamps to
+ inactive time-stamp so that Calc can handle them correctly.
+
+ * org-table.el (org-table-fix-formulas): Warn with a message when
+ formulas have been updated.
+
+ * org-publish.el (org-publish-cache-ctime-of-src): Delete the
+ base-dir argument and use (file-name-directory file) to get the
+ file's directory.
+ (org-publish-update-timestamp)
+ (org-publish-cache-file-needs-publishing): Call
+ `org-publish-cache-ctime-of-src' with only one argument.
+
+ * org.el (org-follow-timestamp-link): Fix bug when using sticky
+ agenda. Add a docstring.
+
+ * org-agenda.el (org-agenda-sticky): Don't use a function to set.
+ Add a :version string.
+
+ * org.el (org-priority): Use a new argument to show priority
+ instead of setting it.
+ (org-show-priority): New function to show priority both in normal
+ Org buffers and in Org Agenda buffers.
+ (org-speed-commands-default): Use "," as a speed command for
+ setting priority.
+
+ * org-agenda.el (org-agenda-mode-map): Bind `org-agenda-priority'
+ to `C-c ,' as it was before.
+ (org-agenda-show-priority): Delete.
+ (org-agenda-priority): Use a new argument to show priority instead
+ of setting it.
+
+ * org.el (org-font-lock-hook, org-set-font-lock-defaults): Add a
+ docstring.
+ (org-display-inline-remove-overlay): Rename from
+ `org-display-inline-modification-hook'.
+ (org-speed-command-activate): Rename from
+ `org-speed-command-default-hook'.
+ (org-babel-speed-command-hook): Rename from
+ `org-babel-speed-command-activate'.
+
+ * org-agenda.el (org-agenda-update-agenda-type): Rename from
+ `org-agenda-post-command-hook'.
+ (org-agenda-mode): Use the new name.
+ (org-agenda-post-command-hook): Define as obsolete function.
+
+ * org-lparse.el (org-lparse): Temporarily activate the hooks
+ needed for the ODT conversion.
+ (org-lparse-preprocess-after-blockquote): Rename from
+ `org-lparse-preprocess-after-blockquote-hook'.
+ (org-lparse-strip-experimental-blocks-maybe): Rename from
+ `org-lparse-strip-experimental-blocks-maybe'.
+ (org-lparse-preprocess-after-blockquote-hook)
+ (org-lparse-strip-experimental-blocks-maybe-hook): Define as
+ obsolete functions.
+
+ * ob.el (org-babel-insert-result): Comma-escape results inserted
+ with ":results org".
+
+ * org-src.el (org-edit-src-code, org-edit-src-exit): Fix bug about
+ saving the source editing window with the default value for
+ `org-src-window-setup' (i.e. 'reorganize-frame).
+
+ * org-src.el (org-src-font-lock-fontify-block): Fix bug: don't
+ fontify the last character.
+
+ * org.el (org-open-at-point): Don't follow timestamp within
+ bracket links.
+
+ * org-capture.el (org-capture-templates): Fix typo in docstring.
+
+ * org-agenda.el (org-agenda-skip): Skip information retrieved from
+ a source block.
+
+ * ob.el (org-babel-common-header-args-w-values)
+ (org-babel-insert-result): Reintroduce ":results org" but using
+ "#+BEGIN_SRC org", not "#+BEGIN_ORG".
+
+ * ob.el (org-babel-common-header-args-w-values): Remove "org" the
+ list of predefined values for the ":results" parameter.
+
+ * ob.el (org-babel-insert-result): Remove support for ":results
+ org".
+
+ * ob.el (org-babel-common-header-args-w-values)
+ (org-babel-insert-result): Deprecate ":results wrap" in favor of
+ ":results drawer".
+
+ * org-crypt.el (org-at-encrypted-entry-p): Fix bug when the check
+ happens before the first headline.
+
+ * org-capture.el (org-at-encrypted-entry-p)
+ (org-encrypt-entry, org-decrypt-entry): Declare.
+ (org-capture-set-target-location): Check whether `org-crypt' has
+ been loaded.
+
+ * org-agenda.el (org-agenda-todo-custom-ignore-p): Fix typo in
+ docstring.
+
+ * org-capture.el (org-capture-finalize): Maybe re-encrypt the
+ target headline if it was decrypted.
+ (org-capture-set-target-location): Maybe decrypt the target
+ headline.
+
+ * org-crypt.el (org-at-encrypted-entry-p): New function.
+
+ * org.el (org-options-keywords): Add "STYLE:".
+
+ * org-agenda.el (org-agenda-ndays): Don't make an alias, as
+ `org-agenda-span' is defined separately.
+
+ * org.el (org-in-subtree-not-table-p): New utility function for
+ building the menu.
+ (org-org-menu): Add an item for refiling. Check more contexts
+ when activating items.
+ (org-tree-to-indirect-buffer): Use `org-up-heading-safe'.
+
+ * org-agenda.el (org-agenda-tree-to-indirect-buffer)
+ (org-agenda-do-tree-to-indirect-buffer): Use argument `arg'.
+
+ * org-capture.el (org-capture-set-target-location): Set a correct
+ time value when storing a note in a datetree and prompting the
+ user for a date.
+
+ * org-capture.el (org-capture-mode): Fix bug: don't run the mode's
+ hook twice.
+
+ * org-agenda.el (org-agenda-menu-two-column)
+ (org-finalize-agenda-hook, org-agenda-ndays): Use
+ `define-obsolete-variable-alias' instead of
+ `make-obsolete-variable'.
+
+ * org.el (org-link-to-org-use-id): Move to org-id.el.
+
+ * org-id.el (org-id-link-to-org-use-id): Rename from
+ `org-link-to-org-use-id'. Use `nil' as the default value.
+ (org-link-to-org-use-id): Alias and define as obsolete.
+
+ * org-agenda.el (org-search-view, org-agenda-get-todos)
+ (org-agenda-get-timestamps, org-agenda-get-blocks): Use the dotime
+ parameter of `org-agenda-format-item' so that 'time-up and
+ 'time-down agenda sorting strategies are handled correctly.
+
+ * org-capture.el (org-capture-fill-template): Fix checking of
+ protected template entries.
+
+ * org.el (org-cycle-global-at-bob): Fix typo in docstring.
+
+ * org.el (org-insert-drawer): Deactivate the mark before trying to
+ indent the :END: of the drawer.
+
+ * org-agenda.el (org-agenda-export-html-style): Default to nil as
+ any string value will replace the htmlize style.
+
+ * org.el (org-cycle-hook): Fix tiny typo in docstring.
+
+ * org.el (org-time-string-to-time)
+ (org-time-string-to-seconds, org-end-of-subtree): Add a dosctring.
+
+ * org-freemind.el (org-freemind-write-node): Enhance links
+ conversion in nodes.
+
+ * org-freemind.el (org-freemind-write-node): Convert links in
+ nodes.
+
+ * org.el (org-link-to-org-use-id, org-directory)
+ (org-default-notes-file, org-reverse-note-order)
+ (org-extend-today-until, org-finish-function)
+ (org-store-link-functions): Use "capture" instead of "remember" in
+ docstrings. Also use the `org-capture' group when it makes sense.
+
+ * org-agenda.el (org-agenda-tree-to-indirect-buffer): Find the
+ correct agenda buffer. Don't split the agenda window when the
+ indirect buffer is displayed in another frame.
+
+ * org.el (org-mode): Try to set the org-hide face correctly.
+
+ * org-exp.el (org-export): Set the mark correctly when exporting a
+ subtree.
+
+ * org-agenda.el (org-agenda-get-restriction-and-command): Fix the
+ display of the number of commands for block agendas.
+
+ * org-agenda.el (org-agenda-before-write-hook)
+ (org-agenda-add-entry-text-maxlines): Enhance phrasing.
+ (org-agenda-finalize-hook, org-agenda-mode-hook): Tell that the
+ buffer is writable when the hook is called.
+ (org-agenda-finalize): Allow org-agenda-finalize-hook to modify
+ the buffer.
+
+ * org-agenda.el (org-habit-show-all-today): Only use defvar to
+ silent the byte-compiler.
+ (org-agenda-get-scheduled): Check whether some org-habit.el
+ options have been defined.
+
+ * org-capture.el (org-capture-entry): New variable.
+ (org-capture-string, org-capture): Use it to possibly skip the
+ interactive prompt for a capture template.
+
+ * org.el (org-activate-plain-links): Don't try to check if we are
+ in a bracket link already.
+
+ * org.el (org-read-date-analyze): Fix bug introduced in commit
+ cc5f9f: adding a time should not prevent relative answers to be
+ parsed correctly.
+
+ * org-agenda.el (org-agenda-bulk-action): Always read the date
+ through `org-read-date'. When possible, use the date at point as
+ the default date.
+
+ * org-agenda.el (org-agenda-bulk-action): Fix bug when
+ bulk-shifting timestamps.
+
+ * org.el (org-version): New constant.
+
+ * org-compat.el (org-random): New compatibility function.
+
+ * org-id.el (org-id-uuid): Use it.
+
+ * org-capture.el (org-capture-use-agenda-date): New option.
+ (org-capture): Use it.
+
+ * org-agenda.el (org-agenda-capture): New command.
+ (org-agenda-mode-map): Bind it to `k'.
+ (org-agenda-menu): Add it to the menu.
+
+ * org-capture.el (org-capture): Update docstring.
+
+ * org-capture.el (org-capture): When called from an agenda buffer,
+ use the cursor date at the default date.
+
+ * org-agenda.el (org-agenda-bulk-action): Use the let-bound
+ `entries' instead the variable.
+
+ * org-agenda.el (org-agenda-bulk-action): Fix bug: don't remove
+ persistent marks too early.
+
+ * org-agenda.el (org-agenda-bulk-action): Possibly use the day at
+ point to reset the scheduled or deadline cookie. On date headers,
+ use it without prompting the user. On an item, use the item's
+ date as the default prompt for `org-read-date'.
+
+ * org.el (org-read-date): Docstring fix.
+
+ * org-agenda.el (org-agenda-bulk-action): Reorder possible actions
+ in the message.
+
+ * org-agenda.el (org-agenda-action, org-agenda-do-action): Delete.
+ (org-agenda-mode-map): Delete related keys.
+
+ * org-agenda.el (org-agenda-menu): Fix a keybinding.
+
+ * org-colview.el (org-columns-goto-top-level): Correctly move the
+ marker `org-columns-top-level-marker'.
+ (org-agenda-columns): Don't set
+ `org-agenda-overriding-columns-format' as a buffer variable, as we
+ only need it dynamically.
+ (org-agenda-colview-summarize): Fix a bug in returning the match
+ string.
+
+ * org-agenda.el (org-agenda-span-to-ndays): Make the second
+ argument `starting-day' optional.
+ (org-agenda-goto-date): Keep parameters of custom agendas.
+
+ * org-agenda.el (org-agenda-list): Allow setting the agenda buffer
+ name through a temporary variable.
+ (org-agenda-buffer-tmp-name): New variable to temporary store the
+ agenda buffer name.
+
+ * org-agenda.el (org-agenda-goto-date): Fix behavior when using
+ sticky agendas.
+
+ * org-agenda.el (org-diary): Don't check whether there is an
+ agenda buffer when trying to compile the prefix format.
+ (org-compile-prefix-format): Check if there is an agenda buffer.
+ If not, use the current buffer.
+
+ * org-agenda.el (org-agenda-get-day-entries): Set the agenda
+ buffer inconditionnally.
+
+ * ob.el (org-babel-named-src-block-regexp-for-name): Generate a
+ more general regexp.
+
+ * ob.el (org-babel-where-is-src-block-head): Find a src block head
+ correctly when #+header(s) is before #+name.
+
+ * org-agenda.el (org-agenda-finalize-hook)
+ (org-agenda-finalize, org-agenda-finalize-entries): Rename from
+ org-finalize-agenda-*.
+ (org-agenda-run-series, org-agenda-finalize, org-timeline)
+ (org-agenda-list, org-search-view, org-todo-list)
+ (org-tags-view, org-diary, org-agenda-finalize-entries)
+ (org-agenda-change-all-lines): Use the new names.
+
+ * org-agenda.el (org-agenda-local-vars): Remove
+ ̀org-agenda-last-arguments' from the list of local variables.
+ (org-agenda-mode-map): `g' does the same than `r' in buffers with
+ only one agenda view, but its behavior differs when there are
+ several views. In manually appended agendas (with `A'), `g'
+ displays only the agenda under the point. With multiple agenda
+ blocks, `g' reinitializes the view by discarding any temporary
+ changes (e.g. with ̀f' or `w'), while ̀r' keeps those temporary
+ changes for the agenda view under the point.
+ (org-agenda-run-series, org-agenda-redo): Implement the above
+ changes.
+ (org-agenda-mark-header-line): Don't set useless properties.
+ (org-agenda-list, org-todo-only, org-search-view)
+ (org-todo-list, org-tags-view, org-agenda-list-stuck-projects)
+ (org-agenda-manipulate-query, org-agenda-goto-today)
+ (org-agenda-later, org-agenda-change-time-span): Use text
+ properties for storing the last command and the last arguments for
+ each agenda block.
+ (org-unhighlight-once): Delete.
+
+ * org-agenda.el (org-agenda-append-agenda): Fit agenda window to
+ buffer.
+
+ * org-agenda.el (org-agenda-append-agenda): Bugfix: correctly
+ check whether we are in org-agenda-mode.
+
+ * org-agenda.el (org-agenda-pre-window-conf): Rename from
+ `org-pre-agenda-window-conf'.
+ (org-agenda-local-vars, org-agenda-prepare-window)
+ (org-agenda-Quit, org-agenda-quit): Use the new name.
+
+ * org-agenda.el (org-keys, org-match): New variable, dynamically
+ scoped in `org-agenda'.
+ (org-agenda, org-agenda-list, org-search-view, org-todo-list)
+ (org-tags-view): Use the new variables.
+ (org-batch-store-agenda-views): Let-bind `match'.
+
+ * org-agenda.el (org-search-view, org-todo-list)
+ (org-tags-view): Do not let `org-agenda-sticky' prevent the use of
+ these functions programmatically. Also use the sticky agenda
+ function correctly.
+
+ * org-agenda.el (org-agenda): Set `org-agenda-buffer-name'
+ correctly with sticky agendas and non-custom commands.
+
+ * org-agenda.el (org-agenda-fit-window-to-buffer): Rename from
+ `org-fit-agenda-window'.
+ (org-agenda-run-series, org-agenda-prepare, org-agenda-list)
+ (org-search-view, org-todo-list, org-tags-view): Use the new name.
+
+ * org-agenda.el (org-agenda-prepare): Let `throw' display an
+ error.
+
+ * org-agenda.el (org-agenda-list): Fix bug: don't throw an error
+ when called from programs as (org-agenda-list).
+
+ * org-agenda.el (org-todo-list): Make arg optional.
+
+ * org.el (org-agenda-prepare-buffers): Rename from
+ `org-prepare-agenda-buffers'.
+ (org-match-sparse-tree, org-map-entries): Use the new names.
+
+ * org-agenda.el (org-agenda-prepare-window): Rename from
+ `org-prepare-agenda-window'.
+ (org-agenda-prepare): Rename from `org-prepare-agenda'.
+ (org-agenda-run-series, org-agenda-prepare, org-timeline)
+ (org-agenda-list, org-search-view, org-todo-list)
+ (org-tags-view, org-agenda-list-stuck-projects, org-diary)
+ (org-agenda-to-appt): Use the new names.
+
+ * org-mobile.el (org-mobile-create-index-file): Ditto.
+
+ * org-icalendar.el (org-export-icalendar): Ditto.
+
+ * org-clock.el (org-dblock-write:clocktable)
+ (org-dblock-write:clocktable): Ditto.
+
+ * org2rem.el (org2rem): Ditto.
+
+ * org-agenda.el (org-agenda): In sticky agendas, use the current
+ command's match to set the buffer name. This gives more
+ information to the user and allows to distinguish various agendas
+ triggered by the same key.
+ (org-batch-store-agenda-views): Handle the new sticky agenda
+ buffer name.
+
+ * org-agenda.el (org-agenda)
+ (org-agenda-get-restriction-and-command): Use `S' as a key for
+ searching words in TODO-only entries.
+
+ * org-agenda.el (org-prepare-agenda): Fit agenda window when
+ displaying a sticky agenda.
+
+ * org-table.el (org-table-number-regexp): Allow the user to set it
+ to a new regexp, which allows commas as decimal mark. The default
+ is to not use this setting, but the one before commit 7ff8c1,
+ which has ben reverted.
+
+ * org-agenda.el (org-agenda-overriding-cmd)
+ (org-agenda-multi-current-cmd)
+ (org-agenda-multi-overriding-arguments): New variables.
+ (org-agenda-run-series): `org-agenda-overriding-arguments'
+ defaults to the last agenda block arguments, so don't use it
+ globally.
+ (org-agenda-mark-header-line): Add properties needed so that
+ `org-agenda-overriding-arguments', `org-agenda-current-span' and
+ `org-agenda-last-arguments' can be set to their correct contextual
+ value.
+ (org-agenda-multi-back-to-pos): New variable.
+ (org-agenda-later): Retrieve `org-agenda-current-span' and
+ `org-agenda-overriding-arguments' from text properties. Also
+ handle numeric span.
+ (org-agenda-later, org-agenda-change-time-span): Set
+ `org-agenda-overriding-cmd' so that we to take overriding
+ arguments into account for this command only.
+
+ * org-agenda.el (org-agenda-kill, org-agenda-archive-with): Fix
+ bug when called with a non-nil value of `org-agenda-stick'.
+
+ * org-agenda.el (org-agenda-refile): Fix bug when refiling an
+ entry from a sticky agenda.
+
+ * org-agenda.el (org-prepare-agenda-window): Use
+ `org-pre-agenda-window-conf' if already set.
+ (org-agenda-Quit): Set `org-pre-agenda-window-conf' to nil when
+ quitting.
+ (org-agenda-quit): Ditto.
+
+ * org-capture.el (org-capture-fill-template): Protect the text
+ used for replacement from being further replaced.
+
+ * org.el (org-contextualize-validate-key): Fix the check against a
+ function.
+
+ * org.el (org-contextualize-keys): Rename from
+ `org-contextualize-agenda-or-capture'. Fix normalization to
+ handle empty key replacement string.
+ (org-contextualize-validate-key): Rename from
+ `org-contexts-validate'. Allow checking against a custom
+ function.
+
+ * org-agenda.el (org-agenda-custom-commands-contexts): Update.
+ (org-agenda): Use `org-contextualize-keys'.
+
+ * org-capture.el (org-capture-templates-contexts): Ditto.
+
+ * org.el (org-contextualize-agenda-or-capture): Normalize
+ contexts.
+
+ * org.el (org-contextualize-agenda-or-capture): Handle key
+ replacement depending on the contexts.
+
+ * org-capture.el (org-capture-templates-contexts): Allow to use
+ the context as a way to replace one capture template by another
+ one.
+
+ * org-agenda.el (org-agenda-custom-commands-contexts): Allow to
+ use the context as a way to replace one agenda custom command by
+ another one.
+
+ * org.el (org-contextualize-agenda-or-capture)
+ (org-rule-validate): New functions, implement context filtering
+ for agenda commands and capture templates.
+
+ * org-agenda.el (org-agenda-custom-commands-contexts): New option.
+ (org-agenda): Use it.
+
+ * org-capture.el (org-capture-templates-contexts): New option.
+ (org-capture-select-template): Use it.
+
+ * org.el (org-beginning-of-defun, org-end-of-defun): Delete.
+ (org-mode): Set `beginning-of-defun-function' and
+ `end-of-defun-function' directly.
+
+ * org.el (org-insert-link): Fix bug: include links abbreviations
+ when completing.
+
+ * org-icalendar.el (org-icalendar-print-entries): Fix bug: when
+ `org-icalendar-use-plain-timestamp' is nil, scheduled and deadline
+ items should not be ignored.
+
+ * org.el (org-ds-keyword-length, org-make-tags-matcher): Docstring
+ clean-up.
+
+ * org-freemind.el (org-freemind-convert-links-from-org): Replace
+ literally to prevent errors when replacing with string containing
+ backslashes.
+
+ * org-pcomplete.el (org-thing-at-point): Allow to match (and then
+ complete) a "thing" containing dashes.
+
+ * org-table.el (org-table-toggle-coordinate-overlays): Better
+ message when interactively toggling.
+
+ * org-table.el (org-table-number-regexp): Update the docstring to
+ show an example of a decimal number using the comma as a
+ separation mark.
+
+ * org-agenda.el (org-prepare-agenda): Minor code clean-up.
+ (org-agenda-filter-by-category): Filtering must be turned off only
+ when a category filter has been set and this filter is not empty.
+
+ * org-agenda.el (org-search-view, org-agenda-get-todos)
+ (org-agenda-get-timestamps, org-agenda-get-sexps)
+ (org-agenda-get-progress, org-agenda-get-deadlines)
+ (org-agenda-get-scheduled, org-agenda-get-blocks): Use
+ `category-pos' instead of `org-category-pos'.
+
+ * ob-fortran.el (org-babel-fortran-transform-list): Rename from
+ `ob-fortran-transform-list'.
+ (org-babel-fortran-var-to-fortran): Use the new function's name.
+
+ * ob-calc.el (org-babel-calc-maybe-resolve-var): Rename from
+ `ob-calc-maybe-resolve-var'.
+ (org-babel-execute:calc): Use the new function's name.
+
+ * org-jsinfo.el (org-infojs-template): Add a license.
+ (org-infojs-handle-options): Replace all template elements.
+
+ * org-html.el (org-export-html-scripts): Add a license.
+ (org-export-html-mathjax-config): Replace all template elements.
+ (org-export-html-mathjax-template): Add a license.
+ (org-export-as-html): Minor code clean-up.
+
+ * org.el (org-options-keywords): Add "#+MATHJAX" and
+ "#+INFOJS_OPT" to the list of keywords for completion.
+
+ * org.el (org-src-prevent-auto-filling): Remove unused and useless
+ option.
+
+ * org.el (org-element-at-point): Autoload.
+ (org-element-up): Remove useless declaration.
+ (org-fill-context-prefix, org-fill-paragraph)
+ (org-mark-element, org-narrow-to-element)
+ (org-transpose-element, org-unindent-buffer): Do not require
+ org-element.
+
+ * org.el (org-fill-paragraph): Require org-element.
+
+ * org-agenda.el (org-agenda-persistent-marks): Minor docstring
+ enhancement.
+
+ * org.el (org-create-math-formula): Use the compatibility function
+ `org-region-active-p'.
+
+ * org-odt.el (org-export-as-odf): Ditto.
+
+ * ob.el (org-babel-demarcate-block): Ditto.
+
+ * org.el (org-mark-subtree): Maybe call `org-mark-element'
+ interactively.
+ (org-mark-element): Only mark further elements when called
+ interactively.
+
+ * org.el (org-mark-element, org-narrow-to-element)
+ (org-transpose-element): Require org-element.
+
+ * org-agenda.el (org-agenda-get-timestamps)
+ (org-agenda-get-sexps, org-agenda-get-deadlines)
+ (org-agenda-get-scheduled): Add the 'warntime as a text property,
+ getting its value from the APPT_WARNTIME property.
+ (org-agenda-to-appt): Use the 'warntime text property.
+
+ * org-capture.el (org-capture-place-table-line): Fix bug.
+
+ * org.el (org-activate-plain-links): Don't activate a plain link
+ when it is part of a bracketed link, unless bracketed links are
+ not enlisted in `org-activate-links'.
+ (org-open-at-point): Don't consider the text immediately after a
+ bracketed link is part of a plain link.
+
+ * org.el (org-compute-latex-and-specials-regexp)
+ (org-paste-subtree, org-sort-entries, org-store-link)
+ (org-open-at-point, org-file-remote-p, org-add-log-setup)
+ (org-set-tags-to, org-fast-tag-selection)
+ (org-diary-sexp-entry): Ditto.
+
+ * org-agenda.el (org-agenda-get-blocks, org-cmp-priority)
+ (org-cmp-effort, org-cmp-todo-state, org-cmp-alpha)
+ (org-cmp-tag, org-cmp-time): Remove useless (t nil) sexps at the
+ end of (cond ...) constructs.
+
+ * org-mobile.el (org-mobile-create-index-file): Ditto.
+
+ * org-lparse.el (org-lparse-format-table-row): Ditto.
+
+ * org-list.el (org-sort-list): Ditto.
+
+ * org-id.el (org-id-get): Ditto.
+
+ * org-html.el (org-export-html-preprocess): Ditto.
+
+ * org-exp.el (org-default-export-plist)
+ (org-table-clean-before-export): Ditto.
+
+ * org.el (org-options-keywords): Add "TODO".
+ (org-make-options-regexp): Make the hashtag mandatory for options
+ and don't allow whitespaces between the hashtag and the plus sign.
+
+ * org.el (org-refresh-category-properties)
+ (org-find-dblock, org-dblock-start-re, org-dblock-end-re): Allow
+ lowercase "#+category" and "#+begin:" dynamic blocks.
+
+ * org.el (org-context): Use case-folding when trying to match
+ clocktables and source blocks contexts.
+
+ * org-clock.el (org-clock-put-overlay): Put the overlay on the
+ whole headline, not only on the last character. This fixes a bug
+ with overlays on headlines ending with a bracketed link.
+
+ * org-html.el (org-export-as-html): Make sure we always process a
+ string.
+
+ * org-exp.el (org-export-cleanup-toc-line): Always return a
+ string.
+
+ * org.el (org-fontify-meta-lines-and-blocks-1): Correctly handle
+ metalines with #+results[...]:.
+
+ * org-exp.el (org-export-handle-metalines): Rename from
+ `org-export-handle-table-metalines'. Now also handle source block
+ metalines.
+ (org-export-res/src-name-cleanup): Delete.
+ (org-export-preprocess-string): Use `org-export-handle-metalines'.
+ Don't use `org-export-res/src-name-cleanup' anymore.
+
+ * org-html.el (org-format-org-table-html): Don't include the
+ caption tag for empty captions in HTML export. Keep it in the
+ DocBook export so that it produces valid DocBook XML.
+
+ * org.el (org-read-date-analyze): Allow both "8am Wed" and "Wed
+ 8am" to be parsed correctly with respect to possible values of
+ `org-read-date-prefer-future'.
+ (org-read-date-prefer-future): Update docstring to remove the
+ restriction about inserting only the time. The user can now
+ insert the time and the day.
+
+ * org-icalendar.el (org-icalendar-print-entries): Rename from
+ `org-print-icalendar-entries'.
+ (org-icalendar-start-file): Rename from
+ `org-start-icalendar-file'.
+ (org-icalendar-finish-file): Rename from
+ `org-finish-icalendar-file'.
+ (org-icalendar-ts-to-string): Rename from `org-ical-ts-to-string'.
+ (org-export-icalendar): Use the correct functions.
+
+ * ob-ref.el (org-babel-ref-index-list): Fix bug introduced by
+ commit e85479.
+
+ * org.el (org-fill-context-prefix): Require org-element.
+ (org-timestamp-change): Fix bug by saving excursion when adjusting
+ another clock.
+
+ * org.el (org-read-date-prefer-future): Fix docstring formatting.
+ (org-read-date-analyze): Fix the interpretation of
+ `org-read-date-prefer-future'.
+
+ * org-agenda.el (org-agenda-menu-two-column): Rename to
+ `org-agenda-menu-two-columns'.
+
+ * ob.el (org-babel-sha1-hash, org-babel-noweb-p): Replace
+ `org-labels' by `let*'.
+
+ * org-bibtex.el (org-bibtex-headline): Ditto.
+
+ * org-compat.el: Delete `org-labels'.
+
+ * ob.el (org-babel-get-src-block-info)
+ (org-babel-check-src-block, org-babel-current-result-hash)
+ (org-babel-parse-src-block-match, org-babel-read-link)
+ (org-babel-insert-result, org-babel-clean-text-properties): Use
+ ̀org-no-properties' instead of `org-babel-clean-text-properties'.
+ (org-babel-clean-text-properties): Delete redundant function
+ `org-babel-clean-text-properties'.
+
+ * ob-tangle.el (org-babel-tangle-collect-blocks)
+ (org-babel-tangle-comment-links): Ditto.
+
+ * ob-table.el (sbe): Ditto.
+
+ * ob-lob.el (org-babel-lob-get-info)
+ (org-babel-lob-execute): Ditto.
+
+ * ob-exp.el (org-babel-exp-non-block-elements): Ditto.
+
+ * org-macs.el (org-no-properties): Allow a new parameter
+ `restricted' to restrict the properties removal to those in
+ `org-rm-props'. The default is now to remove all properties.
+
+ * org-compat.el (org-substring-no-properties): Remove unused
+ defun.
+
+ * org-remember.el (org-remember-apply-template): Remove redundant
+ removal of text properties.
+ (org-remember-apply-template): Use `org-no-properties'.
+
+ * org-capture.el (org-capture-fill-template): Remove redundant
+ removal of text properties.
+ (org-capture-fill-template): Use `org-no-properties'.
+
+ * org-gnus.el (org-gnus-open, org-gnus-follow-link): Use
+ `org-no-properties'.
+
+ * org-colview.el (org-columns-display-here): Ditto.
+
+ * org-table.el (org-table-eval-formula): Ditto.
+
+ * org.el (org-entry-properties): Ditto.
+
+ * org-icalendar.el (org-print-icalendar-entries): Fix bug about
+ handling `alarm-time'.
+
+ * ob-R.el (org-babel-edit-prep:R): Don't set the session.
+
+ * org.el (org-store-log-note): Only skip comments starting with "#
+ " when storing a note.
+
+ * org.el (org-custom-properties): New option.
+ (org-custom-properties-overlays): New variable.
+ (org-toggle-custom-properties-visibility): New command to toggle
+ the visibility of custom properties.
+ (org-check-before-invisible-edit): Also prevent errors when trying
+ to edit invisible properties.
+
+ * org-datetree.el (org-datetree-add-timestamp): New option.
+ (org-datetree-insert-line): Use it.
+
+ * org.el (org-fill-template): Fix bug when filling template for a
+ key associated to the nil value.
+
+ * org-agenda.el (org-diary): Fix tiny typo.
+
+ * org.el (message-in-body-p): Move declaration up to fix compiler
+ warning.
+
+ * org.el (org-fill-context-prefix): Fix auto-filling in
+ `message-mode'.
+
+ * org.el (org-fill-paragraph): Correctly fill paragraph in
+ message-mode.
+ (org-indent-line): Correctly indent according to mode when
+ `orgstruct++-mode' is on.
+ (orgstruct++-mode): Add `fill-prefix' to the variable temporarily
+ stored in `org-fb-vars'.
+
+ * org.el (org-fill-paragraph): Make a command. Fix bug about
+ filling message headers and citations.
+
+ * org.el (org-redisplay-inline-images): New command.
+ (org-mode-map): Bind it to C-c C-x C-M-v.
+
+ * org-colview.el (org-columns-get-format-and-top-level): Fix bug.
+ (org-columns-get-format): Fix compiler warning.
+
+ * org-feed.el: Add declarations.
+
+ * org-agenda.el (org-agenda-get-sexps): Use `org-get-tags-at' to
+ allow tag inheritance.
+
+ * org-capture.el (org-capture): Fix bug introduced by commit
+ 1737d3.
+
+ * org-publish.el (org-publish-needed-p)
+ (org-publish-update-timestamp, org-publish-file)
+ (org-publish-cache-file-needs-publishing): New argument
+ `base-dir'.
+ (org-publish-cache-ctime-of-src): Use the new argument to make
+ sure we find the file according to :base-directory.
+
+ * org-capture.el (org-capture-string): New command to prompt for
+ the interactive text interactively. This can also be used in
+ Elisp programs to use ̀org-capture' with some initial text.
+ (org-capture-initial): New variable to store the initial text.
+ (org-capture): Use `org-capture-initial'.
+
+ * org.el (org-emph-re): Tiny docstring formatting fix.
+
+ * org-compat.el (org-labels): Remove.
+
+ * org-bibtex.el (org-bibtex-headline): Don't use `org-labels'.
+
+ * ob.el (org-babel-sha1-hash, org-babel-noweb-p): Ditto.
+
+ * org.el (org-emph-re): Tiny formatting fix.
+
+ * org.el (orgstruct-setup): Require `org-element'.
+
+ * org.el (org-store-link, org-open-at-point): New link type
+ "help".
+
+ * org-compat.el (org-flet): Remove alias.
+
+ * ob.el (org-babel-edit-distance, org-babel-sha1-hash)
+ (org-babel-get-rownames, org-babel-insert-result)
+ (org-babel-merge-params)
+ (org-babel-expand-noweb-references): Don't use `org-flet'. Also
+ indent some functions correctly.
+
+ * ob.el (org-babel-execute-src-block)
+ (org-babel-join-splits-near-ch, org-babel-format-result)
+ (org-babel-examplize-region): Don't use `org-flet'.
+ (org-babel-tramp-handle-call-process-region): Fix typo.
+
+ * ob-awk.el (org-babel-awk-var-to-awk): Don't use `org-flet'.
+
+ * ob-sh.el (org-babel-sh-var-to-string): Ditto.
+
+ * ob-tangle.el (org-babel-tangle, org-babel-spec-to-string): Don't
+ use `org-flet'.
+
+ * org-pcomplete.el (org-compat): Require.
+
+ * ob-tangle.el (org-babel-load-file): Don't use `org-flet'.
+
+ * org-bibtex.el (org-bibtex-write): Use let*.
+
+ * org-plot.el (org-plot/gnuplot-script): Don't use `org-flet'.
+
+ * org-bibtex.el (org-bibtex-headline, org-bibtex-fleshout)
+ (org-bibtex-read, org-bibtex-write): Don't use `org-flet'.
+
+ * org-clock.el (org-clock-cancel): Use `org-looking-back'.
+
+ * org-pcomplete.el (org-thing-at-point): Ditto.
+
+ * org.el (org-timestamp-change): Ditto.
+
+ * org-mouse.el (org-mouse-timestamp-today)
+ (org-mouse-set-priority, org-mouse-popup-global-menu)
+ (org-mouse-context-menu): Don't use ̀org-flet'.
+
+ * org.el (org-priority): Fix docstring.
+
+ * org-publish.el (org-publish-write-cache-file)
+ (org-publish-initialize-cache)
+ (org-publish-cache-file-needs-publishing)
+ (org-publish-cache-get): Small code clean-up.
+
+ * org-publish.el (org-publish-cache-ctime-of-src): Simplify.
+
+ * org-agenda.el (org-agenda-get-sexps): Add a 'tags property for
+ agenda entries created from sexps.
+
+ * org-capture.el (org-capture-templates): Docstring clean up.
+ (org-capture-place-entry, org-capture-place-item)
+ (org-capture-place-plain-text, org-capture-place-table-line):
+ Ensure to always position the point according to %?.
+
+ * org-table.el (org-table-convert-refs-to-rc): Fix bug when
+ converting remote table references.
+
+ * org-agenda.el (org-agenda-switch-to): Run hooks in
+ ̀org-agenda-after-show-hook'.
+
+ * ob-ref.el (org-babel-ref-index-list): Use let* and rename the
+ variable `length' to `lgth'.
+
+ * org-plot.el (org-plot/gnuplot-to-grid-data): Don't use
+ ̀org-flet'.
+
+ * org-exp.el (org-export-format-source-code-or-example): Ditto.
+
+ * org-exp-blocks.el (org-export-blocks-preprocess): Ditto.
+
+ * ob.el (org-babel-view-src-block-info)
+ (org-babel-execute-src-block, org-babel-edit-distance)
+ (org-babel-switch-to-session-with-code)
+ (org-babel-balanced-split, org-babel-insert-result): Ditto.
+
+ * ob-ref.el (org-babel-ref-index-list): Ditto.
+
+ * ob-python.el (org-babel-python-evaluate-session): Ditto.
+
+ * ob-lob.el (org-babel-lob-get-info): Ditto.
+
+ * ob-gnuplot.el (org-babel-expand-body:gnuplot): Ditto.
+
+ * ob-exp.el (org-babel-exp-do-export): Ditto.
+
+ * org-table.el (orgtbl-to-generic): Fix docstring.
+
+ * org-clock.el (org-clock-in): Call `org-clock-out' with the new
+ argument `switch-to-state' set to nil. Fix docstring.
+ (org-clock-in-last): Prompt for a todo state to switch to when
+ called with three universal prefix arguments. Don't display a
+ message when the clock is already running. Update docstring.
+ (org-clock-out): New argument `switch-to-state'. When this
+ argument is non-nil, prompt for a state to switch the clocked out
+ task to, overriding `org-clock-out-switch-to-state'.
+
+ * org.el (org-entry-get): Don't use `org-flet'.
+
+ * org.el (org-forward-heading-same-level): Rename from
+ `org-forward-same-level'.
+ (org-backward-heading-same-level): Rename from
+ `org-backward-same-level'.
+
+ * org.el (org-forward-element): Rename from `org-element-forward'.
+ (org-backward-element): Rename from `org-element-backward'.
+ (org-up-element): Rename from `org-element-up'.
+ (org-down-element): Rename from `org-element-down'.
+ (org-drag-element-backward): Rename from
+ `org-element-drag-backward'.
+ (org-drag-element-forward): Rename from
+ `org-element-drag-forward'.
+ (org-mark-element): Rename from `org-element-mark-element'.
+ (org-transpose-element): Rename from `org-element-transpose'.
+ (org-unindent-buffer): Rename from `org-element-unindent-buffer'.
+ (org-mode-map): Update the names of a commands. Remove useless
+ declarations.
+
+ * org-element.el (org-element-forward, org-element-backward)
+ (org-element-up, org-element-down)
+ (org-element-drag-backward, org-element-drag-forward)
+ (org-element-mark-element, org-narrow-to-element)
+ (org-element-transpose, org-element-unindent-buffer): Move to
+ org.el.
+
+ * org.el (org-forward-same-level): Fix typo in docstring.
+
+ * org-agenda.el (org-agenda-mode-map): Bind
+ `org-agenda-show-priority' to `C-c,' instead of `P'.
+ (org-agenda-next-item, org-agenda-previous-item): New commands to
+ move by one item down/up in the agenda.
+ (org-agenda-mode-map): Bind `org-agenda-next-item' and
+ `org-agenda-previous-item' to `N' and `P' respectively.
+
+ * org-rmail.el (org-rmail-store-link, org-rmail-follow-link):
+ Toggle headers when necessary.
+
+ * org-element.el (org-narrow-to-element): Autoload.
+
+ * org.el (org-mode-map): Use `M-h' for `org-element-mark-element'.
+ (org-mark-subtree): Allow a numeric prefix argument to move up
+ into the hierarchy of headlines.
+
+ * org-element.el (org-element-up, org-element-down): Autoload.
+
+ * org.el: Declare functions and don't require org-element.
+
+ * org-element.el (org-element-at-point, org-element-forward)
+ (org-element-backward, org-element-drag-backward)
+ (org-element-drag-forward, org-element-mark-element)
+ (org-element-transpose, org-element-unindent-buffer): Autoload.
+ Require 'org and remove all declarations.
+
+ * org.el (org-outline-regexp-bol, org-heading-regexp): Use
+ variables instead of constants.
+
+ * org-archive.el (org-datetree-find-date-create): Declare.
+
+ * org.el (org-open-at-point): Only set
+ `clean-buffer-list-kill-buffer-names' when the feature 'midnight
+ has been loaded.
+
+ * org-icalendar.el (org-print-icalendar-entries): Let
+ APPT_WARNTIME take precedence over ̀org-icalendar-alarm-time'.
+
+ * org.el (org-special-properties): New special property
+ CLOCKSUM_T.
+ (org-entry-properties): Handle the new special property.
+
+ * org-colview.el (org-columns): Handle a new special property
+ CLOCKSUM_T.
+ (org-agenda-colview-summarize, org-agenda-colview-compute): Ditto.
+
+ * org-clock.el (org-clock-sum-today): New function.
+ (org-clock-sum): New argument PROPNAME to set a custom text
+ property instead of :org-clock-minutes.
+
+ * org-agenda.el (org-agenda-check-type): Throw a more appropriate
+ error message when no agenda is currently being displayed.
+
+ * org.el (org-get-property-block): Find blocks before the first
+ headline.
+ (org-entry-properties): Minor code cleanup.
+ (org-entry-get, org-entry-get-with-inheritance): Get property
+ before the first headline.
+
+ * org-mobile.el (org-mobile-create-index-file): Use `files-alist'.
+
+ * org.el (org-make-link): Delete.
+ (org-store-link, org-insert-link)
+ (org-file-complete-link): Don't use `org-make-link'.
+
+ * org-wl.el (org-wl-store-link-folder)
+ (org-wl-store-link-message): Ditto.
+
+ * org-vm.el (org-vm-store-link): Ditto.
+
+ * org-rmail.el (org-rmail-store-link): Ditto.
+
+ * org-mhe.el (org-mhe-store-link): Ditto.
+
+ * org-mew.el (org-mew-store-link): Ditto.
+
+ * org-irc.el (org-irc-erc-store-link): Ditto.
+
+ * org-info.el (org-info-store-link): Ditto.
+
+ * org-id.el (org-id-store-link): Ditto.
+
+ * org-gnus.el (org-gnus-group-link, org-gnus-article-link): Ditto.
+
+ * org-eshell.el (org-eshell-store-link): Ditto.
+
+ * org-bbdb.el (org-bbdb-store-link): Ditto.
+
+ * org.el (org-url-hexify-p): New option. When non-nil (the
+ default), hexify URLs when creating a link.
+
+ * org.el (org-insert-link): Make sure point is at the beginning of
+ the buffer.
+
+ * org.el (clean-buffer-list-kill-buffer-names): Declare.
+ (org-open-at-point): Allow opening multiple shell links by
+ creating a new output buffer for each shell process. The new
+ buffer is added to `clean-buffer-list-kill-buffer-names'.
+
+ * org-mobile.el (org-mobile-create-index-file): Use
+ `org-global-tags-completion-table' instead of
+ `org-tag-alist-for-agenda' to get the tags for the index file.
+
+ * org.el (org-global-tags-completion-table): Fix typo in
+ docstring.
+
+ * org.el (org-link-to-org-use-id): Use `org-capture' instead of
+ `org-remember' in the docstring.
+ (org-link-fontify-links-to-this-file): New function to fontify
+ links to the current buffer in `org-stored-links'.
+ (org-store-link): Small code simplification.
+ (org-link-prettify): Enclose literal links into <...> instead of
+ [[...]].
+ (org-insert-link): Use `org-link-fontify-links-to-this-file'.
+ Also allow completion over links' descriptions, as well as links
+ destinations. When the user uses the description for completion,
+ don't prompt again for a description.
+
+ * org-capture.el (org-capture-templates): Fix docstring by adding
+ Gnus to the list of mail clients.
+
+ * org.el (org-log-repeat): Enhance docstring.
+
+ * org.el (org-mode-map): Don't bind C-<up> and C-<down> to
+ `org-element-backward/forward' as these functions stops when there
+ is no element of the same type before/after point. It is useful
+ to navigate with `forward/backward-paragraph' with no stop in most
+ cases.
+
+ * org-capture.el (org-capture-templates): New template %l to
+ insert the literal link pointing at the current buffer.
+
+ * org.el (org-todo-keywords): Ditto.
+
+ * org.el (org-fill-paragraph): Falls back on
+ `message-fill-paragraph' if required in `message-mode'.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option/x): New macro.
+ (pcomplete/org-mode/file-option/options)
+ (pcomplete/org-mode/file-option/title)
+ (pcomplete/org-mode/file-option/author)
+ (pcomplete/org-mode/file-option/email)
+ (pcomplete/org-mode/file-option/date): Use the new macro to offer
+ completion over default values for #+OPTIONS, #+TITLE, #+AUTHOR,
+ #+EMAIL and #+DATE.
+
+ * org-agenda.el (org-agenda-write): Fix bug when writing agenda to
+ an external file while `org-agenda-sticky' is non-nil.
+
+ * org.el (org-speed-commands-default): New speedy command to
+ quickly add the :APPT_WARNTIME: property.
+
+ * org-agenda.el (org-agenda-to-appt): Use the :APPT_WARNTIME:
+ property to override `appt-message-warning-time' when adding an
+ appointment from an entry.
+
+ * org.el (org-version): Improve docstring.
+ (org-self-insert-cluster-for-undo): The default value should be
+ nil for Emacs >=24.1. See bug#11774.
+
+ * org.el (org-fontify-meta-lines-and-blocks-1): Fix previous
+ commit.
+
+ * org.el (org-options-keywords): New constant.
+ (org-additional-option-like-keywords): Remove duplicates with
+ keywords in the new constant.
+ (org-additional-option-like-keywords-for-flyspell): Use the new
+ constant.
+ (org-mode-flyspell-verify): Exclude keywords from the new
+ constant.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option): Use
+ `org-options-keywords'.
+
+ * org.el (org-toggle-heading): Bugfix: use
+ `org-element-mark-element' instead of `org-mark-list'.
+
+ * org-list.el (org-mark-list): Delete.
+
+ * org.el: Update a few keybindings.
+
+ * org-element.el (org-element-down): Throw an error when the
+ element has no content.
+
+ * org-table.el (orgtbl-radio-table-templates): Add a template for
+ org-mode.
+ (orgtbl-to-orgtbl): Complete and align the table created with
+ orgtbl-to-orgtbl, in case the user use the function for radio
+ tables.
+ (orgtbl-to-table.el): New function to export a table to another
+ one using the table.el format.
+ (orgtbl-to-unicode): New function to export a table using unicode
+ characters.
+
+ * org-exp.el (org-export-language-setup): Use "Sommaire" for the
+ french translation of "Table of contents", to avoid a possible bug
+ when exporting to ODT.
+
+ * org.el (org-additional-option-like-keywords): Add keywords.
+ (org-additional-option-like-keywords-for-flyspell): New constant
+ to use with flyspell.
+ (org-mode-flyspell-verify): Use the dedicated constant and don't
+ check `org-startup-options'.
+
+ * org-agenda.el (org-batch-store-agenda-views): Use the sticky
+ agenda buffer name, if required.
+ (org-agenda-write): New parameter `agenda-bufname' to allow
+ setting the agenda buffer name.
+
+ * org.el (org-mode-map): Add keybindings for
+ `org-element-forward', `org-element-backward', `org-element-up'
+ and `org-element-down'.
+
+ * org.el (org-auto-fill-function): Don't call `do-auto-fill'
+ within (org-let org-fb-vars ...) as `do-auto-fill' should do the
+ right thing whether orgstruct++-mode is turned on or off.
+
+ * org.el (org-sparse-tree-default-date-type): New option.
+ (org-ts-type): New variable.
+ (org-sparse-tree): New argument `type'. Use the new option
+ `org-sparse-tree-default-date-type' as the default value for
+ `type'. Fix docstring.
+ (org-re-timestamp): New function.
+ (org-check-before-date, org-check-after-date)
+ (org-check-dates-range): Use `org-ts-type' and `org-re-timestamp'
+ to tell compute the date regexp.
+
+ * org.el (orgstruct++-mode, org-get-local-variables): Also set
+ `normal-auto-fill-function' when turning on/off orgstruct++-mode.
+
+ * org-agenda.el (org-agenda-start-with-log-mode): Add relevant
+ customization types.
+
+ * org-faces.el (org-document-title): Use the normal height.
+
+ * org-clock.el (org-x11idle-exists-p): New variable.
+ (org-user-idle-seconds): Use it.
+
+ * org.el (org-mode-map): Rebind `org-insert-all-links' to `C-c
+ C-M-l'.
+
+ * org.el (org-insert-all-links): New command.
+ (org-insert-link): `org-keep-stored-link-after-insertion' is now
+ checked when the link to insert has been defined, regardless on
+ how it has been defined. Also don't read the description
+ interactively when the `default-description' parameter was given.
+ (org-mode-map): Bind `org-insert-all-links' to `C-c C-L'.
+
+ * org.el (org-inc-effort): New command to increment the effort
+ property.
+ (org-set-effort): Use it.
+ (org-mode-map): Bind it to `C-c C-x E'.
+ (org-speed-commands-default): Use `E' as a speed command for it.
+
+ * org.el (org-re-property-keyword): New function.
+ (org-entry-put): Use it to fix a bug with respect to setting the
+ value of a property when a property line with no value already
+ exists.
+
+ * org.el (org-timestamp-change): Adjust clock in other org files
+ correctly.
+
+ * org-clock.el (org-user-idle-seconds): Simplify.
+
+ * org.el (org-mode-map): Bind `org-resolve-clocks' to `C-c C-x
+ C-z'.
+
+ * org.el (org-mode-map): Add keybindings to
+ `org-element-transpose' and `org-narrow-to-element'.
+ (org-metaup): Fall back on `org-element-drag-backward'.
+ (org-metadown): Fall back on `org-element-drag-forward'. Also
+ move chunks of declarations and require statements to get rid of
+ compiler warnings.
+
+ * org-exp-blocks.el (org): Don't require org. Add declarations.
+
+ * org-clock.el (org): Don't require org.
+
+ * ob-exp.el (org-list-forbidden-blocks): Add declarations.
+
+ * org.el (org-timestamp-change): Don't use the `position'.
+
+ * org.el (org-clock-history, org-clock-adjust-closest): New
+ variables.
+ (org-timestamp-change): Maybe adjust the next or previous clock in
+ `org-clock-history'.
+ (org-shiftmetaup, org-shiftmetadown): On clock logs, update the
+ timestamp at point and adjust the next or previous clock in
+ `org-clock-history', when possible.
+
+ * org-clock.el (org-clock-in): Set the marker for
+ `org-clock-history' at a safer position.
+
+ * org-timer.el (org-timer-pause-or-continue, org-timer-stop):
+ Autoload.
+
+ * org-mobile.el (org-mobile-post-pull-hook): Fix docstring.
+
+ * org.el (org-indent-line): Fix indentation of a property line
+ starting at the beginning of a line.
+
+ * org-odt.el (org-odt-cleanup-xml-buffers): Use the new alias.
+
+ * org-compat.el: Alias `org-condition-case-unless-debug' to
+ `condition-case-unless-debug' or `condition-case-no-debug'.
+
+ * org.el (org-todo-keywords): Ditto.
+
+ * org.el (org-use-fast-todo-selection): Reformat docstring.
+
+ * org.el (org-flag-drawer): Add a docstring.
+ (org-mode-map): Bind ̀org-clock-cancel' to "C-cC-xC-q" and
+ `org-clock-in-last' to "C-cC-xC-x". This fixes a bug in the
+ previous keybinding for `org-clock-in-last', which would override
+ the one for `org-clock-in'.
+
+ * org-clock.el (org-clock-in-last): Prevent errors when there is
+ no clocking history.
+ (org-clock-cancel): Fix bug when checking against a clock log in a
+ folded drawer.
+
+ * org.el (org-link-expand-abbrev): Implement "%(my-function)" as a
+ new specifier. Update the docstring.
+
+ * org.el (org-startup-options): Fix docstring formatting.
+
+ * org.el (org-use-sub-superscripts): Fix typo in docstring.
+
+ * org.el (org-refile): Fix bug: prevent looping when calling
+ `org-set-tags' internally.
+
+ * org.el (org-mode-map): Add `C-c C-x C-I' as a keybinding for
+ `org-clock-in-last'.
+
+ * org-clock.el (org-clock-continuously): New option.
+ (org-clock-in): Three universal prefix arguments set
+ `org-clock-continuously' to `t' temporarily.
+ (org-clock-in-last): Fix call to `org-clock-select-task' and
+ support continuous clocking.
+ (org-clock-out-time): New variable.
+ (org-clock-out): Set `org-clock-out-time' when clocking out.
+ Small docstring rewriting.
+ (org-clock-remove-empty-clock-drawer): Fix "invalid search bound"
+ bug when trying to delete empty logbook drawer.
+ (org-clock-cancel): If the clock log is gone, send a warning
+ instead of deleting the region that is supposed to contain it.
+
+ * org.el (org-move-line-down, org-move-line-up): Remove.
+ (org-metaup, org-metadown): When the region is active, move it
+ up/down by one line, with no regard to the context.
+
+ * org-odt.el (org-odt-cleanup-xml-buffers): Use the new alias.
+
+ * org-compat.el: Alias `org-condition-case-unless-debug' to
+ `condition-case-unless-debug' or `condition-case-no-debug'.
+
+ * org-pcomplete.el (org-thing-at-point): Ignore trailing
+ whitespaces while looking-back at properties.
+
+ * org.el (org-mode): Set `indent-region-function'.
+ (org-indent-region): New function.
+ (org-fill-paragraph): When in a src block, use `indent-region' to
+ indent the whole source code instead of falling back on
+ `fill-paragraph', as this function messes up the code.
+
+ * org-src.el (org-edit-src-code): Fix docstring formatting.
+
+ * ob.el (org-babel-do-key-sequence-in-edit-buffer): Ditto.
+
+ * org.el (org-mode, org-add-log-setup)
+ (org-get-property-block, org-entry-put)
+ (org-property-next-allowed-value, org-return)
+ (org-indent-line): Rename `org-indent-line-function' to
+ `org-indent-line'.
+
+ * org-timer.el (org-timer-item): Ditto.
+
+ * org-table.el (org-table-store-formulas): Ditto.
+
+ * org-clock.el (org-clock-in, org-clock-find-position): Ditto.
+
+ * org-src.el (org-src-font-lock-fontify-block)
+ (org-src-strip-leading-and-trailing-blank-lines)
+ (org-src-ask-before-returning-to-edit-buffer)
+ (org-edit-src-code, org-edit-src-continue)
+ (org-edit-fixed-width-region)
+ (org-src-do-key-sequence-at-code-block)
+ (org-src-font-lock-fontify-block, org-src-fontify-buffer): Fix
+ typos in docstrings.
+
+ * org-docbook.el (org-export-docbook-emphasis-alist): Fix typo:
+ use "format string" instead of "formatting string".
+
+ * org-latex.el (org-export-latex-emphasis-alist)
+ (org-export-latex-title-command, org-export-latex-tables): Ditto.
+
+ * org-html.el (org-export-html-postamble): Ditto.
+
+ * org-latex.el (org-export-latex-hyperref-options-format): New
+ option.
+ (org-export-latex-make-header): Use it.
+
+ * ob.el (org-babel-confirm-evaluate): Prevent errors when
+ `org-current-export-file' is void.
+
+ * org-table.el (org-table-export): Use the file name extension to
+ suggest the right conversion format. Also amend the docstring.
+
+ * org.el (org-speed-commands-default): Two new speed commands.
+ Use `:' for `org-columns' and ̀#' for `org-toggle-comment'.
+
+ * org.el (org-time-stamp): With two universal arguments, insert an
+ active timestamp with the current time without prompting the user.
+
+ * org-clock.el (org-clock-in-last): New command.
+
+ * org-clock.el (org-clock-in): Fix typo in docstring.
+
+ * org-mobile.el (org-mobile-edit): Fix reference to a free
+ variable.
+
+ * org.el (org-doi-server-url): Update :group.
+
+ * ob-lob.el (org-babel-lob-execute): Fix reference to non-existent
+ variable.
+
+ * org.el (org-doi-server-url): New option.
+ (org-open-at-point): Use it.
+
+ * org.el (org-at-comment-p): New function.
+ (org-toggle-heading): Use `org-at-comment-p' to skip comments.
+
+ * org-html.el (org-export-as-html): Add links to the Org mode and
+ GNU Emacs websites When :html-postamble is set to 't.
+
+ * org-export.el (org-export-creator-string): Add links to the Org
+ mode and GNU Emacs websites.
+
+ * org-special-blocks.el
+ (org-special-blocks-convert-html-special-cookies): Prevent errors
+ by first checking `org-line' is not nil.
+
+ * org-clock.el (org-clock-string-limit)
+ (org-clock-modeline-total, org-clock-task-overrun-text)
+ (org-clock-mode-line-entry): Doc fix, "modeline" -> "mode line".
+
+ * org.el (org-at-timestamp-p): Set ̀org-ts-what' to 'after when the
+ point is right after the timestamp. `org-at-timestamp-p' still
+ returns `t' in this case, as this is more practical.
+ (org-return): Check against ̀org-ts-what' to verify that point is
+ really within the timestamp (if any).
+
+ * org.el (org-return): Follow time-stamp links when point is an a
+ time-stamp.
+
+ * org-capture.el (org-capture-bookmark): New option.
+ (org-capture-finalize): Use it.
+
+ * org-publish.el (org-publish-cache-file-needs-publishing): Make
+ the column mandatory after #+include:.
+
+ * org-exp.el (org-export-handle-include-files): Ditto.
+
+ * org-bibtex.el (org-bibtex-entries): Rename from
+ (org-bibtex-read, org-bibtex-write): Use the new name.
+
+ * org-exp.el (org-export-handle-include-files): Allow to use
+ #+include with no column.
+
+ * org-publish.el (org-publish-cache-file-needs-publishing): Make
+ quotes mandatory around the file name and allow spaces in it.
+
+ * org-html.el (org-export-as-html): Add link to Org's and Emacs's
+ websites.
+
+ * org-latex.el
+ (org-export-latex-link-with-unknown-path-format): New option.
+ (org-export-latex-links): Use it.
+
+ * org-agenda.el (org-agenda-get-timestamps): Remove any active
+ timestamp from the headline text, not only those for the current
+ date.
+
+ * org.el (org-set-tags): Allow setting tags for headlines in the
+ region when `org-loop-over-headlines-in-active-region' is non-nil.
+
+ * org.el (org-allow-promoting-top-level-subtree): New option to
+ allow promoting a top-level subtree.
+ (org-called-with-limited-levels): New variable, dynamically bound
+ within the `org-with-limited-levels' macro.
+ (org-promote): Use the new option to allow promoting a top-level
+ subtree.
+
+ * org-macs.el (org-with-limited-levels): Let-bind
+ `org-called-interactively-p' to t.
+
+ * org.el (org-create-formula-image-with-dvipng)
+ (org-create-formula-image-with-imagemagick): Make sure a file
+ exists before trying to delete it.
+
+ * org.el (org-scan-tags): Correctly match TODO keywords.
+
+ * org-agenda.el (org-agenda-bulk-action): Fix bug: use
+ `org-agenda-bulk-unmark-all'.
+
+ * org.el (orgstruct++-mode): Fix docstring.
+ (org-fill-paragraph): Use the 'justify parameter when falling back
+ on `fill-paragraph'.
+
+ * org.el (org-indent-line-function): Use `org-let' instead of
+ `orgstruct++-ignore-org-filling'.
+ (org-fill-paragraph, org-auto-fill-function): Ditto.
+
+ * org-macs.el (orgstruct++-ignore-org-filling): Delete.
+
+ * org-table.el (org-table-time-string-to-seconds): Return the
+ empty string if provided.
+ (org-table-eval-formula): When assigning a duration string, handle
+ it correctly -- i.e. don't make any computation on it, except the
+ one to insert it using the correct duration format.
+
+ * org.el (org-indent-line-function): Fix bug.
+
+ * org-clock.el (org-frame-title-format-backup): New variable to
+ store the value of `frame-title-format' before `org-clock' might
+ replace it by `org-clock-frame-title-format'.
+ (org-clock-frame-title-format): New option.
+ (org-frame-title-string): Delete.
+ (org-clock-update-mode-line): Minor code reformatting.
+ (org-clock-in, org-clock-out, org-clock-cancel): Use
+ `org-clock-frame-title-format'.
+
+ * org-clock.el (org-clock-get-clock-string): Add a space.
+
+ * org-list.el (org-mark-list): Return an error when there is no
+ list at point.
+
+ * org.el (org-toggle-heading): Allow `C-u C-c *' to mark the list
+ at point before converting items to headings. With a simple
+ universal-argument, set `current-prefix-arg' to 1, otherwise keep
+ the numeric value.
+
+ * org-agenda.el (org-agenda-view-mode-dispatch): Make the message
+ more readable.
+
+ * org-agenda.el (org-agenda-mode-map): New keybinding ̀*' to mark
+ all entries for bulk action.
+ (org-agenda-menu): New menu item for marking all entries.
+ (org-agenda-bulk-mark-all): New function to mark all entries.
+ (org-agenda-bulk-mark-regexp): Minor docstring fix.
+ (org-agenda-bulk-unmark): With a prefix argument, unmark all.
+ Also send a better message.
+ (org-agenda-bulk-remove-all-marks): Rename to
+ `org-agenda-bulk-unmark-all'. Check against
+ `org-agenda-bulk-marked-entries' before trying to unmark entries.
+ Minor docstring fix.
+ (org-agenda-bulk-unmark-all): Renamed from
+ ̀org-agenda-bulk-remove-all-marks'.
+
+ * org-agenda.el (org-agenda-bulk-mark-char): New option.
+ (org-agenda-bulk-mark): Use the new option.
+
+ * org.el (org-src-prevent-auto-filling): New option to prevent
+ auto-filling in src blocks. This defaults to nil to avoid people
+ being surprised that no auto-fill occurs in Org buffers where they
+ use `auto-fill-mode'.
+ (org-auto-fill-function): Use the new option.
+
+ * org.el (org-properties-postprocess-alist): Better customization
+ type.
+ (org-set-property): Fix the check against
+ `org-properties-postprocess-alist'.
+
+ * org-macs.el (orgstruct++-ignore-org-filling): Set
+ `def-edebug-spec' correctly.
+
+ * org-colview.el (org-columns-string-to-number): When computing
+ the values for the colview, match durations and convert them to
+ HH:MM values.
+
+ * org.el (org-duration-string-to-minutes): Match non-round
+ numbers. Add a new optional parameter to allow returning the
+ output as a string.
+
+ * org.el (org-auto-fill-fallback-function)
+ (org-indent-line-fallback-function)
+ (org-fill-paragraph-fallback-function)
+ (org-auto-fill-fallback-function)
+ (org-indent-line-fallback-function)
+ (org-fill-paragraph-fallback-function): Remove.
+ (org-fb-vars): New buffer-local variable.
+ (orgstruct++-mode): Use the fallback variable `org-fb-vars' to
+ store, use and restore variables if needed.
+ (org-fill-paragraph): Ignore `orgstruct++-mode' filling variables
+ when needed.
+ (org-auto-fill-function, org-indent-line-function): Ditto.
+
+ * org-macs.el (orgstruct++-ignore-org-filling): New macro.
+
+ * org-exp-block.el: Use `org-find-library-name' instead of
+ `find-library-name'.
+
+ * org-compat.el (org-find-library-name): Convert into a macro to
+ avoid compilation of a function from XEmacs in Emacs and vice
+ versa.
+
+ * org-table.el (org-table-store-formulas): Fix typo.
+ (org-table-maybe-eval-formula): Fix the regexp to only match
+ formulas, which never end with the `=' character. If the field
+ only contain this character, don't eval either.
+
+ * org.el (org-set-property): Perform the correct check against
+ `org-properties-postprocess-alist'.
+
+ * org-bbdb.el (org-bbdb-anniversary-format-alist): Update the
+ customization type.
+ (name): Suppress (defvar 'name) as name is not eval'ed when
+ setting `org-bbdb-anniversary-format-alist'.
+
+ * org.el (org-version): When called non-interactively, insert the
+ short version string, otherwise send a message with the complete
+ version string.
+
+ * org-odt.el (org-odt-update-meta-file): Use (org-version) and
+ delegate checking whether `org-version' is known as a variable
+ there.
+
+ * org-html.el (org-export-as-html): Use (org-version).
+
+ * org-docbook.el (org-export-as-docbook): Ditto.
+
+ * org-latex.el (org-export-latex-make-header): Ditto.
+
+ * org-clock.el (org-clocktable-write-default): Temporarily disable
+ `delete-active-region' so that we don't accidently delete an
+ active region when exporting a subtree/region.
+
+ * org-clock.el (org-program-exists): Remove.
+ (org-show-notification, org-clock-play-sound): Use
+ `executable-find' instead of `org-program-exists'.
+
+ * org-agenda.el (org-diary): Prevent failure from
+ `org-compile-prefix-format' when there is no agenda buffer.
+
+ * org-agenda.el (org-agenda-mode): Replace obsolete variable
+ `buffer-substring-filters'.
+
+ * org-indent.el (org-indent-mode): Ditto.
+
+ * org-compat.el (org-find-library-name): Silent the byte-compiler
+ about a warning related to XEmacs support.
+
+ * org-special-blocks.el
+ (org-special-blocks-convert-html-special-cookies): Use `org-line'
+ instead of `line'.
+
+ * org-html.el (org-html-handle-links, org-export-as-html)
+ (org-format-org-table-html, org-format-table-table-html)
+ (org-html-export-list-line): Use `org-line' instead of `line' as
+ the free variable name.
+
+ * org-latex.el (org-export-latex-tables): Let-bind `hfmt'.
+
+ * org-faces.el (org-list-dt): New face.
+
+ * org.el (org-set-font-lock-defaults): Use `org-list-dt' as the
+ face for definition terms in definition lists.
+
+ * org.el (org-fill-paragraph): Pass the `justify' argument to
+ `org-fill-paragraph-fallback-function'.
+
+ * org.el (org-eval-in-calendar): Fix docstring to mention the
+ KEEPDATE parameter.
+
+ * org.el (org-refresh-category-properties): Let-bind
+ `inhibit-read-only' to t.
+
+ * org.el (org-auto-fill-fallback-function)
+ (org-indent-line-fallback-function)
+ (org-fill-paragraph-fallback-function): New variables to store
+ some fall-back functions when turning `orgstruct++-mode' on.
+ (orgstruct++-mode): Set the new variables.
+ (org-indent-line-function, org-fill-paragraph)
+ (org-auto-fill-function): Use them.
+
+ * org.el (org-read-date): Bugfix: call `org-eval-in-calendar' with
+ the 'keepdate parameter set to t when setting the cursor type.
+
+ * org-agenda.el (org-agenda-persistent-marks): New option to keep
+ marks after a bulk action. The option defaults to nil.
+ (org-agenda-bulk-action): Use the new option.
+
+ * org-capture.el (org-capture-fill-template): Use %\n instead of
+ %n as a template element to be replaced with the nth prompted
+ string.
+ (org-capture-templates): Update docstring.
+
+ * org.el (org-goto): Fix docstring and document what C-u does.
+
+ * org-publish.el (org-publish-cache-file-needs-publishing): Use
+ (case-fold-search t) when looking for #+INCLUDE:.
+
+ * org.el: Use (case-fold-search t).
+ (org-edit-special, org-ctrl-c-ctrl-c): Ditto.
+
+ * org-table.el:
+ (org-table-store-formulas, org-table-get-stored-formulas)
+ (org-table-fix-formulas, org-table-edit-formulas)
+ (org-old-auto-fill-inhibit-regexp, orgtbl-ctrl-c-ctrl-c)
+ (orgtbl-toggle-comment, org-table-get-remote-range): Ditto.
+
+ * org-footnote.el:
+ (org-footnote-goto-local-insertion-point): Ditto.
+
+ * org-exp.el: Ditto.
+
+ * org-colview.el:
+ (org-dblock-write:columnview, org-dblock-write:columnview): Ditto.
+
+ * org-clock.el (org-clocktable-write-default): Ditto.
+
+ * org-capture.el (org-capture-place-table-line): Ditto.
+
+ * ob.el (org-babel-data-names, org-babel-goto-named-src-block)
+ (org-babel-src-block-names)
+ (org-babel-where-is-src-block-result, org-babel-result-end)
+ (org-babel-where-is-src-block-head)
+ (org-babel-find-named-result, org-babel-result-names): Ditto.
+
+ * org-table.el (orgtbl-send-table): Escape special characters.
+ Introduce a new parameter :no-escape to prevent escaping.
+
+ * org-agenda.el (org-toggle-sticky-agenda): Only shout a message
+ when called interactively.
+ (org-agenda-get-restriction-and-command): Call
+ `org-toggle-sticky-agenda' interactively.
+
+ * org-agenda.el (org-agenda-top-category-filter): New variable for
+ storing the current top-category filter.
+ (org-agenda-redo): Apply a top-category filter, if any.
+ (org-agenda-filter-by-top-category)
+ (org-agenda-filter-top-category-apply): Set
+ `org-agenda-top-category-filter' to the right value.
+
+ * org-clock.el (org-clock-out, org-clock-cancel)
+ (org-clock-in): Don't modify `frame-title-format' if it is a
+ string.
+
+ * org-latex.el (org-export-latex-special-chars): Fix bug when
+ escaping special characters in a table.
+
+ * org.el (org-read-date): Set cursor-type to nil in the calendar.
+
+ * org-faces.el (org-date-selected): Use inverse video. Don't
+ explicitely set bold to nil as it causes `customize-face' to show
+ the weight property and thus encourage the user to change it.
+ Warn in the docstring that using bold might cause problems when
+ displaying the calendar.
+
+ * org-id.el (org-id-update-id-locations): New parameter to silent
+ `org-id-find'.
+ (org-id-find): Use the new parameter.
+
+ * org.el (org-show-hierarchy-above, org-cycle)
+ (org-global-cycle, org-files-list, org-store-link)
+ (org-link-search, org-open-file, org-display-outline-path)
+ (org-refile-get-location, org-update-all-dblocks)
+ (org-change-tag-in-region, org-entry-properties)
+ (org-save-all-org-buffers, org-revert-all-org-buffers)
+ (org-buffer-list, org-cdlatex-mode)
+ (org-install-agenda-files-menu, org-end-of-subtree)
+ (org-speedbar-set-agenda-restriction): Use (derived-mode-p
+ 'org-mode) instead of (eq major-mode 'org-mode).
+
+ * org-timer.el (org-timer-set-timer): Ditto.
+
+ * org-table.el (orgtbl-mode, org-table-align, orgtbl-mode): Ditto.
+
+ * org-src.el (org-edit-src-exit, org-edit-src-code)
+ (org-edit-fixed-width-region, org-edit-src-exit): Ditto.
+
+ * org-remember.el (org-remember-handler): Ditto.
+
+ * org-mouse.el (dnd-open-file, org-mouse-insert-item): Ditto.
+
+ * org-macs.el (org-get-limited-outline-regexp): Ditto.
+
+ * org-lparse.el (org-replace-region-by): Ditto.
+
+ * org-latex.el (org-latex-to-pdf-process)
+ (org-replace-region-by-latex): Ditto.
+
+ * org-indent.el (org-indent-indent-buffer): Ditto.
+
+ * org-id.el (org-id-store-link, org-id-update-id-locations)
+ (org-id-store-link): Ditto.
+
+ * org-html.el (org-export-html-preprocess)
+ (org-replace-region-by-html): Ditto.
+
+ * org-footnote.el (org-footnote-normalize)
+ (org-footnote-goto-definition)
+ (org-footnote-create-definition, org-footnote-normalize): Ditto.
+
+ * org-docbook.el (org-replace-region-by-docbook): Ditto.
+
+ * org-ctags.el (find-tag): Ditto.
+
+ * org-colview.el (org-columns-redo)
+ (org-columns-display-here, org-columns-edit-value)
+ (org-columns-redo): Ditto.
+
+ * org-capture.el (org-capture-insert-template-here)
+ (org-capture, org-capture-finalize)
+ (org-capture-set-target-location)
+ (org-capture-insert-template-here): Ditto.
+
+ * org-ascii.el (org-replace-region-by-ascii): Ditto.
+
+ * org-archive.el (org-archive-subtree): Ditto.
+
+ * org-agenda.el (org-agenda)
+ (org-agenda-get-restriction-and-command)
+ (org-agenda-get-some-entry-text, org-search-view)
+ (org-tags-view, org-agenda-get-day-entries)
+ (org-agenda-format-item, org-agenda-goto, org-agenda-kill)
+ (org-agenda-archive-with, org-agenda-switch-to): Ditto.
+
+ * org.el (org-repeat-re)
+ (org-clone-subtree-with-time-shift, org-auto-repeat-maybe)
+ (org-deadline, org-schedule, org-matcher-time)
+ (org-time-stamp, org-read-date, org-read-date-get-relative)
+ (org-display-custom-time, org-get-wdays)
+ (org-time-string-to-absolute, org-closest-date)
+ (org-timestamp-change): Allow to set hourly repeat cookie. Send
+ an error when an hourly repeat cookie is set and no hour is
+ specified in the timestamp.
+
+ * org-icalendar.el (org-print-icalendar-entries): Handle hourly
+ repeat cookies.
+
+ * org-clock.el (org-program-exists): Fix docstring.
+
+ * org-clock.el (org-clock-file-time-cell-format): New option.
+ (org-clocktable-write-default): Use it.
+
+ * org-faces.el (org-date-selected): New face.
+
+ * org.el (org-date-ovl): Use `org-date-selected'.
+
+ * org.el (org-mode): Don't use `buffer-face-mode' by default.
+
+ * org-agenda.el (org-agenda-mode-map): Bind `^' to
+ `org-agenda-filter-by-top-category'.
+
+ * org-ascii.el (org-export-ascii-underline): Change the default
+ underlining characters for headlines of level 1 and 2. Also
+ introduce \. as the underline character for headlines of level 5.
+
+ * org-table.el (org-table-recalculate-buffer-tables)
+ (org-table-iterate-buffer-tables): Add autoload cookie.
+
+ * org.el (org-table-map-tables): Exclude tables in src and example
+ blocks.
+
+ * org.el (org-fill-paragraph): Leave scheduled/deadline lines
+ untouched when filling an adjacent paragraph.
+
+ * org-html.el (org-export-html-preamble-format)
+ (org-export-html-postamble-format): Improve the docstring.
+
+ * org.el (org-todo): Fix regression: rename `state' to
+ `org-state'.
+
+ * org-clock.el (org-show-notification): Use `fboundp' instead of
+ `featurep' and the additional `require'.
+
+ * org-clock.el (org-clock-in-prepare-hook): New option to format
+ the total time cells.
+ (org-clocktable-write-default): Use the new option.
+
+ * org.el (org-open-at-point): Allow to open the agenda from an
+ active or inactive timestamp in a headline.
+
+ * org-html.el (org-export-html-date-format-string): Make a
+ defcustom.
+
+ * org-latex.el (org-export-as-latex): Fix TeX-master declaration.
+
+2012-09-30 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-table.el (org-table-expand-lhs-ranges): Allow hline
+ references to be expanded correctly in LHS of formulas.
+
+ * org-beamer.el (org-beamer-inherited-properties): New option.
+ (org-beamer-after-initial-vars): Use new option to look for
+ inherited properties.
+
+ * org.el (org-ts-regexp0): Allow time stamps without name of day.
+
+ * org-agenda.el (org-toggle-sticky-agenda):
+ (org-agenda-sticky): Improve :set property.
+
+ * org-agenda.el (org-agenda-local-vars): Clean up the variable
+ list.
+ (org-agenda-get-restriction-and-command): Add a key for toggling
+ sticky agenda views.
+
+ * org-agenda.el (org-agenda-local-vars): Final decisions about
+ global/local
+
+ * org-agenda.el (org-agenda-force-single-file): Variable removed.
+ (org-prepare-agenda-window): Store pre-agenda window config
+ locally.
+ (org-timeline): Introduce a scoped version of
+ `org-agenda-show-log'.
+ (org-agenda-list): Introduce a scoped version of
+ `org-agenda-show-log'.
+ (org-agenda-get-progress): Use the scoped version of
+ `org-agenda-show-log'.
+ (org-agenda-local-vars): Write the analysis result as a comment -
+ to be cleaned up in the next iteration.
+
+ * org-agenda.el (org-toggle-sticky-agenda): Kill all agenda
+ buffers when toggling sticky-agendas.
+ (org-agenda-get-restriction-and-command): Add `C-c a C-k' as a key
+ to explicitly kill all agenda buffers.
+ (org-agenda-run-series): Remove any old agenda markers in the
+ buffer that is going to take the new block agenda.
+ (org-prepare-agenda): Reset markers before erasing the buffer anc
+ running `org-agenda-mode', because after that hte local variable
+ `org-agenda-markers' will have gone away.
+ (org-agenda-Quit):
+ (org-finalize-agenda): Install the marker resetter into the
+ `kill-buffer-hook'.
+ (org-agenda-save-markers-for-cut-and-paste): Look for markers in
+ all agenda buffers.
+ (org-agenda-kill-all-agenda-buffers): New function.
+
+2012-09-30 Chris Gray <chrismgray@gmail.com>
+
+ * org-html.el (org-export-as-html): Remove the check for body-only
+ in the code for generating tables of contents.
+
+2012-09-30 Christoph Dittmann <github@christoph-d.de> (tiny change)
+
+ * org-beamer.el (org-beamer-auto-fragile-frames): Make
+ [fragile] work with overlay specifications.
+
+2012-09-30 Christophe Junke <christophe.junke@inria.fr> (tiny change)
+
+ * org-agenda.el (org-agenda-list): Ensures that the list returned
+ by `org-agenda-add-time-grid-maybe' is appended to ̀rtnall' before
+ checking if the latter is empty.
+
+2012-09-30 Christophe Rhodes <csr21@cantab.net> (tiny change)
+
+ * org-latex.el (org-export-latex-tables): Support setting the
+ :hfmt parameter from #+ATTR_LaTeX.
+
+2012-09-30 Daniel Dehennin <daniel.dehennin@baby-gnu.org> (tiny change)
+
+ * org-exp.el (org-export-handle-include-files)
+ (org-get-file-contents): Handle new parameter :addlevel.
+
+2012-09-30 Dave Abrahams <dave@boostpro.com> (tiny change)
+
+ * org.el (org-link-prettify): New function to prettify links while
+ displaying them with `org-insert-link'.
+ (org-insert-link): Use the new function.
+
+2012-09-30 David Maus <dmaus@ictsoc.de>
+
+ * org-exp.el (org-export-language-setup): Use numeric character
+ entities for proper rendering of non-UTF8 documents.
+
+ * org-exp.el (org-export-language-setup): Add japanese
+ translation.
+
+2012-09-30 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-sh.el (org-babel-sh-evaluate): Don't could 0-length shebangs.
+
+ * ob.el (org-babel-insert-result): Replace key sequence with
+ function call. Use a more informative flag to the local function.
+ (org-add-protective-commas): Declare a new external function.
+
+ * org-src.el (org-add-protective-commas): This should be its own
+ function.
+ (org-edit-src-exit): Use the new function.
+
+ * org-compat.el (org-labels): Remove.
+
+ * org-bibtex.el (org-bibtex-headline): Don't use `org-labels'.
+
+ * ob.el (org-babel-sha1-hash, org-babel-noweb-p): Ditto.
+
+ * ob.el (org-babel-string-read): Don't automatically evaluate code
+ block results which look like elisp.
+ (org-babel-import-elisp-from-file): Raise a warning message when
+ the process of reading code block results raises an error.
+
+ * ob-tangle.el (org-babel-with-temp-filebuffer): Don't execute
+ macro argument multiple times.
+
+ * org.el (org-compat): Require org-compat before we first use one
+ of its functions (a macro actually).
+
+ * ob-comint.el (org-babel-comint-with-output): Don't name the
+ filter function, but rather pass through the anonymous lambda
+ directly.
+
+ * org.el (org-babel-load-languages): Common lisp should be
+ mentioned as a supported babel language.
+
+ * org-clock.el (org-clock-special-range): "concat 'string" ->
+ "concat"
+ (org-clocktable-shift): "concat 'string" -> "concat"
+
+ * org-bibtex.el (org-bibtex-headline): Replacing org-flet with
+ org-labels.
+
+ * ob-calc.el (org-babel-execute:calc): Strip single quotes from
+ calc internal representations.
+
+ * org-clock.el (org-clock-special-range): Replacing cl concatenate
+ with concat.
+ (org-clocktable-shift): Replacing cl concatenate with concat.
+
+ * ob.el (org-babel-edit-distance): Remove use of map at runtime.
+
+ * org-compat.el (org-flet): Compatibility function now that flet
+ has been removed from cl-macs.
+ (org-labels): Compatibility function now that labels has been
+ removed from cl-macs.
+
+ * ob-R.el (org-compat): Require org-compat.
+
+ * ob-comint.el: Require org-compat.
+
+ * ob-exp.el (org-babel-exp-do-export): Switch to compatibility
+ function.
+
+ * ob-gnuplot.el (org-babel-expand-body:gnuplot): Switch to
+ compatibility function.
+
+ * ob-lob.el (org-babel-lob-get-info): Switch to compatibility
+ function.
+ (org-babel-lob-execute): Switch to compatibility function.
+
+ * ob-python.el (org-babel-python-evaluate-session): Switch to
+ compatibility function.
+
+ * ob-ref.el (org-babel-ref-index-list): Switch to compatibility
+ function.
+
+ * ob-sh.el (org-babel-sh-var-to-string): Switch to compatibility
+ function.
+
+ * ob-tangle.el (org-babel-load-file): Switch to compatibility
+ function.
+ (org-babel-tangle): Switch to compatibility function.
+ (org-babel-spec-to-string): Switch to compatibility function.
+
+ * ob.el (org-babel-view-src-block-info): Switch to compatibility
+ function.
+ (org-babel-execute-src-block): Switch to compatibility function.
+ (org-babel-edit-distance): Switch to compatibility function.
+ (org-babel-switch-to-session-with-code): Switch to compatibility
+ function.
+ (org-babel-sha1-hash): Switch to compatibility function.
+ (org-babel-balanced-split): Switch to compatibility function.
+ (org-babel-join-splits-near-ch): Switch to compatibility function.
+ (org-babel-get-rownames): Switch to compatibility function.
+ (org-babel-format-result): Switch to compatibility function.
+ (org-babel-insert-result): Switch to compatibility function.
+ (org-babel-examplize-region): Switch to compatibility function.
+ (org-babel-merge-params): Switch to compatibility function.
+ (org-babel-noweb-p): Switch to compatibility function.
+ (org-babel-expand-noweb-references): Switch to compatibility
+ function.
+
+ * org-bibtex.el (org-bibtex-headline): Switch to compatibility
+ function.
+ (org-bibtex-fleshout): Switch to compatibility function.
+ (org-bibtex-read): Switch to compatibility function.
+ (org-bibtex-write): Switch to compatibility function.
+
+ * org-exp-blocks.el (org-export-blocks-preprocess): Switch to
+ compatibility function.
+
+ * org-exp.el (org-export-format-source-code-or-example): Switch to
+ compatibility function.
+
+ * org-macs.el (org-called-interactively-p): Indentation fix.
+
+ * org-mouse.el (org-mouse-timestamp-today): Switch to
+ compatibility function.
+ (org-mouse-set-priority): Switch to compatibility function.
+ (org-mouse-popup-global-menu): Switch to compatibility function.
+ (org-mouse-context-menu): Switch to compatibility function.
+
+ * org-plot.el (org-plot/gnuplot-to-grid-data): Switch to
+ compatibility function.
+ (org-plot/gnuplot-script): Switch to compatibility function.
+
+ * org.el (org-entry-get): Switch to compatibility function.
+ (org-fill-paragraph): Switch to compatibility function.
+ (org-auto-fill-function): Switch to compatibility function.
+
+ * ob-lob.el (org-babel-lob-execute): Only try to insert extant
+ hashes.
+
+ * ob-R.el (org-babel-R-command): From a defvar to a defcustom.
+
+ * ob.el (org-babel-set-current-result-hash): Change the hash of
+ the results for the current code block.
+ (org-babel-current-result-hash): Fix documentation.
+
+ * ob-lob.el (org-babel-lob-execute): Don't re-execute the called
+ function if the current call line hash matches that in its
+ results.
+
+ * ob-R.el (org-babel-R-assign-elisp): Can't assume every entry in
+ a table is a sequence.
+
+ * ob-R.el (org-babel-R-assign-elisp): Clean up the code
+ implementing reads of irregular data into R.
+
+ * ob.el (org-babel-header-arg-expand): In new buffers
+ (char-before) may return nil so use equal rather than =.
+
+ * ob-R.el (org-babel-header-args:R): Adding values.
+
+ * ob-clojure.el (org-babel-header-args:clojure): Adding values.
+
+ * ob-lisp.el (org-babel-header-args:lisp): Adding values.
+
+ * ob-sql.el (org-babel-header-args:sql): Adding values.
+
+ * ob-sqlite.el (org-babel-header-args:sqlite): Adding values.
+
+ * ob.el (org-babel-combine-header-arg-lists): Combine lists of
+ arguments and values.
+ (org-babel-insert-header-arg): Use new combined header argument
+ lists.
+ (org-babel-header-arg-expand): Add support for completing-read
+ insertion of header arguments after ":"
+ (org-babel-enter-header-arg-w-completion): Completing read
+ insertion of header arguments
+ (org-tab-first-hook): Adding header argument completion.
+ (org-babel-params-from-properties): Combining header argument
+ lists.
+
+ * ob-exp.el (org-babel-exp-results): Ensure noweb expanded body is
+ used on export.
+
+ * ob.el (org-babel-result-to-file): New optional description
+ argument.
+ (org-babel-insert-result): Moved description logic to another
+ function.
+
+ * ob.el (org-babel-insert-result): Change name of filelinkdescr to
+ file-desc.
+ (org-babel-common-header-args-w-values): Change name of
+ filelinkdescr to file-desc.
+
+ * ob-C.el (org-babel-C-execute): Add .exe to the end of compiled C
+ files on windows.
+
+ * ob-exp.el (org-babel-exp-code): Escape all lines when exporting
+ Org-mode blocks.
+
+ * ob.el (org-babel-parse-src-block-match): Make use of the new
+ language argument to org-babel-strip-protective-commas.
+ (org-babel-parse-inline-src-block-match): Make use of the new
+ language argument to org-babel-strip-protective-commas.
+ (org-babel-strip-protective-commas): Now accepts a language
+ argument.
+
+2012-09-30 Fabrice Niessen <fniessen-TA4HMoP+1wHrZ44/DZwexQ@public.gmane.org> (tiny change)
+
+ * org-agenda.el (org-agenda-write-buffer-name): Remove the test
+ for the presence of <style> tag.
+
+2012-09-30 Feng Shu <tumashu@gmail.com>
+
+ * org.el (org-create-formula-image-with-imagemagick): Use
+ 'call-process to launch latex so that no shell output buffer will
+ be shown when previewing formulas.
+
+ * org.el (org-create-formula-image-with-imagemagick): Fix typo.
+
+ * org.el (org-latex-create-formula-image-program): New option to
+ use either dvipng or imagemagick to convert and preview LaTeX
+ fragments.
+ (org-preview-latex-fragment, org-format-latex): Handle the new
+ option.
+ (org-create-formula-image-with-dvipng): Rename from
+ `org-create-formula-image'.
+ (org-create-formula-image-with-imagemagick): New defun to handle
+ LaTeX preview with imagemagick.
+ (org-latex-color, org-latex-color-format): New defuns to handle
+ color conversions.
+
+ * org-latex.el (org-latex-to-pdf-process, org-export-as-pdf):
+ Allow to use imagemagick to convert LaTeX fragments.
+
+ * org-html.el (org-export-html-preprocess): Ditto.
+
+ * org-exp.el (org-export-with-LaTeX-fragments): Ditto.
+
+2012-09-30 George Kettleborough <g.kettleborough@member.fsf.org>
+
+ * org-clock.el: New option `org-clock-clocked-in-display' to
+ control whether the current clock is displayed in the mode line
+ and/or frame title.
+
+ * org-timer.el: New option `org-timer-display' to control whether
+ the current timer is displayed in the mode line and/or frame
+ title.
+
+2012-09-30 Hans-Peter Deifel <hpdeifel@gmx.de> (tiny change)
+
+ * ob.el (org-babel-execute-src-block): Allow the :dir header
+ argument to take relative file names.
+
+2012-09-30 Harri Kiiskinen <harri@pp-kaitue.(none)> (tiny change)
+
+ * org-protocol.el: New option.
+ (org-protocol-store-link, org-protocol-do-capture): Use it.
+
+2012-09-30 Henning Weiss <hdweiss@gmail.com>
+
+ * org-mobile.el (org-mobile-edit): Added handling of addheading,
+ refile, archive, archive-sibling and delete edit nodes.
+ (org-mobile-locate-entry): Olp links containing only a file are
+ now be located correctly.
+ (org-mobile-apply): Instead of finding the location of all target
+ headings for edit nodes in a separate loop, they will be found
+ immediately before applying edits.
+
+ * org-mobile.el (org-mobile-sumo-agenda-command): Use a shorter
+ title.
+
+2012-09-30 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change)
+
+ * org.el (org-parse-time-string): Allow strings supported by
+ tags/properties matcher (eg <now>, <yesterday>, <-7d>) if the time
+ starts with < and ends with >. This means that e.g. in the
+ clocktable parameters you can specify :tstart "<-1w>" :tend
+ "<now>".
+
+2012-09-30 Ippei FURUHASHI <top.tuna+orgmode@gmail.com> (tiny change)
+
+ * org-colview.el (org-columns): New argument `columns-fmt-string'.
+
+ * org-colview.el (org-columns-get-format-end-top-level): Split
+ into `org-columns-get-format' and `org-columns-goto-top-level'.
+
+ * org-colview.el (org-dblock-write:columnview): Add a new
+ parameter :format which specifies the column view format for the
+ output of the columnview dynamic block.
+
+2012-09-30 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-lparse.el (org-lparse-and-open)
+ (org-lparse-do-convert): Open exported files with system-specific
+ application.
+
+ * org-odt.el: Don't meddle with `org-file-apps'.
+
+ * org-compat.el (org-condition-case-unless-debug): Alias to
+ `condition-case' when both `condition-case-no-debug' and
+ `condition-case-unless-debug' is unavailable.
+
+ * org-odt.el (org-odt-do-image-size): Replace `flet' with
+ equivalent construct.
+
+ * org-odt.el (org-odt-cleanup-xml-buffers): Use
+ `condition-case-no-debug' instead of
+ `condition-case-unless-debug'. This ensures backward
+ compatibility with Emacs versions < 24.1.
+
+ * org-odt.el (org-odt-zip-dir)
+ (org-odt-cleanup-xml-buffers): New.
+ (org-export-as-odt-and-open, org-export-as-odt)
+ (org-odt-init-outfile, org-odt-save-as-outfile)
+ (org-export-as-odf, org-export-as-odf-and-open): Use
+ `org-odt-cleanup-xml-buffers'.
+
+ * org-odt.el (org-export-odt-default-org-styles-alist): Add
+ default character style.
+
+ * org-odt.el (org-export-odt-default-org-styles-alist): Add
+ default character style.
+
+ * org-lparse.el (org-do-lparse): Remove stray call to
+ `org-export-html-after-blockquotes-hook'.
+
+ * org-bbdb.el (org-bbdb-export): Add support for ODT format.
+
+ * org-odt.el (org-odt-update-meta-file): Check for `org-version'
+ is bound before accessing it.
+
+ * org-odt.el (org-odt-schema-dir-list): OD Schema files have been
+ moved away from $(git-root)/contrib/odt/etc/schema/ to
+ $(git-root)/etc/schema/.
+
+ * org-odt.el (org-odt-format-org-link): Pay no heed to whether the
+ internal links destined for headlines provide a description or
+ not. In fact, the `org-store-link' and `org-insert-link' create
+ internal links which do have a description.
+
+ * org-lparse.el (org-lparse-insert-org-table): Consider short
+ caption as plain text and not as org text.
+
+ * org-odt.el (org-export-odt-format-formula)
+ (org-export-odt-format-image): Ditto.
+
+ * org-odt.el (org-odt-begin-table)
+ (org-export-odt-format-formula, org-export-odt-format-image)
+ (org-odt-format-entity): Handle short caption.
+
+ * org-lparse.el (org-lparse-insert-org-table)
+ (org-lparse-insert-list-table, org-lparse-insert-table-table):
+ Ditto.
+
+2012-09-30 Jay McCarthy <jay.mccarthy@gmail.com> (tiny change)
+
+ * org-colview.el (org-columns-new-overlay): Make sure to add a
+ face to a string that has no face.
+
+2012-09-30 Jérémie Courrèges-Anglas <jca@wxcvbn.org> (tiny change)
+
+ * org-latex.el: Ensure a final newline is appended to the export
+ buffer.
+
+2012-09-30 Levin Du <zslevin@gmail.com> (tiny change)
+
+ * org-clock.el (org-clock-in): Fix bug in setting the clock
+ heading.
+
+2012-09-30 Madan Ramakrishnan <madanr79@gmail.com> (tiny change)
+
+ * org-agenda.el (org-agenda-bulk-mark): Truly make arg optional as
+ advertised by the function.
+
+2012-09-30 Mark E. Shoulson <mark@kli.org> (tiny change)
+
+ * org.el (org-fontify-entities): Hide {} when prettifying
+ entities.
+
+2012-09-30 Mark Shoulson <mark@kli.org> (tiny change)
+
+ * org-entities.el (org-entities): Add new entities for characters
+ which could cause formatting changes if typed directly.
+
+ * org-entities.el (org-entities): Added \asciicirc entity for ^;
+ also fixed \circ expansion in latex.
+
+ * org.el (org-fontify-entities): Fix bug: The entities \sup[123]
+ and \there4 were not "prettified" when org-pretty-entities was
+ enabled.
+
+2012-09-30 Mats Lidell <matsl@xemacs.org> (tiny change)
+
+ * org-element.el (org-element-paragraph-separate): Remove
+ redundant and misplaced t clause in case.
+
+2012-09-30 Matt Lundin <mdl@imapmail.org>
+
+ * org-datetree.el: Fix regexp to allow datetree to find headings
+ with trailing whitespace. This fixes a bug in which an existing
+ datetree heading (e.g., "* 2012 ") would not be found by
+ org-datetree-find-year-create if it had trailing whitespace. This
+ can cause problems, for instance, if one is using column view on
+ the date tree, since editing subheadings with column view adds
+ whitespace at the end of the top heading.
+
+ * org-footnote.el (org-footnote-new): Don't call
+ org-footnote-unique-label if org-footnote-auto-label is set to
+ random.
+
+ * org-gnus.el: (org-gnus-follow-link): Fix argument to
+ gnus-group-read-group so that following a link does not result in
+ unread article being selected.
+
+ * org-bbdb.el (org-bbdb-anniv-extract-date)
+ (org-bbdb-make-anniv-hash): Fix org-bbdb anniversary functionality
+ to accommodate BBDB 3.x. There are two major changes in BBDB 3.x
+ that need to be taken into account. The first is that
+ `bbdb-split' reverses the order of its parameters in 3.x. The
+ second is that `bbdb-record-getprop' is replaced by
+ bbdb-record-note in 3.x.
+
+2012-09-30 Max Mikhanosha <max@openchat.com>
+
+ * org-agenda.el (org-agenda-change-all-lines): Speedup refresh of
+ a single line of agenda by narrowing the agenda buffer to just
+ that line before calling `org-agenda-finalize'.
+
+ * org.el (org-mode): Don't set org-hide's foreground to
+ "invisible-bg".
+ (org-find-invisible-foreground): New function.
+
+ * org-agenda.el (defvar org-habit-show-all-today): New variable
+ (org-agenda-get-scheduled): Show all habits if user wants it
+
+ * org-habit.el (defcustom org-habit-show-all-today): New variable
+
+ * org-agenda.el (org-agenda-quit): Copy the code for optionally
+ restoring window configuration after burying the sticky agenda
+ buffer.
+
+ * org-agenda.el (org-agenda-new-marker): Check for NIL
+ org-agenda-buffer
+ (org-agenda-to-appt): Bind org-agenda-buffer to NIL
+
+ * org-agenda.el (org-agenda-change-all-lines): Move accessing of
+ 'extra text property outside of with-current-buffer for original
+ buffer
+
+ * org-agenda.el (defvar org-habit-show-habits-only-for-today):
+ initialize to nil
+
+2012-09-30 Michael Brand <michael.ch.brand@gmail.com>
+
+ * org-id.el (org-id-link-to-org-use-id): Align the doc string to
+ the changed default.
+
+ * ob-tangle.el (org-babel-tangle-collect-blocks): Use dummy string
+ when heading has no text.
+
+ * org-capture.el (org-capture-inside-embedded-elisp-p): Improve
+ parsing.
+
+ * org-feed.el (org-feed-format-entry): Require `org-capture'.
+ Expand Elisp %(...) templates.
+ (org-feed-default-template): Update docstring.
+
+ * org-capture.el (org-capture-expand-embedded-elisp): New
+ function.
+ (org-capture-fill-template): Use it.
+ (org-capture-inside-embedded-elisp-p): New function to tell if we
+ are within an Elisp %(...) template.
+
+ * org-list.el (org-at-item-description-p)
+ (org-list-item-body-column): Make the inline regexp more
+ consistent with `org-list-full-item-re', the inline regexp
+ "Description list items" from `org-set-font-lock-defaults and
+ others'.
+
+2012-09-30 Mike Sperber <sperber@deinprogramm.de>
+
+ * org.el (org-fill-paragraph): Pass optional argument to
+ `fill-paragraph' to fix compatibility with XEmacs.
+
+ * org.el (org-self-insert-cluster-for-undo): Default
+ `org-self-insert-cluster-for-undo' also on XEmacs.
+
+ * org.el (org-kill-line): Access `visual-line-mode' only if it's
+ bound.
+
+2012-09-30 Muchenxuan Tong <demon386@gmail.com> (tiny change)
+
+ * org-timer.el (org-timer-set-mode-line): Check
+ `org-timer-display' when value is 'off.
+
+2012-09-30 Nicolas Calderon Asselin <nicolas.calderon.asselin@gmail.com> (tiny change)
+
+ * org-clock.el (org-clock-idle-time): Org-mode assumed that
+ x11idle was an available command, and returned an idle time of 0
+ if it was not
+ (never idle). Added checks so that org-idle-time will come from
+ emacs' own current-idle-time if x11idle cannot be found or if it
+ cannot retrieve the idle time from X11
+
+2012-09-30 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-element.el: Properly remove COMMENT and QUOTE keywords from
+ title in parser.
+
+ * org-element.el (org-element-headline-parser): Fix parsing for
+ headlines with a single COMMENT or QUOTE keyword.
+
+ * ob-org.el (org-babel-default-header-args:org): By default,
+ export code from Org src blocks.
+
+ * org-element.el (org-element-inline-src-block-successor): Fix
+ inline-src-block parsing at the beginning of an item.
+
+ * org-element.el (org-element--collect-affiliated-keywords): Fix
+ caption parsing.
+
+ * org-element.el (org-element--current-element): At the very
+ beginning of a footnote definition or an item, next element is
+ always a paragraph.
+
+ * org-element.el (org-element-headline-parser): Handle nil titles.
+ (org-element-inlinetask-parser): Add :raw-value property. Also
+ handle nil titles.
+
+ * org.el (org-set-regexps-and-options): Don't consider tags as a
+ replacement for a missing title in an headline.
+
+ * org.el (org-setup-filling): Remove duplicate code.
+
+ * org.el (org-adaptive-fill-function): Make sure fill prefix is
+ computed from beginning of line.
+
+ * org-element.el (org-element-section-parser): Make sure section
+ cannot contain an headline.
+ (org-element--current-element): Fix bug requiring to parse a quote
+ section even when point is at an headline.
+
+ * org.el (org-adaptive-fill-function): Remove occasional spurious
+ space character when auto-filling.
+
+ * org.el (org-mode): Call external initalizers. Now both filling
+ code and comments code have their own independant part in org.el.
+ (org-setup-filling): Renamed from `org-set-autofill-regexps'.
+ (org-setup-comments-handling): New function.
+
+ * org.el (org-fill-paragraph): Refine filling in comments and in
+ paragraphs. Allow commented blank lines. Take into consideration
+ the indentation of the second line of the paragraph being filled.
+ (org-comment-or-uncomment-region): Rewrite function. Now comment
+ region at a fixed column: the minimal indentation of the region.
+ (org-fill-context-prefix): Rename function into
+ `org-adaptive-fill-function'. Also, In a paragraph, choose the
+ same prefix as the current line.
+
+ * org-exp.el (org-export-handle-comments): Also remove comments at
+ column 0.
+
+ * org-exp.el (org-export-handle-comments): Handle inline comments
+ with new syntax.
+
+ * org.el (org-structure-template-alist): Add missing colon to
+ #+INCLUDE.
+
+ * org.el (org-backward-element): When called at the beginning of
+ first element in section, the function shouldn't return an error
+ but move point to headline or point-min instead.
+
+ * org-element.el (org-element-paragraph-parser): Tiny refactoring.
+
+ * org-element.el (org-element-paragraph-parser): Remove trailing
+ code comments.
+
+ * org.el (org-fill-context-prefix): Fix incorrect output when
+ called at the beginning of a plain list with an affiliated
+ keyword.
+ (org-fill-paragraph): Remove useless variable.
+
+ * org-element.el (org-element-paragraph-parser): Fix parsing of
+ paragraph at the beginning of an item.
+
+ * org.el (org-mode): Set back comment-start-skip so comment-dwim
+ can tell a keyword from a comment.
+
+ * org.el (org-set-autofill-regexps): Install new comment line
+ break function.
+ (org-comment-line-break-function): New function.
+ (org-mode): Remove unnecessary line.
+
+ * org.el (org-fill-context-prefix, org-fill-paragraph): Do not
+ fill verse blocks contents. Verse blocks can be used to format
+ free-form poetry, so filling has to be done manually.
+
+ * org.el (org-fill-paragraph-separate-nobreak-p): New function.
+ (org-set-autofill-regexps): Introduce new predicate.
+ (org-fill-item-nobreak-p): Remove function.
+
+ * org-element.el (org-element-paragraph-separate): Since this
+ variable is meant to be searched forward, \end{...} shouldn't
+ trigger the end of a paragraph before checking if it is the end of
+ a complete environment.
+ (org-element-latex-environment-parser): Slight change to the
+ regexp matching the beginning of a latex environment.
+ (org-element-paragraph-parser): Paragraphs don't end at incomplete
+ latex environments.
+ (org-element-latex-or-entity-successor): Remove paragraph
+ environments from latex fragment search.
+
+ * org-table.el (org-table-number-regexp): By default, accept comma
+ as a decimal mark to represent numbers.
+
+ * org-element.el (org-element-map): Fix comment typo.
+
+ * org.el (org-fill-paragraph): Add a `save-excursion' to avoid
+ returning funny results.
+
+ * org.el (org-fill-paragraph): Try not to include message header
+ and citation lines in a paragraph when filling it.
+
+ * org.el (org-fill-paragraph): Fix filling in a narrowed buffer.
+ (org-fill-context-prefix): Fill prefix doesn't depend on current
+ narrowing.
+
+ * org.el (org-mode): Line with a single hash sign on it is a
+ comment.
+
+ * org.el (org-set-font-lock-defaults): Fix comment fontification.
+
+ * org-element.el (org-element-item-parser): Do not remove tag from
+ body if list isn't descriptive.
+
+ * org-list.el (org-insert-item): Only ask about a term for
+ descriptive lists.
+ (org-list-struct, org-list-insert-item): Do not recognize a tag in
+ an ordered list.
+
+ * org-element.el (org-element-set-element): Rewrite function.
+ (org-element-adopt-elements): New function.
+ (org-element-adopt-element): Removed function.
+ (org-element--parse-elements, org-element--parse-objects): Use new
+ function.
+
+ * org-list.el (org-list-automatic-rules): Remove `bullet' rule,
+ which is now hard-coded.
+ (org-cycle-list-bullet): Hard code `bullet' rule.
+ (org-list-get-list-type): Make sure a list with numbered bullets
+ cannot have `descriptive' type.
+
+ * org-element.el (org-element-paragraph-parser): Fix previous
+ patch.
+
+ * org.el (org-fill-paragraph): No need to use
+ `org-element-paragraph-separate' in a verse block since blank
+ lines only can end a "paragraph".
+
+ * org-element.el (org-element-paragraph-separate): Apply changes
+ to comments.
+ (org-element-paragraph-parser): Correctly find end of paragraphs.
+ (org-element--current-element): Require colons for Babel calls.
+ (org-element-center-block-parser)
+ (org-element-dynamic-block-parser, org-element-quote-block-parser)
+ (org-element-special-block-parser)
+ (org-element-comment-block-parser)
+ (org-element-example-block-parser)
+ (org-element-export-block-parser, org-element-src-block-parser)
+ (org-element-verse-block-parser): Fall-back to paragraph parsing
+ when incomplete or ill-formed.
+
+ * org-element.el (org-element-swap-A-B): Small refactoring.
+
+ * org-element.el (org-element-text-markup-successor): Fix typo in
+ docstring.
+
+ * org-element.el (org-element-at-point): Return consistent value
+ when function is called on a blank line within a plain list.
+
+ * org-element.el (org-element-paragraph-separate): Fix comments in
+ paragraph separator regexp. Optimize it.
+
+ * org-element.el: Update code commets.
+
+ * org.el (org-mark-subtree): Fix bug when marking subtree with
+ point on an inlinetask. Refactor code.
+
+ * org.el (org-mark-subtree): Do not make a special case for
+ inlinetasks when marking a subtree. These are handled by
+ `org-element-mark-element'.
+
+ * org-element.el (org-element-comment-parser): Consider first "+"
+ as a comment when parsing an ill-defined keyword.
+
+ * org-element.el (org-element-item-interpreter): Simplify bullet
+ creation.
+ (org-element-plain-list-interpreter): Fix wrong bullets, if
+ needed.
+
+ * org-element.el (org-element-comment-parser): Fix parsing when a
+ keyword follows the commented line.
+
+ * org.el (org-fill-context-prefix): Auto-fill first paragraph in
+ footnote definitions.
+
+ * org.el (org-mode): Define new comment syntax.
+ (org-fontify-meta-lines-and-blocks-1, org-strip-protective-commas)
+ (org-fill-context-prefix, org-insert-comment)
+ (org-comment-or-uncomment-region): Use new comment syntax.
+
+ * org-element.el (org-element-comment-parser)
+ (org-element-comment-interpreter, org-element--current-element):
+ Use new comment syntax.
+
+ * org.el (org-fill-paragraph): When at an item or a footnote
+ definition, fill first paragraph instead.
+
+ * org.el (org-fill-paragraph): Fix filling when point is at the
+ very end of a paragraph.
+
+ * org.el (org-mode): Set comments related variables.
+ (org-insert-comment, org-comment-or-uncomment-region): New
+ functions.
+
+ * org.el (org-fill-context-prefix): Small refactoring.
+ (org-fill-paragraph): Add code comments.
+
+ * org-element.el (org-element-at-point): Add :parent property to
+ output.
+ (org-element-context): Add :parent property to output. Also
+ return a single element or object instead of a list of parents.
+ (org-element-forward, org-element-up): Apply changes.
+
+ * org.el (org-fill-context-prefix): New function.
+ (org-fill-paragraph, org-auto-fill-function): Use new function.
+ Also handle comments.
+ (org-adaptive-fill-function): Remove function.
+ (org-get-local-variables, orgstruct++-mode): Don't store now
+ unused adaptive-fill* functions.
+
+ * org-element.el (org-element-at-point): Fix function when buffer
+ starts with an inlinetask. Also fix it when called on the last
+ element in a greater element or the buffer.
+
+ * org-element.el (org-element-center-block-parser)
+ (org-element-dynamic-block-parser)
+ (org-element-footnote-definition-parser)
+ (org-element-headline-parser, org-element-inlinetask-parser)
+ (org-element-quote-block-parser, org-element-special-block-parser)
+ (org-element-plain-list-parser): Refactor code.
+ (org-element-drawer-parser): Fall-back to paragraph parser when
+ drawer is incomplete.
+
+ * org-macs.el (org-with-limited-levels): Fix typo.
+
+ * org-element.el (org-element-paragraph-separate): Refactor.
+ (org-element-paragraph-parser): Fix paragraph parsing.
+
+ * org.el (org-fill-paragraph): Rewrite function using
+ `org-element-at-point'.
+
+ * org-element.el (org-element-fill-paragraph): Remove function.
+
+ * org.el (org-planning-or-clock-line-re): Make it a defconst.
+ It's no use to make it a buffer-local variable since variables on
+ which it depends are not buffer-local anyway.
+
+ * org.el (org-drawer-regexp): Provide default value for
+ `org-drawer-regexp' in non-Org buffers.
+
+ * org-entities.el (org-entities-create-table): Function chokes
+ when CAR of `org-entities' is a string.
+
+ * org-list.el (org-list-automatic-rules): Allow check-boxes in
+ description lists.
+ (org-list-struct-apply-struct, org-insert-item): Remove rule
+ check.
+
+ * org-footnote.el (org-footnote-normalize): Fix positionning in
+ HTML export without a footnote section.
+
+ * org-list.el (org-list-struct-indent): Follow
+ `org-list-demote-modify-bullet' specifications for ordered
+ bullets.
+ (org-list-indent-item-generic, org-indent-item-tree)
+ (org-outdent-item-tree): Fix bug when operating on a region.
+ (org-outdent-item, org-indent-item): Allow to operate on a region.
+
+ * org.el (org-shiftmetaleft, org-shiftmetaright): Allow to operate
+ on a region.
+
+ * org-footnote.el (org-footnote-delete-definitions): Remove blank
+ lines before the footnote definition instead of removing those
+ after it.
+
+ * org-footnote.el (org-footnote-at-definition-p): Don't grab
+ trailing blank lines in a footnote definition.
+ (org-footnote-delete-definitions): Remove both footnote definition
+ and trailing blank lines.
+
+2012-09-30 Rick Frankel <rick@rickster.com>
+
+ * ob-sql.el: Add dbi engine type and pre/post processing.
+
+2012-09-30 Sean O'Halpin <sean.ohalpin@gmail.com> (tiny change)
+
+ * ob.el (org-babel-expand-noweb-references): Capture current noweb
+ start and end patterns then use to set buffer locals in
+ (with-temp-buffer) form.
+
+2012-09-30 Sebastien Vauban <sva@mygooglest.com> (tiny change)
+
+ * org.el (org-update-all-dblocks): Autoload function.
+
+2012-09-30 Simon Thum <simon.thum@gmx.de> (tiny change)
+
+ * ob-maxima.el (org-babel-execute:maxima): Let cmdline always
+ return a string.
+
+2012-09-30 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk> (tiny change)
+
+ * org-icalendar.el (org-icalendar-timezone): Fix typo and clarify
+ meaning.
+
+2012-09-30 Stuart Hickinbottom <stuart@hickinbottom.com> (tiny change)
+
+ * org-clock.el (org-x11idle-exists-p): Only shell out when running
+ on X.
+
+2012-09-30 Suhail Shergill <suhailshergill@gmail.com> (tiny change)
+
+ * org-html.el (org-export-as-html): If possible, use the
+ :CUSTOM_ID: property to assign unique ids to footnotes.
+
+2012-09-30 T.F. Torrey <tftorrey@tftorrey.com> (tiny change)
+
+ * org-exp.el (org-export-remember-html-container-classes): Allow
+ exporting a single subtree with HTML_CONTAINER_CLASS property.
+
+ * org-rmail.el (org-rmail-follow-link): Use `rmail-widen' instead
+ of `widen' and don't toggle header as `rmail-widen' already takes
+ care of this.
+
+2012-09-30 Tim Howe <vsync@quadium.net> (tiny change)
+
+ * org-clock.el (org-clocktable-defaults): Revert extra layer of
+ quoting.
+
+2012-09-30 Toby S. Cubitt <tsc25@cantab.net>
+
+ * org-capture.el (org-capture-fill-template): Expand %<num> escape
+ sequences into text entered for <num>'th %^{PROMPT} escape.
+
+ * org-capture.el (org-capture-fill-template): Fixed regexp for
+ %<n> expandos to match any positive integer.
+ (org-capture-templates): Updated docstring accordingly.
+
+ * org-agenda.el (org-agenda-skip-timestamp-if-deadline-is-shown):
+ Skip timestamp items in agenda view if item is already shown as a
+ deadline item.
+ (org-agenda-skip-dealine-if-done): Pass deadline results to
+ org-agenda-get-timestamps.
+ (org-agenda-get-timestamps): Optionally take list of deadline
+ results, so that timestamp results can be skipped if already
+ included in deadline results.
+
+ * org-agenda.el (org-agenda-diary-sexp-prefix): Regexp matching
+ deadline/scheduling information to be displayed in diary sexp
+ agenda items.
+ (org-agenda-get-sexps): Extract deadline/scheduling information
+ from diary sexp entries.
+
+ * org-capture.el (org-capture-place-entry): Place captured entry
+ immediately after last subheading of target, instead of just
+ before next heading at same level as target.
+
+ * org-capture.el (org-capture-templates): Document new capture
+ template properties.
+
+ * org-capture.el (org-capture-place-entry)
+ (org-capture-empty-lines-before): Make new :empty-lines-before
+ property override :empty-lines when inserting empty lines before
+ captured captured entry.
+
+ * org-capture.el (org-capture-finalize)
+ (org-capture-empty-lines-after): Make new :empty-lines-after
+ property override :empty-lines when inserting empty lines after
+ captured captured entry.
+
+ * org-agenda.el (org-agenda-skip-if, org-agenda-skip-if-todo): Add
+ new todo-unblocked and nottodo-unblocked skip conditions. These
+ match as for todo and nottodo, but only for unblocked todo items.
+
+2012-09-30 Zachary Kanfer <zkanfer@gmail.com> (tiny change)
+
+ * org.el (org-read-date-display): Fix bug when displaying the
+ overlay.
+
+2012-09-30 Niels Giesen <niels.giesen@gmail.com>
+
+ * org-table.el (orgtbl-to-generic): Add check for :skipheadrule.
+ When present, the :hline following the head will be skipped. This
+ is necessary to avoid doubling of horizontal rules in LaTeX
+ longtable environments and consequent width problems.
+
+ * org-latex.el (org-export-latex-tables-tstart)
+ (org-export-latex-tables-hline)
+ (org-export-latex-tables-tend): New options.
+ (org-export-latex-tables): Use the new options.
+
+2012-09-30 tumashu <tumashu@gmail.com> (tiny change)
+
+ * org-exp.el (org-export-language-setup): Add simplified chinese
+ translation.
+
2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
Better seed support for (random).
diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el
index 583510ac618..ba50722e325 100644
--- a/lisp/org/ob-C.el
+++ b/lisp/org/ob-C.el
@@ -61,7 +61,7 @@ is currently being evaluated.")
(org-babel-execute:C++ body params))
(defun org-babel-execute:C++ (body params)
- "Execute a block of C++ code with org-babel. This function is
+ "Execute a block of C++ code with org-babel. This function is
called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
@@ -88,9 +88,7 @@ or `org-babel-execute:C++'."
(cond
((equal org-babel-c-variant 'c) ".c")
((equal org-babel-c-variant 'cpp) ".cpp"))))
- (tmp-bin-file (org-babel-temp-file
- "C-bin-"
- (if (equal system-type 'windows-nt) ".exe" "")))
+ (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext))
(cmdline (cdr (assoc :cmdline params)))
(flags (cdr (assoc :flags params)))
(full-body (org-babel-C-expand body params))
@@ -118,8 +116,8 @@ or `org-babel-execute:C++'."
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
(org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(defun org-babel-C-expand (body params)
"Expand a block of C or C++ code with org-babel according to
@@ -131,22 +129,22 @@ it's header arguments."
(defines (org-babel-read
(or (cdr (assoc :defines params))
(org-babel-read (org-entry-get nil "defines" t))))))
- (mapconcat 'identity
- (list
- ;; includes
- (mapconcat
- (lambda (inc) (format "#include %s" inc))
- (if (listp includes) includes (list includes)) "\n")
- ;; defines
- (mapconcat
- (lambda (inc) (format "#define %s" inc))
- (if (listp defines) defines (list defines)) "\n")
- ;; variables
- (mapconcat 'org-babel-C-var-to-C vars "\n")
- ;; body
- (if main-p
- (org-babel-C-ensure-main-wrap body)
- body) "\n") "\n")))
+ (mapconcat 'identity
+ (list
+ ;; includes
+ (mapconcat
+ (lambda (inc) (format "#include %s" inc))
+ (if (listp includes) includes (list includes)) "\n")
+ ;; defines
+ (mapconcat
+ (lambda (inc) (format "#define %s" inc))
+ (if (listp defines) defines (list defines)) "\n")
+ ;; variables
+ (mapconcat 'org-babel-C-var-to-C vars "\n")
+ ;; body
+ (if main-p
+ (org-babel-C-ensure-main-wrap body)
+ body) "\n") "\n")))
(defun org-babel-C-ensure-main-wrap (body)
"Wrap body in a \"main\" function call if none exists."
diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el
index 49a8a85cf6d..3dedb393654 100644
--- a/lisp/org/ob-R.el
+++ b/lisp/org/ob-R.el
@@ -39,24 +39,48 @@
(declare-function ess-make-buffer-current "ext:ess-inf" ())
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
(declare-function org-number-sequence "org-compat" (from &optional to inc))
-
-(defconst org-babel-header-arg-names:R
- '(width height bg units pointsize antialias quality compression
- res type family title fonts version paper encoding
- pagecentre colormodel useDingbats horizontal)
+(declare-function org-remove-if-not "org" (predicate seq))
+
+(defconst org-babel-header-args:R
+ '((width . :any)
+ (height . :any)
+ (bg . :any)
+ (units . :any)
+ (pointsize . :any)
+ (antialias . :any)
+ (quality . :any)
+ (compression . :any)
+ (res . :any)
+ (type . :any)
+ (family . :any)
+ (title . :any)
+ (fonts . :any)
+ (version . :any)
+ (paper . :any)
+ (encoding . :any)
+ (pagecentre . :any)
+ (colormodel . :any)
+ (useDingbats . :any)
+ (horizontal . :any)
+ (results . ((file list vector table scalar verbatim)
+ (raw org html latex code pp wrap)
+ (replace silent append prepend)
+ (output value graphics))))
"R-specific header arguments.")
(defvar org-babel-default-header-args:R '())
-(defvar org-babel-R-command "R --slave --no-save"
- "Name of command to use for executing R code.")
+(defcustom org-babel-R-command "R --slave --no-save"
+ "Name of command to use for executing R code."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
-(defvar ess-local-process-name)
+(defvar ess-local-process-name) ; dynamically scoped
(defun org-babel-edit-prep:R (info)
(let ((session (cdr (assoc :session (nth 2 info)))))
(when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
- (save-match-data (org-babel-R-initiate-session session nil))
- (setq ess-local-process-name (match-string 1 session)))))
+ (save-match-data (org-babel-R-initiate-session session nil)))))
(defun org-babel-expand-body:R (body params &optional graphics-file)
"Expand BODY according to PARAMS, return the expanded body."
@@ -120,7 +144,7 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:R (params)
- "Return list of R statements assigning the block's variables"
+ "Return list of R statements assigning the block's variables."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapcar
(lambda (pair)
@@ -146,25 +170,45 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-R-assign-elisp (name value colnames-p rownames-p)
"Construct R code assigning the elisp VALUE to a variable named NAME."
(if (listp value)
- (let ((transition-file (org-babel-temp-file "R-import-")))
+ (let ((max (apply #'max (mapcar #'length (org-remove-if-not
+ #'sequencep value))))
+ (min (apply #'min (mapcar #'length (org-remove-if-not
+ #'sequencep value))))
+ (transition-file (org-babel-temp-file "R-import-")))
;; ensure VALUE has an orgtbl structure (depth of at least 2)
(unless (listp (car value)) (setq value (list value)))
(with-temp-file transition-file
- (insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)))
- (insert "\n"))
- (format "%s <- read.table(\"%s\", header=%s, row.names=%s, sep=\"\\t\", as.is=TRUE)"
- name (org-babel-process-file-name transition-file 'noquote)
- (if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE")
- (if rownames-p "1" "NULL")))
+ (insert
+ (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))
+ "\n"))
+ (let ((file (org-babel-process-file-name transition-file 'noquote))
+ (header (if (or (eq (nth 1 value) 'hline) colnames-p)
+ "TRUE" "FALSE"))
+ (row-names (if rownames-p "1" "NULL")))
+ (if (= max min)
+ (format "%s <- read.table(\"%s\",
+ header=%s,
+ row.names=%s,
+ sep=\"\\t\",
+ as.is=TRUE)" name file header row-names)
+ (format "%s <- read.table(\"%s\",
+ header=%s,
+ row.names=%s,
+ sep=\"\\t\",
+ as.is=TRUE,
+ fill=TRUE,
+ col.names = paste(\"V\", seq_len(%d), sep =\"\"))"
+ name file header row-names max))))
(format "%s <- %s" name (org-babel-R-quote-tsv-field value))))
-(defvar ess-ask-for-ess-directory nil)
+(defvar ess-ask-for-ess-directory) ; dynamically scoped
(defun org-babel-R-initiate-session (session params)
"If there is not a current R process then create one."
(unless (string= session "none")
(let ((session (or session "*R*"))
(ess-ask-for-ess-directory
- (and ess-ask-for-ess-directory (not (cdr (assoc :dir params))))))
+ (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory)
+ (not (cdr (assoc :dir params))))))
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
@@ -177,7 +221,6 @@ This function is called by `org-babel-execute-src-block'."
(buffer-name))))
(current-buffer))))))
-(defvar ess-local-process-name nil)
(defun org-babel-R-associate-session (session)
"Associate R code buffer with an R session.
Make SESSION be the inferior ESS process associated with the
@@ -219,7 +262,7 @@ current code buffer."
(setq args (mapconcat
(lambda (pair)
(if (member (car pair) allowed-args)
- (format ",%s=%s"
+ (format ",%s=%S"
(substring (symbol-name (car pair)) 1)
(cdr pair)) ""))
params ""))
@@ -245,7 +288,7 @@ current code buffer."
(body result-type result-params column-names-p row-names-p)
"Evaluate BODY in external R process.
If RESULT-TYPE equals 'output then return standard output as a
-string. If RESULT-TYPE equals 'value then return the value of the
+string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(value
@@ -272,7 +315,7 @@ last statement in BODY, as elisp."
(session body result-type result-params column-names-p row-names-p)
"Evaluate BODY in SESSION.
If RESULT-TYPE equals 'output then return standard output as a
-string. If RESULT-TYPE equals 'value then return the value of the
+string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
(case result-type
(value
diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el
index d95829c7f79..a3c5e3db954 100644
--- a/lisp/org/ob-asymptote.el
+++ b/lisp/org/ob-asymptote.el
@@ -88,7 +88,7 @@ Asymptote does not support sessions"
(error "Asymptote does not support sessions"))
(defun org-babel-variable-assignments:asymptote (params)
- "Return list of asymptote statements assigning the block's variables"
+ "Return list of asymptote statements assigning the block's variables."
(mapcar #'org-babel-asymptote-var-to-asymptote
(mapcar #'cdr (org-babel-get-header params :var))))
@@ -128,7 +128,7 @@ a variable of the same value."
DATA is a list. Return type as a symbol.
The type is `string' if any element in DATA is
-a string. Otherwise, it is either `real', if some elements are
+a string. Otherwise, it is either `real', if some elements are
floats, or `int'."
(let* ((type 'int)
find-type ; for byte-compiler
diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el
index 682d802c11c..6e139966eee 100644
--- a/lisp/org/ob-awk.el
+++ b/lisp/org/ob-awk.el
@@ -33,6 +33,7 @@
;;; Code:
(require 'ob)
(require 'ob-eval)
+(require 'org-compat)
(eval-when-compile (require 'cl))
(declare-function org-babel-ref-resolve "ob-ref" (ref))
@@ -96,13 +97,13 @@ called by `org-babel-execute-src-block'"
(defun org-babel-awk-var-to-awk (var &optional sep)
"Return a printed value of VAR suitable for parsing with awk."
- (flet ((echo-var (v) (if (stringp v) v (format "%S" v))))
+ (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
(cond
((and (listp var) (listp (car var)))
- (orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var)))
+ (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
((listp var)
- (mapconcat #'echo-var var "\n"))
- (t (echo-var var)))))
+ (mapconcat echo-var var "\n"))
+ (t (funcall echo-var var)))))
(defun org-babel-awk-table-or-string (results)
"If the results look like a table, then convert them into an
diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el
index f8ad7e3374e..c79d0b5d1b4 100644
--- a/lisp/org/ob-calc.el
+++ b/lisp/org/ob-calc.el
@@ -71,16 +71,16 @@
(cond
((numberp res) res)
((math-read-number res) (math-read-number res))
- ((listp res) (error "calc error \"%s\" on input \"%s\""
+ ((listp res) (error "Calc error \"%s\" on input \"%s\""
(cadr res) line))
(t (replace-regexp-in-string
- "'\\[" "["
+ "'" ""
(calc-eval
(math-evaluate-expr
;; resolve user variables, calc built in
;; variables are handled automatically
;; upstream by calc
- (mapcar #'ob-calc-maybe-resolve-var
+ (mapcar #'org-babel-calc-maybe-resolve-var
;; parse line into calc objects
(car (math-read-exprs line)))))))))
(calc-eval line))))))))
@@ -91,14 +91,14 @@
(calc-eval (calc-top 1)))))
(defvar var-syms) ; Dynamically scoped from org-babel-execute:calc
-(defun ob-calc-maybe-resolve-var (el)
+(defun org-babel-calc-maybe-resolve-var (el)
(if (consp el)
(if (and (equal 'var (car el)) (member (cadr el) var-syms))
(progn
(calc-recall (cadr el))
(prog1 (calc-top 1)
(calc-pop 1)))
- (mapcar #'ob-calc-maybe-resolve-var el))
+ (mapcar #'org-babel-calc-maybe-resolve-var el))
el))
(provide 'ob-calc)
diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el
index 69d3db86de4..f3894047c72 100644
--- a/lisp/org/ob-clojure.el
+++ b/lisp/org/ob-clojure.el
@@ -45,7 +45,7 @@
(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
(defvar org-babel-default-header-args:clojure '())
-(defvar org-babel-header-arg-names:clojure '(package))
+(defvar org-babel-header-args:clojure '((package . :any)))
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el
index a0712b90f35..ba3b99d5d70 100644
--- a/lisp/org/ob-comint.el
+++ b/lisp/org/ob-comint.el
@@ -31,6 +31,7 @@
;;; Code:
(require 'ob)
+(require 'org-compat)
(require 'comint)
(eval-when-compile (require 'cl))
(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
@@ -50,7 +51,7 @@ executed inside the protection of `save-excursion' and
`(save-excursion
(save-match-data
(unless (org-babel-comint-buffer-livep ,buffer)
- (error "buffer %s doesn't exist or has no process" ,buffer))
+ (error "Buffer %s does not exist or has no process" ,buffer))
(set-buffer ,buffer)
,@body)))
(def-edebug-spec org-babel-comint-in-buffer (form body))
@@ -74,39 +75,40 @@ or user `keyboard-quit' during execution of body."
(full-body (cadr (cdr (cdr meta)))))
`(org-babel-comint-in-buffer ,buffer
(let ((string-buffer "") dangling-text raw)
- (flet ((my-filt (text)
- (setq string-buffer (concat string-buffer text))))
- ;; setup filter
- (add-hook 'comint-output-filter-functions 'my-filt)
- (unwind-protect
- (progn
- ;; got located, and save dangling text
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (let ((start (point))
- (end (point-max)))
- (setq dangling-text (buffer-substring start end))
- (delete-region start end))
- ;; pass FULL-BODY to process
- ,@body
- ;; wait for end-of-evaluation indicator
- (while (progn
- (goto-char comint-last-input-end)
- (not (save-excursion
- (and (re-search-forward
- (regexp-quote ,eoe-indicator) nil t)
- (re-search-forward
- comint-prompt-regexp nil t)))))
- (accept-process-output (get-buffer-process (current-buffer)))
- ;; thought the following this would allow async
- ;; background running, but I was wrong...
- ;; (run-with-timer .5 .5 'accept-process-output
- ;; (get-buffer-process (current-buffer)))
- )
- ;; replace cut dangling text
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (insert dangling-text))
- ;; remove filter
- (remove-hook 'comint-output-filter-functions 'my-filt)))
+ ;; setup filter
+ (setq comint-output-filter-functions
+ (cons (lambda (text) (setq string-buffer (concat string-buffer text)))
+ comint-output-filter-functions))
+ (unwind-protect
+ (progn
+ ;; got located, and save dangling text
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (let ((start (point))
+ (end (point-max)))
+ (setq dangling-text (buffer-substring start end))
+ (delete-region start end))
+ ;; pass FULL-BODY to process
+ ,@body
+ ;; wait for end-of-evaluation indicator
+ (while (progn
+ (goto-char comint-last-input-end)
+ (not (save-excursion
+ (and (re-search-forward
+ (regexp-quote ,eoe-indicator) nil t)
+ (re-search-forward
+ comint-prompt-regexp nil t)))))
+ (accept-process-output (get-buffer-process (current-buffer)))
+ ;; thought the following this would allow async
+ ;; background running, but I was wrong...
+ ;; (run-with-timer .5 .5 'accept-process-output
+ ;; (get-buffer-process (current-buffer)))
+ )
+ ;; replace cut dangling text
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert dangling-text))
+ ;; remove filter
+ (setq comint-output-filter-functions
+ (cdr comint-output-filter-functions)))
;; remove echo'd FULL-BODY from input
(if (and ,remove-echo ,full-body
(string-match
@@ -142,10 +144,10 @@ statement (not large blocks of code)."
(defun org-babel-comint-eval-invisibly-and-wait-for-file
(buffer file string &optional period)
"Evaluate STRING in BUFFER invisibly.
-Don't return until FILE exists. Code in STRING must ensure that
+Don't return until FILE exists. Code in STRING must ensure that
FILE exists at end of evaluation."
(unless (org-babel-comint-buffer-livep buffer)
- (error "buffer %s doesn't exist or has no process" buffer))
+ (error "Buffer %s does not exist or has no process" buffer))
(if (file-exists-p file) (delete-file file))
(process-send-string
(get-buffer-process buffer)
@@ -154,7 +156,7 @@ FILE exists at end of evaluation."
(if (file-remote-p default-directory)
(let (v)
(with-parsed-tramp-file-name default-directory nil
- (tramp-flush-directory-property v ""))))
+ (tramp-flush-directory-property v ""))))
(while (not (file-exists-p file)) (sit-for (or period 0.25))))
(provide 'ob-comint)
diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el
index a9ac1cfa20f..6259ebc0c2f 100644
--- a/lisp/org/ob-css.el
+++ b/lisp/org/ob-css.el
@@ -34,7 +34,7 @@
(defun org-babel-execute:css (body params)
"Execute a block of CSS code.
This function is called by `org-babel-execute-src-block'."
- body)
+ body)
(defun org-babel-prep-session:css (session params)
"Return an error if the :session header argument is set.
diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el
index 57ae4b94758..ae7794b659c 100644
--- a/lisp/org/ob-ditaa.el
+++ b/lisp/org/ob-ditaa.el
@@ -34,15 +34,28 @@
;; 3) we are adding the "file" and "cmdline" header arguments
;;
;; 4) there are no variables (at least for now)
+;;
+;; 5) it depends on a variable defined in org-exp-blocks (namely
+;; `org-ditaa-jar-path') so be sure you have org-exp-blocks loaded
;;; Code:
(require 'ob)
+(defvar org-ditaa-jar-path) ;; provided by org-exp-blocks
+
(defvar org-babel-default-header-args:ditaa
- '((:results . "file") (:exports . "results") (:java . "-Dfile.encoding=UTF-8"))
+ '((:results . "file")
+ (:exports . "results")
+ (:java . "-Dfile.encoding=UTF-8"))
"Default arguments for evaluating a ditaa source block.")
-(defvar org-ditaa-jar-path)
+(defcustom org-ditaa-jar-option "-jar"
+ "Option for the ditaa jar file.
+Do not leave leading or trailing spaces in this string."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
(defun org-babel-execute:ditaa (body params)
"Execute a block of Ditaa code with org-babel.
This function is called by `org-babel-execute-src-block'."
@@ -55,7 +68,7 @@ This function is called by `org-babel-execute-src-block'."
(cmdline (cdr (assoc :cmdline params)))
(java (cdr (assoc :java params)))
(in-file (org-babel-temp-file "ditaa-"))
- (cmd (concat "java " java " -jar "
+ (cmd (concat "java " java " " org-ditaa-jar-option " "
(shell-quote-argument
(expand-file-name org-ditaa-jar-path))
" " cmdline
diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el
index 1d4b7da7e18..99748b0a95b 100644
--- a/lisp/org/ob-dot.el
+++ b/lisp/org/ob-dot.el
@@ -64,7 +64,8 @@
"Execute a block of Dot code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (cdr (assoc :result-params params)))
- (out-file (cdr (assoc :file params)))
+ (out-file (cdr (or (assoc :file params)
+ (error "You need to specify a :file parameter"))))
(cmdline (or (cdr (assoc :cmdline params))
(format "-T%s" (file-name-extension out-file))))
(cmd (or (cdr (assoc :cmd params)) "dot"))
diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el
index c8af6062002..d83ca246a84 100644
--- a/lisp/org/ob-emacs-lisp.el
+++ b/lisp/org/ob-emacs-lisp.el
@@ -41,12 +41,12 @@
(result-params (cdr (assoc :result-params params)))
(print-level nil) (print-length nil)
(body (if (> (length vars) 0)
- (concat "(let ("
- (mapconcat
- (lambda (var)
- (format "%S" (print `(,(car var) ',(cdr var)))))
- vars "\n ")
- ")\n" body "\n)")
+ (concat "(let ("
+ (mapconcat
+ (lambda (var)
+ (format "%S" (print `(,(car var) ',(cdr var)))))
+ vars "\n ")
+ ")\n" body "\n)")
(concat body "\n"))))
(if (or (member "code" result-params)
(member "pp" result-params))
diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el
index 0ac6ab004b7..ddad067a560 100644
--- a/lisp/org/ob-eval.el
+++ b/lisp/org/ob-eval.el
@@ -64,8 +64,8 @@ STDERR with `org-babel-eval-error-notify'."
(buffer-string)))
(defun org-babel-shell-command-on-region (start end command
- &optional output-buffer replace
- error-buffer display-error-buffer)
+ &optional output-buffer replace
+ error-buffer display-error-buffer)
"Execute COMMAND in an inferior shell with region as input.
Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'
diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el
index 0f0cca3d94b..d17fd3475ae 100644
--- a/lisp/org/ob-exp.el
+++ b/lisp/org/ob-exp.el
@@ -32,10 +32,18 @@
(defvar org-current-export-file)
(defvar org-babel-lob-one-liner-regexp)
(defvar org-babel-ref-split-regexp)
+(defvar org-list-forbidden-blocks)
+
(declare-function org-babel-lob-get-info "ob-lob" ())
(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
-(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements))
+(declare-function org-heading-components "org" ())
+(declare-function org-link-search "org" (s &optional type avoid-pos stealth))
+(declare-function org-fill-template "org" (template alist))
+(declare-function org-in-verbatim-emphasis "org" ())
+(declare-function org-in-block-p "org" (names))
+(declare-function org-between-regexps-p "org" (start-re end-re &optional lim-up lim-down))
+(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements))
(org-export-blocks-add-block '(src org-babel-exp-src-block nil))
(defcustom org-export-babel-evaluate t
@@ -47,28 +55,33 @@ process."
:type 'boolean)
(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
+(defun org-babel-exp-get-export-buffer ()
+ "Return the current export buffer if possible."
+ (cond
+ ((bufferp org-current-export-file) org-current-export-file)
+ (org-current-export-file (get-file-buffer org-current-export-file))
+ ('otherwise
+ (error "Requested export buffer when `org-current-export-file' is nil"))))
+
(defmacro org-babel-exp-in-export-file (lang &rest body)
(declare (indent 1))
`(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
(heading (nth 4 (ignore-errors (org-heading-components))))
- (link (when org-current-export-file
- (org-make-link-string
- (if heading
- (concat org-current-export-file "::" heading)
- org-current-export-file))))
- (export-buffer (current-buffer)) results)
- (when link
+ (export-buffer (current-buffer))
+ (original-buffer (org-babel-exp-get-export-buffer)) results)
+ (when original-buffer
;; resolve parameters in the original file so that
;; headline and file-wide parameters are included, attempt
;; to go to the same heading in the original file
- (set-buffer (get-file-buffer org-current-export-file))
+ (set-buffer original-buffer)
(save-restriction
- (condition-case nil
- (let ((org-link-search-inhibit-query t))
- (org-open-link-from-string link))
- (error (when heading
- (goto-char (point-min))
- (re-search-forward (regexp-quote heading) nil t))))
+ (when heading
+ (condition-case nil
+ (let ((org-link-search-inhibit-query t))
+ (org-link-search heading))
+ (error (when heading
+ (goto-char (point-min))
+ (re-search-forward (regexp-quote heading) nil t)))))
(setq results ,@body))
(set-buffer export-buffer)
results)))
@@ -108,15 +121,25 @@ none ----- do not display either code or results upon export"
(if (boundp lang-headers) (eval lang-headers) nil)
raw-params))))
(setf hash (org-babel-sha1-hash info)))
- ;; expand noweb references in the original file
- (setf (nth 1 info)
- (if (and (cdr (assoc :noweb (nth 2 info)))
- (string= "yes" (cdr (assoc :noweb (nth 2 info)))))
- (org-babel-expand-noweb-references
- info (get-file-buffer org-current-export-file))
- (nth 1 info)))
(org-babel-exp-do-export info 'block hash)))))
+(defcustom org-babel-exp-call-line-template
+ ""
+ "Template used to export call lines.
+This template may be customized to include the call line name
+with any export markup. The template is filled out using
+`org-fill-template', and the following %keys may be used.
+
+ line --- call line
+
+An example value would be \"\\n: call: %line\" to export the call line
+wrapped in a verbatim environment.
+
+Note: the results are inserted separately after the contents of
+this template."
+ :group 'org-babel
+ :type 'string)
+
(defvar org-babel-default-lob-header-args)
(defun org-babel-exp-non-block-elements (start end)
"Process inline source and call lines between START and END for export."
@@ -147,7 +170,7 @@ none ----- do not display either code or results upon export"
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references
- info (get-file-buffer org-current-export-file))
+ info (org-babel-exp-get-export-buffer))
(nth 1 info)))
(let ((code-replacement (save-match-data
(org-babel-exp-do-export
@@ -163,22 +186,24 @@ none ----- do not display either code or results upon export"
(inlinep (match-string 11))
(inline-start (match-end 11))
(inline-end (match-end 0))
- (rep (let ((lob-info (org-babel-lob-get-info)))
- (save-match-data
- (org-babel-exp-do-export
- (list "emacs-lisp" "results"
- (org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-lob-header-args
- (org-babel-params-from-properties)
- (org-babel-parse-header-arguments
- (org-babel-clean-text-properties
- (concat ":var results="
- (mapconcat #'identity
- (butlast lob-info)
- " ")))))
- "" nil (car (last lob-info)))
- 'lob)))))
+ (results (save-match-data
+ (org-babel-exp-do-export
+ (list "emacs-lisp" "results"
+ (org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-lob-header-args
+ (org-babel-params-from-properties)
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat ":var results="
+ (mapconcat #'identity
+ (butlast lob-info)
+ " ")))))
+ "" nil (car (last lob-info)))
+ 'lob)))
+ (rep (org-fill-template
+ org-babel-exp-call-line-template
+ `(("line" . ,(nth 0 lob-info))))))
(if inlinep
(save-excursion
(goto-char inline-start)
@@ -202,26 +227,58 @@ org-mode text."
(defun org-babel-exp-do-export (info type &optional hash)
"Return a string with the exported content of a code block.
The function respects the value of the :exports header argument."
- (flet ((silently () (let ((session (cdr (assoc :session (nth 2 info)))))
- (when (not (and session (equal "none" session)))
- (org-babel-exp-results info type 'silent))))
- (clean () (unless (eq type 'inline) (org-babel-remove-result info))))
+ (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info)))))
+ (when (not (and session (equal "none" session)))
+ (org-babel-exp-results info type 'silent)))))
+ (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info)))))
(case (intern (or (cdr (assoc :exports (nth 2 info))) "code"))
- ('none (silently) (clean) "")
- ('code (silently) (clean) (org-babel-exp-code info))
+ ('none (funcall silently) (funcall clean) "")
+ ('code (funcall silently) (funcall clean) (org-babel-exp-code info))
('results (org-babel-exp-results info type nil hash) "")
('both (org-babel-exp-results info type nil hash)
(org-babel-exp-code info)))))
+(defcustom org-babel-exp-code-template
+ "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC"
+ "Template used to export the body of code blocks.
+This template may be customized to include additional information
+such as the code block name, or the values of particular header
+arguments. The template is filled out using `org-fill-template',
+and the following %keys may be used.
+
+ lang ------ the language of the code block
+ name ------ the name of the code block
+ body ------ the body of the code block
+ flags ----- the flags passed to the code block
+
+In addition to the keys mentioned above, every header argument
+defined for the code block may be used as a key and will be
+replaced with its value."
+ :group 'org-babel
+ :type 'string)
+
(defun org-babel-exp-code (info)
"Return the original code block formatted for export."
+ (setf (nth 1 info)
+ (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info))))
+ (replace-regexp-in-string
+ (org-babel-noweb-wrap) "" (nth 1 info))
+ (if (org-babel-noweb-p (nth 2 info) :export)
+ (org-babel-expand-noweb-references
+ info (org-babel-exp-get-export-buffer))
+ (nth 1 info))))
(org-fill-template
- "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC"
+ org-babel-exp-code-template
`(("lang" . ,(nth 0 info))
- ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info)))
("body" . ,(if (string= (nth 0 info) "org")
(replace-regexp-in-string "^" "," (nth 1 info))
- (nth 1 info))))))
+ (nth 1 info)))
+ ,@(mapcar (lambda (pair)
+ (cons (substring (symbol-name (car pair)) 1)
+ (format "%S" (cdr pair))))
+ (nth 2 info))
+ ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info)))
+ ("name" . ,(or (nth 4 info) "")))))
(defun org-babel-exp-results (info type &optional silent hash)
"Evaluate and return the results of the current code block for export.
@@ -232,11 +289,16 @@ inhibit insertion of results into the buffer."
(when (and org-export-babel-evaluate
(not (and hash (equal hash (org-babel-current-result-hash)))))
(let ((lang (nth 0 info))
- (body (nth 1 info)))
+ (body (if (org-babel-noweb-p (nth 2 info) :eval)
+ (org-babel-expand-noweb-references
+ info (org-babel-exp-get-export-buffer))
+ (nth 1 info)))
+ (info (copy-sequence info)))
;; skip code blocks which we can't evaluate
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer)
(prog1 nil
+ (setf (nth 1 info) body)
(setf (nth 2 info)
(org-babel-exp-in-export-file lang
(org-babel-process-params
diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el
index 491dde3e070..7f2d1a8054b 100644
--- a/lisp/org/ob-fortran.el
+++ b/lisp/org/ob-fortran.el
@@ -7,20 +7,20 @@
;; Keywords: literate programming, reproducible research, fortran
;; Homepage: http://orgmode.org
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; This file is part of GNU Emacs.
;;
-;; This program is distributed in the hope that it will be useful,
+;; 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
@@ -46,7 +46,7 @@
(defun org-babel-execute:fortran (body params)
"This function should only be called by `org-babel-execute:fortran'"
(let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90"))
- (tmp-bin-file (org-babel-temp-file "fortran-bin-"))
+ (tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext))
(cmdline (cdr (assoc :cmdline params)))
(flags (cdr (assoc :flags params)))
(full-body (org-babel-expand-body:fortran body params))
@@ -72,8 +72,8 @@
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
(org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(defun org-babel-expand-body:fortran (body params)
"Expand a block of fortran or fortran code with org-babel according to
@@ -85,42 +85,42 @@ it's header arguments."
(defines (org-babel-read
(or (cdr (assoc :defines params))
(org-babel-read (org-entry-get nil "defines" t))))))
- (mapconcat 'identity
- (list
- ;; includes
- (mapconcat
- (lambda (inc) (format "#include %s" inc))
- (if (listp includes) includes (list includes)) "\n")
- ;; defines
- (mapconcat
- (lambda (inc) (format "#define %s" inc))
- (if (listp defines) defines (list defines)) "\n")
- ;; body
- (if main-p
- (org-babel-fortran-ensure-main-wrap
- (concat
- ;; variables
- (mapconcat 'org-babel-fortran-var-to-fortran vars "\n")
- body) params)
- body) "\n") "\n")))
+ (mapconcat 'identity
+ (list
+ ;; includes
+ (mapconcat
+ (lambda (inc) (format "#include %s" inc))
+ (if (listp includes) includes (list includes)) "\n")
+ ;; defines
+ (mapconcat
+ (lambda (inc) (format "#define %s" inc))
+ (if (listp defines) defines (list defines)) "\n")
+ ;; body
+ (if main-p
+ (org-babel-fortran-ensure-main-wrap
+ (concat
+ ;; variables
+ (mapconcat 'org-babel-fortran-var-to-fortran vars "\n")
+ body) params)
+ body) "\n") "\n")))
(defun org-babel-fortran-ensure-main-wrap (body params)
"Wrap body in a \"program ... end program\" block if none exists."
(if (string-match "^[ \t]*program[ \t]*.*" (capitalize body))
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
- (if vars (error "cannot use :vars if 'program' statement is present"))
- body)
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (if vars (error "Cannot use :vars if 'program' statement is present"))
+ body)
(format "program main\n%s\nend program main\n" body)))
(defun org-babel-prep-session:fortran (session params)
"This function does nothing as fortran is a compiled language with no
support for sessions"
- (error "fortran is a compiled languages -- no support for sessions"))
+ (error "Fortran is a compiled languages -- no support for sessions"))
(defun org-babel-load-session:fortran (session body params)
"This function does nothing as fortran is a compiled language with no
support for sessions"
- (error "fortran is a compiled languages -- no support for sessions"))
+ (error "Fortran is a compiled languages -- no support for sessions"))
;; helper functions
@@ -146,15 +146,15 @@ of the same value."
(length val) var val))
((listp val)
(format "real, parameter :: %S(%d) = %s\n"
- var (length val) (ob-fortran-transform-list val)))
+ var (length val) (org-babel-fortran-transform-list val)))
(t
(error (format "the type of parameter %s is not supported by ob-fortran"
var))))))
-(defun ob-fortran-transform-list (val)
+(defun org-babel-fortran-transform-list (val)
"Return a fortran representation of enclose syntactic lists."
(if (listp val)
- (concat "(/" (mapconcat #'ob-fortran-transform-list val ", ") "/)")
+ (concat "(/" (mapconcat #'org-babel-fortran-transform-list val ", ") "/)")
(format "%S" val)))
(provide 'ob-fortran)
diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el
index 5d07366e774..55c415320d6 100644
--- a/lisp/org/ob-gnuplot.el
+++ b/lisp/org/ob-gnuplot.el
@@ -87,46 +87,45 @@ code."
(timefmt (plist-get params :timefmt))
(time-ind (or (plist-get params :timeind)
(when timefmt 1)))
+ (add-to-body (lambda (text) (setq body (concat text "\n" body))))
output)
- (flet ((add-to-body (text)
- (setq body (concat text "\n" body))))
- ;; append header argument settings to body
- (when title (add-to-body (format "set title '%s'" title))) ;; title
- (when lines (mapc (lambda (el) (add-to-body el)) lines)) ;; line
- (when sets
- (mapc (lambda (el) (add-to-body (format "set %s" el))) sets))
- (when x-labels
- (add-to-body
- (format "set xtics (%s)"
- (mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
- x-labels ", "))))
- (when y-labels
- (add-to-body
- (format "set ytics (%s)"
- (mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
- y-labels ", "))))
- (when time-ind
- (add-to-body "set xdata time")
- (add-to-body (concat "set timefmt \""
- (or timefmt
- "%Y-%m-%d-%H:%M:%S") "\"")))
- (when out-file (add-to-body (format "set output \"%s\"" out-file)))
- (when term (add-to-body (format "set term %s" term)))
- ;; insert variables into code body: this should happen last
- ;; placing the variables at the *top* of the code in case their
- ;; values are used later
- (add-to-body (mapconcat #'identity
- (org-babel-variable-assignments:gnuplot params)
- "\n"))
- ;; replace any variable names preceded by '$' with the actual
- ;; value of the variable
- (mapc (lambda (pair)
- (setq body (replace-regexp-in-string
- (format "\\$%s" (car pair)) (cdr pair) body)))
- vars))
- body)))
+ ;; append header argument settings to body
+ (when title (funcall add-to-body (format "set title '%s'" title))) ;; title
+ (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) ;; line
+ (when sets
+ (mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets))
+ (when x-labels
+ (funcall add-to-body
+ (format "set xtics (%s)"
+ (mapconcat (lambda (pair)
+ (format "\"%s\" %d" (cdr pair) (car pair)))
+ x-labels ", "))))
+ (when y-labels
+ (funcall add-to-body
+ (format "set ytics (%s)"
+ (mapconcat (lambda (pair)
+ (format "\"%s\" %d" (cdr pair) (car pair)))
+ y-labels ", "))))
+ (when time-ind
+ (funcall add-to-body "set xdata time")
+ (funcall add-to-body (concat "set timefmt \""
+ (or timefmt
+ "%Y-%m-%d-%H:%M:%S") "\"")))
+ (when out-file (funcall add-to-body (format "set output \"%s\"" out-file)))
+ (when term (funcall add-to-body (format "set term %s" term)))
+ ;; insert variables into code body: this should happen last
+ ;; placing the variables at the *top* of the code in case their
+ ;; values are used later
+ (funcall add-to-body (mapconcat #'identity
+ (org-babel-variable-assignments:gnuplot params)
+ "\n"))
+ ;; replace any variable names preceded by '$' with the actual
+ ;; value of the variable
+ (mapc (lambda (pair)
+ (setq body (replace-regexp-in-string
+ (format "\\$%s" (car pair)) (cdr pair) body)))
+ vars))
+ body))
(defun org-babel-execute:gnuplot (body params)
"Execute a block of Gnuplot code.
@@ -183,7 +182,7 @@ This function is called by `org-babel-execute-src-block'."
buffer)))
(defun org-babel-variable-assignments:gnuplot (params)
- "Return list of gnuplot statements assigning the block's variables"
+ "Return list of gnuplot statements assigning the block's variables."
(mapcar
(lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair)))
(org-babel-gnuplot-process-vars params)))
diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el
index 53c55329752..1588f99f1e4 100644
--- a/lisp/org/ob-haskell.el
+++ b/lisp/org/ob-haskell.el
@@ -125,12 +125,12 @@ then create one. Return the initialized session."
(current-buffer))))
(defun org-babel-variable-assignments:haskell (params)
- "Return list of haskell statements assigning the block's variables"
+ "Return list of haskell statements assigning the block's variables."
(mapcar (lambda (pair)
(format "let %s = %s"
(car pair)
(org-babel-haskell-var-to-haskell (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (mapcar #'cdr (org-babel-get-header params :var))))
(defun org-babel-haskell-table-or-string (results)
"Convert RESULTS to an Emacs-lisp table or string.
diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el
new file mode 100644
index 00000000000..20648266056
--- /dev/null
+++ b/lisp/org/ob-io.el
@@ -0,0 +1,122 @@
+;;; ob-io.el --- org-babel functions for Io evaluation
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Andrzej Lichnerowicz
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; Currently only supports the external execution. No session support yet.
+;; :results output -- runs in scripting mode
+;; :results output repl -- runs in repl mode
+
+;;; Requirements:
+;; - Io language :: http://iolanguage.org/
+;; - Io major mode :: Can be installed from Io sources
+;; https://github.com/stevedekorte/io/blob/master/extras/SyntaxHighlighters/Emacs/io-mode.el
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(add-to-list 'org-babel-tangle-lang-exts '("io" . "io"))
+(defvar org-babel-default-header-args:io '())
+(defvar org-babel-io-command "io"
+ "Name of the command to use for executing Io code.")
+
+
+(defun org-babel-execute:io (body params)
+ "Execute a block of Io code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (message "executing Io source code block")
+ (let* ((processed-params (org-babel-process-params params))
+ (session (org-babel-io-initiate-session (nth 0 processed-params)))
+ (vars (nth 1 processed-params))
+ (result-params (nth 2 processed-params))
+ (result-type (cdr (assoc :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params))
+ (result (org-babel-io-evaluate
+ session full-body result-type result-params)))
+
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+
+
+(defun org-babel-io-table-or-string (results)
+ "Convert RESULTS into an appropriate elisp value.
+If RESULTS look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape results))
+
+
+(defvar org-babel-io-wrapper-method
+ "(
+%s
+) asString print
+")
+
+
+(defun org-babel-io-evaluate (session body &optional result-type result-params)
+ "Evaluate BODY in external Io process.
+If RESULT-TYPE equals 'output then return standard output as a string.
+If RESULT-TYPE equals 'value then return the value of the last statement
+in BODY as elisp."
+ (when session (error "Sessions are not (yet) supported for Io"))
+ (case result-type
+ (output
+ (if (member "repl" result-params)
+ (org-babel-eval org-babel-io-command body)
+ (let ((src-file (org-babel-temp-file "io-")))
+ (progn (with-temp-file src-file (insert body))
+ (org-babel-eval
+ (concat org-babel-io-command " " src-file) "")))))
+ (value (let* ((src-file (org-babel-temp-file "io-"))
+ (wrapper (format org-babel-io-wrapper-method body)))
+ (with-temp-file src-file (insert wrapper))
+ ((lambda (raw)
+ (if (member "code" result-params)
+ raw
+ (org-babel-io-table-or-string raw)))
+ (org-babel-eval
+ (concat org-babel-io-command " " src-file) ""))))))
+
+
+(defun org-babel-prep-session:io (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (error "Sessions are not (yet) supported for Io"))
+
+(defun org-babel-io-initiate-session (&optional session)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session. Sessions are not
+supported in Io."
+ nil)
+
+(provide 'ob-io)
+
+
+
+;;; ob-io.el ends here
diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el
index 20cad4e6b40..21381725cb1 100644
--- a/lisp/org/ob-js.el
+++ b/lisp/org/ob-js.el
@@ -130,7 +130,7 @@ specifying a variable of the same value."
session))
(defun org-babel-variable-assignments:js (params)
- "Return list of Javascript statements assigning the block's variables"
+ "Return list of Javascript statements assigning the block's variables."
(mapcar
(lambda (pair) (format "var %s=%s;"
(car pair) (org-babel-js-var-to-js (cdr pair))))
@@ -152,9 +152,9 @@ then create. Return the initialized session."
(sit-for .5)
(org-babel-js-initiate-session session))))
((string= "node" org-babel-js-cmd )
- (error "session evaluation with node.js is not supported"))
+ (error "Session evaluation with node.js is not supported"))
(t
- (error "sessions are only supported with mozrepl add \":cmd mozrepl\"")))))
+ (error "Sessions are only supported with mozrepl add \":cmd mozrepl\"")))))
(provide 'ob-js)
diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el
index 23e8d91fecd..43f673edf59 100644
--- a/lisp/org/ob-latex.el
+++ b/lisp/org/ob-latex.el
@@ -132,7 +132,7 @@ This function is called by `org-babel-execute-src-block'."
(when (file-exists-p transient-pdf-file)
(delete-file transient-pdf-file))))))
((string-match "\\.\\([^\\.]+\\)$" out-file)
- (error "can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
+ (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
(match-string 1 out-file))))
nil) ;; signal that output has already been written to file
body))
diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el
index a454d51e391..2635730a93a 100644
--- a/lisp/org/ob-ledger.el
+++ b/lisp/org/ob-ledger.el
@@ -52,8 +52,8 @@ called by `org-babel-execute-src-block'."
(out-file (org-babel-temp-file "ledger-output-")))
(with-temp-file in-file (insert body))
(message "%s" (concat "ledger"
- " -f " (org-babel-process-file-name in-file)
- " " cmdline))
+ " -f " (org-babel-process-file-name in-file)
+ " " cmdline))
(with-output-to-string
(shell-command (concat "ledger"
" -f " (org-babel-process-file-name in-file)
diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el
index b3e77f32e55..e19b0c34c6a 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -23,10 +23,14 @@
;;; Commentary:
-;; Installation / usage info, and examples are available at
-;; https://github.com/mjago/ob-lilypond
+;; Installation, ob-lilypond documentation, and examples are available at
+;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
+;;
+;; Lilypond documentation can be found at
+;; http://lilypond.org/manuals.html
;;; Code:
+
(require 'ob)
(require 'ob-eval)
(require 'ob-tangle)
@@ -36,7 +40,9 @@
(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
(defvar org-babel-default-header-args:lilypond '()
- "Default header arguments for js code blocks.")
+ "Default header arguments for lilypond code blocks.
+NOTE: The arguments are determined at lilypond compile time.
+See (ly-set-header-args)")
(defvar ly-compile-post-tangle t
"Following the org-babel-tangle (C-c C-v t) command,
@@ -48,14 +54,14 @@ Default value is t")
(defvar ly-display-pdf-post-tangle t
"Following a successful LilyPond compilation
ly-display-pdf-post-tangle determines whether to automate the
-drawing / redrawing of the resultant pdf. If the value is nil,
-the pdf is not automatically redrawn. Default value is t")
+drawing / redrawing of the resultant pdf. If the value is nil,
+the pdf is not automatically redrawn. Default value is t")
(defvar ly-play-midi-post-tangle t
"Following a successful LilyPond compilation
ly-play-midi-post-tangle determines whether to automate the
-playing of the resultant midi file. If the value is nil,
-the midi file is not automatically played. Default value is t")
+playing of the resultant midi file. If the value is nil,
+the midi file is not automatically played. Default value is t")
(defvar ly-OSX-ly-path
"/Applications/lilypond.app/Contents/Resources/bin/lilypond")
@@ -71,24 +77,28 @@ the midi file is not automatically played. Default value is t")
(defvar ly-w32-midi-path "")
(defvar ly-gen-png nil
-"Image generation (png) can be turned on by default by setting
+ "Image generation (png) can be turned on by default by setting
LY-GEN-PNG to t")
(defvar ly-gen-svg nil
-"Image generation (SVG) can be turned on by default by setting
+ "Image generation (SVG) can be turned on by default by setting
LY-GEN-SVG to t")
(defvar ly-gen-html nil
-"HTML generation can be turned on by default by setting
+ "HTML generation can be turned on by default by setting
LY-GEN-HTML to t")
+(defvar ly-gen-pdf nil
+ "PDF generation can be turned on by default by setting
+LY-GEN-PDF to t")
+
(defvar ly-use-eps nil
-"You can force the compiler to use the EPS backend by setting
+ "You can force the compiler to use the EPS backend by setting
LY-USE-EPS to t")
(defvar ly-arrange-mode nil
"Arrange mode is turned on by setting LY-ARRANGE-MODE
-to t. In Arrange mode the following settings are altered
+to t. In Arrange mode the following settings are altered
from default...
:tangle yes, :noweb yes
:results silent :comments yes.
@@ -97,7 +107,6 @@ blocks")
(defun org-babel-expand-body:lilypond (body params)
"Expand BODY according to PARAMS, return the expanded body."
-
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
(mapc
(lambda (pair)
@@ -117,7 +126,6 @@ Depending on whether we are in arrange mode either:
1. Attempt to execute lilypond block according to header settings
(This is the default basic mode)
2. Tangle all lilypond blocks and process the result (arrange mode)"
-
(ly-set-header-args ly-arrange-mode)
(if ly-arrange-mode
(ly-tangle)
@@ -125,16 +133,14 @@ Depending on whether we are in arrange mode either:
(defun ly-tangle ()
"ob-lilypond specific tangle, attempts to invoke
-=ly-execute-tangled-ly= if tangle is successful. Also passes
+=ly-execute-tangled-ly= if tangle is successful. Also passes
specific arguments to =org-babel-tangle="
-
(interactive)
(if (org-babel-tangle nil "yes" "lilypond")
(ly-execute-tangled-ly) nil))
(defun ly-process-basic (body params)
- "Execute a lilypond block in basic mode"
-
+ "Execute a lilypond block in basic mode."
(let* ((result-params (cdr (assoc :result-params params)))
(out-file (cdr (assoc :file params)))
(cmdline (or (cdr (assoc :cmdline params))
@@ -143,7 +149,6 @@ specific arguments to =org-babel-tangle="
(with-temp-file in-file
(insert (org-babel-expand-body:generic body params)))
-
(org-babel-eval
(concat
(ly-determine-ly-path)
@@ -155,18 +160,15 @@ specific arguments to =org-babel-tangle="
(file-name-sans-extension out-file)
" "
cmdline
- in-file) "")
- ) nil)
+ in-file) "")) nil)
(defun org-babel-prep-session:lilypond (session params)
"Return an error because LilyPond exporter does not support sessions."
-
(error "Sorry, LilyPond does not currently support sessions!"))
(defun ly-execute-tangled-ly ()
"Compile result of block tangle with lilypond.
If error in compilation, attempt to mark the error in lilypond org file"
-
(when ly-compile-post-tangle
(let ((ly-tangled-file (ly-switch-extension
(buffer-file-name) ".lilypond"))
@@ -193,24 +195,25 @@ If error in compilation, attempt to mark the error in lilypond org file"
(defun ly-compile-lilyfile (file-name &optional test)
"Compile lilypond file and check for compile errors
FILE-NAME is full path to lilypond (.ly) file"
-
(message "Compiling LilyPond...")
(let ((arg-1 (ly-determine-ly-path)) ;program
(arg-2 nil) ;infile
(arg-3 "*lilypond*") ;buffer
(arg-4 t) ;display
- (arg-5 (if ly-gen-png "--png" "")) ;&rest...
- (arg-6 (if ly-gen-html "--html" ""))
- (arg-7 (if ly-use-eps "-dbackend=eps" ""))
- (arg-8 (if ly-gen-svg "-dbackend=svg" ""))
- (arg-9 (concat "--output=" (file-name-sans-extension file-name)))
- (arg-10 file-name))
+ (arg-4 t) ;display
+ (arg-5 (if ly-gen-png "--png" "")) ;&rest...
+ (arg-6 (if ly-gen-html "--html" ""))
+ (arg-7 (if ly-gen-pdf "--pdf" ""))
+ (arg-8 (if ly-use-eps "-dbackend=eps" ""))
+ (arg-9 (if ly-gen-svg "-dbackend=svg" ""))
+ (arg-10 (concat "--output=" (file-name-sans-extension file-name)))
+ (arg-11 file-name))
(if test
- `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5
- ,arg-6 ,arg-7 ,arg-8 ,arg-9 ,arg-10)
+ `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6
+ ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11)
(call-process
- arg-1 arg-2 arg-3 arg-4 arg-5
- arg-6 arg-7 arg-8 arg-9 arg-10))))
+ arg-1 arg-2 arg-3 arg-4 arg-5 arg-6
+ arg-7 arg-8 arg-9 arg-10 arg-11))))
(defun ly-check-for-compile-error (file-name &optional test)
"Check for compile error.
@@ -229,7 +232,6 @@ nil as file-name since it is unused in this context"
(defun ly-process-compile-error (file-name)
"Process the compilation error that has occurred.
FILE-NAME is full path to lilypond file"
-
(let ((line-num (ly-parse-line-num)))
(let ((error-lines (ly-parse-error-line file-name line-num)))
(ly-mark-error-line file-name error-lines)
@@ -239,7 +241,6 @@ FILE-NAME is full path to lilypond file"
"Mark the erroneous lines in the lilypond org buffer.
FILE-NAME is full path to lilypond file.
LINE is the erroneous line"
-
(switch-to-buffer-other-window
(concat (file-name-nondirectory
(ly-switch-extension file-name ".org"))))
@@ -255,7 +256,6 @@ LINE is the erroneous line"
(defun ly-parse-line-num (&optional buffer)
"Extract error line number."
-
(when buffer
(set-buffer buffer))
(let ((start
@@ -280,7 +280,6 @@ LINE is the erroneous line"
"Extract the erroneous line from the tangled .ly file
FILE-NAME is full path to lilypond file.
LINENO is the number of the erroneous line"
-
(with-temp-buffer
(insert-file-contents (ly-switch-extension file-name ".ly")
nil nil nil t)
@@ -295,7 +294,6 @@ LINENO is the number of the erroneous line"
"Attempt to display the generated pdf file
FILE-NAME is full path to lilypond file
If TEST is non-nil, the shell command is returned and is not run"
-
(when ly-display-pdf-post-tangle
(let ((pdf-file (ly-switch-extension file-name ".pdf")))
(if (file-exists-p pdf-file)
@@ -303,14 +301,17 @@ If TEST is non-nil, the shell command is returned and is not run"
(concat (ly-determine-pdf-path) " " pdf-file)))
(if test
cmd-string
- (shell-command cmd-string)))
- (message "No pdf file generated so can't display!")))))
+ (start-process
+ "\"Audition pdf\""
+ "*lilypond*"
+ (ly-determine-pdf-path)
+ pdf-file)))
+ (message "No pdf file generated so can't display!")))))
(defun ly-attempt-to-play-midi (file-name &optional test)
"Attempt to play the generated MIDI file
FILE-NAME is full path to lilypond file
If TEST is non-nil, the shell command is returned and is not run"
-
(when ly-play-midi-post-tangle
(let ((midi-file (ly-switch-extension file-name ".midi")))
(if (file-exists-p midi-file)
@@ -318,13 +319,16 @@ If TEST is non-nil, the shell command is returned and is not run"
(concat (ly-determine-midi-path) " " midi-file)))
(if test
cmd-string
- (shell-command cmd-string)))
+ (start-process
+ "\"Audition midi\""
+ "*lilypond*"
+ (ly-determine-midi-path)
+ midi-file)))
(message "No midi file generated so can't play!")))))
(defun ly-determine-ly-path (&optional test)
"Return correct path to ly binary depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
-
(let ((sys-type
(or test system-type)))
(cond ((string= sys-type "darwin")
@@ -336,7 +340,6 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
(defun ly-determine-pdf-path (&optional test)
"Return correct path to pdf viewer depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
-
(let ((sys-type
(or test system-type)))
(cond ((string= sys-type "darwin")
@@ -348,7 +351,6 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
(defun ly-determine-midi-path (&optional test)
"Return correct path to midi player depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
-
(let ((sys-type
(or test test system-type)))
(cond ((string= sys-type "darwin")
@@ -358,8 +360,7 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
(t ly-nix-midi-path))))
(defun ly-toggle-midi-play ()
- "Toggle whether midi will be played following a successful compilation"
-
+ "Toggle whether midi will be played following a successful compilation."
(interactive)
(setq ly-play-midi-post-tangle
(not ly-play-midi-post-tangle))
@@ -368,8 +369,7 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
"ENABLED." "DISABLED."))))
(defun ly-toggle-pdf-display ()
- "Toggle whether pdf will be displayed following a successful compilation"
-
+ "Toggle whether pdf will be displayed following a successful compilation."
(interactive)
(setq ly-display-pdf-post-tangle
(not ly-display-pdf-post-tangle))
@@ -378,26 +378,28 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
"ENABLED." "DISABLED."))))
(defun ly-toggle-png-generation ()
- "Toggle whether png image will be generated by compilation"
-
+ "Toggle whether png image will be generated by compilation."
(interactive)
- (setq ly-gen-png
- (not ly-gen-png))
+ (setq ly-gen-png (not ly-gen-png))
(message (concat "PNG image generation has been "
(if ly-gen-png "ENABLED." "DISABLED."))))
(defun ly-toggle-html-generation ()
- "Toggle whether html will be generated by compilation"
-
+ "Toggle whether html will be generated by compilation."
(interactive)
- (setq ly-gen-html
- (not ly-gen-html))
+ (setq ly-gen-html (not ly-gen-html))
(message (concat "HTML generation has been "
(if ly-gen-html "ENABLED." "DISABLED."))))
-(defun ly-toggle-arrange-mode ()
- "Toggle whether in Arrange mode or Basic mode"
+(defun ly-toggle-pdf-generation ()
+ "Toggle whether pdf will be generated by compilation."
+ (interactive)
+ (setq ly-gen-pdf (not ly-gen-pdf))
+ (message (concat "PDF generation has been "
+ (if ly-gen-pdf "ENABLED." "DISABLED."))))
+(defun ly-toggle-arrange-mode ()
+ "Toggle whether in Arrange mode or Basic mode."
(interactive)
(setq ly-arrange-mode
(not ly-arrange-mode))
@@ -406,18 +408,18 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes"
(defun ly-switch-extension (file-name ext)
"Utility command to swap current FILE-NAME extension with EXT"
-
(concat (file-name-sans-extension
file-name) ext))
(defun ly-get-header-args (mode)
"Default arguments to use when evaluating a lilypond
-source block. These depend upon whether we are in arrange
-mode i.e. ARRANGE-MODE is t"
+source block. These depend upon whether we are in arrange
+mode i.e. ARRANGE-MODE is t"
(cond (mode
'((:tangle . "yes")
(:noweb . "yes")
(:results . "silent")
+ (:cache . "yes")
(:comments . "yes")))
(t
'((:results . "file")
@@ -431,6 +433,4 @@ dependent on LY-ARRANGE-MODE"
(provide 'ob-lilypond)
-
-
;;; ob-lilypond.el ends here
diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el
index 8fb67219692..71e80bdf9ea 100644
--- a/lisp/org/ob-lisp.el
+++ b/lisp/org/ob-lisp.el
@@ -41,7 +41,7 @@
(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp"))
(defvar org-babel-default-header-args:lisp '())
-(defvar org-babel-header-arg-names:lisp '(package))
+(defvar org-babel-header-args:lisp '((package . :any)))
(defcustom org-babel-lisp-dir-fmt
"(let ((*default-pathname-defaults* #P%S)) %%s)"
@@ -85,8 +85,8 @@ current directory string."
(insert (org-babel-expand-body:lisp body params))
(slime-eval `(swank:eval-and-grab-output
,(let ((dir (if (assoc :dir params)
- (cdr (assoc :dir params))
- default-directory)))
+ (cdr (assoc :dir params))
+ default-directory)))
(format
(if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)")
(buffer-substring-no-properties
diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el
index 7828f1d51c2..6aafe34dcd3 100644
--- a/lisp/org/ob-lob.el
+++ b/lisp/org/ob-lob.el
@@ -97,38 +97,49 @@ if so then run the appropriate source block from the Library."
;;;###autoload
(defun org-babel-lob-get-info ()
"Return a Library of Babel function call as a string."
- (flet ((nonempty (a b)
- (let ((it (match-string a)))
- (if (= (length it) 0) (match-string b) it))))
- (let ((case-fold-search t))
- (save-excursion
- (beginning-of-line 1)
- (when (looking-at org-babel-lob-one-liner-regexp)
- (append
- (mapcar #'org-babel-clean-text-properties
- (list
- (format "%s%s(%s)%s"
- (nonempty 3 12)
- (if (not (= 0 (length (nonempty 5 14))))
- (concat "[" (nonempty 5 14) "]") "")
- (or (nonempty 7 16) "")
- (or (nonempty 8 19) ""))
- (nonempty 9 18)))
- (list (length (if (= (length (match-string 12)) 0)
- (match-string 2) (match-string 11))))))))))
+ (let ((case-fold-search t)
+ (nonempty (lambda (a b)
+ (let ((it (match-string a)))
+ (if (= (length it) 0) (match-string b) it)))))
+ (save-excursion
+ (beginning-of-line 1)
+ (when (looking-at org-babel-lob-one-liner-regexp)
+ (append
+ (mapcar #'org-no-properties
+ (list
+ (format "%s%s(%s)%s"
+ (funcall nonempty 3 12)
+ (if (not (= 0 (length (funcall nonempty 5 14))))
+ (concat "[" (funcall nonempty 5 14) "]") "")
+ (or (funcall nonempty 7 16) "")
+ (or (funcall nonempty 8 19) ""))
+ (funcall nonempty 9 18)))
+ (list (length (if (= (length (match-string 12)) 0)
+ (match-string 2) (match-string 11)))))))))
(defun org-babel-lob-execute (info)
"Execute the lob call specified by INFO."
- (let ((params (org-babel-process-params
- (org-babel-merge-params
- org-babel-default-header-args
- (org-babel-params-from-properties)
- (org-babel-parse-header-arguments
- (org-babel-clean-text-properties
- (concat ":var results="
- (mapconcat #'identity (butlast info) " "))))))))
- (org-babel-execute-src-block
- nil (list "emacs-lisp" "results" params nil nil (nth 2 info)))))
+ (let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info))))
+ (pre-params (org-babel-merge-params
+ org-babel-default-header-args
+ (org-babel-params-from-properties)
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat ":var results="
+ (mapconcat #'identity (butlast info) " "))))))
+ (pre-info (funcall mkinfo pre-params))
+ (cache? (and (cdr (assoc :cache pre-params))
+ (string= "yes" (cdr (assoc :cache pre-params)))))
+ (new-hash (when cache? (org-babel-sha1-hash pre-info)))
+ (old-hash (when cache? (org-babel-current-result-hash))))
+ (if (and cache? (equal new-hash old-hash))
+ (save-excursion (goto-char (org-babel-where-is-src-block-result))
+ (forward-line 1)
+ (message "%S" (org-babel-read-result)))
+ (prog1 (org-babel-execute-src-block
+ nil (funcall mkinfo (org-babel-process-params pre-params)))
+ ;; update the hash
+ (when new-hash (org-babel-set-current-result-hash new-hash))))))
(provide 'ob-lob)
diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el
index b092e1330e7..06fa3cfe884 100644
--- a/lisp/org/ob-maxima.el
+++ b/lisp/org/ob-maxima.el
@@ -48,21 +48,21 @@
(defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
- (mapconcat 'identity
- (list
- ;; graphic output
- (let ((graphic-file (org-babel-maxima-graphical-output-file params)))
- (if graphic-file
- (format
- "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);"
- graphic-file)
- ""))
- ;; variables
- (mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
- ;; body
- body
- "gnuplot_close ()$")
- "\n")))
+ (mapconcat 'identity
+ (list
+ ;; graphic output
+ (let ((graphic-file (org-babel-maxima-graphical-output-file params)))
+ (if graphic-file
+ (format
+ "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);"
+ graphic-file)
+ ""))
+ ;; variables
+ (mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
+ ;; body
+ body
+ "gnuplot_close ()$")
+ "\n")))
(defun org-babel-execute:maxima (body params)
"Execute a block of Maxima entries with org-babel. This function is
@@ -70,7 +70,7 @@ called by `org-babel-execute-src-block'."
(message "executing Maxima source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(result
- (let* ((cmdline (cdr (assoc :cmdline params)))
+ (let* ((cmdline (or (cdr (assoc :cmdline params)) ""))
(in-file (org-babel-temp-file "maxima-" ".max"))
(cmd (format "%s --very-quiet -r 'batchload(%S)$' %s"
org-babel-maxima-command in-file cmdline)))
@@ -110,8 +110,8 @@ of the same value."
(setq val (symbol-name val))
(when (= (length val) 1)
(setq val (string-to-char val))))
- (format "%S: %s$" var
- (org-babel-maxima-elisp-to-maxima val))))
+ (format "%S: %s$" var
+ (org-babel-maxima-elisp-to-maxima val))))
(defun org-babel-maxima-graphical-output-file (params)
"Name of file to which maxima should send graphical output."
diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el
index b40f9a39cef..64d35457b6b 100644
--- a/lisp/org/ob-mscgen.el
+++ b/lisp/org/ob-mscgen.el
@@ -24,7 +24,7 @@
;;; Commentary:
;;
;; This software provides EMACS org-babel export support for message
-;; sequence charts. The mscgen utility is used for processing the
+;; sequence charts. The mscgen utility is used for processing the
;; sequence definition, and must therefore be installed in the system.
;;
;; Mscgen is available and documented at
@@ -64,13 +64,13 @@
(defun org-babel-execute:mscgen (body params)
"Execute a block of Mscgen code with Babel.
This function is called by `org-babel-execute-src-block'.
-Default filetype is png. Modify by setting :filetype parameter to
+Default filetype is png. Modify by setting :filetype parameter to
mscgen supported formats."
(let* ((out-file (or (cdr (assoc :file params)) "output.png" ))
(filetype (or (cdr (assoc :filetype params)) "png" )))
(unless (cdr (assoc :file params))
(error "
-ERROR: no output file specified. Add \":file name.png\" to the src header"))
+ERROR: no output file specified. Add \":file name.png\" to the src header"))
(org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body)
nil)) ;; signal that output has already been written to file
diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el
index 8d61ff37e6e..d2bf36636a5 100644
--- a/lisp/org/ob-ocaml.el
+++ b/lisp/org/ob-ocaml.el
@@ -72,7 +72,7 @@
(progn (setq out nil) line)
(when (string-match re line)
(progn (setq out t) nil))))
- (mapcar #'org-babel-trim (reverse raw))))))))
+ (mapcar #'org-babel-trim (reverse raw))))))))
(org-babel-reassemble-table
(org-babel-ocaml-parse-output (org-babel-trim clean))
(org-babel-pick-name
@@ -93,7 +93,7 @@
(get-buffer tuareg-interactive-buffer-name))))
(defun org-babel-variable-assignments:ocaml (params)
- "Return list of ocaml statements assigning the block's variables"
+ "Return list of ocaml statements assigning the block's variables."
(mapcar
(lambda (pair) (format "let %s = %s;;" (car pair)
(org-babel-ocaml-elisp-to-ocaml (cdr pair))))
@@ -131,11 +131,11 @@ Emacs-lisp table, otherwise return the results as a string."
"Convert RESULTS into an elisp table or string.
If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape
- (replace-regexp-in-string
- "\\[|" "[" (replace-regexp-in-string
- "|\\]" "]" (replace-regexp-in-string
- "; " "," results)))))
+ (org-babel-script-escape
+ (replace-regexp-in-string
+ "\\[|" "[" (replace-regexp-in-string
+ "|\\]" "]" (replace-regexp-in-string
+ "; " "," results)))))
(provide 'ob-ocaml)
diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el
index 9e8575768dc..73f25eca155 100644
--- a/lisp/org/ob-octave.el
+++ b/lisp/org/ob-octave.el
@@ -52,7 +52,7 @@
to a non-nil value.")
(defvar org-babel-matlab-emacs-link-wrapper-method
- "%s
+ "%s
if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid);
else, save -ascii %s ans
end
@@ -110,7 +110,7 @@ end")
(org-babel-prep-session:octave session params 'matlab))
(defun org-babel-variable-assignments:octave (params)
- "Return list of octave statements assigning the block's variables"
+ "Return list of octave statements assigning the block's variables."
(mapcar
(lambda (pair)
(format "%s=%s;"
@@ -147,13 +147,13 @@ specifying a variable of the same value."
(defun org-babel-matlab-initiate-session (&optional session params)
"Create a matlab inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
-create. Return the initialized session."
+create. Return the initialized session."
(org-babel-octave-initiate-session session params 'matlab))
(defun org-babel-octave-initiate-session (&optional session params matlabp)
"Create an octave inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
-create. Return the initialized session."
+create. Return the initialized session."
(if matlabp (require 'matlab) (require 'octave-inf))
(unless (string= session "none")
(let ((session (or session
@@ -225,9 +225,9 @@ value of the last statement in BODY, as elisp."
(message "Waiting for Matlab Emacs Link")
(while (file-exists-p wait-file) (sit-for 0.01))
"")) ;; matlab-shell-run-region doesn't seem to
- ;; make *matlab* buffer contents easily
- ;; available, so :results output currently
- ;; won't work
+ ;; make *matlab* buffer contents easily
+ ;; available, so :results output currently
+ ;; won't work
(org-babel-comint-with-output
(session
(if matlabp
@@ -265,7 +265,7 @@ This removes initial blank and comment lines and then calls
(org-babel-import-elisp-from-file temp-file '(16))))
(defun org-babel-octave-read-string (string)
- "Strip \\\"s from around octave string"
+ "Strip \\\"s from around octave string."
(if (string-match "^\"\\([^\000]+\\)\"$" string)
(match-string 1 string)
string))
diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el
index d57f8b506d1..64de4b2ce45 100644
--- a/lisp/org/ob-org.el
+++ b/lisp/org/ob-org.el
@@ -32,7 +32,7 @@
(declare-function org-export-string "org-exp" (string fmt &optional dir))
(defvar org-babel-default-header-args:org
- '((:results . "raw silent") (:exports . "results"))
+ '((:results . "raw silent") (:exports . "code"))
"Default arguments for evaluating a org source block.")
(defvar org-babel-org-default-header
diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el
index 71e02b05054..abf0ed637d7 100644
--- a/lisp/org/ob-perl.el
+++ b/lisp/org/ob-perl.el
@@ -47,7 +47,7 @@ This function is called by `org-babel-execute-src-block'."
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:perl params)))
- (session (org-babel-perl-initiate-session session)))
+ (session (org-babel-perl-initiate-session session)))
(org-babel-reassemble-table
(org-babel-perl-evaluate session full-body result-type)
(org-babel-pick-name
@@ -57,10 +57,10 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-prep-session:perl (session params)
"Prepare SESSION according to the header arguments in PARAMS."
- (error "Sessions are not supported for Perl."))
+ (error "Sessions are not supported for Perl"))
(defun org-babel-variable-assignments:perl (params)
- "Return list of perl statements assigning the block's variables"
+ "Return list of perl statements assigning the block's variables."
(mapcar
(lambda (pair)
(format "$%s=%s;"
@@ -81,8 +81,8 @@ specifying a var of the same value."
(defvar org-babel-perl-buffers '(:default . nil))
(defun org-babel-perl-initiate-session (&optional session params)
- "Return nil because sessions are not supported by perl"
-nil)
+ "Return nil because sessions are not supported by perl."
+ nil)
(defvar org-babel-perl-wrapper-method
"
@@ -101,7 +101,7 @@ print o join(\"\\n\", @r), \"\\n\"")
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY, as elisp."
- (when session (error "Sessions are not supported for Perl."))
+ (when session (error "Sessions are not supported for Perl"))
(case result-type
(output (org-babel-eval org-babel-perl-command body))
(value (let ((tmp-file (org-babel-temp-file "perl-")))
diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el
index 06c9ab8df60..dd0704fc14e 100644
--- a/lisp/org/ob-picolisp.el
+++ b/lisp/org/ob-picolisp.el
@@ -25,16 +25,16 @@
;;; Commentary:
;; This library enables the use of PicoLisp in the multi-language
-;; programming framework Org-Babel. PicoLisp is a minimal yet
+;; programming framework Org-Babel. PicoLisp is a minimal yet
;; fascinating lisp dialect and a highly productive application
;; framework for web-based client-server applications on top of
-;; object-oriented databases. A good way to learn PicoLisp is to first
+;; object-oriented databases. A good way to learn PicoLisp is to first
;; read Paul Grahams essay "The hundred year language"
;; (http://www.paulgraham.com/hundred.html) and then study the various
;; documents and essays published in the PicoLisp wiki
;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some
;; GNU/Linux Distributions, and can be downloaded here:
-;; http://software-lab.de/down.html. It ships with a picolisp-mode and
+;; http://software-lab.de/down.html. It ships with a picolisp-mode and
;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/
;; directory).
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index 7da689393a3..37d8b7d1ee0 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -52,7 +52,7 @@
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file (or (cdr (assoc :file params))
- (error "plantuml requires a \":file\" header argument")))
+ (error "PlantUML requires a \":file\" header argument")))
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
(java (or (cdr (assoc :java params)) ""))
diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el
index 348248f35cf..71adf73073b 100644
--- a/lisp/org/ob-python.el
+++ b/lisp/org/ob-python.el
@@ -44,7 +44,7 @@
(defvar org-babel-default-header-args:python '())
(defvar org-babel-python-command "python"
- "Name of command for executing python code.")
+ "Name of command for executing Python code.")
(defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python)
"Preferred python mode for use in running python interactively.
@@ -99,7 +99,7 @@ VARS contains resolved variable references"
;; helper functions
(defun org-babel-variable-assignments:python (params)
- "Return list of python statements assigning the block's variables"
+ "Return a list of Python statements assigning the block's variables."
(mapcar
(lambda (pair)
(format "%s=%s"
@@ -160,7 +160,7 @@ then create. Return the initialized session."
(py-shell)
(setq python-buffer (concat "*" bufname "*"))))
(t
- (error "No function available for running an inferior python.")))
+ (error "No function available for running an inferior Python")))
(setq org-babel-python-buffers
(cons (cons session python-buffer)
(assq-delete-all session org-babel-python-buffers)))
@@ -190,7 +190,7 @@ open('%s', 'w').write( pprint.pformat(main()) )")
(defun org-babel-python-evaluate
(session body &optional result-type result-params preamble)
- "Evaluate BODY as python code."
+ "Evaluate BODY as Python code."
(if session
(org-babel-python-evaluate-session
session body result-type result-params)
@@ -201,7 +201,7 @@ open('%s', 'w').write( pprint.pformat(main()) )")
(body &optional result-type result-params preamble)
"Evaluate BODY in external python process.
If RESULT-TYPE equals 'output then return standard output as a
-string. If RESULT-TYPE equals 'value then return the value of the
+string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
((lambda (raw)
(if (or (member "code" result-params)
@@ -236,24 +236,25 @@ last statement in BODY, as elisp."
(session body &optional result-type result-params)
"Pass BODY to the Python process in SESSION.
If RESULT-TYPE equals 'output then return standard output as a
-string. If RESULT-TYPE equals 'value then return the value of the
+string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
- (flet ((send-wait () (comint-send-input nil t) (sleep-for 0 5))
+ (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5)))
(dump-last-value
- (tmp-file pp)
- (mapc
- (lambda (statement) (insert statement) (send-wait))
- (if pp
- (list
- "import pprint"
- (format "open('%s', 'w').write(pprint.pformat(_))"
- (org-babel-process-file-name tmp-file 'noquote)))
- (list (format "open('%s', 'w').write(str(_))"
- (org-babel-process-file-name tmp-file 'noquote))))))
- (input-body (body)
- (mapc (lambda (line) (insert line) (send-wait))
- (split-string body "[\r\n]"))
- (send-wait)))
+ (lambda
+ (tmp-file pp)
+ (mapc
+ (lambda (statement) (insert statement) (funcall send-wait))
+ (if pp
+ (list
+ "import pprint"
+ (format "open('%s', 'w').write(pprint.pformat(_))"
+ (org-babel-process-file-name tmp-file 'noquote)))
+ (list (format "open('%s', 'w').write(str(_))"
+ (org-babel-process-file-name tmp-file 'noquote)))))))
+ (input-body (lambda (body)
+ (mapc (lambda (line) (insert line) (funcall send-wait))
+ (split-string body "[\r\n]"))
+ (funcall send-wait))))
((lambda (results)
(unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
(if (or (member "code" result-params)
@@ -269,25 +270,25 @@ last statement in BODY, as elisp."
(butlast
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator t body)
- (input-body body)
- (send-wait) (send-wait)
+ (funcall input-body body)
+ (funcall send-wait) (funcall send-wait)
(insert org-babel-python-eoe-indicator)
- (send-wait))
+ (funcall send-wait))
2) "\n"))
(value
(let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator nil body)
(let ((comint-process-echoes nil))
- (input-body body)
- (dump-last-value tmp-file (member "pp" result-params))
- (send-wait) (send-wait)
+ (funcall input-body body)
+ (funcall dump-last-value tmp-file (member "pp" result-params))
+ (funcall send-wait) (funcall send-wait)
(insert org-babel-python-eoe-indicator)
- (send-wait)))
+ (funcall send-wait)))
(org-babel-eval-read-file tmp-file)))))))
(defun org-babel-python-read-string (string)
- "Strip 's from around python string"
+ "Strip 's from around Python string."
(if (string-match "^'\\([^\000]+\\)'$" string)
(match-string 1 string)
string))
diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el
index 08cb4e3a25f..79861f1b78a 100644
--- a/lisp/org/ob-ref.el
+++ b/lisp/org/ob-ref.el
@@ -120,89 +120,89 @@ the variable."
(defun org-babel-ref-resolve (ref)
"Resolve the reference REF and return its value."
(save-window-excursion
- (save-excursion
- (let ((case-fold-search t)
- type args new-refere new-header-args new-referent result
- lob-info split-file split-ref index index-row index-col id)
- ;; if ref is indexed grab the indices -- beware nested indices
- (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
- (let ((str (substring ref 0 (match-beginning 0))))
- (= (org-count ?( str) (org-count ?) str))))
- (setq index (match-string 1 ref))
- (setq ref (substring ref 0 (match-beginning 0))))
- ;; assign any arguments to pass to source block
- (when (string-match
- "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
- (setq new-refere (match-string 1 ref))
- (setq new-header-args (match-string 3 ref))
- (setq new-referent (match-string 5 ref))
- (when (> (length new-refere) 0)
- (when (> (length new-referent) 0)
- (setq args (mapcar (lambda (ref) (cons :var ref))
- (org-babel-ref-split-args new-referent))))
- (when (> (length new-header-args) 0)
- (setq args (append (org-babel-parse-header-arguments
- new-header-args) args)))
- (setq ref new-refere)))
- (when (string-match "^\\(.+\\):\\(.+\\)$" ref)
- (setq split-file (match-string 1 ref))
- (setq split-ref (match-string 2 ref))
- (find-file split-file) (setq ref split-ref))
- (save-restriction
- (widen)
- (goto-char (point-min))
- (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref))
- (res-rx (org-babel-named-data-regexp-for-name ref)))
- ;; goto ref in the current buffer
- (or
- ;; check for code blocks
- (re-search-forward src-rx nil t)
- ;; check for named data
- (re-search-forward res-rx nil t)
- ;; check for local or global headlines by id
- (setq id (org-babel-ref-goto-headline-id ref))
- ;; check the Library of Babel
- (setq lob-info (cdr (assoc (intern ref)
- org-babel-library-of-babel)))))
- (unless (or lob-info id) (goto-char (match-beginning 0)))
- ;; ;; TODO: allow searching for names in other buffers
- ;; (setq id-loc (org-id-find ref 'marker)
- ;; buffer (marker-buffer id-loc)
- ;; loc (marker-position id-loc))
- ;; (move-marker id-loc nil)
- (error "reference '%s' not found in this buffer" ref))
- (cond
- (lob-info (setq type 'lob))
- (id (setq type 'id))
- ((and (looking-at org-babel-src-name-regexp)
- (save-excursion
- (forward-line 1)
- (or (looking-at org-babel-src-block-regexp)
- (looking-at org-babel-multi-line-header-regexp))))
- (setq type 'source-block))
- (t (while (not (setq type (org-babel-ref-at-ref-p)))
- (forward-line 1)
- (beginning-of-line)
- (if (or (= (point) (point-min)) (= (point) (point-max)))
- (error "reference not found")))))
- (let ((params (append args '((:results . "silent")))))
- (setq result
- (case type
- (results-line (org-babel-read-result))
- (table (org-babel-read-table))
- (list (org-babel-read-list))
- (file (org-babel-read-link))
- (source-block (org-babel-execute-src-block
- nil nil (if org-babel-update-intermediate
- nil params)))
- (lob (org-babel-execute-src-block
- nil lob-info params))
- (id (org-babel-ref-headline-body)))))
- (if (symbolp result)
- (format "%S" result)
- (if (and index (listp result))
- (org-babel-ref-index-list index result)
- result)))))))
+ (save-excursion
+ (let ((case-fold-search t)
+ type args new-refere new-header-args new-referent result
+ lob-info split-file split-ref index index-row index-col id)
+ ;; if ref is indexed grab the indices -- beware nested indices
+ (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
+ (let ((str (substring ref 0 (match-beginning 0))))
+ (= (org-count ?( str) (org-count ?) str))))
+ (setq index (match-string 1 ref))
+ (setq ref (substring ref 0 (match-beginning 0))))
+ ;; assign any arguments to pass to source block
+ (when (string-match
+ "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
+ (setq new-refere (match-string 1 ref))
+ (setq new-header-args (match-string 3 ref))
+ (setq new-referent (match-string 5 ref))
+ (when (> (length new-refere) 0)
+ (when (> (length new-referent) 0)
+ (setq args (mapcar (lambda (ref) (cons :var ref))
+ (org-babel-ref-split-args new-referent))))
+ (when (> (length new-header-args) 0)
+ (setq args (append (org-babel-parse-header-arguments
+ new-header-args) args)))
+ (setq ref new-refere)))
+ (when (string-match "^\\(.+\\):\\(.+\\)$" ref)
+ (setq split-file (match-string 1 ref))
+ (setq split-ref (match-string 2 ref))
+ (find-file split-file) (setq ref split-ref))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref))
+ (res-rx (org-babel-named-data-regexp-for-name ref)))
+ ;; goto ref in the current buffer
+ (or
+ ;; check for code blocks
+ (re-search-forward src-rx nil t)
+ ;; check for named data
+ (re-search-forward res-rx nil t)
+ ;; check for local or global headlines by id
+ (setq id (org-babel-ref-goto-headline-id ref))
+ ;; check the Library of Babel
+ (setq lob-info (cdr (assoc (intern ref)
+ org-babel-library-of-babel)))))
+ (unless (or lob-info id) (goto-char (match-beginning 0)))
+ ;; ;; TODO: allow searching for names in other buffers
+ ;; (setq id-loc (org-id-find ref 'marker)
+ ;; buffer (marker-buffer id-loc)
+ ;; loc (marker-position id-loc))
+ ;; (move-marker id-loc nil)
+ (error "Reference '%s' not found in this buffer" ref))
+ (cond
+ (lob-info (setq type 'lob))
+ (id (setq type 'id))
+ ((and (looking-at org-babel-src-name-regexp)
+ (save-excursion
+ (forward-line 1)
+ (or (looking-at org-babel-src-block-regexp)
+ (looking-at org-babel-multi-line-header-regexp))))
+ (setq type 'source-block))
+ (t (while (not (setq type (org-babel-ref-at-ref-p)))
+ (forward-line 1)
+ (beginning-of-line)
+ (if (or (= (point) (point-min)) (= (point) (point-max)))
+ (error "Reference not found")))))
+ (let ((params (append args '((:results . "silent")))))
+ (setq result
+ (case type
+ (results-line (org-babel-read-result))
+ (table (org-babel-read-table))
+ (list (org-babel-read-list))
+ (file (org-babel-read-link))
+ (source-block (org-babel-execute-src-block
+ nil nil (if org-babel-update-intermediate
+ nil params)))
+ (lob (org-babel-execute-src-block
+ nil lob-info params))
+ (id (org-babel-ref-headline-body)))))
+ (if (symbolp result)
+ (format "%S" result)
+ (if (and index (listp result))
+ (org-babel-ref-index-list index result)
+ result)))))))
(defun org-babel-ref-index-list (index lis)
"Return the subset of LIS indexed by INDEX.
@@ -218,28 +218,29 @@ returned, or an empty string or \"*\" both of which are
interpreted to mean the entire range and as such are equivalent
to \"0:-1\"."
(if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index))
- (let ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)")
- (length (length lis))
- (portion (match-string 1 index))
- (remainder (substring index (match-end 0))))
- (flet ((wrap (num) (if (< num 0) (+ length num) num))
- (open (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls)))
- (open
- (mapcar
- (lambda (sub-lis)
- (if (listp sub-lis)
- (org-babel-ref-index-list remainder sub-lis)
- sub-lis))
- (if (or (= 0 (length portion)) (string-match ind-re portion))
- (mapcar
- (lambda (n) (nth n lis))
- (apply 'org-number-sequence
- (if (and (> (length portion) 0) (match-string 2 portion))
- (list
- (wrap (string-to-number (match-string 2 portion)))
- (wrap (string-to-number (match-string 3 portion))))
- (list (wrap 0) (wrap -1)))))
- (list (nth (wrap (string-to-number portion)) lis)))))))
+ (let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)")
+ (lgth (length lis))
+ (portion (match-string 1 index))
+ (remainder (substring index (match-end 0)))
+ (wrap (lambda (num) (if (< num 0) (+ lgth num) num)))
+ (open (lambda (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls))))
+ (funcall
+ open
+ (mapcar
+ (lambda (sub-lis)
+ (if (listp sub-lis)
+ (org-babel-ref-index-list remainder sub-lis)
+ sub-lis))
+ (if (or (= 0 (length portion)) (string-match ind-re portion))
+ (mapcar
+ (lambda (n) (nth n lis))
+ (apply 'org-number-sequence
+ (if (and (> (length portion) 0) (match-string 2 portion))
+ (list
+ (funcall wrap (string-to-number (match-string 2 portion)))
+ (funcall wrap (string-to-number (match-string 3 portion))))
+ (list (funcall wrap 0) (funcall wrap -1)))))
+ (list (nth (funcall wrap (string-to-number portion)) lis))))))
lis))
(defun org-babel-ref-split-args (arg-string)
diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el
index 19cce58d820..54077d0d685 100644
--- a/lisp/org/ob-ruby.el
+++ b/lisp/org/ob-ruby.el
@@ -64,12 +64,12 @@ This function is called by `org-babel-execute-src-block'."
body params (org-babel-variable-assignments:ruby params)))
(result (if (member "xmp" result-params)
(with-temp-buffer
- (require 'rcodetools)
- (insert full-body)
- (xmp (cdr (assoc :xmp-option params)))
- (buffer-string))
+ (require 'rcodetools)
+ (insert full-body)
+ (xmp (cdr (assoc :xmp-option params)))
+ (buffer-string))
(org-babel-ruby-evaluate
- session full-body result-type result-params))))
+ session full-body result-type result-params))))
(org-babel-reassemble-table
result
(org-babel-pick-name (cdr (assoc :colname-names params))
@@ -102,7 +102,7 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:ruby (params)
- "Return list of ruby statements assigning the block's variables"
+ "Return list of ruby statements assigning the block's variables."
(mapcar
(lambda (pair)
(format "%s=%s"
diff --git a/lisp/org/ob-scala.el b/lisp/org/ob-scala.el
new file mode 100644
index 00000000000..b5eb18484b9
--- /dev/null
+++ b/lisp/org/ob-scala.el
@@ -0,0 +1,120 @@
+;;; ob-scala.el --- org-babel functions for Scala evaluation
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Andrzej Lichnerowicz
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; Currently only supports the external execution. No session support yet.
+
+;;; Requirements:
+;; - Scala language :: http://www.scala-lang.org/
+;; - Scala major mode :: Can be installed from Scala sources
+;; https://github.com/scala/scala-dist/blob/master/tool-support/src/emacs/scala-mode.el
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala"))
+(defvar org-babel-default-header-args:scala '())
+(defvar org-babel-scala-command "scala"
+ "Name of the command to use for executing Scala code.")
+
+
+(defun org-babel-execute:scala (body params)
+ "Execute a block of Scala code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (message "executing Scala source code block")
+ (let* ((processed-params (org-babel-process-params params))
+ (session (org-babel-scala-initiate-session (nth 0 processed-params)))
+ (vars (nth 1 processed-params))
+ (result-params (nth 2 processed-params))
+ (result-type (cdr (assoc :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params))
+ (result (org-babel-scala-evaluate
+ session full-body result-type result-params)))
+
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+
+
+(defun org-babel-scala-table-or-string (results)
+ "Convert RESULTS into an appropriate elisp value.
+If RESULTS look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape results))
+
+
+(defvar org-babel-scala-wrapper-method
+ "(
+%s
+) asString print
+")
+
+
+(defun org-babel-scala-evaluate
+ (session body &optional result-type result-params)
+ "Evaluate BODY in external Scala process.
+If RESULT-TYPE equals 'output then return standard output as a string.
+If RESULT-TYPE equals 'value then return the value of the last statement
+in BODY as elisp."
+ (when session (error "Sessions are not (yet) supported for Scala"))
+ (case result-type
+ (output
+ (let ((src-file (org-babel-temp-file "scala-")))
+ (progn (with-temp-file src-file (insert body))
+ (org-babel-eval
+ (concat org-babel-scala-command " " src-file) ""))))
+ (value
+ (let* ((src-file (org-babel-temp-file "scala-"))
+ (wrapper (format org-babel-scala-wrapper-method body)))
+ (with-temp-file src-file (insert wrapper))
+ ((lambda (raw)
+ (if (member "code" result-params)
+ raw
+ (org-babel-scala-table-or-string raw)))
+ (org-babel-eval
+ (concat org-babel-scala-command " " src-file) ""))))))
+
+
+(defun org-babel-prep-session:scala (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (error "Sessions are not (yet) supported for Scala"))
+
+(defun org-babel-scala-initiate-session (&optional session)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session. Sessions are not
+supported in Scala."
+ nil)
+
+(provide 'ob-scala)
+
+
+
+;;; ob-scala.el ends here
diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el
index 37cdb28690a..c6288924235 100644
--- a/lisp/org/ob-screen.el
+++ b/lisp/org/ob-screen.el
@@ -23,7 +23,7 @@
;;; Commentary:
-;; Org-Babel support for interactive terminals. Mostly shell scripts.
+;; Org-Babel support for interactive terminals. Mostly shell scripts.
;; Heavily inspired by 'eev' from Eduardo Ochs
;;
;; Adding :cmd and :terminal as header arguments
@@ -64,8 +64,8 @@ In case you want to use a different screen than one selected by your $PATH")
(process-name (concat "org-babel: terminal (" session ")")))
(apply 'start-process process-name "*Messages*"
terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location
- "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session)
- ,cmd))
+ "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session)
+ ,cmd))
;; XXX: Is there a better way than the following?
(while (not (org-babel-screen-session-socketname session))
;; wait until screen session is available before returning
@@ -81,8 +81,8 @@ In case you want to use a different screen than one selected by your $PATH")
(apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*"
org-babel-screen-location
`("-S" ,socket "-X" "eval" "msgwait 0"
- ,(concat "readreg z " tmpfile)
- "paste z"))))))
+ ,(concat "readreg z " tmpfile)
+ "paste z"))))))
(defun org-babel-screen-session-socketname (session)
"Check if SESSION exists by parsing output of \"screen -ls\"."
@@ -137,7 +137,7 @@ The terminal should shortly flicker."
(message (concat "org-babel-screen: Setup "
(if (string-match random-string tmp-string)
"WORKS."
- "DOESN'T work.")))))
+ "DOESN'T work.")))))
(provide 'ob-screen)
diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el
index 6f4cb4ffdfc..1cb607f148d 100644
--- a/lisp/org/ob-sh.el
+++ b/lisp/org/ob-sh.el
@@ -56,14 +56,13 @@ This will be passed to `shell-command-on-region'")
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-sh-initiate-session
(cdr (assoc :session params))))
- (result-params (cdr (assoc :result-params params)))
(stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string
- (org-babel-ref-resolve stdin))))
+ (org-babel-ref-resolve stdin))))
(cdr (assoc :stdin params))))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:sh params))))
(org-babel-reassemble-table
- (org-babel-sh-evaluate session full-body result-params stdin)
+ (org-babel-sh-evaluate session full-body params stdin)
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@@ -91,7 +90,7 @@ This function is called by `org-babel-execute-src-block'."
;; helper functions
(defun org-babel-variable-assignments:sh (params)
- "Return list of shell statements assigning the block's variables"
+ "Return list of shell statements assigning the block's variables."
(let ((sep (cdr (assoc :separator params))))
(mapcar
(lambda (pair)
@@ -108,13 +107,13 @@ var of the same value."
(defun org-babel-sh-var-to-string (var &optional sep)
"Convert an elisp value to a string."
- (flet ((echo-var (v) (if (stringp v) v (format "%S" v))))
+ (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
(cond
((and (listp var) (listp (car var)))
- (orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var)))
+ (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
((listp var)
- (mapconcat #'echo-var var "\n"))
- (t (echo-var var)))))
+ (mapconcat echo-var var "\n"))
+ (t (funcall echo-var var)))))
(defun org-babel-sh-table-or-results (results)
"Convert RESULTS to an appropriate elisp value.
@@ -134,29 +133,38 @@ Emacs-lisp table, otherwise return the results as a string."
(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
"String to indicate that evaluation has completed.")
-(defun org-babel-sh-evaluate (session body &optional result-params stdin)
+(defun org-babel-sh-evaluate (session body &optional params stdin)
"Pass BODY to the Shell process in BUFFER.
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY."
((lambda (results)
(when results
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params)
- (member "output" result-params))
- results
- (let ((tmp-file (org-babel-temp-file "sh-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file)))))
+ (let ((result-params (cdr (assoc :result-params params))))
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params)
+ (member "output" result-params))
+ results
+ (let ((tmp-file (org-babel-temp-file "sh-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file))))))
(cond
(stdin ; external shell script w/STDIN
(let ((script-file (org-babel-temp-file "sh-script-"))
- (stdin-file (org-babel-temp-file "sh-stdin-")))
- (with-temp-file script-file (insert body))
+ (stdin-file (org-babel-temp-file "sh-stdin-"))
+ (shebang (cdr (assoc :shebang params)))
+ (padline (not (string= "no" (cdr (assoc :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert (concat shebang "\n")))
+ (when padline (insert "\n"))
+ (insert body))
+ (set-file-modes script-file #o755)
(with-temp-file stdin-file (insert stdin))
(with-temp-buffer
(call-process-shell-command
- (format "%s %s" org-babel-sh-command script-file)
+ (if shebang
+ script-file
+ (format "%s %s" org-babel-sh-command script-file))
stdin-file
(current-buffer))
(buffer-string))))
@@ -182,7 +190,18 @@ return the value of the last statement in BODY."
(list org-babel-sh-eoe-indicator))))
2)) "\n"))
('otherwise ; external shell script
- (org-babel-eval org-babel-sh-command (org-babel-trim body))))))
+ (if (and (cdr (assoc :shebang params))
+ (> (length (cdr (assoc :shebang params))) 0))
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (shebang (cdr (assoc :shebang params)))
+ (padline (not (string= "no" (cdr (assoc :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert (concat shebang "\n")))
+ (when padline (insert "\n"))
+ (insert body))
+ (set-file-modes script-file #o755)
+ (org-babel-eval script-file ""))
+ (org-babel-eval org-babel-sh-command (org-babel-trim body)))))))
(defun org-babel-sh-strip-weird-long-prompt (string)
"Remove prompt cruft from a string of shell output."
diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el
index 68bd95af9f9..ad7b1e29a93 100644
--- a/lisp/org/ob-sql.el
+++ b/lisp/org/ob-sql.el
@@ -51,8 +51,9 @@
(defvar org-babel-default-header-args:sql '())
-(defvar org-babel-header-arg-names:sql
- '(engine out-file))
+(defvar org-babel-header-args:sql
+ '((engine . :any)
+ (out-file . :any)))
(defun org-babel-expand-body:sql (body params)
"Expand BODY according to the values of PARAMS."
@@ -70,6 +71,15 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-temp-file "sql-out-")))
(header-delim "")
(command (case (intern engine)
+ ('dbi (format "dbish --batch '%s' < %s | sed '%s' > %s"
+ (or cmdline "")
+ (org-babel-process-file-name in-file)
+ "/^+/d;s/^\|//;$d"
+ (org-babel-process-file-name out-file)))
+ ('monetdb (format "mclient -f tab %s < %s > %s"
+ (or cmdline "")
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)))
('msosql (format "osql %s -s \"\t\" -i %s -o %s"
(or cmdline "")
(org-babel-process-file-name in-file)
@@ -80,12 +90,16 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-process-file-name out-file)))
('postgresql (format
"psql -A -P footer=off -F \"\t\" -f %s -o %s %s"
- (org-babel-process-file-name in-file)
- (org-babel-process-file-name out-file)
- (or cmdline "")))
- (t (error "no support for the %s sql engine" engine)))))
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)
+ (or cmdline "")))
+ (t (error "No support for the %s SQL engine" engine)))))
(with-temp-file in-file
- (insert (org-babel-expand-body:sql body params)))
+ (insert
+ (case (intern engine)
+ ('dbi "/format partbox\n")
+ (t ""))
+ (org-babel-expand-body:sql body params)))
(message command)
(shell-command command)
(if (or (member "scalar" result-params)
@@ -134,8 +148,8 @@ This function is called by `org-babel-execute-src-block'."
(with-temp-file data-file
(insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el)
- el
- (format "%S" el)))))))
+ el
+ (format "%S" el)))))))
data-file)
(org-babel-temp-file "sql-data-"))
(if (stringp val) val (format "%S" val))))
@@ -146,7 +160,7 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-prep-session:sql (session params)
"Raise an error because Sql sessions aren't implemented."
- (error "sql sessions not yet implemented"))
+ (error "SQL sessions not yet implemented"))
(provide 'ob-sql)
diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el
index 84d6bb26bae..24a7dd58c2c 100644
--- a/lisp/org/ob-sqlite.el
+++ b/lisp/org/ob-sqlite.el
@@ -37,8 +37,18 @@
(defvar org-babel-default-header-args:sqlite '())
-(defvar org-babel-header-arg-names:sqlite
- '(db header echo bail csv column html line list separator nullvalue)
+(defvar org-babel-header-args:sqlite
+ '((db . :any)
+ (header . :any)
+ (echo . :any)
+ (bail . :any)
+ (csv . :any)
+ (column . :any)
+ (html . :any)
+ (line . :any)
+ (list . :any)
+ (separator . :any)
+ (nullvalue . :any))
"Sqlite specific header args.")
(defun org-babel-expand-body:sqlite (body params)
@@ -61,7 +71,7 @@ This function is called by `org-babel-execute-src-block'."
(list :header :echo :bail :column
:csv :html :line :list))))
exit-code)
- (unless db (error "ob-sqlite: can't evaluate without a database."))
+ (unless db (error "ob-sqlite: can't evaluate without a database"))
(with-temp-buffer
(insert
(org-babel-eval
@@ -118,8 +128,8 @@ This function is called by `org-babel-execute-src-block'."
(with-temp-file data-file
(insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el)
- el
- (format "%S" el)))))))
+ el
+ (format "%S" el)))))))
data-file)
(org-babel-temp-file "sqlite-data-"))
(if (stringp val) val (format "%S" val))))
@@ -145,9 +155,9 @@ This function is called by `org-babel-execute-src-block'."
table))
(defun org-babel-prep-session:sqlite (session params)
- "Raise an error because support for sqlite sessions isn't implemented.
+ "Raise an error because support for SQLite sessions isn't implemented.
Prepare SESSION according to the header arguments specified in PARAMS."
- (error "sqlite sessions not yet implemented"))
+ (error "SQLite sessions not yet implemented"))
(provide 'ob-sqlite)
diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el
index f636415d987..242ddf09020 100644
--- a/lisp/org/ob-table.el
+++ b/lisp/org/ob-table.el
@@ -99,7 +99,7 @@ as shown in the example below.
(prog1 nil (setq quote t))
(prog1 (if quote
(format "\"%s\"" el)
- (org-babel-clean-text-properties el))
+ (org-no-properties el))
(setq quote nil))))
(cdr var)))))
variables)))
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index db4721b70bc..7077a1571eb 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -122,13 +122,15 @@ represented in the file."
`progn', then kill the FILE buffer returning the result of
evaluating BODY."
(declare (indent 1))
- (let ((temp-result (make-symbol "temp-result"))
+ (let ((temp-path (make-symbol "temp-path"))
+ (temp-result (make-symbol "temp-result"))
(temp-file (make-symbol "temp-file"))
(visited-p (make-symbol "visited-p")))
- `(let (,temp-result ,temp-file
- (,visited-p (get-file-buffer ,file)))
- (org-babel-find-file-noselect-refresh ,file)
- (setf ,temp-file (get-file-buffer ,file))
+ `(let* ((,temp-path ,file)
+ (,visited-p (get-file-buffer ,temp-path))
+ ,temp-result ,temp-file)
+ (org-babel-find-file-noselect-refresh ,temp-path)
+ (setf ,temp-file (get-file-buffer ,temp-path))
(with-current-buffer ,temp-file
(setf ,temp-result (progn ,@body)))
(unless ,visited-p (kill-buffer ,temp-file))
@@ -142,19 +144,19 @@ This function exports the source code using
`org-babel-tangle' and then loads the resulting file using
`load-file'."
(interactive "fFile to load: ")
- (flet ((age (file)
- (float-time
- (time-subtract (current-time)
- (nth 5 (or (file-attributes (file-truename file))
- (file-attributes file)))))))
- (let* ((base-name (file-name-sans-extension file))
- (exported-file (concat base-name ".el")))
- ;; tangle if the org-mode file is newer than the elisp file
- (unless (and (file-exists-p exported-file)
- (> (age file) (age exported-file)))
- (org-babel-tangle-file file exported-file "emacs-lisp"))
- (load-file exported-file)
- (message "loaded %s" exported-file))))
+ (let* ((age (lambda (file)
+ (float-time
+ (time-subtract (current-time)
+ (nth 5 (or (file-attributes (file-truename file))
+ (file-attributes file)))))))
+ (base-name (file-name-sans-extension file))
+ (exported-file (concat base-name ".el")))
+ ;; tangle if the org-mode file is newer than the elisp file
+ (unless (and (file-exists-p exported-file)
+ (> (funcall age file) (funcall age exported-file)))
+ (org-babel-tangle-file file exported-file "emacs-lisp"))
+ (load-file exported-file)
+ (message "Loaded %s" exported-file)))
;;;###autoload
(defun org-babel-tangle-file (file &optional target-file lang)
@@ -189,96 +191,95 @@ exported source code blocks by language."
(run-hooks 'org-babel-pre-tangle-hook)
;; possibly restrict the buffer to the current code block
(save-restriction
- (when only-this-block
- (unless (org-babel-where-is-src-block-head)
- (error "Point is not currently inside of a code block"))
- (save-match-data
- (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
- target-file)
- (setq target-file
- (read-from-minibuffer "Tangle to: " (buffer-file-name)))))
- (narrow-to-region (match-beginning 0) (match-end 0)))
- (save-excursion
- (let ((block-counter 0)
- (org-babel-default-header-args
- (if target-file
- (org-babel-merge-params org-babel-default-header-args
- (list (cons :tangle target-file)))
- org-babel-default-header-args))
- path-collector)
- (mapc ;; map over all languages
- (lambda (by-lang)
- (let* ((lang (car by-lang))
- (specs (cdr by-lang))
- (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
- (lang-f (intern
- (concat
- (or (and (cdr (assoc lang org-src-lang-modes))
- (symbol-name
- (cdr (assoc lang org-src-lang-modes))))
- lang)
- "-mode")))
- she-banged)
- (mapc
- (lambda (spec)
- (flet ((get-spec (name)
- (cdr (assoc name (nth 4 spec)))))
- (let* ((tangle (get-spec :tangle))
- (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
- (get-spec :shebang)))
- (base-name (cond
- ((string= "yes" tangle)
- (file-name-sans-extension
- (buffer-file-name)))
- ((string= "no" tangle) nil)
- ((> (length tangle) 0) tangle)))
- (file-name (when base-name
- ;; decide if we want to add ext to base-name
- (if (and ext (string= "yes" tangle))
- (concat base-name "." ext) base-name))))
- (when file-name
- ;; possibly create the parent directories for file
- (when ((lambda (m) (and m (not (string= m "no"))))
- (get-spec :mkdirp))
- (make-directory (file-name-directory file-name) 'parents))
- ;; delete any old versions of file
- (when (and (file-exists-p file-name)
- (not (member file-name path-collector)))
- (delete-file file-name))
- ;; drop source-block to file
- (with-temp-buffer
- (when (fboundp lang-f) (ignore-errors (funcall lang-f)))
- (when (and she-bang (not (member file-name she-banged)))
- (insert (concat she-bang "\n"))
- (setq she-banged (cons file-name she-banged)))
- (org-babel-spec-to-string spec)
- ;; We avoid append-to-file as it does not work with tramp.
- (let ((content (buffer-string)))
- (with-temp-buffer
- (if (file-exists-p file-name)
- (insert-file-contents file-name))
- (goto-char (point-max))
- (insert content)
- (write-region nil nil file-name))))
- ;; if files contain she-bangs, then make the executable
- (when she-bang (set-file-modes file-name #o755))
- ;; update counter
- (setq block-counter (+ 1 block-counter))
- (add-to-list 'path-collector file-name)))))
- specs)))
- (org-babel-tangle-collect-blocks lang))
- (message "tangled %d code block%s from %s" block-counter
- (if (= block-counter 1) "" "s")
- (file-name-nondirectory
- (buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
- ;; run `org-babel-post-tangle-hook' in all tangled files
- (when org-babel-post-tangle-hook
- (mapc
- (lambda (file)
- (org-babel-with-temp-filebuffer file
- (run-hooks 'org-babel-post-tangle-hook)))
- path-collector))
- path-collector))))
+ (when only-this-block
+ (unless (org-babel-where-is-src-block-head)
+ (error "Point is not currently inside of a code block"))
+ (save-match-data
+ (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
+ target-file)
+ (setq target-file
+ (read-from-minibuffer "Tangle to: " (buffer-file-name)))))
+ (narrow-to-region (match-beginning 0) (match-end 0)))
+ (save-excursion
+ (let ((block-counter 0)
+ (org-babel-default-header-args
+ (if target-file
+ (org-babel-merge-params org-babel-default-header-args
+ (list (cons :tangle target-file)))
+ org-babel-default-header-args))
+ path-collector)
+ (mapc ;; map over all languages
+ (lambda (by-lang)
+ (let* ((lang (car by-lang))
+ (specs (cdr by-lang))
+ (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
+ (lang-f (intern
+ (concat
+ (or (and (cdr (assoc lang org-src-lang-modes))
+ (symbol-name
+ (cdr (assoc lang org-src-lang-modes))))
+ lang)
+ "-mode")))
+ she-banged)
+ (mapc
+ (lambda (spec)
+ (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
+ (let* ((tangle (funcall get-spec :tangle))
+ (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
+ (funcall get-spec :shebang)))
+ (base-name (cond
+ ((string= "yes" tangle)
+ (file-name-sans-extension
+ (buffer-file-name)))
+ ((string= "no" tangle) nil)
+ ((> (length tangle) 0) tangle)))
+ (file-name (when base-name
+ ;; decide if we want to add ext to base-name
+ (if (and ext (string= "yes" tangle))
+ (concat base-name "." ext) base-name))))
+ (when file-name
+ ;; possibly create the parent directories for file
+ (when ((lambda (m) (and m (not (string= m "no"))))
+ (funcall get-spec :mkdirp))
+ (make-directory (file-name-directory file-name) 'parents))
+ ;; delete any old versions of file
+ (when (and (file-exists-p file-name)
+ (not (member file-name path-collector)))
+ (delete-file file-name))
+ ;; drop source-block to file
+ (with-temp-buffer
+ (when (fboundp lang-f) (ignore-errors (funcall lang-f)))
+ (when (and she-bang (not (member file-name she-banged)))
+ (insert (concat she-bang "\n"))
+ (setq she-banged (cons file-name she-banged)))
+ (org-babel-spec-to-string spec)
+ ;; We avoid append-to-file as it does not work with tramp.
+ (let ((content (buffer-string)))
+ (with-temp-buffer
+ (if (file-exists-p file-name)
+ (insert-file-contents file-name))
+ (goto-char (point-max))
+ (insert content)
+ (write-region nil nil file-name))))
+ ;; if files contain she-bangs, then make the executable
+ (when she-bang (set-file-modes file-name #o755))
+ ;; update counter
+ (setq block-counter (+ 1 block-counter))
+ (add-to-list 'path-collector file-name)))))
+ specs)))
+ (org-babel-tangle-collect-blocks lang))
+ (message "Tangled %d code block%s from %s" block-counter
+ (if (= block-counter 1) "" "s")
+ (file-name-nondirectory
+ (buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
+ ;; run `org-babel-post-tangle-hook' in all tangled files
+ (when org-babel-post-tangle-hook
+ (mapc
+ (lambda (file)
+ (org-babel-with-temp-filebuffer file
+ (run-hooks 'org-babel-post-tangle-hook)))
+ path-collector))
+ path-collector))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
@@ -290,12 +291,59 @@ references."
(interactive)
(goto-char (point-min))
(while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t)
- (re-search-forward "<<[^[:space:]]*>>" nil t))
+ (re-search-forward (org-babel-noweb-wrap) nil t))
(delete-region (save-excursion (beginning-of-line 1) (point))
(save-excursion (end-of-line 1) (forward-char 1) (point)))))
(defvar org-stored-links)
(defvar org-bracket-link-regexp)
+(defun org-babel-spec-to-string (spec)
+ "Insert SPEC into the current file.
+Insert the source-code specified by SPEC into the current
+source code file. This function uses `comment-region' which
+assumes that the appropriate major-mode is set. SPEC has the
+form
+
+ (start-line file link source-name params body comment)"
+ (let* ((start-line (nth 0 spec))
+ (file (nth 1 spec))
+ (link (nth 2 spec))
+ (source-name (nth 3 spec))
+ (body (nth 5 spec))
+ (comment (nth 6 spec))
+ (comments (cdr (assoc :comments (nth 4 spec))))
+ (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
+ (link-p (or (string= comments "both") (string= comments "link")
+ (string= comments "yes") (string= comments "noweb")))
+ (link-data (mapcar (lambda (el)
+ (cons (symbol-name el)
+ ((lambda (le)
+ (if (stringp le) le (format "%S" le)))
+ (eval el))))
+ '(start-line file link source-name)))
+ (insert-comment (lambda (text)
+ (when (and comments (not (string= comments "no"))
+ (> (length text) 0))
+ (when padline (insert "\n"))
+ (comment-region (point) (progn (insert text) (point)))
+ (end-of-line nil) (insert "\n")))))
+ (when comment (funcall insert-comment comment))
+ (when link-p
+ (funcall
+ insert-comment
+ (org-fill-template org-babel-tangle-comment-format-beg link-data)))
+ (when padline (insert "\n"))
+ (insert
+ (format
+ "%s\n"
+ (replace-regexp-in-string
+ "^," ""
+ (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
+ (when link-p
+ (funcall
+ insert-comment
+ (org-fill-template org-babel-tangle-comment-format-end link-data)))))
+
(defun org-babel-tangle-collect-blocks (&optional language)
"Collect source blocks in the current Org-mode file.
Return an association list of source-code block specifications of
@@ -312,7 +360,8 @@ code blocks by language."
(setq block-counter (+ 1 block-counter))))
(replace-regexp-in-string "[ \t]" "-"
(condition-case nil
- (nth 4 (org-heading-components))
+ (or (nth 4 (org-heading-components))
+ "(dummy for heading without text)")
(error (buffer-file-name)))))
(let* ((start-line (save-restriction (widen)
(+ 1 (line-number-at-pos (point)))))
@@ -326,7 +375,7 @@ code blocks by language."
(link ((lambda (link)
(and (string-match org-bracket-link-regexp link)
(match-string 1 link)))
- (org-babel-clean-text-properties
+ (org-no-properties
(org-store-link nil))))
(source-name
(intern (or (nth 4 info)
@@ -351,11 +400,7 @@ code blocks by language."
body params
(and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
- (if (and (cdr (assoc :noweb params)) ;; expand noweb refs
- (let ((nowebs (split-string
- (cdr (assoc :noweb params)))))
- (or (member "yes" nowebs)
- (member "tangle" nowebs))))
+ (if (org-babel-noweb-p params :tangle)
(org-babel-expand-noweb-references info)
(nth 1 info)))))
(comment
@@ -392,57 +437,12 @@ code blocks by language."
blocks))
blocks))
-(defun org-babel-spec-to-string (spec)
- "Insert SPEC into the current file.
-Insert the source-code specified by SPEC into the current
-source code file. This function uses `comment-region' which
-assumes that the appropriate major-mode is set. SPEC has the
-form
-
- (start-line file link source-name params body comment)"
- (let* ((start-line (nth 0 spec))
- (file (nth 1 spec))
- (link (nth 2 spec))
- (source-name (nth 3 spec))
- (body (nth 5 spec))
- (comment (nth 6 spec))
- (comments (cdr (assoc :comments (nth 4 spec))))
- (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
- (link-p (or (string= comments "both") (string= comments "link")
- (string= comments "yes") (string= comments "noweb")))
- (link-data (mapcar (lambda (el)
- (cons (symbol-name el)
- ((lambda (le)
- (if (stringp le) le (format "%S" le)))
- (eval el))))
- '(start-line file link source-name))))
- (flet ((insert-comment (text)
- (when (and comments (not (string= comments "no"))
- (> (length text) 0))
- (when padline (insert "\n"))
- (comment-region (point) (progn (insert text) (point)))
- (end-of-line nil) (insert "\n"))))
- (when comment (insert-comment comment))
- (when link-p
- (insert-comment
- (org-fill-template org-babel-tangle-comment-format-beg link-data)))
- (when padline (insert "\n"))
- (insert
- (format
- "%s\n"
- (replace-regexp-in-string
- "^," ""
- (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
- (when link-p
- (insert-comment
- (org-fill-template org-babel-tangle-comment-format-end link-data))))))
-
(defun org-babel-tangle-comment-links ( &optional info)
"Return a list of begin and end link comments for the code block at point."
(let* ((start-line (org-babel-where-is-src-block-head))
(file (buffer-file-name))
(link (org-link-escape (progn (call-interactively 'org-store-link)
- (org-babel-clean-text-properties
+ (org-no-properties
(car (pop org-stored-links))))))
(source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
(link-data (mapcar (lambda (el)
@@ -475,7 +475,7 @@ which enable the original code blocks to be found."
(org-babel-update-block-body new-body)))
(setq counter (+ 1 counter)))
(goto-char end))
- (prog1 counter (message "detangled %d code blocks" counter)))))
+ (prog1 counter (message "Detangled %d code blocks" counter)))))
(defun org-babel-tangle-jump-to-org ()
"Jump from a tangled code file to the related Org-mode file."
@@ -498,7 +498,7 @@ which enable the original code blocks to be found."
" ends here") nil t)
(setq end (point-at-bol))))))))
(unless (and start (< start mid) (< mid end))
- (error "not in tangled code"))
+ (error "Not in tangled code"))
(setq body (org-babel-trim (buffer-substring start end))))
(when (string-match "::" path)
(setq path (substring path 0 (match-beginning 0))))
diff --git a/lisp/org/ob.el b/lisp/org/ob.el
index 05122487588..f15457d68e2 100644
--- a/lisp/org/ob.el
+++ b/lisp/org/ob.el
@@ -27,12 +27,19 @@
(require 'cl))
(require 'ob-eval)
(require 'org-macs)
+(require 'org-compat)
+(defconst org-babel-exeext
+ (if (memq system-type '(windows-nt cygwin))
+ ".exe"
+ nil))
(defvar org-babel-call-process-region-original)
(defvar org-src-lang-modes)
(defvar org-babel-library-of-babel)
(declare-function show-all "outline" ())
(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS))
+(declare-function org-mark-ring-push "org" (&optional pos buffer))
+(declare-function org-strip-protective-commas "org" (beg end))
(declare-function tramp-compat-make-temp-file "tramp-compat"
(filename &optional dir-flag))
(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
@@ -44,7 +51,7 @@
(&optional context code edit-buffer-name quietp))
(declare-function org-edit-src-exit "org-src" (&optional context))
(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
-(declare-function org-save-outline-visibility "org" (use-markers &rest body))
+(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body))
(declare-function org-outline-overlay-data "org" (&optional use-markers))
(declare-function org-set-outline-overlay-data "org" (data))
(declare-function org-narrow-to-subtree "org" ())
@@ -57,6 +64,7 @@
(declare-function org-cycle "org" (&optional arg))
(declare-function org-uniquify "org" (list))
(declare-function org-current-level "org" ())
+(declare-function org-strip-protective-commas "org" (beg end))
(declare-function org-table-import "org-table" (file arg))
(declare-function org-add-hook "org-compat"
(hook function &optional append local))
@@ -80,6 +88,9 @@
(declare-function org-list-prevs-alist "org-list" (struct))
(declare-function org-list-get-list-end "org-list" (item struct prevs))
(declare-function org-strip-protective-commas "org" (beg end))
+(declare-function org-remove-if "org" (predicate seq))
+(declare-function org-completing-read "org" (&rest args))
+(declare-function org-add-protective-commas "org-src" (beg end))
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
@@ -104,9 +115,9 @@ remove code block execution from C-c C-c as further protection
against accidental code block evaluation. The
`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
remove code block execution from the C-c C-c keybinding."
- :group 'org-babel
- :version "24.1"
- :type '(choice boolean function))
+ :group 'org-babel
+ :version "24.1"
+ :type '(choice boolean function))
;; don't allow this variable to be changed through file settings
(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t)))
@@ -123,6 +134,23 @@ be used."
:group 'org-babel
:type 'string)
+(defcustom org-babel-noweb-wrap-start "<<"
+ "String used to begin a noweb reference in a code block.
+See also `org-babel-noweb-wrap-end'."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-noweb-wrap-end ">>"
+ "String used to end a noweb reference in a code block.
+See also `org-babel-noweb-wrap-start'."
+ :group 'org-babel
+ :type 'string)
+
+(defun org-babel-noweb-wrap (&optional regexp)
+ (concat org-babel-noweb-wrap-start
+ (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
+ org-babel-noweb-wrap-end))
+
(defvar org-babel-src-name-regexp
"^[ \t]*#\\+name:[ \t]*"
"Regular expression used to match a source name line.")
@@ -227,7 +255,7 @@ Returns a list
(nth 2 info)
(org-babel-parse-header-arguments (match-string 1)))))
(when (looking-at org-babel-src-name-w-name-regexp)
- (setq name (org-babel-clean-text-properties (match-string 3)))
+ (setq name (org-no-properties (match-string 3)))
(when (and (match-string 5) (> (length (match-string 5)) 0))
(setf (nth 2 info) ;; merge functional-syntax vars and header-args
(org-babel-merge-params
@@ -263,15 +291,18 @@ of potentially harmful code."
(let* ((eval (or (cdr (assoc :eval (nth 2 info)))
(when (assoc :noeval (nth 2 info)) "no")))
(query (cond ((equal eval "query") t)
- ((and org-current-export-file
+ ((and (boundp 'org-current-export-file)
+ org-current-export-file
(equal eval "query-export")) t)
((functionp org-confirm-babel-evaluate)
(funcall org-confirm-babel-evaluate
(nth 0 info) (nth 1 info)))
(t org-confirm-babel-evaluate))))
(if (or (equal eval "never") (equal eval "no")
- (and org-current-export-file (or (equal eval "no-export")
- (equal eval "never-export")))
+ (and (boundp 'org-current-export-file)
+ org-current-export-file
+ (or (equal eval "no-export")
+ (equal eval "never-export")))
(and query
(not (yes-or-no-p
(format "Evaluate this%scode block%son your system? "
@@ -314,27 +345,27 @@ then run `org-babel-execute-src-block'."
This includes header arguments, language and name, and is largely
a window into the `org-babel-get-src-block-info' function."
(interactive)
- (let ((info (org-babel-get-src-block-info 'light)))
- (flet ((full (it) (> (length it) 0))
- (printf (fmt &rest args) (princ (apply #'format fmt args))))
- (when info
- (with-help-window (help-buffer)
- (let ((name (nth 4 info))
- (lang (nth 0 info))
- (switches (nth 3 info))
- (header-args (nth 2 info)))
- (when name (printf "Name: %s\n" name))
- (when lang (printf "Lang: %s\n" lang))
- (when (full switches) (printf "Switches: %s\n" switches))
- (printf "Header Arguments:\n")
- (dolist (pair (sort header-args
- (lambda (a b) (string< (symbol-name (car a))
- (symbol-name (car b))))))
- (when (full (cdr pair))
- (printf "\t%S%s\t%s\n"
- (car pair)
- (if (> (length (format "%S" (car pair))) 7) "" "\t")
- (cdr pair))))))))))
+ (let ((info (org-babel-get-src-block-info 'light))
+ (full (lambda (it) (> (length it) 0)))
+ (printf (lambda (fmt &rest args) (princ (apply #'format fmt args)))))
+ (when info
+ (with-help-window (help-buffer)
+ (let ((name (nth 4 info))
+ (lang (nth 0 info))
+ (switches (nth 3 info))
+ (header-args (nth 2 info)))
+ (when name (funcall printf "Name: %s\n" name))
+ (when lang (funcall printf "Lang: %s\n" lang))
+ (when (funcall full switches) (funcall printf "Switches: %s\n" switches))
+ (funcall printf "Header Arguments:\n")
+ (dolist (pair (sort header-args
+ (lambda (a b) (string< (symbol-name (car a))
+ (symbol-name (car b))))))
+ (when (funcall full (cdr pair))
+ (funcall printf "\t%S%s\t%s\n"
+ (car pair)
+ (if (> (length (format "%S" (car pair))) 7) "" "\t")
+ (cdr pair)))))))))
;;;###autoload
(defun org-babel-expand-src-block-maybe ()
@@ -380,24 +411,26 @@ then run `org-babel-pop-to-session'."
(eval . ((never query)))
(exports . ((code results both none)))
(file . :any)
+ (file-desc . :any)
(hlines . ((no yes)))
(mkdirp . ((yes no)))
(no-expand)
(noeval)
- (noweb . ((yes no tangle)))
+ (noweb . ((yes no tangle no-export strip-export)))
(noweb-ref . :any)
(noweb-sep . :any)
(padline . ((yes no)))
(results . ((file list vector table scalar verbatim)
- (raw org html latex code pp wrap)
- (replace silent append prepend)
- (output value)))
+ (raw html latex org code pp drawer)
+ (replace silent append prepend)
+ (output value)))
(rownames . ((no yes)))
(sep . :any)
(session . :any)
(shebang . :any)
(tangle . ((tangle yes no :any)))
- (var . :any)))
+ (var . :any)
+ (wrap . :any)))
(defconst org-babel-header-arg-names
(mapcar #'car org-babel-common-header-args-w-values)
@@ -415,7 +448,7 @@ specific header arguments as well.")
'((:session . "none") (:results . "replace") (:exports . "results"))
"Default arguments to use when evaluating an inline source block.")
-(defvar org-babel-data-names '("TBLNAME" "RESULTS" "NAME"))
+(defvar org-babel-data-names '("tblname" "results" "name"))
(defvar org-babel-result-regexp
(concat "^[ \t]*#\\+"
@@ -433,8 +466,8 @@ be saved in the second match data.")
"The minimum number of lines for block output.
If number of lines of output is equal to or exceeds this
value, the output is placed in a #+begin_example...#+end_example
-block. Otherwise the output is marked as literal by inserting
-colons at the starts of the lines. This variable only takes
+block. Otherwise the output is marked as literal by inserting
+colons at the starts of the lines. This variable only takes
effect if the :results output option is in effect.")
(defvar org-babel-noweb-error-langs nil
@@ -452,7 +485,7 @@ can not be resolved.")
(defun org-babel-named-src-block-regexp-for-name (name)
"This generates a regexp used to match a src block named NAME."
(concat org-babel-src-name-regexp (regexp-quote name)
- "\\([ \t]\\|$\\|(\\)" ".*[\r\n]"
+ "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*"
(substring org-babel-src-block-regexp 1)))
(defun org-babel-named-data-regexp-for-name (name)
@@ -495,15 +528,13 @@ block."
(new-hash (when cache? (org-babel-sha1-hash info)))
(old-hash (when cache? (org-babel-current-result-hash)))
(body (setf (nth 1 info)
- (let ((noweb (cdr (assoc :noweb params))))
- (if (and noweb
- (or (string= "yes" noweb)
- (string= "tangle" noweb)))
- (org-babel-expand-noweb-references info)
- (nth 1 info)))))
+ (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info))))
(dir (cdr (assoc :dir params)))
(default-directory
- (or (and dir (file-name-as-directory dir)) default-directory))
+ (or (and dir (file-name-as-directory (expand-file-name dir)))
+ default-directory))
(org-babel-call-process-region-original
(if (boundp 'org-babel-call-process-region-original)
org-babel-call-process-region-original
@@ -511,15 +542,16 @@ block."
(indent (car (last info)))
result cmd)
(unwind-protect
- (flet ((call-process-region (&rest args)
- (apply 'org-babel-tramp-handle-call-process-region args)))
- (flet ((lang-check (f)
- (let ((f (intern (concat "org-babel-execute:" f))))
- (when (fboundp f) f))))
+ (let ((call-process-region
+ (lambda (&rest args)
+ (apply 'org-babel-tramp-handle-call-process-region args))))
+ (let ((lang-check (lambda (f)
+ (let ((f (intern (concat "org-babel-execute:" f))))
+ (when (fboundp f) f)))))
(setq cmd
- (or (lang-check lang)
- (lang-check (symbol-name
- (cdr (assoc lang org-src-lang-modes))))
+ (or (funcall lang-check lang)
+ (funcall lang-check (symbol-name
+ (cdr (assoc lang org-src-lang-modes))))
(error "No org-babel-execute function for %s!" lang))))
(if (and (not arg) new-hash (equal new-hash old-hash))
(save-excursion ;; return cached result
@@ -572,10 +604,9 @@ arguments and pop open the results in a preview buffer."
(params (setf (nth 2 info)
(sort (org-babel-merge-params (nth 2 info) params)
(lambda (el1 el2) (string< (symbol-name (car el1))
- (symbol-name (car el2)))))))
+ (symbol-name (car el2)))))))
(body (setf (nth 1 info)
- (if (and (cdr (assoc :noweb params))
- (string= "yes" (cdr (assoc :noweb params))))
+ (if (org-babel-noweb-p params :eval)
(org-babel-expand-noweb-references info) (nth 1 info))))
(expand-cmd (intern (concat "org-babel-expand-body:" lang)))
(assignments-cmd (intern (concat "org-babel-variable-assignments:"
@@ -592,17 +623,32 @@ arguments and pop open the results in a preview buffer."
"Return the edit (levenshtein) distance between strings S1 S2."
(let* ((l1 (length s1))
(l2 (length s2))
- (dist (map 'vector (lambda (_) (make-vector (1+ l2) nil))
- (number-sequence 1 (1+ l1)))))
- (flet ((in (i j) (aref (aref dist i) j))
- (mmin (&rest lst) (apply #'min (remove nil lst))))
- (setf (aref (aref dist 0) 0) 0)
- (dolist (i (number-sequence 1 l1))
- (dolist (j (number-sequence 1 l2))
- (setf (aref (aref dist i) j)
- (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
- (mmin (in (1- i) j) (in i (1- j)) (in (1- i) (1- j)))))))
- (in l1 l2))))
+ (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil))
+ (number-sequence 1 (1+ l1)))))
+ (in (lambda (i j) (aref (aref dist i) j)))
+ (mmin (lambda (&rest lst) (apply #'min (remove nil lst)))))
+ (setf (aref (aref dist 0) 0) 0)
+ (dolist (i (number-sequence 1 l1))
+ (dolist (j (number-sequence 1 l2))
+ (setf (aref (aref dist i) j)
+ (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
+ (funcall mmin (funcall in (1- i) j)
+ (funcall in i (1- j))
+ (funcall in (1- i) (1- j)))))))
+ (funcall in l1 l2)))
+
+(defun org-babel-combine-header-arg-lists (original &rest others)
+ "Combine a number of lists of header argument names and arguments."
+ (let ((results (copy-sequence original)))
+ (dolist (new-list others)
+ (dolist (arg-pair new-list)
+ (let ((header (car arg-pair))
+ (args (cdr arg-pair)))
+ (setq results
+ (cons arg-pair (org-remove-if
+ (lambda (pair) (equal header (car pair)))
+ results))))))
+ results))
;;;###autoload
(defun org-babel-check-src-block ()
@@ -616,13 +662,13 @@ arguments and pop open the results in a preview buffer."
(dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1))
(and (org-babel-where-is-src-block-head)
(org-babel-parse-header-arguments
- (org-babel-clean-text-properties
+ (org-no-properties
(match-string 4))))))
(dolist (name names)
(when (and (not (string= header name))
(<= (org-babel-edit-distance header name) too-close)
(not (member header names)))
- (error "supplied header \"%S\" is suspiciously close to \"%S\""
+ (error "Supplied header \"%S\" is suspiciously close to \"%S\""
header name))))
(message "No suspicious header arguments found.")))
@@ -631,17 +677,15 @@ arguments and pop open the results in a preview buffer."
"Insert a header argument selecting from lists of common args and values."
(interactive)
(let* ((lang (car (org-babel-get-src-block-info 'light)))
- (lang-headers (intern (concat "org-babel-header-arg-names:" lang)))
- (headers (append (if (boundp lang-headers)
- (mapcar (lambda (h) (cons h :any))
- (eval lang-headers))
- nil)
- org-babel-common-header-args-w-values))
+ (lang-headers (intern (concat "org-babel-header-args:" lang)))
+ (headers (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values
+ (if (boundp lang-headers) (eval lang-headers) nil)))
(arg (org-icompleting-read
- "Header Arg: "
- (mapcar
- (lambda (header-spec) (symbol-name (car header-spec)))
- headers))))
+ "Header Arg: "
+ (mapcar
+ (lambda (header-spec) (symbol-name (car header-spec)))
+ headers))))
(insert ":" arg)
(let ((vals (cdr (assoc (intern arg) headers))))
(when vals
@@ -661,6 +705,30 @@ arguments and pop open the results in a preview buffer."
"")))
vals ""))))))))
+;; Add support for completing-read insertion of header arguments after ":"
+(defun org-babel-header-arg-expand ()
+ "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts."
+ (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head))
+ (org-babel-enter-header-arg-w-completion (match-string 2))))
+
+(defun org-babel-enter-header-arg-w-completion (&optional lang)
+ "Insert header argument appropriate for LANG with completion."
+ (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang)))
+ (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var)))
+ (headers-w-values (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values lang-headers))
+ (headers (mapcar #'symbol-name (mapcar #'car headers-w-values)))
+ (header (org-completing-read "Header Arg: " headers))
+ (args (cdr (assoc (intern header) headers-w-values)))
+ (arg (when (and args (listp args))
+ (org-completing-read
+ (format "%s: " header)
+ (mapcar #'symbol-name (apply #'append args))))))
+ (insert (concat header " " (or arg "")))
+ (cons header arg)))
+
+(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand)
+
;;;###autoload
(defun org-babel-load-in-session (&optional arg info)
"Load the body of the current source-code block.
@@ -672,8 +740,7 @@ session."
(lang (nth 0 info))
(params (nth 2 info))
(body (setf (nth 1 info)
- (if (and (cdr (assoc :noweb params))
- (string= "yes" (cdr (assoc :noweb params))))
+ (if (org-babel-noweb-p params :eval)
(org-babel-expand-noweb-references info)
(nth 1 info))))
(session (cdr (assoc :session params)))
@@ -691,7 +758,7 @@ session."
"Initiate session for current code block.
If called with a prefix argument then resolve any variable
references in the header arguments and assign these variables in
-the session. Copy the body of the code block to the kill ring."
+the session. Copy the body of the code block to the kill ring."
(interactive "P")
(let* ((info (or info (org-babel-get-src-block-info (not arg))))
(lang (nth 0 info))
@@ -718,7 +785,7 @@ the session. Copy the body of the code block to the kill ring."
;;;###autoload
(defun org-babel-switch-to-session (&optional arg info)
"Switch to the session of the current code block.
-Uses `org-babel-initiate-session' to start the session. If called
+Uses `org-babel-initiate-session' to start the session. If called
with a prefix argument then this is passed on to
`org-babel-initiate-session'."
(interactive "P")
@@ -731,18 +798,18 @@ with a prefix argument then this is passed on to
(defun org-babel-switch-to-session-with-code (&optional arg info)
"Switch to code buffer and display session."
(interactive "P")
- (flet ((swap-windows
- ()
- (let ((other-window-buffer (window-buffer (next-window))))
- (set-window-buffer (next-window) (current-buffer))
- (set-window-buffer (selected-window) other-window-buffer))
- (other-window 1)))
- (let ((info (org-babel-get-src-block-info))
- (org-src-window-setup 'reorganize-frame))
- (save-excursion
- (org-babel-switch-to-session arg info))
- (org-edit-src-code))
- (swap-windows)))
+ (let ((swap-windows
+ (lambda ()
+ (let ((other-window-buffer (window-buffer (next-window))))
+ (set-window-buffer (next-window) (current-buffer))
+ (set-window-buffer (selected-window) other-window-buffer))
+ (other-window 1)))
+ (info (org-babel-get-src-block-info))
+ (org-src-window-setup 'reorganize-frame))
+ (save-excursion
+ (org-babel-switch-to-session arg info))
+ (org-edit-src-code)
+ (funcall swap-windows)))
(defmacro org-babel-do-in-edit-buffer (&rest body)
"Evaluate BODY in edit buffer if there is a code block at point.
@@ -759,9 +826,9 @@ Return t if a code block was found at point, nil otherwise."
(defun org-babel-do-key-sequence-in-edit-buffer (key)
"Read key sequence and execute the command in edit buffer.
Enter a key sequence to be executed in the language major-mode
-edit buffer. For example, TAB will alter the contents of the
+edit buffer. For example, TAB will alter the contents of the
Org-mode code block according to the effect of TAB in the
-language major-mode buffer. For languages that support
+language major-mode buffer. For languages that support
interactive sessions, this can be used to send code from the Org
buffer to the session for evaluation using the native major-mode
evaluation mechanisms."
@@ -959,11 +1026,11 @@ the current subtree."
(setf (nth 2 info)
(sort (copy-sequence (nth 2 info))
(lambda (a b) (string< (car a) (car b)))))
- (labels ((rm (lst)
+ (let* ((rm (lambda (lst)
(dolist (p '("replace" "silent" "append" "prepend"))
(setq lst (remove p lst)))
- lst)
- (norm (arg)
+ lst))
+ (norm (lambda (arg)
(let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
(copy-sequence (cdr arg))
(cdr arg))))
@@ -973,19 +1040,19 @@ the current subtree."
(cond
((and (listp v) ; lists are sorted
(member (car arg) '(:result-params)))
- (sort (rm v) #'string<))
+ (sort (funcall rm v) #'string<))
((and (stringp v) ; strings are sorted
(member (car arg) '(:results :exports)))
- (mapconcat #'identity (sort (rm (split-string v))
+ (mapconcat #'identity (sort (funcall rm (split-string v))
#'string<) " "))
- (t v))))))
+ (t v)))))))
((lambda (hash)
(when (org-called-interactively-p 'interactive) (message hash)) hash)
(let ((it (format "%s-%s"
(mapconcat
#'identity
(delq nil (mapcar (lambda (arg)
- (let ((normalized (norm arg)))
+ (let ((normalized (funcall norm arg)))
(when normalized
(format "%S" normalized))))
(nth 2 info))) ":")
@@ -993,9 +1060,17 @@ the current subtree."
(sha1 it))))))
(defun org-babel-current-result-hash ()
- "Return the in-buffer hash associated with INFO."
+ "Return the current in-buffer hash."
+ (org-babel-where-is-src-block-result)
+ (org-no-properties (match-string 3)))
+
+(defun org-babel-set-current-result-hash (hash)
+ "Set the current in-buffer hash to HASH."
(org-babel-where-is-src-block-result)
- (org-babel-clean-text-properties (match-string 3)))
+ (save-excursion (goto-char (match-beginning 3))
+ ;; (mapc #'delete-overlay (overlays-at (point)))
+ (replace-match hash nil nil nil 3)
+ (org-babel-hide-hash)))
(defun org-babel-hide-hash ()
"Hide the hash in the current results line.
@@ -1136,22 +1211,23 @@ may be specified in the properties of the current outline entry."
(cons (intern (concat ":" header-arg))
(org-babel-read val))))
(mapcar
- 'symbol-name
- (append
- org-babel-header-arg-names
- (progn
- (setq sym (intern (concat "org-babel-header-arg-names:"
- lang)))
- (and (boundp sym) (eval sym)))))))))))
+ #'symbol-name
+ (mapcar
+ #'car
+ (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values
+ (progn
+ (setq sym (intern (concat "org-babel-header-args:" lang)))
+ (and (boundp sym) (eval sym))))))))))))
(defvar org-src-preserve-indentation)
(defun org-babel-parse-src-block-match ()
"Parse the results from a match of the `org-babel-src-block-regexp'."
(let* ((block-indentation (length (match-string 1)))
- (lang (org-babel-clean-text-properties (match-string 2)))
+ (lang (org-no-properties (match-string 2)))
(lang-headers (intern (concat "org-babel-default-header-args:" lang)))
(switches (match-string 3))
- (body (org-babel-clean-text-properties
+ (body (org-no-properties
(let* ((body (match-string 5))
(sub-length (- (length body) 1)))
(if (and (> sub-length 0)
@@ -1173,23 +1249,23 @@ may be specified in the properties of the current outline entry."
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-parse-header-arguments
- (org-babel-clean-text-properties (or (match-string 4) ""))))
+ (org-no-properties (or (match-string 4) ""))))
switches
block-indentation)))
(defun org-babel-parse-inline-src-block-match ()
"Parse the results from a match of the `org-babel-inline-src-block-regexp'."
- (let* ((lang (org-babel-clean-text-properties (match-string 2)))
+ (let* ((lang (org-no-properties (match-string 2)))
(lang-headers (intern (concat "org-babel-default-header-args:" lang))))
(list lang
(org-babel-strip-protective-commas
- (org-babel-clean-text-properties (match-string 5)) lang)
+ (org-no-properties (match-string 5)) lang)
(org-babel-merge-params
org-babel-default-inline-header-args
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-parse-header-arguments
- (org-babel-clean-text-properties (or (match-string 4) "")))))))
+ (org-no-properties (or (match-string 4) "")))))))
(defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS.
@@ -1197,43 +1273,44 @@ ALTS is a cons of two character options where each option may be
either the numeric code of a single character or a list of
character alternatives. For example to split on balanced
instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
- (flet ((matches (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))
- (matched (ch last)
- (if (consp alts)
- (and (matches ch (cdr alts))
- (matches last (car alts)))
- (matches ch alts))))
- (let ((balance 0) (quote nil) (partial nil) (lst nil) (last 0))
- (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]:
- (setq balance (+ balance
- (cond ((or (equal 91 ch) (equal 40 ch)) 1)
- ((or (equal 93 ch) (equal 41 ch)) -1)
- (t 0))))
- (when (and (equal 34 ch) (not (equal 92 last)))
- (setq quote (not quote)))
- (setq partial (cons ch partial))
- (when (and (= balance 0) (not quote) (matched ch last))
- (setq lst (cons (apply #'string (nreverse
- (if (consp alts)
- (cddr partial)
- (cdr partial))))
- lst))
- (setq partial nil))
- (setq last ch))
- (string-to-list string))
- (nreverse (cons (apply #'string (nreverse partial)) lst)))))
+ (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch))))
+ (matched (lambda (ch last)
+ (if (consp alts)
+ (and (funcall matches ch (cdr alts))
+ (funcall matches last (car alts)))
+ (funcall matches ch alts))))
+ (balance 0) (last 0)
+ quote partial lst)
+ (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]:
+ (setq balance (+ balance
+ (cond ((or (equal 91 ch) (equal 40 ch)) 1)
+ ((or (equal 93 ch) (equal 41 ch)) -1)
+ (t 0))))
+ (when (and (equal 34 ch) (not (equal 92 last)))
+ (setq quote (not quote)))
+ (setq partial (cons ch partial))
+ (when (and (= balance 0) (not quote) (funcall matched ch last))
+ (setq lst (cons (apply #'string (nreverse
+ (if (consp alts)
+ (cddr partial)
+ (cdr partial))))
+ lst))
+ (setq partial nil))
+ (setq last ch))
+ (string-to-list string))
+ (nreverse (cons (apply #'string (nreverse partial)) lst))))
(defun org-babel-join-splits-near-ch (ch list)
"Join splits where \"=\" is on either end of the split."
- (flet ((last= (str) (= ch (aref str (1- (length str)))))
- (first= (str) (= ch (aref str 0))))
+ (let ((last= (lambda (str) (= ch (aref str (1- (length str))))))
+ (first= (lambda (str) (= ch (aref str 0)))))
(reverse
(org-reduce (lambda (acc el)
- (let ((head (car acc)))
- (if (and head (or (last= head) (first= el)))
- (cons (concat head el) (cdr acc))
- (cons el acc))))
- list :initial-value nil))))
+ (let ((head (car acc)))
+ (if (and head (or (funcall last= head) (funcall first= el)))
+ (cons (concat head el) (cdr acc))
+ (cons el acc))))
+ list :initial-value nil))))
(defun org-babel-parse-header-arguments (arg-string)
"Parse a string of header arguments returning an alist."
@@ -1322,20 +1399,20 @@ names."
Return a cons cell, the `car' of which contains the TABLE less
colnames, and the `cdr' of which contains a list of the column
names. Note: this function removes any hlines in TABLE."
- (flet ((trans (table) (apply #'mapcar* #'list table)))
- (let* ((width (apply 'max
- (mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
- (table (trans (mapcar (lambda (row)
- (if (not (equal row 'hline))
- row
- (setq row '())
- (dotimes (n width)
- (setq row (cons 'hline row)))
- row))
- table))))
- (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
- (trans (cdr table)))
- (remove 'hline (car table))))))
+ (let* ((trans (lambda (table) (apply #'mapcar* #'list table)))
+ (width (apply 'max
+ (mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
+ (table (funcall trans (mapcar (lambda (row)
+ (if (not (equal row 'hline))
+ row
+ (setq row '())
+ (dotimes (n width)
+ (setq row (cons 'hline row)))
+ row))
+ table))))
+ (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
+ (funcall trans (cdr table)))
+ (remove 'hline (car table)))))
(defun org-babel-put-colnames (table colnames)
"Add COLNAMES to TABLE if they exist."
@@ -1410,7 +1487,7 @@ to the table for reinsertion to org-mode."
Return the point at the beginning of the current source
block. Specifically at the beginning of the #+BEGIN_SRC line.
If the point is not on a source block then return nil."
- (let ((initial (point)) top bottom)
+ (let ((initial (point)) (case-fold-search t) top bottom)
(or
(save-excursion ;; on a source name line or a #+header line
(beginning-of-line 1)
@@ -1418,7 +1495,8 @@ If the point is not on a source block then return nil."
(looking-at org-babel-multi-line-header-regexp))
(progn
(while (and (forward-line 1)
- (looking-at org-babel-multi-line-header-regexp)))
+ (or (looking-at org-babel-src-name-regexp)
+ (looking-at org-babel-multi-line-header-regexp))))
(looking-at org-babel-src-block-regexp))
(point)))
(save-excursion ;; on a #+begin_src line
@@ -1439,26 +1517,49 @@ If the point is not on a source block then return nil."
"Go to the beginning of the current code block."
(interactive)
((lambda (head)
- (if head (goto-char head) (error "not currently in a code block")))
+ (if head (goto-char head) (error "Not currently in a code block")))
(org-babel-where-is-src-block-head)))
;;;###autoload
(defun org-babel-goto-named-src-block (name)
"Go to a named source-code block."
(interactive
- (let ((completion-ignore-case t))
- (list (org-icompleting-read "source-block name: "
- (org-babel-src-block-names) nil t))))
+ (let ((completion-ignore-case t)
+ (case-fold-search t)
+ (under-point (thing-at-point 'line)))
+ (list (org-icompleting-read
+ "source-block name: " (org-babel-src-block-names) nil t
+ (cond
+ ;; noweb
+ ((string-match (org-babel-noweb-wrap) under-point)
+ (let ((block-name (match-string 1 under-point)))
+ (string-match "[^(]*" block-name)
+ (match-string 0 block-name)))
+ ;; #+call:
+ ((string-match org-babel-lob-one-liner-regexp under-point)
+ (let ((source-info (car (org-babel-lob-get-info))))
+ (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info)
+ (let ((source-name (match-string 1 source-info)))
+ source-name))))
+ ;; #+results:
+ ((string-match (concat "#\\+" org-babel-results-keyword
+ "\\:\s+\\([^\\(]*\\)") under-point)
+ (match-string 1 under-point))
+ ;; symbol-at-point
+ ((and (thing-at-point 'symbol))
+ (org-babel-find-named-block (thing-at-point 'symbol))
+ (thing-at-point 'symbol))
+ (""))))))
(let ((point (org-babel-find-named-block name)))
(if point
;; taken from `org-open-at-point'
- (progn (goto-char point) (org-show-context))
+ (progn (org-mark-ring-push) (goto-char point) (org-show-context))
(message "source-code block '%s' not found in this buffer" name))))
(defun org-babel-find-named-block (name)
"Find a named source-code block.
Return the location of the source block identified by source
-NAME, or nil if no such block exists. Set match data according to
+NAME, or nil if no such block exists. Set match data according to
org-babel-named-src-block-regexp."
(save-excursion
(let ((case-fold-search t)
@@ -1472,7 +1573,7 @@ org-babel-named-src-block-regexp."
"Returns the names of source blocks in FILE or the current buffer."
(save-excursion
(when file (find-file file)) (goto-char (point-min))
- (let (names)
+ (let ((case-fold-search t) names)
(while (re-search-forward org-babel-src-name-w-name-regexp nil t)
(setq names (cons (match-string 3) names)))
names)))
@@ -1495,23 +1596,24 @@ org-babel-named-src-block-regexp."
Return the location of the result named NAME in the current
buffer or nil if no such result exists."
(save-excursion
- (goto-char (or point (point-min)))
- (catch 'is-a-code-block
- (when (re-search-forward
- (concat org-babel-result-regexp
- "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t)
- (when (and (string= "name" (downcase (match-string 1)))
- (or (beginning-of-line 1)
- (looking-at org-babel-src-block-regexp)
- (looking-at org-babel-multi-line-header-regexp)))
- (throw 'is-a-code-block (org-babel-find-named-result name (point))))
- (beginning-of-line 0) (point)))))
+ (let ((case-fold-search t))
+ (goto-char (or point (point-min)))
+ (catch 'is-a-code-block
+ (when (re-search-forward
+ (concat org-babel-result-regexp
+ "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t)
+ (when (and (string= "name" (downcase (match-string 1)))
+ (or (beginning-of-line 1)
+ (looking-at org-babel-src-block-regexp)
+ (looking-at org-babel-multi-line-header-regexp)))
+ (throw 'is-a-code-block (org-babel-find-named-result name (point))))
+ (beginning-of-line 0) (point))))))
(defun org-babel-result-names (&optional file)
"Returns the names of results in FILE or the current buffer."
(save-excursion
(when file (find-file file)) (goto-char (point-min))
- (let (names)
+ (let ((case-fold-search t) names)
(while (re-search-forward org-babel-result-w-name-regexp nil t)
(setq names (cons (match-string 4) names)))
names)))
@@ -1541,7 +1643,7 @@ With optional prefix argument ARG, jump backward ARG many source blocks."
;;;###autoload
(defun org-babel-mark-block ()
- "Mark current src block"
+ "Mark current src block."
(interactive)
((lambda (head)
(when head
@@ -1585,13 +1687,13 @@ region is not active then the point is demarcated."
""
(concat "\n" (make-string (current-column) ? )))))))
(move-end-of-line 2))
- (sort (if (region-active-p) (list (mark) (point)) (list (point))) #'>))
+ (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
(let ((start (point))
(lang (org-icompleting-read "Lang: "
(mapcar (lambda (el) (symbol-name (car el)))
org-babel-load-languages)))
(body (delete-and-extract-region
- (if (region-active-p) (mark) (point)) (point))))
+ (if (org-region-active-p) (mark) (point)) (point))))
(insert (concat (if (looking-at "^") "" "\n")
(if arg (concat stars "\n") "")
"#+begin_src " lang "\n"
@@ -1609,11 +1711,12 @@ source block. Specifically at the beginning of the results line.
If no result exists for this block then create a results line
following the source block."
(save-excursion
- (let* ((on-lob-line (save-excursion
+ (let* ((case-fold-search t)
+ (on-lob-line (save-excursion
(beginning-of-line 1)
(looking-at org-babel-lob-one-liner-regexp)))
(inlinep (when (org-babel-get-inline-src-block-matches)
- (match-end 0)))
+ (match-end 0)))
(name (if on-lob-line
(mapconcat #'identity (butlast (org-babel-lob-get-info)) "")
(nth 4 (or info (org-babel-get-src-block-info 'light)))))
@@ -1722,7 +1825,7 @@ If the path of the link is a file path it is expanded using
`expand-file-name'."
(let* ((case-fold-search t)
(raw (and (looking-at org-bracket-link-regexp)
- (org-babel-clean-text-properties (match-string 1))))
+ (org-no-properties (match-string 1))))
(type (and (string-match org-link-types-re raw)
(match-string 1 raw))))
(cond
@@ -1734,17 +1837,13 @@ If the path of the link is a file path it is expanded using
(defun org-babel-format-result (result &optional sep)
"Format RESULT for writing to file."
- (flet ((echo-res (result)
- (if (stringp result) result (format "%S" result))))
+ (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r)))))
(if (listp result)
;; table result
(orgtbl-to-generic
- result
- (list
- :sep (or sep "\t")
- :fmt 'echo-res))
+ result (list :sep (or sep "\t") :fmt echo-res))
;; scalar result
- (echo-res result))))
+ (funcall echo-res result))))
(defun org-babel-insert-result
(result &optional result-params info hash indent lang)
@@ -1752,7 +1851,7 @@ If the path of the link is a file path it is expanded using
By default RESULT is inserted after the end of the
current source block. With optional argument RESULT-PARAMS
controls insertion of results in the org-mode file.
-RESULT-PARAMS can take the following values...
+RESULT-PARAMS can take the following values:
replace - (default option) insert results after the source block
replacing any previously inserted results
@@ -1768,16 +1867,13 @@ raw ----- results are added directly to the Org-mode file. This
is a good option if you code block will output org-mode
formatted text.
-wrap ---- results are added directly to the Org-mode file as with
+drawer -- results are added directly to the Org-mode file as with
\"raw\", but are wrapped in a RESULTS drawer, allowing
them to later be replaced or removed automatically.
-org ----- similar in effect to raw, only the results are wrapped
- in an org code block. Similar to the raw option, on
- export the results will be interpreted as org-formatted
- text, however by wrapping the results in an org code
- block they can be replaced upon re-execution of the
- code block.
+org ----- results are added inside of a \"#+BEGIN_SRC org\" block.
+ They are not comma-escaped when inserted, but Org syntax
+ here will be discarded when exporting the file.
html ---- results are added inside of a #+BEGIN_HTML block. This
is a good option if you code block will output html
@@ -1794,9 +1890,12 @@ code ---- the results are extracted in the syntax of the source
optional LANG argument."
(if (stringp result)
(progn
- (setq result (org-babel-clean-text-properties result))
+ (setq result (org-no-properties result))
(when (member "file" result-params)
- (setq result (org-babel-result-to-file result))))
+ (setq result (org-babel-result-to-file
+ result (when (assoc :file-desc (nth 2 info))
+ (or (cdr (assoc :file-desc (nth 2 info)))
+ result))))))
(unless (listp result) (setq result (format "%S" result))))
(if (and result-params (member "silent" result-params))
(progn
@@ -1838,12 +1937,13 @@ code ---- the results are extracted in the syntax of the source
((member "prepend" result-params)))) ; already there
(setq results-switches
(if results-switches (concat " " results-switches) ""))
- (flet ((wrap (start finish)
- (goto-char end) (insert (concat finish "\n"))
- (goto-char beg) (insert (concat start "\n"))
- (goto-char end) (goto-char (point-at-eol))
- (setq end (point-marker)))
- (proper-list-p (it) (and (listp it) (null (cdr (last it))))))
+ (let ((wrap (lambda (start finish &optional escape)
+ (goto-char end) (insert (concat finish "\n"))
+ (goto-char beg) (insert (concat start "\n"))
+ (if escape (org-add-protective-commas (point) end))
+ (goto-char end) (goto-char (point-at-eol))
+ (setq end (point-marker))))
+ (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it)))))))
;; insert results based on type
(cond
;; do nothing for an empty result
@@ -1860,7 +1960,7 @@ code ---- the results are extracted in the syntax of the source
'(:splicep nil :istart "- " :iend "\n")))
"\n"))
;; assume the result is a table if it's not a string
- ((proper-list-p result)
+ ((funcall proper-list-p result)
(goto-char beg)
(insert (concat (orgtbl-to-orgtbl
(if (or (eq 'hline (car result))
@@ -1869,30 +1969,35 @@ code ---- the results are extracted in the syntax of the source
result (list result))
'(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
(goto-char beg) (when (org-at-table-p) (org-table-align)))
- ((and (listp result) (not (proper-list-p result)))
+ ((and (listp result) (not (funcall proper-list-p result)))
(insert (format "%s\n" result)))
((member "file" result-params)
(when inlinep (goto-char inlinep))
(insert result))
(t (goto-char beg) (insert result)))
- (when (proper-list-p result) (goto-char (org-table-end)))
+ (when (funcall proper-list-p result) (goto-char (org-table-end)))
(setq end (point-marker))
;; possibly wrap result
(cond
+ ((assoc :wrap (nth 2 info))
+ (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS")))
+ (funcall wrap (concat "#+BEGIN_" name) (concat "#+END_" name))))
((member "html" result-params)
- (wrap "#+BEGIN_HTML" "#+END_HTML"))
+ (funcall wrap "#+BEGIN_HTML" "#+END_HTML"))
((member "latex" result-params)
- (wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
- ((member "code" result-params)
- (wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
- "#+END_SRC"))
+ (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
((member "org" result-params)
- (wrap "#+BEGIN_ORG" "#+END_ORG"))
+ (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" 'escape))
+ ((member "code" result-params)
+ (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
+ "#+END_SRC"))
((member "raw" result-params)
(goto-char beg) (if (org-at-table-p) (org-cycle)))
- ((member "wrap" result-params)
- (wrap ":RESULTS:" ":END:"))
- ((and (not (proper-list-p result))
+ ((or (member "drawer" result-params)
+ ;; Stay backward compatible with <7.9.2
+ (member "wrap" result-params))
+ (funcall wrap ":RESULTS:" ":END:"))
+ ((and (not (funcall proper-list-p result))
(not (member "file" result-params)))
(org-babel-examplize-region beg end results-switches)
(setq end (point)))))
@@ -1919,44 +2024,40 @@ code ---- the results are extracted in the syntax of the source
(delete-region start (org-babel-result-end))))))
(defun org-babel-result-end ()
- "Return the point at the end of the current set of results"
+ "Return the point at the end of the current set of results."
(save-excursion
(cond
((org-at-table-p) (progn (goto-char (org-table-end)) (point)))
((org-at-item-p) (let* ((struct (org-list-struct))
(prvs (org-list-prevs-alist struct)))
(org-list-get-list-end (point-at-bol) struct prvs)))
- ((looking-at "^\\([ \t]*\\):RESULTS:")
+ ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:"))
(progn (re-search-forward (concat "^" (match-string 1) ":END:"))
(forward-char 1) (point)))
(t
- (let ((case-fold-search t)
- (blocks-re (regexp-opt
- (list "latex" "html" "example" "src" "result" "org"))))
- (if (looking-at (concat "[ \t]*#\\+begin_" blocks-re))
- (progn (re-search-forward (concat "[ \t]*#\\+end_" blocks-re) nil t)
+ (let ((case-fold-search t))
+ (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)"))
+ (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1))
+ nil t)
(forward-char 1))
(while (looking-at "[ \t]*\\(: \\|\\[\\[\\)")
(forward-line 1))))
(point)))))
-(defun org-babel-result-to-file (result)
- "Convert RESULT into an `org-mode' link.
+(defun org-babel-result-to-file (result &optional description)
+ "Convert RESULT into an `org-mode' link with optional DESCRIPTION.
If the `default-directory' is different from the containing
file's directory then expand relative links."
- (flet ((cond-exp (file)
- (if (and default-directory
- buffer-file-name
- (not (string= (expand-file-name default-directory)
- (expand-file-name
- (file-name-directory buffer-file-name)))))
- (expand-file-name file default-directory)
- file)))
- (if (stringp result)
- (format "[[file:%s]]" (cond-exp result))
- (when (and (listp result) (= 2 (length result))
- (stringp (car result)) (stringp (cadr result)))
- (format "[[file:%s][%s]]" (car result) (cadr result))))))
+ (when (stringp result)
+ (format "[[file:%s]%s]"
+ (if (and default-directory
+ buffer-file-name
+ (not (string= (expand-file-name default-directory)
+ (expand-file-name
+ (file-name-directory buffer-file-name)))))
+ (expand-file-name result default-directory)
+ result)
+ (if description (concat "[" description "]") ""))))
(defvar org-babel-capitalize-examplize-region-markers nil
"Make true to capitalize begin/end example markers inserted by code blocks.")
@@ -1964,12 +2065,12 @@ file's directory then expand relative links."
(defun org-babel-examplize-region (beg end &optional results-switches)
"Comment out region using the inline '==' or ': ' org example quote."
(interactive "*r")
- (flet ((chars-between (b e)
- (not (string-match "^[\\s]*$" (buffer-substring b e))))
- (maybe-cap (str) (if org-babel-capitalize-examplize-region-markers
- (upcase str) str)))
- (if (or (chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
- (chars-between end (save-excursion (goto-char end) (point-at-eol))))
+ (let ((chars-between (lambda (b e)
+ (not (string-match "^[\\s]*$" (buffer-substring b e)))))
+ (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers
+ (upcase str) str))))
+ (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
+ (funcall chars-between end (save-excursion (goto-char end) (point-at-eol))))
(save-excursion
(goto-char beg)
(insert (format "=%s=" (prog1 (buffer-substring beg end)
@@ -1985,16 +2086,16 @@ file's directory then expand relative links."
(goto-char beg)
(insert (if results-switches
(format "%s%s\n"
- (maybe-cap "#+begin_example")
+ (funcall maybe-cap "#+begin_example")
results-switches)
- (maybe-cap "#+begin_example\n")))
+ (funcall maybe-cap "#+begin_example\n")))
(if (markerp end) (goto-char end) (forward-char (- end beg)))
- (insert (maybe-cap "#+end_example\n")))))))))
+ (insert (funcall maybe-cap "#+end_example\n")))))))))
(defun org-babel-update-block-body (new-body)
"Update the body of the current code block to NEW-BODY."
(if (not (org-babel-where-is-src-block-head))
- (error "not in source block")
+ (error "Not in a source block")
(save-match-data
(replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5))
(indent-rigidly (match-beginning 5) (match-end 5) 2)))
@@ -2004,104 +2105,108 @@ file's directory then expand relative links."
Later elements of PLISTS override the values of previous elements.
This takes into account some special considerations for certain
parameters when merging lists."
- (let ((results-exclusive-groups
- (mapcar (lambda (group) (mapcar #'symbol-name group))
- (cdr (assoc 'results org-babel-common-header-args-w-values))))
- (exports-exclusive-groups
- (mapcar (lambda (group) (mapcar #'symbol-name group))
- (cdr (assoc 'exports org-babel-common-header-args-w-values))))
- (variable-index 0)
- params results exports tangle noweb cache vars shebang comments padline)
- (flet ((e-merge (exclusive-groups &rest result-params)
- ;; maintain exclusivity of mutually exclusive parameters
- (let (output)
- (mapc (lambda (new-params)
- (mapc (lambda (new-param)
- (mapc (lambda (exclusive-group)
- (when (member new-param exclusive-group)
- (mapcar (lambda (excluded-param)
- (setq output
- (delete
- excluded-param
- output)))
- exclusive-group)))
- exclusive-groups)
- (setq output (org-uniquify
- (cons new-param output))))
- new-params))
- result-params)
- output)))
- (mapc
- (lambda (plist)
- (mapc
- (lambda (pair)
- (case (car pair)
- (:var
- (let ((name (if (listp (cdr pair))
- (cadr pair)
- (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
- (cdr pair))
- (intern (match-string 1 (cdr pair)))))))
- (if name
- (setq vars
- (append
- (if (member name (mapcar #'car vars))
- (delq nil
- (mapcar
- (lambda (p)
- (unless (equal (car p) name) p))
- vars))
- vars)
- (list (cons name pair))))
- ;; if no name is given and we already have named variables
- ;; then assign to named variables in order
- (if (and vars (nth variable-index vars))
- (prog1 (setf (cddr (nth variable-index vars))
- (concat (symbol-name
- (car (nth variable-index vars)))
- "=" (cdr pair)))
- (incf variable-index))
- (error "variable \"%s\" must be assigned a default value"
- (cdr pair))))))
- (:results
- (setq results (e-merge results-exclusive-groups
- results
- (split-string
- (let ((r (cdr pair)))
- (if (stringp r) r (eval r)))))))
- (:file
- (when (cdr pair)
- (setq results (e-merge results-exclusive-groups
- results '("file")))
- (unless (or (member "both" exports)
- (member "none" exports)
- (member "code" exports))
- (setq exports (e-merge exports-exclusive-groups
- exports '("results"))))
- (setq params (cons pair (assq-delete-all (car pair) params)))))
- (:exports
- (setq exports (e-merge exports-exclusive-groups
- exports (split-string (cdr pair)))))
- (:tangle ;; take the latest -- always overwrite
- (setq tangle (or (list (cdr pair)) tangle)))
- (:noweb
- (setq noweb (e-merge '(("yes" "no" "tangle")) noweb
- (split-string (or (cdr pair) "")))))
- (:cache
- (setq cache (e-merge '(("yes" "no")) cache
+ (let* ((results-exclusive-groups
+ (mapcar (lambda (group) (mapcar #'symbol-name group))
+ (cdr (assoc 'results org-babel-common-header-args-w-values))))
+ (exports-exclusive-groups
+ (mapcar (lambda (group) (mapcar #'symbol-name group))
+ (cdr (assoc 'exports org-babel-common-header-args-w-values))))
+ (variable-index 0)
+ (e-merge (lambda (exclusive-groups &rest result-params)
+ ;; maintain exclusivity of mutually exclusive parameters
+ (let (output)
+ (mapc (lambda (new-params)
+ (mapc (lambda (new-param)
+ (mapc (lambda (exclusive-group)
+ (when (member new-param exclusive-group)
+ (mapcar (lambda (excluded-param)
+ (setq output
+ (delete
+ excluded-param
+ output)))
+ exclusive-group)))
+ exclusive-groups)
+ (setq output (org-uniquify
+ (cons new-param output))))
+ new-params))
+ result-params)
+ output)))
+ params results exports tangle noweb cache vars shebang comments padline)
+
+ (mapc
+ (lambda (plist)
+ (mapc
+ (lambda (pair)
+ (case (car pair)
+ (:var
+ (let ((name (if (listp (cdr pair))
+ (cadr pair)
+ (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
+ (cdr pair))
+ (intern (match-string 1 (cdr pair)))))))
+ (if name
+ (setq vars
+ (append
+ (if (member name (mapcar #'car vars))
+ (delq nil
+ (mapcar
+ (lambda (p)
+ (unless (equal (car p) name) p))
+ vars))
+ vars)
+ (list (cons name pair))))
+ ;; if no name is given and we already have named variables
+ ;; then assign to named variables in order
+ (if (and vars (nth variable-index vars))
+ (prog1 (setf (cddr (nth variable-index vars))
+ (concat (symbol-name
+ (car (nth variable-index vars)))
+ "=" (cdr pair)))
+ (incf variable-index))
+ (error "Variable \"%s\" must be assigned a default value"
+ (cdr pair))))))
+ (:results
+ (setq results (funcall e-merge results-exclusive-groups
+ results
+ (split-string
+ (let ((r (cdr pair)))
+ (if (stringp r) r (eval r)))))))
+ (:file
+ (when (cdr pair)
+ (setq results (funcall e-merge results-exclusive-groups
+ results '("file")))
+ (unless (or (member "both" exports)
+ (member "none" exports)
+ (member "code" exports))
+ (setq exports (funcall e-merge exports-exclusive-groups
+ exports '("results"))))
+ (setq params (cons pair (assq-delete-all (car pair) params)))))
+ (:exports
+ (setq exports (funcall e-merge exports-exclusive-groups
+ exports (split-string (cdr pair)))))
+ (:tangle ;; take the latest -- always overwrite
+ (setq tangle (or (list (cdr pair)) tangle)))
+ (:noweb
+ (setq noweb (funcall e-merge
+ '(("yes" "no" "tangle" "no-export"
+ "strip-export" "eval"))
+ noweb
+ (split-string (or (cdr pair) "")))))
+ (:cache
+ (setq cache (funcall e-merge '(("yes" "no")) cache
+ (split-string (or (cdr pair) "")))))
+ (:padline
+ (setq padline (funcall e-merge '(("yes" "no")) padline
(split-string (or (cdr pair) "")))))
- (:padline
- (setq padline (e-merge '(("yes" "no")) padline
- (split-string (or (cdr pair) "")))))
- (:shebang ;; take the latest -- always overwrite
- (setq shebang (or (list (cdr pair)) shebang)))
- (:comments
- (setq comments (e-merge '(("yes" "no")) comments
- (split-string (or (cdr pair) "")))))
- (t ;; replace: this covers e.g. :session
- (setq params (cons pair (assq-delete-all (car pair) params))))))
- plist))
- plists))
+ (:shebang ;; take the latest -- always overwrite
+ (setq shebang (or (list (cdr pair)) shebang)))
+ (:comments
+ (setq comments (funcall e-merge '(("yes" "no")) comments
+ (split-string (or (cdr pair) "")))))
+ (t ;; replace: this covers e.g. :session
+ (setq params (cons pair (assq-delete-all (car pair) params))))))
+ plist))
+ plists)
(setq vars (reverse vars))
(while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
(mapc
@@ -2118,6 +2223,21 @@ This results in much faster noweb reference expansion but does
not properly allow code blocks to inherit the \":noweb-ref\"
header argument from buffer or subtree wide properties.")
+(defun org-babel-noweb-p (params context)
+ "Check if PARAMS require expansion in CONTEXT.
+CONTEXT may be one of :tangle, :export or :eval."
+ (let* (intersect
+ (intersect (lambda (as bs)
+ (when as
+ (if (member (car as) bs)
+ (car as)
+ (funcall intersect (cdr as) bs))))))
+ (funcall intersect (case context
+ (:tangle '("yes" "tangle" "no-export" "strip-export"))
+ (:eval '("yes" "no-export" "strip-export" "eval"))
+ (:export '("yes")))
+ (split-string (or (cdr (assoc :noweb params)) "")))))
+
(defun org-babel-expand-noweb-references (&optional info parent-buffer)
"Expand Noweb references in the body of the current source code block.
@@ -2152,105 +2272,104 @@ block but are passed literally to the \"example-block\"."
(info (or info (org-babel-get-src-block-info)))
(lang (nth 0 info))
(body (nth 1 info))
+ (ob-nww-start org-babel-noweb-wrap-start)
+ (ob-nww-end org-babel-noweb-wrap-end)
(comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
(rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
":noweb-ref[ \t]+" "\\)"))
- (new-body "") index source-name evaluate prefix blocks-in-buffer)
- (flet ((nb-add (text) (setq new-body (concat new-body text)))
- (c-wrap (text)
+ (new-body "")
+ (nb-add (lambda (text) (setq new-body (concat new-body text))))
+ (c-wrap (lambda (text)
(with-temp-buffer
(funcall (intern (concat lang "-mode")))
(comment-region (point) (progn (insert text) (point)))
(org-babel-trim (buffer-string)))))
- (with-temp-buffer
- (insert body) (goto-char (point-min))
- (setq index (point))
- (while (and (re-search-forward "<<\\([^ \t\n].+?[^ \t\n]\\|[^ \t\n]\\)>>"
- nil t))
- (save-match-data (setf source-name (match-string 1)))
- (save-match-data (setq evaluate (string-match "\(.*\)" source-name)))
- (save-match-data
- (setq prefix
- (buffer-substring (match-beginning 0)
- (save-excursion
- (beginning-of-line 1) (point)))))
- ;; add interval to new-body (removing noweb reference)
- (goto-char (match-beginning 0))
- (nb-add (buffer-substring index (point)))
- (goto-char (match-end 0))
- (setq index (point))
- (nb-add
- (with-current-buffer parent-buffer
- (save-restriction
- (widen)
- (mapconcat ;; interpose PREFIX between every line
- #'identity
- (split-string
- (if evaluate
- (let ((raw (org-babel-ref-resolve source-name)))
- (if (stringp raw) raw (format "%S" raw)))
- (or
- ;; retrieve from the library of babel
- (nth 2 (assoc (intern source-name)
- org-babel-library-of-babel))
- ;; return the contents of headlines literally
- (save-excursion
- (when (org-babel-ref-goto-headline-id source-name)
- (org-babel-ref-headline-body)))
- ;; find the expansion of reference in this buffer
- (let ((rx (concat rx-prefix source-name "[ \t\n]"))
- expansion)
- (save-excursion
- (goto-char (point-min))
- (if *org-babel-use-quick-and-dirty-noweb-expansion*
- (while (re-search-forward rx nil t)
- (let* ((i (org-babel-get-src-block-info 'light))
- (body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
- "\n"))
- (full (if comment
- ((lambda (cs)
- (concat (c-wrap (car cs)) "\n"
- body "\n"
- (c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- body)))
- (setq expansion (cons sep (cons full expansion)))))
- (org-babel-map-src-blocks nil
- (let ((i (org-babel-get-src-block-info 'light)))
- (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
- (nth 4 i))
- source-name)
- (let* ((body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
- "\n"))
- (full (if comment
- ((lambda (cs)
- (concat (c-wrap (car cs)) "\n"
- body "\n"
- (c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- body)))
- (setq expansion
- (cons sep (cons full expansion)))))))))
- (and expansion
- (mapconcat #'identity (nreverse (cdr expansion)) "")))
- ;; possibly raise an error if named block doesn't exist
- (if (member lang org-babel-noweb-error-langs)
- (error "%s" (concat
- "<<" source-name ">> "
- "could not be resolved (see "
- "`org-babel-noweb-error-langs')"))
- "")))
- "[\n\r]") (concat "\n" prefix))))))
- (nb-add (buffer-substring index (point-max)))))
+ index source-name evaluate prefix blocks-in-buffer)
+ (with-temp-buffer
+ (org-set-local 'org-babel-noweb-wrap-start ob-nww-start)
+ (org-set-local 'org-babel-noweb-wrap-end ob-nww-end)
+ (insert body) (goto-char (point-min))
+ (setq index (point))
+ (while (and (re-search-forward (org-babel-noweb-wrap) nil t))
+ (save-match-data (setf source-name (match-string 1)))
+ (save-match-data (setq evaluate (string-match "\(.*\)" source-name)))
+ (save-match-data
+ (setq prefix
+ (buffer-substring (match-beginning 0)
+ (save-excursion
+ (beginning-of-line 1) (point)))))
+ ;; add interval to new-body (removing noweb reference)
+ (goto-char (match-beginning 0))
+ (funcall nb-add (buffer-substring index (point)))
+ (goto-char (match-end 0))
+ (setq index (point))
+ (funcall nb-add
+ (with-current-buffer parent-buffer
+ (save-restriction
+ (widen)
+ (mapconcat ;; interpose PREFIX between every line
+ #'identity
+ (split-string
+ (if evaluate
+ (let ((raw (org-babel-ref-resolve source-name)))
+ (if (stringp raw) raw (format "%S" raw)))
+ (or
+ ;; retrieve from the library of babel
+ (nth 2 (assoc (intern source-name)
+ org-babel-library-of-babel))
+ ;; return the contents of headlines literally
+ (save-excursion
+ (when (org-babel-ref-goto-headline-id source-name)
+ (org-babel-ref-headline-body)))
+ ;; find the expansion of reference in this buffer
+ (let ((rx (concat rx-prefix source-name "[ \t\n]"))
+ expansion)
+ (save-excursion
+ (goto-char (point-min))
+ (if *org-babel-use-quick-and-dirty-noweb-expansion*
+ (while (re-search-forward rx nil t)
+ (let* ((i (org-babel-get-src-block-info 'light))
+ (body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ ((lambda (cs)
+ (concat (funcall c-wrap (car cs)) "\n"
+ body "\n"
+ (funcall c-wrap (cadr cs))))
+ (org-babel-tangle-comment-links i))
+ body)))
+ (setq expansion (cons sep (cons full expansion)))))
+ (org-babel-map-src-blocks nil
+ (let ((i (org-babel-get-src-block-info 'light)))
+ (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
+ (nth 4 i))
+ source-name)
+ (let* ((body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ ((lambda (cs)
+ (concat (funcall c-wrap (car cs)) "\n"
+ body "\n"
+ (funcall c-wrap (cadr cs))))
+ (org-babel-tangle-comment-links i))
+ body)))
+ (setq expansion
+ (cons sep (cons full expansion)))))))))
+ (and expansion
+ (mapconcat #'identity (nreverse (cdr expansion)) "")))
+ ;; possibly raise an error if named block doesn't exist
+ (if (member lang org-babel-noweb-error-langs)
+ (error "%s" (concat
+ (org-babel-noweb-wrap source-name)
+ "could not be resolved (see "
+ "`org-babel-noweb-error-langs')"))
+ "")))
+ "[\n\r]") (concat "\n" prefix))))))
+ (funcall nb-add (buffer-substring index (point-max))))
new-body))
-(defun org-babel-clean-text-properties (text)
- "Strip all properties from text return."
- (when text
- (set-text-properties 0 (length text) nil text) text))
-
(defun org-babel-strip-protective-commas (body &optional lang)
"Strip protective commas from bodies of source blocks."
(with-temp-buffer
@@ -2340,14 +2459,14 @@ If the table is trivial, then return it as a scalar."
(let (result)
(save-window-excursion
(with-temp-buffer
- (condition-case nil
+ (condition-case err
(progn
(org-table-import file-name separator)
(delete-file file-name)
(setq result (mapcar (lambda (row)
(mapcar #'org-babel-string-read row))
(org-table-to-lisp))))
- (error nil)))
+ (error (message "Error reading results: %s" err) nil)))
(if (null (cdr result)) ;; if result is trivial vector, then scalarize it
(if (consp (car result))
(if (null (cdr (car result)))
@@ -2361,7 +2480,7 @@ If the table is trivial, then return it as a scalar."
(org-babel-read (or (and (stringp cell)
(string-match "\\\"\\(.+\\)\\\"" cell)
(match-string 1 cell))
- cell)))
+ cell) t))
(defun org-babel-reverse-string (string)
"Return the reverse of STRING."
@@ -2388,7 +2507,7 @@ of the string."
(defvar org-babel-org-babel-call-process-region-original nil)
(defun org-babel-tramp-handle-call-process-region
(start end program &optional delete buffer display &rest args)
- "Use tramp to handle call-process-region.
+ "Use Tramp to handle `call-process-region'.
Fixes a bug in `tramp-handle-call-process-region'."
(if (and (featurep 'tramp) (file-remote-p default-directory))
(let ((tmpfile (tramp-compat-make-temp-file "")))
@@ -2400,7 +2519,7 @@ Fixes a bug in `tramp-handle-call-process-region'."
(apply 'process-file program tmpfile buffer display args)
(delete-file tmpfile)))
;; org-babel-call-process-region-original is the original emacs
- ;; definition. It is in scope from the let binding in
+ ;; definition. It is in scope from the let binding in
;; org-babel-execute-src-block
(apply org-babel-call-process-region-original
start end program delete buffer display args)))
@@ -2410,17 +2529,16 @@ Fixes a bug in `tramp-handle-call-process-region'."
(if (file-remote-p file)
(let (localname)
(with-parsed-tramp-file-name file nil
- localname))
+ localname))
file))
(defun org-babel-process-file-name (name &optional no-quote-p)
"Prepare NAME to be used in an external process.
If NAME specifies a remote location, the remote portion of the
name is removed, since in that case the process will be executing
-remotely. The file name is then processed by
-`expand-file-name'. Unless second argument NO-QUOTE-P is non-nil,
-the file name is additionally processed by
-`shell-quote-argument'"
+remotely. The file name is then processed by `expand-file-name'.
+Unless second argument NO-QUOTE-P is non-nil, the file name is
+additionally processed by `shell-quote-argument'"
((lambda (f) (if no-quote-p f (shell-quote-argument f)))
(expand-file-name (org-babel-local-file-name name))))
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 2b4a001979b..32fecde2af0 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -29,15 +29,15 @@
;; The functions `org-batch-agenda', `org-batch-agenda-csv', and
;; `org-batch-store-agenda-views' are implemented as macros to provide
;; a convenient way for extracting agenda information from the command
-;; line. The Lisp does not evaluate parameters of a macro call; thus
+;; line. The Lisp does not evaluate parameters of a macro call; thus
;; it is not necessary to quote the parameters passed to one of those
-;; functions. E.g. you can write:
+;; functions. E.g. you can write:
;;
;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)'
;;
-;; To export an agenda spanning 7 days. If `org-batch-agenda' would
+;; To export an agenda spanning 7 days. If `org-batch-agenda' would
;; have been implemented as a regular function you'd have to quote the
-;; symbol org-agenda-span. Moreover: To use a symbol as parameter
+;; symbol org-agenda-span. Moreover: To use a symbol as parameter
;; value you would have to double quote the symbol.
;;
;; This is a hack, but it works even when running Org byte-compiled.
@@ -46,6 +46,7 @@
;;; Code:
(require 'org)
+(require 'org-macs)
(eval-when-compile
(require 'cl))
@@ -80,23 +81,30 @@
(declare-function org-habit-get-priority "org-habit" (habit &optional moment))
(declare-function org-pop-to-buffer-same-window "org-compat"
(&optional buffer-or-name norecord label))
-
-(defvar calendar-mode-map)
-(defvar org-clock-current-task) ; defined in org-clock.el
-(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el
-(defvar org-habit-show-habits)
+(declare-function org-agenda-columns "org-colview" ())
+(declare-function org-add-archive-files "org-archive" (files))
+(declare-function org-capture "org-capture" (&optional goto keys))
+
+(defvar calendar-mode-map) ; defined in calendar.el
+(defvar org-clock-current-task nil) ; defined in org-clock.el
+(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el
+(defvar org-habit-show-habits) ; defined in org-habit.el
(defvar org-habit-show-habits-only-for-today)
+(defvar org-habit-show-all-today)
;; Defined somewhere in this file, but used before definition.
-(defvar org-agenda-buffer-name)
-(defvar org-agenda-overriding-header)
+(defvar org-agenda-buffer-name "*Org Agenda*")
+(defvar org-agenda-overriding-header nil)
(defvar org-agenda-title-append nil)
-(defvar entry)
-(defvar date)
-(defvar org-agenda-undo-list)
-(defvar org-agenda-pending-undo-list)
+(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
+(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
(defvar original-date) ; dynamically scoped, calendar.el does scope this
+(defvar org-agenda-undo-list nil
+ "List of undoable operations in the agenda since last refresh.")
+(defvar org-agenda-pending-undo-list nil
+ "In a series of undo commands, this is the list of remaining undo items.")
+
(defcustom org-agenda-confirm-kill 1
"When set, remote killing from the agenda buffer needs confirmation.
When t, a confirmation is always needed. When a number N, confirmation is
@@ -127,9 +135,9 @@ addresses the separator between the current and the previous block."
(string)))
(defgroup org-agenda-export nil
- "Options concerning exporting agenda views in Org-mode."
- :tag "Org Agenda Export"
- :group 'org-agenda)
+ "Options concerning exporting agenda views in Org-mode."
+ :tag "Org Agenda Export"
+ :group 'org-agenda)
(defcustom org-agenda-with-colors t
"Non-nil means use colors in agenda views."
@@ -152,8 +160,8 @@ before assigned to the variables. So make sure to quote values you do
(sexp :tag "Value"))))
(defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text)
- "Hook run in temporary buffer before writing it to an export file.
-A useful function is `org-agenda-add-entry-text'."
+ "Hook run in a temporary buffer before writing the agenda to an export file.
+A useful function for this hook is `org-agenda-add-entry-text'."
:group 'org-agenda-export
:type 'hook
:options '(org-agenda-add-entry-text))
@@ -161,7 +169,7 @@ A useful function is `org-agenda-add-entry-text'."
(defcustom org-agenda-add-entry-text-maxlines 0
"Maximum number of entry text lines to be added to agenda.
This is only relevant when `org-agenda-add-entry-text' is part of
-`org-agenda-before-write-hook', which it is by default.
+`org-agenda-before-write-hook', which is the default.
When this is 0, nothing will happen. When it is greater than 0, it
specifies the maximum number of lines that will be added for each entry
that is listed in the agenda view.
@@ -180,7 +188,7 @@ When this variable nil, the URL will (also) be shown."
:group 'org-agenda
:type 'boolean)
-(defcustom org-agenda-export-html-style ""
+(defcustom org-agenda-export-html-style nil
"The style specification for exported HTML Agenda files.
If this variable contains a string, it will replace the default <style>
section as produced by `htmlize'.
@@ -216,8 +224,7 @@ or, if you want to keep the style in a file,
<link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
As the value of this option simply gets inserted into the HTML <head> header,
-you can \"misuse\" it to also add other text to the header. However,
-<style>...</style> is required, if not present the variable will be ignored."
+you can \"misuse\" it to also add other text to the header."
:group 'org-agenda-export
:group 'org-export-html
:type 'string)
@@ -228,9 +235,9 @@ you can \"misuse\" it to also add other text to the header. However,
:type 'boolean)
(defgroup org-agenda-custom-commands nil
- "Options concerning agenda views in Org-mode."
- :tag "Org Agenda Custom Commands"
- :group 'org-agenda)
+ "Options concerning agenda views in Org-mode."
+ :tag "Org Agenda Custom Commands"
+ :group 'org-agenda)
(defconst org-sorting-choice
'(choice
@@ -247,116 +254,118 @@ you can \"misuse\" it to also add other text to the header. However,
;; Keep custom values for `org-agenda-filter-preset' compatible with
;; the new variable `org-agenda-tag-filter-preset'.
-(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
+ (defvaralias 'org-agenda-filter 'org-agenda-tag-filter))
(defconst org-agenda-custom-commands-local-options
- `(repeat :tag "Local settings for this command. Remember to quote values"
+ `(repeat :tag "Local settings for this command. Remember to quote values"
(choice :tag "Setting"
- (list :tag "Heading for this block"
- (const org-agenda-overriding-header)
- (string :tag "Headline"))
- (list :tag "Files to be searched"
- (const org-agenda-files)
- (list
- (const :format "" quote)
- (repeat (file))))
- (list :tag "Sorting strategy"
- (const org-agenda-sorting-strategy)
- (list
- (const :format "" quote)
- (repeat
- ,org-sorting-choice)))
- (list :tag "Prefix format"
- (const org-agenda-prefix-format :value " %-12:c%?-12t% s")
- (string))
- (list :tag "Number of days in agenda"
- (const org-agenda-span)
- (choice (const :tag "Day" 'day)
- (const :tag "Week" 'week)
- (const :tag "Month" 'month)
- (const :tag "Year" 'year)
- (integer :tag "Custom")))
- (list :tag "Fixed starting date"
- (const org-agenda-start-day)
- (string :value "2007-11-01"))
- (list :tag "Start on day of week"
- (const org-agenda-start-on-weekday)
- (choice :value 1
- (const :tag "Today" nil)
- (integer :tag "Weekday No.")))
- (list :tag "Include data from diary"
- (const org-agenda-include-diary)
- (boolean))
- (list :tag "Deadline Warning days"
- (const org-deadline-warning-days)
- (integer :value 1))
- (list :tag "Category filter preset"
- (const org-agenda-category-filter-preset)
- (list
- (const :format "" quote)
- (repeat
- (string :tag "+category or -category"))))
- (list :tag "Tags filter preset"
- (const org-agenda-tag-filter-preset)
- (list
- (const :format "" quote)
- (repeat
- (string :tag "+tag or -tag"))))
- (list :tag "Set daily/weekly entry types"
- (const org-agenda-entry-types)
- (list
- (const :format "" quote)
- (set :greedy t :value (:deadline :scheduled :timestamp :sexp)
- (const :deadline)
- (const :scheduled)
- (const :timestamp)
- (const :sexp))))
- (list :tag "Standard skipping condition"
- :value (org-agenda-skip-function '(org-agenda-skip-entry-if))
- (const org-agenda-skip-function)
- (list
- (const :format "" quote)
- (list
- (choice
- :tag "Skipping range"
- (const :tag "Skip entry" org-agenda-skip-entry-if)
- (const :tag "Skip subtree" org-agenda-skip-subtree-if))
- (repeat :inline t :tag "Conditions for skipping"
- (choice
- :tag "Condition type"
- (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp))
- (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp))
- (list :tag "TODO state is" :inline t
- (const 'todo)
+ (list :tag "Heading for this block"
+ (const org-agenda-overriding-header)
+ (string :tag "Headline"))
+ (list :tag "Files to be searched"
+ (const org-agenda-files)
+ (list
+ (const :format "" quote)
+ (repeat (file))))
+ (list :tag "Sorting strategy"
+ (const org-agenda-sorting-strategy)
+ (list
+ (const :format "" quote)
+ (repeat
+ ,org-sorting-choice)))
+ (list :tag "Prefix format"
+ (const org-agenda-prefix-format :value " %-12:c%?-12t% s")
+ (string))
+ (list :tag "Number of days in agenda"
+ (const org-agenda-span)
+ (choice (const :tag "Day" 'day)
+ (const :tag "Week" 'week)
+ (const :tag "Month" 'month)
+ (const :tag "Year" 'year)
+ (integer :tag "Custom")))
+ (list :tag "Fixed starting date"
+ (const org-agenda-start-day)
+ (string :value "2007-11-01"))
+ (list :tag "Start on day of week"
+ (const org-agenda-start-on-weekday)
+ (choice :value 1
+ (const :tag "Today" nil)
+ (integer :tag "Weekday No.")))
+ (list :tag "Include data from diary"
+ (const org-agenda-include-diary)
+ (boolean))
+ (list :tag "Deadline Warning days"
+ (const org-deadline-warning-days)
+ (integer :value 1))
+ (list :tag "Category filter preset"
+ (const org-agenda-category-filter-preset)
+ (list
+ (const :format "" quote)
+ (repeat
+ (string :tag "+category or -category"))))
+ (list :tag "Tags filter preset"
+ (const org-agenda-tag-filter-preset)
+ (list
+ (const :format "" quote)
+ (repeat
+ (string :tag "+tag or -tag"))))
+ (list :tag "Set daily/weekly entry types"
+ (const org-agenda-entry-types)
+ (list
+ (const :format "" quote)
+ (set :greedy t :value (:deadline :scheduled :timestamp :sexp)
+ (const :deadline)
+ (const :scheduled)
+ (const :timestamp)
+ (const :sexp))))
+ (list :tag "Standard skipping condition"
+ :value (org-agenda-skip-function '(org-agenda-skip-entry-if))
+ (const org-agenda-skip-function)
+ (list
+ (const :format "" quote)
+ (list
+ (choice
+ :tag "Skipping range"
+ (const :tag "Skip entry" org-agenda-skip-entry-if)
+ (const :tag "Skip subtree" org-agenda-skip-subtree-if))
+ (repeat :inline t :tag "Conditions for skipping"
(choice
- (const :tag "any not-done state" 'todo)
- (const :tag "any done state" 'done)
- (const :tag "any state" 'any)
- (list :tag "Keyword list"
- (const :format "" quote)
- (repeat (string :tag "Keyword")))))
- (list :tag "TODO state is not" :inline t
- (const 'nottodo)
- (choice
- (const :tag "any not-done state" 'todo)
- (const :tag "any done state" 'done)
- (const :tag "any state" 'any)
- (list :tag "Keyword list"
- (const :format "" quote)
- (repeat (string :tag "Keyword")))))
- (const :tag "scheduled" 'scheduled)
- (const :tag "not scheduled" 'notscheduled)
- (const :tag "deadline" 'deadline)
- (const :tag "no deadline" 'notdeadline)
- (const :tag "timestamp" 'timestamp)
- (const :tag "no timestamp" 'nottimestamp))))))
- (list :tag "Non-standard skipping condition"
- :value (org-agenda-skip-function)
- (const org-agenda-skip-function)
- (sexp :tag "Function or form (quoted!)"))
- (list :tag "Any variable"
- (variable :tag "Variable")
- (sexp :tag "Value (sexp)"))))
+ :tag "Condition type"
+ (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp))
+ (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp))
+ (list :tag "TODO state is" :inline t
+ (const 'todo)
+ (choice
+ (const :tag "any not-done state" 'todo)
+ (const :tag "any done state" 'done)
+ (const :tag "any state" 'any)
+ (list :tag "Keyword list"
+ (const :format "" quote)
+ (repeat (string :tag "Keyword")))))
+ (list :tag "TODO state is not" :inline t
+ (const 'nottodo)
+ (choice
+ (const :tag "any not-done state" 'todo)
+ (const :tag "any done state" 'done)
+ (const :tag "any state" 'any)
+ (list :tag "Keyword list"
+ (const :format "" quote)
+ (repeat (string :tag "Keyword")))))
+ (const :tag "scheduled" 'scheduled)
+ (const :tag "not scheduled" 'notscheduled)
+ (const :tag "deadline" 'deadline)
+ (const :tag "no deadline" 'notdeadline)
+ (const :tag "timestamp" 'timestamp)
+ (const :tag "no timestamp" 'nottimestamp))))))
+ (list :tag "Non-standard skipping condition"
+ :value (org-agenda-skip-function)
+ (const org-agenda-skip-function)
+ (sexp :tag "Function or form (quoted!)"))
+ (list :tag "Any variable"
+ (variable :tag "Variable")
+ (sexp :tag "Value (sexp)"))))
"Selection of examples for agenda command settings.
This will be spliced into the custom type of
`org-agenda-custom-commands'.")
@@ -434,69 +443,69 @@ should provide a description for the prefix, like
:group 'org-agenda-custom-commands
:type `(repeat
(choice :value ("x" "Describe command here" tags "" nil)
- (list :tag "Single command"
- (string :tag "Access Key(s) ")
- (option (string :tag "Description"))
- (choice
- (const :tag "Agenda" agenda)
- (const :tag "TODO list" alltodo)
- (const :tag "Search words" search)
- (const :tag "Stuck projects" stuck)
- (const :tag "Tags/Property match (all agenda files)" tags)
- (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo)
- (const :tag "TODO keyword search (all agenda files)" todo)
- (const :tag "Tags sparse tree (current buffer)" tags-tree)
- (const :tag "TODO keyword tree (current buffer)" todo-tree)
- (const :tag "Occur tree (current buffer)" occur-tree)
- (sexp :tag "Other, user-defined function"))
- (string :tag "Match (only for some commands)")
- ,org-agenda-custom-commands-local-options
- (option (repeat :tag "Export" (file :tag "Export to"))))
- (list :tag "Command series, all agenda files"
- (string :tag "Access Key(s)")
- (string :tag "Description ")
- (repeat :tag "Component"
- (choice
- (list :tag "Agenda"
- (const :format "" agenda)
- (const :tag "" :format "" "")
- ,org-agenda-custom-commands-local-options)
- (list :tag "TODO list (all keywords)"
- (const :format "" alltodo)
- (const :tag "" :format "" "")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Search words"
- (const :format "" search)
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Stuck projects"
- (const :format "" stuck)
- (const :tag "" :format "" "")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Tags search"
- (const :format "" tags)
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Tags search, TODO entries only"
- (const :format "" tags-todo)
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)
- (list :tag "TODO keyword search"
- (const :format "" todo)
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Other, user-defined function"
- (symbol :tag "function")
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)))
-
- (repeat :tag "Settings for entire command set"
- (list (variable :tag "Any variable")
- (sexp :tag "Value")))
- (option (repeat :tag "Export" (file :tag "Export to"))))
- (cons :tag "Prefix key documentation"
- (string :tag "Access Key(s)")
- (string :tag "Description ")))))
+ (list :tag "Single command"
+ (string :tag "Access Key(s) ")
+ (option (string :tag "Description"))
+ (choice
+ (const :tag "Agenda" agenda)
+ (const :tag "TODO list" alltodo)
+ (const :tag "Search words" search)
+ (const :tag "Stuck projects" stuck)
+ (const :tag "Tags/Property match (all agenda files)" tags)
+ (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo)
+ (const :tag "TODO keyword search (all agenda files)" todo)
+ (const :tag "Tags sparse tree (current buffer)" tags-tree)
+ (const :tag "TODO keyword tree (current buffer)" todo-tree)
+ (const :tag "Occur tree (current buffer)" occur-tree)
+ (sexp :tag "Other, user-defined function"))
+ (string :tag "Match (only for some commands)")
+ ,org-agenda-custom-commands-local-options
+ (option (repeat :tag "Export" (file :tag "Export to"))))
+ (list :tag "Command series, all agenda files"
+ (string :tag "Access Key(s)")
+ (string :tag "Description ")
+ (repeat :tag "Component"
+ (choice
+ (list :tag "Agenda"
+ (const :format "" agenda)
+ (const :tag "" :format "" "")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "TODO list (all keywords)"
+ (const :format "" alltodo)
+ (const :tag "" :format "" "")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "Search words"
+ (const :format "" search)
+ (string :tag "Match")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "Stuck projects"
+ (const :format "" stuck)
+ (const :tag "" :format "" "")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "Tags search"
+ (const :format "" tags)
+ (string :tag "Match")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "Tags search, TODO entries only"
+ (const :format "" tags-todo)
+ (string :tag "Match")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "TODO keyword search"
+ (const :format "" todo)
+ (string :tag "Match")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "Other, user-defined function"
+ (symbol :tag "function")
+ (string :tag "Match")
+ ,org-agenda-custom-commands-local-options)))
+
+ (repeat :tag "Settings for entire command set"
+ (list (variable :tag "Any variable")
+ (sexp :tag "Value")))
+ (option (repeat :tag "Export" (file :tag "Export to"))))
+ (cons :tag "Prefix key documentation"
+ (string :tag "Access Key(s)")
+ (string :tag "Description ")))))
(defcustom org-agenda-query-register ?o
"The register holding the current query string.
@@ -550,9 +559,9 @@ this one will be used."
(const :tag "equal" "=")))
(defgroup org-agenda-skip nil
- "Options concerning skipping parts of agenda files."
- :tag "Org Agenda Skip"
- :group 'org-agenda)
+ "Options concerning skipping parts of agenda files."
+ :tag "Org Agenda Skip"
+ :group 'org-agenda)
(defcustom org-agenda-skip-function-global nil
"Function to be called at each match during agenda construction.
@@ -636,11 +645,11 @@ all Don't show any entries with a timestamp in the global todo list.
The idea behind this is that by setting a timestamp, you
have already \"taken care\" of this item.
-This variable can also have an integer as a value. If positive (N),
-todos with a timestamp N or more days in the future will be ignored. If
+This variable can also have an integer as a value. If positive (N),
+todos with a timestamp N or more days in the future will be ignored. If
negative (-N), todos with a timestamp N or more days in the past will be
-ignored. If 0, todos with a timestamp either today or in the future will
-be ignored. For example, a value of -1 will exclude todos with a
+ignored. If 0, todos with a timestamp either today or in the future will
+be ignored. For example, a value of -1 will exclude todos with a
timestamp in the past (yesterday or earlier), while a value of 7 will
exclude todos with a timestamp a week or more in the future.
@@ -674,7 +683,7 @@ all Don't show any scheduled entries in the global todo list.
t Same as `all', for backward compatibility.
-This variable can also have an integer as a value. See
+This variable can also have an integer as a value. See
`org-agenda-todo-ignore-timestamp' for more details.
See also `org-agenda-todo-ignore-with-date'.
@@ -715,7 +724,7 @@ all Ignore all TODO entries that do have a deadline.
t Same as `near', for backward compatibility.
-This variable can also have an integer as a value. See
+This variable can also have an integer as a value. See
`org-agenda-todo-ignore-timestamp' for more details.
See also `org-agenda-todo-ignore-with-date'.
@@ -774,6 +783,21 @@ but not scheduled today."
(const :tag "Always" t)
(const :tag "Not when scheduled today" not-today)))
+(defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil
+ "Non-nil means skip timestamp line if same entry shows because of deadline.
+In the agenda of today, an entry can show up multiple times
+because it has both a plain timestamp and has a nearby deadline.
+When this variable is t, then only the deadline is shown and the
+fact that the entry has a timestamp for or including today is not
+shown. When this variable is nil, the entry will be shown
+several times."
+ :group 'org-agenda-skip
+ :group 'org-agenda-daily/weekly
+ :version "24.1"
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)))
+
(defcustom org-agenda-skip-deadline-if-done nil
"Non-nil means don't show deadlines when the corresponding item is done.
When nil, the deadline is still shown and should give you a happy feeling.
@@ -860,12 +884,14 @@ N days, just insert a special line indicating the size of the gap."
When nil, the matcher string is not shown, but is put into the help-echo
property so than moving the mouse over the command shows it.
Setting it to nil is good if matcher strings are very long and/or if
-you want to use two-column display (see `org-agenda-menu-two-column')."
+you want to use two-columns display (see `org-agenda-menu-two-columns')."
:group 'org-agenda
:version "24.1"
:type 'boolean)
-(defcustom org-agenda-menu-two-column nil
+(define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3")
+
+(defcustom org-agenda-menu-two-columns nil
"Non-nil means, use two columns to show custom commands in the dispatcher.
If you use this, you probably want to set `org-agenda-menu-show-matcher'
to nil."
@@ -873,8 +899,14 @@ to nil."
:version "24.1"
:type 'boolean)
-(defcustom org-finalize-agenda-hook nil
- "Hook run just before displaying an agenda buffer."
+(define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3")
+(defcustom org-agenda-finalize-hook nil
+ "Hook run just before displaying an agenda buffer.
+The buffer is still writable when the hook is called.
+
+You can modify some of the buffer substrings but you should be
+extra careful not to modify the text properties of the agenda
+headlines as the agenda display heavily relies on them."
:group 'org-agenda-startup
:type 'hook)
@@ -932,7 +964,8 @@ have been removed when this is called, as will any matches for regular
expressions listed in `org-agenda-entry-text-exclude-regexps'.")
(defvar org-agenda-include-inactive-timestamps nil
- "Non-nil means include inactive time stamps in agenda and timeline.")
+ "Non-nil means include inactive time stamps in agenda and timeline.
+Dynamically scoped.")
(defgroup org-agenda-windows nil
"Options concerning the windows used by the Agenda in Org Mode."
@@ -975,11 +1008,11 @@ option will be ignored."
:type 'boolean)
(defcustom org-agenda-ndays nil
- "Number of days to include in overview display.
+ "Number of days to include in overview display.
Should be 1 or 7.
Obsolete, see `org-agenda-span'."
- :group 'org-agenda-daily/weekly
- :type 'integer)
+ :group 'org-agenda-daily/weekly
+ :type 'integer)
(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
@@ -1202,10 +1235,18 @@ agenda display."
:type 'boolean)
(defcustom org-agenda-start-with-log-mode nil
- "The initial value of log-mode in a newly created agenda window."
+ "The initial value of log-mode in a newly created agenda window.
+See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further
+explanations on the possible values."
:group 'org-agenda-startup
:group 'org-agenda-daily/weekly
- :type 'boolean)
+ :type '(choice (const :tag "Don't show log items" nil)
+ (const :tag "Show only log items" 'only)
+ (const :tag "Show all possible log items" 'clockcheck)
+ (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'"
+ (choice (const :tag "Show closed log items" 'closed)
+ (const :tag "Show clocked log items" 'clock)
+ (const :tag "Show all logged state changes" 'state)))))
(defcustom org-agenda-start-with-clockreport-mode nil
"The initial value of clockreport-mode in a newly created agenda window."
@@ -1501,8 +1542,10 @@ Custom commands can set this variable in the options section."
:group 'org-agenda-line-format)
(defvar org-prefix-format-compiled nil
- "The compiled version of the most recently used prefix format.
-See the variable `org-agenda-prefix-format'.")
+ "The compiled prefix format and associated variables.
+This is a list where first element is a list of variable bindings, and second
+element is the compiled format expression. See the variable
+`org-agenda-prefix-format'.")
(defcustom org-agenda-todo-keyword-format "%-1s"
"Format for the TODO keyword in agenda lines.
@@ -1511,6 +1554,16 @@ to occupy a fixed space in the agenda display."
:group 'org-agenda-line-format
:type 'string)
+(defcustom org-agenda-diary-sexp-prefix nil
+ "A regexp that matches part of a diary sexp entry
+which should be treated as scheduling/deadline information in
+`org-agenda'.
+
+For example, you can use this to extract the `diary-remind-message' from
+`diary-remind' entries."
+ :group 'org-agenda-line-format
+ :type '(choice (const :tag "None" nil) (regexp :tag "Regexp")))
+
(defcustom org-agenda-timerange-leaders '("" "(%d/%d): ")
"Text preceding timerange entries in the agenda view.
This is a list with two strings. The first applies when the range
@@ -1659,7 +1712,7 @@ determines if it is a foreground or a background color."
(defcustom org-agenda-day-face-function nil
"Function called to determine what face should be used to display a day.
-The only argument passed to that function is the day. It should
+The only argument passed to that function is the day. It should
returns a face, or nil if does not want to specify a face and let
the normal rules apply."
:group 'org-agenda-line-format
@@ -1762,10 +1815,6 @@ Note that functions in this alist don't need to be quoted."
:version "24.1"
:group 'org-agenda)
-(eval-when-compile
- (require 'cl))
-(require 'org)
-
(defmacro org-agenda-with-point-at-orig-entry (string &rest body)
"Execute BODY with point at location given by `org-hd-marker' property.
If STRING is non-nil, the text property will be fetched from position 0
@@ -1789,7 +1838,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
(setcdr ass (cdr entry))
(push entry org-agenda-custom-commands))))
-;;; Define the Org-agenda-mode
+;;; Define the org-agenda-mode
(defvar org-agenda-mode-map (make-sparse-keymap)
"Keymap for `org-agenda-mode'.")
@@ -1797,7 +1846,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
(defvaralias 'org-agenda-keymap 'org-agenda-mode-map))
(defvar org-agenda-menu) ; defined later in this file.
-(defvar org-agenda-restrict) ; defined later in this file.
+(defvar org-agenda-restrict nil) ; defined later in this file.
(defvar org-agenda-follow-mode nil)
(defvar org-agenda-entry-text-mode nil)
(defvar org-agenda-clockreport-mode nil)
@@ -1805,10 +1854,76 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
(defvar org-agenda-redo-command nil)
(defvar org-agenda-query-string nil)
(defvar org-agenda-mode-hook nil
- "Hook for `org-agenda-mode', run after the mode is turned on.")
+ "Hook run after `org-agenda-mode' is turned on.
+The buffer is still writable when this hook is called.")
(defvar org-agenda-type nil)
(defvar org-agenda-force-single-file nil)
-(defvar org-agenda-bulk-marked-entries) ;; Defined further down in this file
+(defvar org-agenda-bulk-marked-entries nil
+ "List of markers that refer to marked entries in the agenda.")
+
+;;; Multiple agenda buffers support
+
+(defcustom org-agenda-sticky nil
+ "Non-nil means agenda q key will bury agenda buffers.
+Agenda commands will then show existing buffer instead of generating new ones.
+When nil, `q' will kill the single agenda buffer."
+ :group 'org-agenda
+ :version "24.3"
+ :type 'boolean)
+
+;;;###autoload
+(defun org-toggle-sticky-agenda (&optional arg)
+ "Toggle `org-agenda-sticky'."
+ (interactive "P")
+ (let ((new-value (if arg
+ (> (prefix-numeric-value arg) 0)
+ (not org-agenda-sticky))))
+ (if (equal new-value org-agenda-sticky)
+ (and (org-called-interactively-p 'interactive)
+ (message "Sticky agenda was already %s"
+ (if org-agenda-sticky "enabled" "disabled")))
+ (setq org-agenda-sticky new-value)
+ (org-agenda-kill-all-agenda-buffers)
+ (and (org-called-interactively-p 'interactive)
+ (message "Sticky agenda was %s"
+ (if org-agenda-sticky "enabled" "disabled"))))))
+
+(defvar org-agenda-buffer nil
+ "Agenda buffer currently being generated.")
+
+(defvar org-agenda-last-prefix-arg nil)
+(defvar org-agenda-this-buffer-name nil)
+(defvar org-agenda-doing-sticky-redo nil)
+(defvar org-agenda-this-buffer-is-sticky nil)
+
+(defconst org-agenda-local-vars
+ '(org-agenda-this-buffer-name
+ org-agenda-undo-list
+ org-agenda-pending-undo-list
+ org-agenda-follow-mode
+ org-agenda-entry-text-mode
+ org-agenda-clockreport-mode
+ org-agenda-show-log
+ org-agenda-redo-command
+ org-agenda-query-string
+ org-agenda-type
+ org-agenda-bulk-marked-entries
+ org-agenda-undo-has-started-in
+ org-agenda-info
+ org-agenda-tag-filter-overlays
+ org-agenda-cat-filter-overlays
+ org-agenda-pre-window-conf
+ org-agenda-columns-active
+ org-agenda-tag-filter
+ org-agenda-category-filter
+ org-agenda-markers
+ org-agenda-last-search-view-search-was-boolean
+ org-agenda-filtered-by-category
+ org-agenda-filter-form
+ org-agenda-show-window
+ org-agenda-cycle-counter
+ org-agenda-last-prefix-arg)
+ "Variables that must be local in agenda buffers to allow multiple buffers.")
(defun org-agenda-mode ()
"Mode for time-sorted view on action items in Org-mode files.
@@ -1817,7 +1932,30 @@ The following commands are available:
\\{org-agenda-mode-map}"
(interactive)
- (kill-all-local-variables)
+ (cond (org-agenda-doing-sticky-redo
+ ;; Refreshing sticky agenda-buffer
+ ;;
+ ;; Preserve the value of `org-agenda-local-vars' variables,
+ ;; while letting `kill-all-local-variables' kill the rest
+ (let ((save (buffer-local-variables)))
+ (kill-all-local-variables)
+ (mapc 'make-local-variable org-agenda-local-vars)
+ (dolist (elem save)
+ (let ((var (car elem))
+ (val (cdr elem)))
+ (when (and val
+ (member var org-agenda-local-vars))
+ (set var val)))))
+ (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t))
+ (org-agenda-sticky
+ ;; Creating a sticky Agenda buffer for the first time
+ (kill-all-local-variables)
+ (mapc 'make-local-variable org-agenda-local-vars)
+ (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t))
+ (t
+ ;; Creating a non-sticky agenda buffer
+ (kill-all-local-variables)
+ (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil)))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil
org-agenda-bulk-marked-entries nil)
@@ -1829,14 +1967,13 @@ The following commands are available:
(easy-menu-add org-agenda-menu)
(if org-startup-truncated (setq truncate-lines t))
(org-set-local 'line-move-visual nil)
- (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
+ (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
(org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
;; Make sure properties are removed when copying text
- (when (boundp 'buffer-substring-filters)
- (org-set-local 'buffer-substring-filters
- (cons (lambda (x)
- (set-text-properties 0 (length x) nil x) x)
- buffer-substring-filters)))
+ (make-local-variable 'filter-buffer-substring-functions)
+ (add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (substring-no-properties (funcall fun start end delete))))
(unless org-agenda-keep-modes
(setq org-agenda-follow-mode org-agenda-start-with-follow-mode
org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
@@ -1868,11 +2005,13 @@ The following commands are available:
(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill)
(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile)
(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark)
+(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all)
(org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp)
(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark)
-(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-remove-all-marks)
-(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda)
+(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-unmark-all)
(org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action)
+(org-defkey org-agenda-mode-map "k" 'org-agenda-capture)
+(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda)
(org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default)
(org-defkey org-agenda-mode-map "\C-c\C-xa" 'org-agenda-toggle-archive-tag)
@@ -1901,8 +2040,6 @@ The following commands are available:
(org-defkey org-agenda-mode-map "y" 'org-agenda-year-view)
(org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note)
(org-defkey org-agenda-mode-map "z" 'org-agenda-add-note)
-(org-defkey org-agenda-mode-map "k" 'org-agenda-action)
-(org-defkey org-agenda-mode-map "\C-c\C-x\C-k" 'org-agenda-action)
(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later)
(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier)
(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later)
@@ -1913,7 +2050,7 @@ The following commands are available:
(org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
(let ((l '(1 2 3 4 5 6 7 8 9 0)))
(while l (org-defkey org-agenda-mode-map
- (int-to-string (pop l)) 'digit-argument)))
+ (int-to-string (pop l)) 'digit-argument)))
(org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode)
(org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode)
@@ -1924,21 +2061,23 @@ The following commands are available:
(org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines)
(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
(org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
-(org-defkey org-agenda-mode-map "g" 'org-agenda-redo)
+(org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t)))
(org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort)
(org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
'org-clock-modify-effort-estimate)
(org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property)
(org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
+(org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit)
(org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write)
(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
-(org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority)
(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
(org-defkey org-agenda-mode-map "n" 'org-agenda-next-line)
(org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line)
+(org-defkey org-agenda-mode-map "N" 'org-agenda-next-item)
+(org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item)
(substitute-key-definition 'next-line 'org-agenda-next-line
org-agenda-mode-map global-map)
(substitute-key-definition 'previous-line 'org-agenda-previous-line
@@ -1946,8 +2085,8 @@ The following commands are available:
(org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach)
(org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line)
(org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line)
-(org-defkey org-agenda-mode-map "," 'org-agenda-priority)
(org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority)
+(org-defkey org-agenda-mode-map "," 'org-agenda-priority)
(org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry)
(org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar)
(org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date)
@@ -1981,6 +2120,7 @@ The following commands are available:
(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
+(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-category)
(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
@@ -2034,7 +2174,7 @@ The following commands are available:
["Show some entry text" org-agenda-entry-text-mode
:style toggle :selected org-agenda-entry-text-mode
:active t]
- "--"
+ "--"
["Show Logbook entries" org-agenda-log-mode
:style toggle :selected org-agenda-show-log
:active (org-agenda-check-type nil 'agenda 'timeline)
@@ -2054,9 +2194,10 @@ The following commands are available:
["Show original entry" org-agenda-show t]
["Go To (other window)" org-agenda-goto t]
["Go To (this window)" org-agenda-switch-to t]
+ ["Capture with cursor date" org-agenda-capture t]
["Follow Mode" org-agenda-follow-mode
:style toggle :selected org-agenda-follow-mode :active t]
-; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
+ ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
"--"
("TODO"
["Cycle TODO" org-agenda-todo t]
@@ -2075,10 +2216,11 @@ The following commands are available:
["Delete subtree" org-agenda-kill t])
("Bulk action"
["Mark entry" org-agenda-bulk-mark t]
+ ["Mark all" org-agenda-bulk-mark-all t]
["Mark matching regexp" org-agenda-bulk-mark-regexp t]
["Unmark entry" org-agenda-bulk-unmark t]
- ["Unmark all entries" org-agenda-bulk-remove-all-marks :active t :keys "C-u s"])
- ["Act on all marked" org-agenda-bulk-action t]
+ ["Unmark all entries" org-agenda-bulk-unmark-all :active t :keys "U"])
+ ["Act on all marked" org-agenda-bulk-action t]
"--"
("Tags and Properties"
["Show all Tags" org-agenda-show-tags t]
@@ -2090,11 +2232,6 @@ The following commands are available:
["Schedule" org-agenda-schedule t]
["Set Deadline" org-agenda-deadline t]
"--"
- ["Mark item" org-agenda-action :active t :keys "k m"]
- ["Show mark item" org-agenda-action :active t :keys "k v"]
- ["Schedule marked item" org-agenda-action :active t :keys "k s"]
- ["Set Deadline for marked item" org-agenda-action :active t :keys "k d"]
- "--"
["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"]
@@ -2115,7 +2252,7 @@ The following commands are available:
["Set Priority" org-agenda-priority t]
["Increase Priority" org-agenda-priority-up t]
["Decrease Priority" org-agenda-priority-down t]
- ["Show Priority" org-agenda-show-priority t])
+ ["Show Priority" org-show-priority t])
("Calendar/Diary"
["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)]
["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)]
@@ -2144,12 +2281,8 @@ The following commands are available:
(defvar org-agenda-allow-remote-undo t
"Non-nil means allow remote undo from the agenda buffer.")
-(defvar org-agenda-undo-list nil
- "List of undoable operations in the agenda since last refresh.")
(defvar org-agenda-undo-has-started-in nil
"Buffers that have already seen `undo-start' in the current undo sequence.")
-(defvar org-agenda-pending-undo-list nil
- "In a series of undo commands, this is the list of remaining undo items.")
(defun org-agenda-undo ()
"Undo a remote editing step in the agenda.
@@ -2193,14 +2326,60 @@ that have been changed along."
;;; Agenda dispatch
-(defvar org-agenda-restrict nil)
(defvar org-agenda-restrict-begin (make-marker))
(defvar org-agenda-restrict-end (make-marker))
(defvar org-agenda-last-dispatch-buffer nil)
(defvar org-agenda-overriding-restriction nil)
+(defcustom org-agenda-custom-commands-contexts nil
+ "Alist of custom agenda keys and contextual rules.
+
+For example, if you have a custom agenda command \"p\" and you
+want this command to be accessible only from plain text files,
+use this:
+
+ '((\"p\" (in-file . \"\\.txt\")))
+
+Here are the available contexts definitions:
+
+ in-file: command displayed only in matching files
+ in-mode: command displayed only in matching modes
+ not-in-file: command not displayed in matching files
+ not-in-mode: command not displayed in matching modes
+ [function]: a custom function taking no argument
+
+If you define several checks, the agenda command will be
+accessible if there is at least one valid check.
+
+You can also bind a key to another agenda custom command
+depending on contextual rules.
+
+ '((\"p\" \"q\" (in-file . \"\\.txt\")))
+
+Here it means: in .txt files, use \"p\" as the key for the
+agenda command otherwise associated with \"q\". (The command
+originally associated with \"q\" is not displayed to avoid
+duplicates.)"
+ :version "24.3"
+ :group 'org-agenda-custom-commands
+ :type '(repeat (list :tag "Rule"
+ (string :tag " Agenda key")
+ (string :tag "Replace by command")
+ (repeat :tag "Available when"
+ (choice
+ (cons :tag "Condition"
+ (choice
+ (const :tag "In file" in-file)
+ (const :tag "Not in file" not-in-file)
+ (const :tag "In mode" in-mode)
+ (const :tag "Not in mode" not-in-mode))
+ (regexp))
+ (function :tag "Custom function"))))))
+
+(defvar org-keys nil)
+(defvar org-match nil)
;;;###autoload
-(defun org-agenda (&optional arg keys restriction)
+(defun org-agenda (&optional arg org-keys restriction)
"Dispatch agenda commands to collect entries to the agenda buffer.
Prompts for a command to execute. Any prefix arg will be passed
on to the selected command. The default selections are:
@@ -2215,6 +2394,7 @@ M Like `m', but select only TODO entries, no ordinary headlines.
L Create a timeline for the current buffer.
e Export views to associated files.
s Search entries for keywords.
+S Search entries for keywords, only with TODO keywords.
/ Multi occur across all agenda files and also files listed
in `org-agenda-text-search-extra-files'.
< Restrict agenda commands to buffer, subtree, or region.
@@ -2236,6 +2416,7 @@ Pressing `<' twice means to restrict to the current subtree or region
(interactive "P")
(catch 'exit
(let* ((prefix-descriptions nil)
+ (org-agenda-buffer-name org-agenda-buffer-name)
(org-agenda-window-setup (if (equal (buffer-name)
org-agenda-buffer-name)
'current-window
@@ -2253,9 +2434,12 @@ Pressing `<' twice means to restrict to the current subtree or region
((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
(t (cons (car x) (cons "" (cdr x))))))
org-agenda-custom-commands)))
+ (org-agenda-custom-commands
+ (org-contextualize-keys
+ org-agenda-custom-commands org-agenda-custom-commands-contexts))
(buf (current-buffer))
(bfn (buffer-file-name (buffer-base-buffer)))
- entry key type match lprops ans)
+ entry key type org-match lprops ans)
;; Turn off restriction unless there is an overriding one,
(unless org-agenda-overriding-restriction
(unless (org-bound-and-true-p org-agenda-keep-restricted-file-list)
@@ -2270,10 +2454,16 @@ Pressing `<' twice means to restrict to the current subtree or region
(put 'org-agenda-redo-command 'last-args nil)
;; Remember where this call originated
(setq org-agenda-last-dispatch-buffer (current-buffer))
- (unless keys
+ (unless org-keys
(setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
- keys (car ans)
+ org-keys (car ans)
restriction (cdr ans)))
+ ;; If we have sticky agenda buffers, set a name for the buffer,
+ ;; depending on the invoking keys. The user may still set this
+ ;; as a command option, which will overwrite what we do here.
+ (if org-agenda-sticky
+ (setq org-agenda-buffer-name
+ (format "*Org Agenda(%s)*" org-keys)))
;; Establish the restriction, if any
(when (and (not org-agenda-overriding-restriction) restriction)
(put 'org-agenda-files 'org-restrict (list bfn))
@@ -2292,11 +2482,15 @@ Pressing `<' twice means to restrict to the current subtree or region
;; For example the todo list should not need it (but does...)
(cond
- ((setq entry (assoc keys org-agenda-custom-commands))
+ ((setq entry (assoc org-keys org-agenda-custom-commands))
(if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
(progn
- (setq type (nth 2 entry) match (eval (nth 3 entry))
+ (setq type (nth 2 entry) org-match (eval (nth 3 entry))
lprops (nth 4 entry))
+ (if org-agenda-sticky
+ (setq org-agenda-buffer-name
+ (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match))
+ (format "*Org Agenda(%s)*" org-keys))))
(put 'org-agenda-redo-command 'org-lprops lprops)
(cond
((eq type 'agenda)
@@ -2304,44 +2498,45 @@ Pressing `<' twice means to restrict to the current subtree or region
((eq type 'alltodo)
(org-let lprops '(org-todo-list current-prefix-arg)))
((eq type 'search)
- (org-let lprops '(org-search-view current-prefix-arg match nil)))
+ (org-let lprops '(org-search-view current-prefix-arg org-match nil)))
((eq type 'stuck)
(org-let lprops '(org-agenda-list-stuck-projects
current-prefix-arg)))
((eq type 'tags)
- (org-let lprops '(org-tags-view current-prefix-arg match)))
+ (org-let lprops '(org-tags-view current-prefix-arg org-match)))
((eq type 'tags-todo)
- (org-let lprops '(org-tags-view '(4) match)))
+ (org-let lprops '(org-tags-view '(4) org-match)))
((eq type 'todo)
- (org-let lprops '(org-todo-list match)))
+ (org-let lprops '(org-todo-list org-match)))
((eq type 'tags-tree)
(org-check-for-org-mode)
- (org-let lprops '(org-match-sparse-tree current-prefix-arg match)))
+ (org-let lprops '(org-match-sparse-tree current-prefix-arg org-match)))
((eq type 'todo-tree)
(org-check-for-org-mode)
(org-let lprops
'(org-occur (concat "^" org-outline-regexp "[ \t]*"
- (regexp-quote match) "\\>"))))
+ (regexp-quote org-match) "\\>"))))
((eq type 'occur-tree)
(org-check-for-org-mode)
- (org-let lprops '(org-occur match)))
+ (org-let lprops '(org-occur org-match)))
((functionp type)
- (org-let lprops '(funcall type match)))
+ (org-let lprops '(funcall type org-match)))
((fboundp type)
- (org-let lprops '(funcall type match)))
+ (org-let lprops '(funcall type org-match)))
(t (error "Invalid custom agenda command type %s" type))))
(org-agenda-run-series (nth 1 entry) (cddr entry))))
- ((equal keys "C")
+ ((equal org-keys "C")
(setq org-agenda-custom-commands org-agenda-custom-commands-orig)
(customize-variable 'org-agenda-custom-commands))
- ((equal keys "a") (call-interactively 'org-agenda-list))
- ((equal keys "s") (call-interactively 'org-search-view))
- ((equal keys "t") (call-interactively 'org-todo-list))
- ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
- ((equal keys "m") (call-interactively 'org-tags-view))
- ((equal keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
- ((equal keys "e") (call-interactively 'org-store-agenda-views))
- ((equal keys "?") (org-tags-view nil "+FLAGGED")
+ ((equal org-keys "a") (call-interactively 'org-agenda-list))
+ ((equal org-keys "s") (call-interactively 'org-search-view))
+ ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4))))
+ ((equal org-keys "t") (call-interactively 'org-todo-list))
+ ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
+ ((equal org-keys "m") (call-interactively 'org-tags-view))
+ ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
+ ((equal org-keys "e") (call-interactively 'org-store-agenda-views))
+ ((equal org-keys "?") (org-tags-view nil "+FLAGGED")
(org-add-hook
'post-command-hook
(lambda ()
@@ -2357,15 +2552,15 @@ Pressing `<' twice means to restrict to the current subtree or region
(copy-sequence note))
nil 'face 'org-warning)))))))
t t))
- ((equal keys "L")
- (unless (eq major-mode 'org-mode)
+ ((equal org-keys "L")
+ (unless (derived-mode-p 'org-mode)
(error "This is not an Org-mode file"))
(unless restriction
(put 'org-agenda-files 'org-restrict (list bfn))
(org-call-with-arg 'org-timeline arg)))
- ((equal keys "#") (call-interactively 'org-agenda-list-stuck-projects))
- ((equal keys "/") (call-interactively 'org-occur-in-agenda-files))
- ((equal keys "!") (customize-variable 'org-stuck-projects))
+ ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
+ ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
+ ((equal org-keys "!") (customize-variable 'org-stuck-projects))
(t (error "Invalid agenda key"))))))
(defun org-agenda-append-agenda ()
@@ -2373,11 +2568,13 @@ Pressing `<' twice means to restrict to the current subtree or region
This function allows interactive building of block agendas.
Agenda views are separated by `org-agenda-block-separator'."
(interactive)
- (unless (string= (buffer-name) org-agenda-buffer-name)
+ (unless (derived-mode-p 'org-agenda-mode)
(error "Can only append from within agenda buffer"))
(let ((org-agenda-multi t))
(org-agenda)
- (widen)))
+ (widen)
+ (org-agenda-finalize)
+ (org-agenda-fit-window-to-buffer)))
(defun org-agenda-normalize-custom-commands (cmds)
(delq nil
@@ -2393,7 +2590,7 @@ Agenda views are separated by `org-agenda-block-separator'."
"The user interface for selecting an agenda command."
(catch 'exit
(let* ((bfn (buffer-file-name (buffer-base-buffer)))
- (restrict-ok (and bfn (eq major-mode 'org-mode)))
+ (restrict-ok (and bfn (derived-mode-p 'org-mode)))
(region-p (org-region-active-p))
(custom org-agenda-custom-commands)
(selstring "")
@@ -2406,15 +2603,15 @@ Agenda views are separated by `org-agenda-block-separator'."
(erase-buffer)
(insert (eval-when-compile
(let ((header
-"
-Press key for an agenda command: < Buffer, subtree/region restriction
+ "Press key for an agenda command: < Buffer, subtree/region restriction
-------------------------------- > Remove restriction
a Agenda for current week or day e Export agenda views
t List of all TODO entries T Entries with special TODO kwd
m Match a TAGS/PROP/TODO query M Like m, but only TODO entries
+s Search for keywords S Like s, but only TODO entries
L Timeline for current buffer # List stuck projects (!=configure)
-s Search for keywords C Configure custom agenda commands
-/ Multi-occur ? Find :FLAGGED: entries
+/ Multi-occur C Configure custom agenda commands
+? Find :FLAGGED: entries * Toggle sticky agenda views
")
(start 0))
(while (string-match
@@ -2474,13 +2671,12 @@ s Search for keywords C Configure custom agenda commands
((stringp match)
(setq match (copy-sequence match))
(org-add-props match nil 'face 'org-warning))
- (match
- (format "set of %d commands" (length match)))
- (t ""))))
+ ((listp type)
+ (format "set of %d commands" (length type))))))
(if (org-string-nw-p match)
(add-text-properties
0 (length line) (list 'help-echo
- (concat "Matcher: "match)) line)))
+ (concat "Matcher: " match)) line)))
(push line lines)))
(setq lines (nreverse lines))
(when prefixes
@@ -2497,7 +2693,7 @@ s Search for keywords C Configure custom agenda commands
prefixes))
;; Check if we should display in two columns
- (if org-agenda-menu-two-column
+ (if org-agenda-menu-two-columns
(progn
(setq n (length lines)
n1 (+ (/ n 2) (mod n 2))
@@ -2547,6 +2743,9 @@ s Search for keywords C Configure custom agenda commands
nil
(cons (substring (car x) 1) (cdr x))))
custom))))
+ ((eq c ?*)
+ (call-interactively 'org-toggle-sticky-agenda)
+ (sit-for 2))
((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
(message "Restriction is only possible in Org-mode buffers")
(ding) (sit-for 1))
@@ -2568,7 +2767,7 @@ s Search for keywords C Configure custom agenda commands
((eq c ?>)
(org-agenda-remove-restriction-lock 'noupdate)
(setq restriction nil))
- ((and (equal selstring "") (memq c '(?s ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
+ ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
(throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
((and (> (length selstring) 0) (eq c ?\d))
(delete-window)
@@ -2577,55 +2776,72 @@ s Search for keywords C Configure custom agenda commands
((equal c ?q) (error "Abort"))
(t (error "Invalid key %c" c))))))))
-(defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter
-(defvar org-agenda-last-arguments nil
- "The arguments of the previous call to `org-agenda'.")
+(defun org-agenda-fit-window-to-buffer ()
+ "Fit the window to the buffer size."
+ (and (memq org-agenda-window-setup '(reorganize-frame))
+ (fboundp 'fit-window-to-buffer)
+ (org-fit-window-to-buffer
+ nil
+ (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
+ (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
+
+(defvar org-cmd nil)
+(defvar org-agenda-overriding-cmd nil)
+(defvar org-agenda-overriding-arguments nil)
+(defvar org-agenda-overriding-cmd-arguments nil)
(defun org-agenda-run-series (name series)
- (org-let (nth 1 series) '(org-prepare-agenda name))
+ (org-let (nth 1 series) '(org-agenda-prepare name))
+ ;; We need to reset agenda markers here, because when constructing a
+ ;; block agenda, the individual blocks do not do that.
+ (org-agenda-reset-markers)
(let* ((org-agenda-multi t)
(redo (list 'org-agenda-run-series name (list 'quote series)))
- (org-agenda-overriding-arguments
- (or org-agenda-overriding-arguments
- (unless (null (delq nil (get 'org-agenda-redo-command 'last-args)))
- (get 'org-agenda-redo-command 'last-args))))
(cmds (car series))
(gprops (nth 1 series))
match ;; The byte compiler incorrectly complains about this. Keep it!
- cmd type lprops)
- (while (setq cmd (pop cmds))
- (setq type (car cmd) match (eval (nth 1 cmd)) lprops (nth 2 cmd))
- (cond
- ((eq type 'agenda)
- (org-let2 gprops lprops
- '(call-interactively 'org-agenda-list)))
- ((eq type 'alltodo)
- (org-let2 gprops lprops
- '(call-interactively 'org-todo-list)))
- ((eq type 'search)
- (org-let2 gprops lprops
- '(org-search-view current-prefix-arg match nil)))
- ((eq type 'stuck)
- (org-let2 gprops lprops
- '(call-interactively 'org-agenda-list-stuck-projects)))
- ((eq type 'tags)
- (org-let2 gprops lprops
- '(org-tags-view current-prefix-arg match)))
- ((eq type 'tags-todo)
- (org-let2 gprops lprops
- '(org-tags-view '(4) match)))
- ((eq type 'todo)
- (org-let2 gprops lprops
- '(org-todo-list match)))
- ((fboundp type)
- (org-let2 gprops lprops
- '(funcall type match)))
- (t (error "Invalid type in command series"))))
+ org-cmd type lprops)
+ (while (setq org-cmd (pop cmds))
+ (setq type (car org-cmd)
+ match (eval (nth 1 org-cmd))
+ lprops (nth 2 org-cmd))
+ (let ((org-agenda-overriding-arguments
+ (if (eq org-agenda-overriding-cmd org-cmd)
+ (or org-agenda-overriding-arguments
+ org-agenda-overriding-cmd-arguments))))
+ (cond
+ ((eq type 'agenda)
+ (org-let2 gprops lprops
+ '(call-interactively 'org-agenda-list)))
+ ((eq type 'alltodo)
+ (org-let2 gprops lprops
+ '(call-interactively 'org-todo-list)))
+ ((eq type 'search)
+ (org-let2 gprops lprops
+ '(org-search-view current-prefix-arg match nil)))
+ ((eq type 'stuck)
+ (org-let2 gprops lprops
+ '(call-interactively 'org-agenda-list-stuck-projects)))
+ ((eq type 'tags)
+ (org-let2 gprops lprops
+ '(org-tags-view current-prefix-arg match)))
+ ((eq type 'tags-todo)
+ (org-let2 gprops lprops
+ '(org-tags-view '(4) match)))
+ ((eq type 'todo)
+ (org-let2 gprops lprops
+ '(org-todo-list match)))
+ ((fboundp type)
+ (org-let2 gprops lprops
+ '(funcall type match)))
+ (t (error "Invalid type in command series")))))
(widen)
+ (let ((inhibit-read-only t))
+ (add-text-properties (point-min) (point-max)
+ `(org-series t org-series-redo-cmd ,redo)))
(setq org-agenda-redo-command redo)
- (put 'org-agenda-redo-command 'last-args org-agenda-last-arguments)
(goto-char (point-min)))
- (org-fit-agenda-window)
- (org-let (nth 1 series) '(org-finalize-agenda)))
+ (org-agenda-fit-window-to-buffer)
+ (org-let (nth 1 series) '(org-agenda-finalize)))
;;;###autoload
(defmacro org-batch-agenda (cmd-key &rest parameters)
@@ -2743,7 +2959,6 @@ This ensures the export commands can easily use it."
(setq res (replace-match ";" t t res)))
(org-trim res)))
-
;;;###autoload
(defun org-store-agenda-views (&rest parameters)
(interactive)
@@ -2756,11 +2971,18 @@ This ensures the export commands can easily use it."
(pop-up-frames nil)
(dir default-directory)
(pars (org-make-parameter-alist parameters))
- cmd thiscmdkey files opts cmd-or-set)
+ cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname)
(save-window-excursion
(while cmds
(setq cmd (pop cmds)
thiscmdkey (car cmd)
+ thiscmdcmd (cdr cmd)
+ match (nth 2 thiscmdcmd)
+ bufname (if org-agenda-sticky
+ (or (and (stringp match)
+ (format "*Org Agenda(%s:%s)*" thiscmdkey match))
+ (format "*Org Agenda(%s)*" thiscmdkey))
+ org-agenda-buffer-name)
cmd-or-set (nth 2 cmd)
opts (nth (if (listp cmd-or-set) 3 4) cmd)
files (nth (if (listp cmd-or-set) 4 5) cmd))
@@ -2769,15 +2991,17 @@ This ensures the export commands can easily use it."
(org-eval-in-environment (append org-agenda-exporter-settings
opts pars)
(org-agenda nil thiscmdkey))
- (set-buffer org-agenda-buffer-name)
+ (set-buffer bufname)
(while files
(org-eval-in-environment (append org-agenda-exporter-settings
opts pars)
- (org-agenda-write (expand-file-name (pop files) dir) nil t)))
- (and (get-buffer org-agenda-buffer-name)
- (kill-buffer org-agenda-buffer-name)))))))
+ (org-agenda-write (expand-file-name (pop files) dir) nil t bufname)))
+ (and (get-buffer bufname)
+ (kill-buffer bufname)))))))
(def-edebug-spec org-batch-store-agenda-views (&rest sexp))
+(defvar org-agenda-current-span nil
+ "The current span used in the agenda view.") ; local variable in the agenda buffer
(defun org-agenda-mark-header-line (pos)
"Mark the line at POS as an agenda structure header."
(save-excursion
@@ -2788,9 +3012,9 @@ This ensures the export commands can easily use it."
(put-text-property (point-at-bol) (point-at-eol)
'org-agenda-title-append org-agenda-title-append))))
-(defvar org-mobile-creating-agendas)
+(defvar org-mobile-creating-agendas) ; defined in org-mobile.el
(defvar org-agenda-write-buffer-name "Agenda View")
-(defun org-agenda-write (file &optional open nosettings)
+(defun org-agenda-write (file &optional open nosettings agenda-bufname)
"Write the current buffer (an agenda view) as a file.
Depending on the extension of the file name, plain text (.txt),
HTML (.html or .htm) or Postscript (.ps) is produced.
@@ -2801,7 +3025,8 @@ With prefix argument OPEN, open the new file immediately.
If NOSETTINGS is given, do not scope the settings of
`org-agenda-exporter-settings' into the export commands. This is used when
the settings have already been scoped and we do not wish to overrule other,
-higher priority settings."
+higher priority settings.
+If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(interactive "FWrite agenda to file: \nP")
(if (not (file-writable-p file))
(error "Cannot write agenda to file %s" file))
@@ -2828,9 +3053,7 @@ higher priority settings."
((string-match "\\.html?\\'" file)
(require 'htmlize)
(set-buffer (htmlize-buffer (current-buffer)))
-
- (when (and org-agenda-export-html-style
- (string-match "<style>" org-agenda-export-html-style))
+ (when org-agenda-export-html-style
;; replace <style> section with org-agenda-export-html-style
(goto-char (point-min))
(kill-region (- (search-forward "<style") 6)
@@ -2870,7 +3093,9 @@ higher priority settings."
(save-buffer 0)
(kill-buffer (current-buffer))
(message "Plain text written to %s" file))))))))
- (set-buffer org-agenda-buffer-name))
+ (set-buffer (or agenda-bufname
+ (and (called-interactively-p 'any) (buffer-name))
+ org-agenda-buffer-name)))
(when open (org-open-file file)))
(defvar org-agenda-tag-filter-overlays nil)
@@ -2933,7 +3158,7 @@ removed from the entry content. Currently only `planning' is allowed here."
(let (txt drawer-re kwd-time-re ind)
(save-excursion
(with-current-buffer (marker-buffer marker)
- (if (not (eq major-mode 'org-mode))
+ (if (not (derived-mode-p 'org-mode))
(setq txt "")
(save-excursion
(save-restriction
@@ -3049,28 +3274,19 @@ removed from the entry content. Currently only `planning' is allowed here."
(defun org-check-for-org-mode ()
"Make sure current buffer is in org-mode. Error if not."
- (or (eq major-mode 'org-mode)
+ (or (derived-mode-p 'org-mode)
(error "Cannot execute org-mode agenda command on buffer in %s"
major-mode)))
-(defun org-fit-agenda-window ()
- "Fit the window to the buffer size."
- (and (memq org-agenda-window-setup '(reorganize-frame))
- (fboundp 'fit-window-to-buffer)
- (org-fit-window-to-buffer
- nil
- (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
- (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
-
;;; Agenda prepare and finalize
(defvar org-agenda-multi nil) ; dynamically scoped
-(defvar org-agenda-buffer-name "*Org Agenda*")
-(defvar org-pre-agenda-window-conf nil)
+(defvar org-agenda-pre-window-conf nil)
(defvar org-agenda-columns-active nil)
(defvar org-agenda-name nil)
(defvar org-agenda-tag-filter nil)
(defvar org-agenda-category-filter nil)
+(defvar org-agenda-top-category-filter nil)
(defvar org-agenda-tag-filter-while-redo nil)
(defvar org-agenda-tag-filter-preset nil
"A preset of the tags filter used for secondary agenda filtering.
@@ -3092,63 +3308,107 @@ the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
-(defun org-prepare-agenda (&optional name)
- (setq org-todo-keywords-for-agenda nil)
- (setq org-drawers-for-agenda nil)
- (unless org-agenda-persistent-filter
- (setq org-agenda-tag-filter nil
- org-agenda-category-filter nil))
- (put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset)
- (put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset)
- (if org-agenda-multi
+
+(defun org-agenda-use-sticky-p ()
+ "Return non-nil if an agenda buffer named
+`org-agenda-buffer-name' exists and should be shown instead of
+generating a new one."
+ (and
+ ;; turned off by user
+ org-agenda-sticky
+ ;; For multi-agenda buffer already exists
+ (not org-agenda-multi)
+ ;; buffer found
+ (get-buffer org-agenda-buffer-name)
+ ;; C-u parameter is same as last call
+ (with-current-buffer (get-buffer org-agenda-buffer-name)
+ (and
+ (equal current-prefix-arg
+ org-agenda-last-prefix-arg)
+ ;; In case user turned stickiness on, while having existing
+ ;; Agenda buffer active, don't reuse that buffer, because it
+ ;; does not have org variables local
+ org-agenda-this-buffer-is-sticky))))
+
+(defun org-agenda-prepare-window (abuf)
+ "Setup agenda buffer in the window."
+ (let* ((awin (get-buffer-window abuf))
+ wconf)
+ (cond
+ ((equal (current-buffer) abuf) nil)
+ (awin (select-window awin))
+ ((not (setq wconf (current-window-configuration))))
+ ((equal org-agenda-window-setup 'current-window)
+ (org-pop-to-buffer-same-window abuf))
+ ((equal org-agenda-window-setup 'other-window)
+ (org-switch-to-buffer-other-window abuf))
+ ((equal org-agenda-window-setup 'other-frame)
+ (switch-to-buffer-other-frame abuf))
+ ((equal org-agenda-window-setup 'reorganize-frame)
+ (delete-other-windows)
+ (org-switch-to-buffer-other-window abuf)))
+ ;; additional test in case agenda is invoked from within agenda
+ ;; buffer via elisp link
+ (unless (equal (current-buffer) abuf)
+ (org-pop-to-buffer-same-window abuf))
+ (setq org-agenda-pre-window-conf
+ (or org-agenda-pre-window-conf wconf))))
+
+(defun org-agenda-prepare (&optional name)
+ (if (org-agenda-use-sticky-p)
(progn
- (setq buffer-read-only nil)
- (goto-char (point-max))
- (unless (or (bobp) org-agenda-compact-blocks
- (not org-agenda-block-separator))
- (insert "\n"
- (if (stringp org-agenda-block-separator)
- org-agenda-block-separator
- (make-string (window-width) org-agenda-block-separator))
- "\n"))
- (narrow-to-region (point) (point-max)))
- (setq org-done-keywords-for-agenda nil)
- (org-agenda-reset-markers)
- (setq org-agenda-contributing-files nil)
- (setq org-agenda-columns-active nil)
- (org-prepare-agenda-buffers (org-agenda-files nil 'ifmode))
- (setq org-todo-keywords-for-agenda
- (org-uniquify org-todo-keywords-for-agenda))
- (setq org-done-keywords-for-agenda
- (org-uniquify org-done-keywords-for-agenda))
- (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
- (let* ((abuf (get-buffer-create org-agenda-buffer-name))
- (awin (get-buffer-window abuf)))
- (cond
- ((equal (current-buffer) abuf) nil)
- (awin (select-window awin))
- ((not (setq org-pre-agenda-window-conf (current-window-configuration))))
- ((equal org-agenda-window-setup 'current-window)
- (org-pop-to-buffer-same-window abuf))
- ((equal org-agenda-window-setup 'other-window)
- (org-switch-to-buffer-other-window abuf))
- ((equal org-agenda-window-setup 'other-frame)
- (switch-to-buffer-other-frame abuf))
- ((equal org-agenda-window-setup 'reorganize-frame)
- (delete-other-windows)
- (org-switch-to-buffer-other-window abuf)))
- ;; additional test in case agenda is invoked from within agenda
- ;; buffer via elisp link
- (unless (equal (current-buffer) abuf)
- (org-pop-to-buffer-same-window abuf)))
- (setq buffer-read-only nil)
- (let ((inhibit-read-only t)) (erase-buffer))
- (org-agenda-mode)
- (and name (not org-agenda-name)
- (org-set-local 'org-agenda-name name)))
- (setq buffer-read-only nil))
-
-(defun org-finalize-agenda ()
+ ;; Popup existing buffer
+ (org-agenda-prepare-window (get-buffer org-agenda-buffer-name))
+ (message "Sticky Agenda buffer, use `r' to refresh")
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
+ (setq org-todo-keywords-for-agenda nil)
+ (setq org-drawers-for-agenda nil)
+ (unless org-agenda-persistent-filter
+ (setq org-agenda-tag-filter nil
+ org-agenda-category-filter nil))
+ (put 'org-agenda-tag-filter :preset-filter
+ org-agenda-tag-filter-preset)
+ (put 'org-agenda-category-filter :preset-filter
+ org-agenda-category-filter-preset)
+ (if org-agenda-multi
+ (progn
+ (setq buffer-read-only nil)
+ (goto-char (point-max))
+ (unless (or (bobp) org-agenda-compact-blocks
+ (not org-agenda-block-separator))
+ (insert "\n"
+ (if (stringp org-agenda-block-separator)
+ org-agenda-block-separator
+ (make-string (window-width) org-agenda-block-separator))
+ "\n"))
+ (narrow-to-region (point) (point-max)))
+ (setq org-done-keywords-for-agenda nil)
+
+ ;; Setting any org variables that are in org-agenda-local-vars
+ ;; list need to be done after the prepare call
+ (org-agenda-prepare-window (get-buffer-create org-agenda-buffer-name))
+ (setq buffer-read-only nil)
+ (org-agenda-reset-markers)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (org-agenda-mode)
+ (setq org-agenda-buffer (current-buffer))
+ (setq org-agenda-contributing-files nil)
+ (setq org-agenda-columns-active nil)
+ (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
+ (setq org-todo-keywords-for-agenda
+ (org-uniquify org-todo-keywords-for-agenda))
+ (setq org-done-keywords-for-agenda
+ (org-uniquify org-done-keywords-for-agenda))
+ (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
+ (setq org-agenda-last-prefix-arg current-prefix-arg)
+ (setq org-agenda-this-buffer-name org-agenda-buffer-name)
+ (and name (not org-agenda-name)
+ (org-set-local 'org-agenda-name name)))
+ (setq buffer-read-only nil)))
+
+(defvar org-agenda-overriding-columns-format) ; From org-colview.el
+(defun org-agenda-finalize ()
"Finishing touch for the agenda buffer, called just before displaying it."
(unless org-agenda-multi
(save-excursion
@@ -3177,13 +3437,14 @@ the global options and expect it to be applied to the entire view.")
(org-agenda-entry-text-show))
(if (functionp 'org-habit-insert-consistency-graphs)
(org-habit-insert-consistency-graphs))
- (run-hooks 'org-finalize-agenda-hook)
+ (let ((inhibit-read-only t))
+ (run-hooks 'org-agenda-finalize-hook))
(setq org-agenda-type (org-get-at-bol 'org-agenda-type))
(when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter))
(org-agenda-filter-apply org-agenda-tag-filter 'tag))
(when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter))
(org-agenda-filter-apply org-agenda-category-filter 'category))
- )))
+ (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))))
(defun org-agenda-mark-clocking-task ()
"Mark the current clock entry in the agenda if it is present."
@@ -3203,7 +3464,7 @@ the global options and expect it to be applied to the entire view.")
(overlay-put ov 'type 'org-agenda-clocking)
(overlay-put ov 'face 'org-agenda-clocking)
(overlay-put ov 'help-echo
- "The clock is running in this item")))))))
+ "The clock is running in this item")))))))
(defun org-agenda-fontify-priorities ()
"Make highest priority lines bold, and lowest italic."
@@ -3288,6 +3549,7 @@ A good way to set it is through options in `org-agenda-custom-commands'.")
Also moves point to the end of the skipped region, so that search can
continue from there."
(let ((p (point-at-bol)) to)
+ (when (org-in-src-block-p) (throw :skip t))
(and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
(get-text-property p :org-archived)
(org-end-of-subtree t)
@@ -3328,7 +3590,10 @@ Org-mode keeps a list of these markers and resets them when they are
no longer in use."
(let ((m (copy-marker (or pos (point)))))
(setq org-agenda-last-marker-time (org-float-time))
- (push m org-agenda-markers)
+ (if org-agenda-buffer
+ (with-current-buffer org-agenda-buffer
+ (push m org-agenda-markers))
+ (push m org-agenda-markers))
m))
(defun org-agenda-reset-markers ()
@@ -3337,9 +3602,13 @@ no longer in use."
(move-marker (pop org-agenda-markers) nil)))
(defun org-agenda-save-markers-for-cut-and-paste (beg end)
- "Save relative positions of markers in region."
- (mapc (lambda (m) (org-check-and-save-marker m beg end))
- org-agenda-markers))
+ "Save relative positions of markers in region.
+This check for agenda markers in all agenda buffers currently active."
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (eq major-mode 'org-agenda-mode)
+ (mapc (lambda (m) (org-check-and-save-marker m beg end))
+ org-agenda-markers)))))
;;; Entry text mode
@@ -3400,18 +3669,17 @@ under the current date.
If the buffer contains an active region, only check the region for
dates."
(interactive "P")
- (org-compile-prefix-format 'timeline)
- (org-set-sorting-strategy 'timeline)
(let* ((dopast t)
- (doclosed org-agenda-show-log)
+ (org-agenda-show-log-scoped org-agenda-show-log)
(entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
(current-buffer))))
(date (calendar-current-date))
(beg (if (org-region-active-p) (region-beginning) (point-min)))
(end (if (org-region-active-p) (region-end) (point-max)))
- (day-numbers (org-get-all-dates beg end 'no-ranges
- t doclosed ; always include today
- org-timeline-show-empty-dates))
+ (day-numbers (org-get-all-dates
+ beg end 'no-ranges
+ t org-agenda-show-log-scoped ; always include today
+ org-timeline-show-empty-dates))
(org-deadline-warning-days 0)
(org-agenda-only-exact-dates t)
(today (org-today))
@@ -3427,8 +3695,10 @@ dates."
(setq day-numbers (delq nil (mapcar (lambda(x)
(if (>= x today) x nil))
day-numbers))))
- (org-prepare-agenda (concat "Timeline " (file-name-nondirectory entry)))
- (if doclosed (push :closed args))
+ (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry)))
+ (org-compile-prefix-format 'timeline)
+ (org-set-sorting-strategy 'timeline)
+ (if org-agenda-show-log-scoped (push :closed args))
(push :timestamp args)
(push :deadline args)
(push :scheduled args)
@@ -3470,13 +3740,13 @@ dates."
(put-text-property s (1- (point)) 'org-agenda-date-header t)
(if (equal d today)
(put-text-property s (1- (point)) 'org-today t))
- (and rtn (insert (org-finalize-agenda-entries rtn) "\n"))
+ (and rtn (insert (org-agenda-finalize-entries rtn) "\n"))
(put-text-property s (1- (point)) 'day d)))))
(goto-char (point-min))
(goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
(point-min)))
(add-text-properties (point-min) (point-max) '(org-agenda-type timeline))
- (org-finalize-agenda)
+ (org-agenda-finalize)
(setq buffer-read-only t)))
(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re)
@@ -3489,7 +3759,7 @@ When EMPTY is non-nil, also include days without any entries."
(let ((re (concat
(if pre-re pre-re "")
(if inactive org-ts-regexp-both org-ts-regexp)))
- dates dates1 date day day1 day2 ts1 ts2 pos)
+ dates dates1 date day day1 day2 ts1 ts2 pos)
(if force-today
(setq dates (list (org-today))))
(save-excursion
@@ -3528,11 +3798,9 @@ When EMPTY is non-nil, also include days without any entries."
;;; Agenda Daily/Weekly
(defvar org-agenda-start-day nil ; dynamically scoped parameter
-"Start day for the agenda view.
+ "Start day for the agenda view.
Custom commands can set this variable in the options section.")
(defvar org-starting-day nil) ; local variable in the agenda buffer
-(defvar org-agenda-current-span nil
- "The current span used in the agenda view.") ; local variable in the agenda buffer
(defvar org-arg-loc nil) ; local variable
(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
@@ -3568,6 +3836,7 @@ command. A good way to set it is through options in
somewhat less efficient) way of determining what is included in
the daily/weekly agenda, see `org-agenda-skip-function'.")
+(defvar org-agenda-buffer-tmp-name nil)
;;;###autoload
(defun org-agenda-list (&optional arg start-day span)
"Produce a daily/weekly view from all files in variable `org-agenda-files'.
@@ -3581,167 +3850,181 @@ the number of days. SPAN defaults to `org-agenda-span'.
START-DAY defaults to TODAY, or to the most recent match for the weekday
given in `org-agenda-start-on-weekday'."
(interactive "P")
- (if (and (integerp arg) (> arg 0))
- (setq span arg arg nil))
- (setq start-day (or start-day org-agenda-start-day))
(if org-agenda-overriding-arguments
(setq arg (car org-agenda-overriding-arguments)
start-day (nth 1 org-agenda-overriding-arguments)
span (nth 2 org-agenda-overriding-arguments)))
- (if (stringp start-day)
- ;; Convert to an absolute day number
- (setq start-day (time-to-days (org-read-date nil t start-day))))
- (setq org-agenda-last-arguments (list arg start-day span))
- (org-compile-prefix-format 'agenda)
- (org-set-sorting-strategy 'agenda)
- (let* ((span (org-agenda-ndays-to-span
- (or span org-agenda-ndays org-agenda-span)))
- (today (org-today))
- (sd (or start-day today))
- (ndays (org-agenda-span-to-ndays span sd))
- (org-agenda-start-on-weekday
- (if (eq ndays 7)
- org-agenda-start-on-weekday))
- (thefiles (org-agenda-files nil 'ifmode))
- (files thefiles)
- (start (if (or (null org-agenda-start-on-weekday)
- (< ndays 7))
- sd
- (let* ((nt (calendar-day-of-week
- (calendar-gregorian-from-absolute sd)))
- (n1 org-agenda-start-on-weekday)
- (d (- nt n1)))
- (- sd (+ (if (< d 0) 7 0) d)))))
- (day-numbers (list start))
- (day-cnt 0)
- (inhibit-redisplay (not debug-on-error))
- s e rtn rtnall file date d start-pos end-pos todayp
- clocktable-start clocktable-end filter)
- (setq org-agenda-redo-command
- (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span)))
- (dotimes (n (1- ndays))
- (push (1+ (car day-numbers)) day-numbers))
- (setq day-numbers (nreverse day-numbers))
- (setq clocktable-start (car day-numbers)
- clocktable-end (1+ (or (org-last day-numbers) 0)))
- (org-prepare-agenda "Day/Week")
- (org-set-local 'org-starting-day (car day-numbers))
- (org-set-local 'org-arg-loc arg)
- (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span))
- (unless org-agenda-compact-blocks
- (let* ((d1 (car day-numbers))
- (d2 (org-last day-numbers))
- (w1 (org-days-to-iso-week d1))
- (w2 (org-days-to-iso-week d2)))
- (setq s (point))
- (if org-agenda-overriding-header
- (insert (org-add-props (copy-sequence org-agenda-overriding-header)
- nil 'face 'org-agenda-structure) "\n")
- (insert (org-agenda-span-name span)
- "-agenda"
- (if (< (- d2 d1) 350)
- (if (= w1 w2)
- (format " (W%02d)" w1)
- (format " (W%02d-W%02d)" w1 w2))
- "")
- ":\n")))
- (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
- 'org-date-line t))
- (org-agenda-mark-header-line s))
- (while (setq d (pop day-numbers))
- (setq date (calendar-gregorian-from-absolute d)
- s (point))
- (if (or (setq todayp (= d today))
- (and (not start-pos) (= d sd)))
- (setq start-pos (point))
- (if (and start-pos (not end-pos))
- (setq end-pos (point))))
- (setq files thefiles
- rtnall nil)
- (while (setq file (pop files))
- (catch 'nextfile
- (org-check-agenda-file file)
- (let ((org-agenda-entry-types org-agenda-entry-types))
- (unless org-agenda-include-deadlines
- (setq org-agenda-entry-types
- (delq :deadline org-agenda-entry-types)))
- (cond
- ((memq org-agenda-show-log '(only clockcheck))
- (setq rtn (org-agenda-get-day-entries
- file date :closed)))
- (org-agenda-show-log
- (setq rtn (apply 'org-agenda-get-day-entries
- file date
- (append '(:closed) org-agenda-entry-types))))
- (t
- (setq rtn (apply 'org-agenda-get-day-entries
- file date
- org-agenda-entry-types)))))
- (setq rtnall (append rtnall rtn)))) ;; all entries
- (if org-agenda-include-diary
- (let ((org-agenda-search-headline-for-time t))
- (require 'diary-lib)
- (setq rtn (org-get-entries-from-diary date))
- (setq rtnall (append rtnall rtn))))
- (if (or rtnall org-agenda-show-all-dates)
- (progn
- (setq day-cnt (1+ day-cnt))
- (insert
- (if (stringp org-agenda-format-date)
- (format-time-string org-agenda-format-date
- (org-time-from-absolute date))
- (funcall org-agenda-format-date date))
- "\n")
- (put-text-property s (1- (point)) 'face
- (org-agenda-get-day-face date))
- (put-text-property s (1- (point)) 'org-date-line t)
- (put-text-property s (1- (point)) 'org-agenda-date-header t)
- (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
- (when todayp
- (put-text-property s (1- (point)) 'org-today t))
- (if rtnall (insert ;; all entries
- (org-finalize-agenda-entries
- (org-agenda-add-time-grid-maybe
- rtnall ndays todayp))
- "\n"))
- (put-text-property s (1- (point)) 'day d)
- (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
- (when (and org-agenda-clockreport-mode clocktable-start)
- (let ((org-agenda-files (org-agenda-files nil 'ifmode))
- ;; the above line is to ensure the restricted range!
- (p (copy-sequence org-agenda-clockreport-parameter-plist))
- tbl)
- (setq p (org-plist-delete p :block))
- (setq p (plist-put p :tstart clocktable-start))
- (setq p (plist-put p :tend clocktable-end))
- (setq p (plist-put p :scope 'agenda))
- (when (and (eq org-agenda-clockreport-mode 'with-filter)
- (setq filter (or org-agenda-tag-filter-while-redo
- (get 'org-agenda-tag-filter :preset-filter))))
- (setq p (plist-put p :tags (mapconcat (lambda (x)
- (if (string-match "[<>=]" x)
- ""
- x))
- filter ""))))
- (setq tbl (apply 'org-get-clocktable p))
- (insert tbl)))
- (goto-char (point-min))
- (or org-agenda-multi (org-fit-agenda-window))
- (unless (and (pos-visible-in-window-p (point-min))
- (pos-visible-in-window-p (point-max)))
- (goto-char (1- (point-max)))
- (recenter -1)
- (if (not (pos-visible-in-window-p (or start-pos 1)))
- (progn
- (goto-char (or start-pos 1))
- (recenter 1))))
- (goto-char (or start-pos 1))
- (add-text-properties (point-min) (point-max) '(org-agenda-type agenda))
- (if (eq org-agenda-show-log 'clockcheck)
- (org-agenda-show-clocking-issues))
- (org-finalize-agenda)
- (setq buffer-read-only t)
- (message "")))
+ (if (and (integerp arg) (> arg 0))
+ (setq span arg arg nil))
+ (catch 'exit
+ (setq org-agenda-buffer-name
+ (or org-agenda-buffer-tmp-name
+ (if org-agenda-sticky
+ (cond ((and org-keys (stringp org-match))
+ (format "*Org Agenda(%s:%s)*" org-keys org-match))
+ (org-keys
+ (format "*Org Agenda(%s)*" org-keys))
+ (t "*Org Agenda(a)*")))
+ org-agenda-buffer-name))
+ (org-agenda-prepare "Day/Week")
+ (setq start-day (or start-day org-agenda-start-day))
+ (if (stringp start-day)
+ ;; Convert to an absolute day number
+ (setq start-day (time-to-days (org-read-date nil t start-day))))
+ (org-compile-prefix-format 'agenda)
+ (org-set-sorting-strategy 'agenda)
+ (let* ((span (org-agenda-ndays-to-span
+ (or span org-agenda-ndays org-agenda-span)))
+ (today (org-today))
+ (sd (or start-day today))
+ (ndays (org-agenda-span-to-ndays span sd))
+ (org-agenda-start-on-weekday
+ (if (eq ndays 7)
+ org-agenda-start-on-weekday))
+ (thefiles (org-agenda-files nil 'ifmode))
+ (files thefiles)
+ (start (if (or (null org-agenda-start-on-weekday)
+ (< ndays 7))
+ sd
+ (let* ((nt (calendar-day-of-week
+ (calendar-gregorian-from-absolute sd)))
+ (n1 org-agenda-start-on-weekday)
+ (d (- nt n1)))
+ (- sd (+ (if (< d 0) 7 0) d)))))
+ (day-numbers (list start))
+ (day-cnt 0)
+ (inhibit-redisplay (not debug-on-error))
+ (org-agenda-show-log-scoped org-agenda-show-log)
+ s e rtn rtnall file date d start-pos end-pos todayp
+ clocktable-start clocktable-end filter)
+ (setq org-agenda-redo-command
+ (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span)))
+ (dotimes (n (1- ndays))
+ (push (1+ (car day-numbers)) day-numbers))
+ (setq day-numbers (nreverse day-numbers))
+ (setq clocktable-start (car day-numbers)
+ clocktable-end (1+ (or (org-last day-numbers) 0)))
+ (org-set-local 'org-starting-day (car day-numbers))
+ (org-set-local 'org-arg-loc arg)
+ (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span))
+ (unless org-agenda-compact-blocks
+ (let* ((d1 (car day-numbers))
+ (d2 (org-last day-numbers))
+ (w1 (org-days-to-iso-week d1))
+ (w2 (org-days-to-iso-week d2)))
+ (setq s (point))
+ (if org-agenda-overriding-header
+ (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+ nil 'face 'org-agenda-structure) "\n")
+ (insert (org-agenda-span-name span)
+ "-agenda"
+ (if (< (- d2 d1) 350)
+ (if (= w1 w2)
+ (format " (W%02d)" w1)
+ (format " (W%02d-W%02d)" w1 w2))
+ "")
+ ":\n")))
+ (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
+ 'org-date-line t))
+ (org-agenda-mark-header-line s))
+ (while (setq d (pop day-numbers))
+ (setq date (calendar-gregorian-from-absolute d)
+ s (point))
+ (if (or (setq todayp (= d today))
+ (and (not start-pos) (= d sd)))
+ (setq start-pos (point))
+ (if (and start-pos (not end-pos))
+ (setq end-pos (point))))
+ (setq files thefiles
+ rtnall nil)
+ (while (setq file (pop files))
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (let ((org-agenda-entry-types org-agenda-entry-types))
+ (unless org-agenda-include-deadlines
+ (setq org-agenda-entry-types
+ (delq :deadline org-agenda-entry-types)))
+ (cond
+ ((memq org-agenda-show-log-scoped '(only clockcheck))
+ (setq rtn (org-agenda-get-day-entries
+ file date :closed)))
+ (org-agenda-show-log-scoped
+ (setq rtn (apply 'org-agenda-get-day-entries
+ file date
+ (append '(:closed) org-agenda-entry-types))))
+ (t
+ (setq rtn (apply 'org-agenda-get-day-entries
+ file date
+ org-agenda-entry-types)))))
+ (setq rtnall (append rtnall rtn)))) ;; all entries
+ (if org-agenda-include-diary
+ (let ((org-agenda-search-headline-for-time t))
+ (require 'diary-lib)
+ (setq rtn (org-get-entries-from-diary date))
+ (setq rtnall (append rtnall rtn))))
+ (if (or rtnall org-agenda-show-all-dates)
+ (progn
+ (setq day-cnt (1+ day-cnt))
+ (insert
+ (if (stringp org-agenda-format-date)
+ (format-time-string org-agenda-format-date
+ (org-time-from-absolute date))
+ (funcall org-agenda-format-date date))
+ "\n")
+ (put-text-property s (1- (point)) 'face
+ (org-agenda-get-day-face date))
+ (put-text-property s (1- (point)) 'org-date-line t)
+ (put-text-property s (1- (point)) 'org-agenda-date-header t)
+ (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
+ (when todayp
+ (put-text-property s (1- (point)) 'org-today t))
+ (setq rtnall
+ (org-agenda-add-time-grid-maybe rtnall ndays todayp))
+ (if rtnall (insert ;; all entries
+ (org-agenda-finalize-entries rtnall)
+ "\n"))
+ (put-text-property s (1- (point)) 'day d)
+ (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
+ (when (and org-agenda-clockreport-mode clocktable-start)
+ (let ((org-agenda-files (org-agenda-files nil 'ifmode))
+ ;; the above line is to ensure the restricted range!
+ (p (copy-sequence org-agenda-clockreport-parameter-plist))
+ tbl)
+ (setq p (org-plist-delete p :block))
+ (setq p (plist-put p :tstart clocktable-start))
+ (setq p (plist-put p :tend clocktable-end))
+ (setq p (plist-put p :scope 'agenda))
+ (when (and (eq org-agenda-clockreport-mode 'with-filter)
+ (setq filter (or org-agenda-tag-filter-while-redo
+ (get 'org-agenda-tag-filter :preset-filter))))
+ (setq p (plist-put p :tags (mapconcat (lambda (x)
+ (if (string-match "[<>=]" x)
+ ""
+ x))
+ filter ""))))
+ (setq tbl (apply 'org-get-clocktable p))
+ (insert tbl)))
+ (goto-char (point-min))
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (unless (and (pos-visible-in-window-p (point-min))
+ (pos-visible-in-window-p (point-max)))
+ (goto-char (1- (point-max)))
+ (recenter -1)
+ (if (not (pos-visible-in-window-p (or start-pos 1)))
+ (progn
+ (goto-char (or start-pos 1))
+ (recenter 1))))
+ (goto-char (or start-pos 1))
+ (add-text-properties (point-min) (point-max)
+ `(org-agenda-type agenda
+ org-last-args (,arg ,start-day ,span)
+ org-redo-cmd ,org-agenda-redo-command
+ org-series-cmd ,org-cmd))
+ (if (eq org-agenda-show-log-scoped 'clockcheck)
+ (org-agenda-show-clocking-issues))
+ (org-agenda-finalize)
+ (setq buffer-read-only t)
+ (message ""))))
(defun org-agenda-ndays-to-span (n)
"Return a span symbol for a span of N days, or N if none matches."
@@ -3750,8 +4033,8 @@ given in `org-agenda-start-on-weekday'."
((= n 7) 'week)
(t n)))
-(defun org-agenda-span-to-ndays (span start-day)
- "Return ndays from SPAN starting at START-DAY."
+(defun org-agenda-span-to-ndays (span &optional start-day)
+ "Return ndays from SPAN, possibly starting at START-DAY."
(cond ((numberp span) span)
((eq span 'day) 1)
((eq span 'week) 7)
@@ -3773,13 +4056,13 @@ given in `org-agenda-start-on-weekday'."
;;; Agenda word search
(defvar org-agenda-search-history nil)
-(defvar org-todo-only nil)
(defvar org-search-syntax-table nil
"Special syntax table for org-mode search.
In this table, we have single quotes not as word constituents, to
that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
+(defvar org-mode-syntax-table) ; From org.el
(defun org-search-syntax-table ()
(unless org-search-syntax-table
(setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table))
@@ -3834,9 +4117,10 @@ as a whole, to include whitespace.
This command searches the agenda files, and in addition the files listed
in `org-agenda-text-search-extra-files'."
(interactive "P")
- (org-compile-prefix-format 'search)
- (org-set-sorting-strategy 'search)
- (org-prepare-agenda "SEARCH")
+ (if org-agenda-overriding-arguments
+ (setq todo-only (car org-agenda-overriding-arguments)
+ string (nth 1 org-agenda-overriding-arguments)
+ edit-at (nth 2 org-agenda-overriding-arguments)))
(let* ((props (list 'face nil
'done-face 'org-agenda-done
'org-not-done-regexp org-not-done-regexp
@@ -3847,7 +4131,7 @@ in `org-agenda-text-search-extra-files'."
(full-words org-agenda-search-view-force-full-words)
(org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
regexp rtn rtnall files file pos
- marker category org-category-pos tags c neg re boolean
+ marker category category-pos tags c neg re boolean
ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
(unless (and (not edit-at)
(stringp string)
@@ -3855,182 +4139,194 @@ in `org-agenda-text-search-extra-files'."
(setq string (read-string
(if org-agenda-search-view-always-boolean
"[+-]Word/{Regexp} ...: "
- "Phrase, or [+-]Word/{Regexp} ...: ")
+ "Phrase or [+-]Word/{Regexp} ...: ")
(cond
((integerp edit-at) (cons string edit-at))
(edit-at string))
'org-agenda-search-history)))
- (org-set-local 'org-todo-only todo-only)
- (setq org-agenda-redo-command
- (list 'org-search-view (if todo-only t nil) string
- '(if current-prefix-arg 1 nil)))
- (setq org-agenda-query-string string)
-
- (if (equal (string-to-char string) ?*)
- (setq hdl-only t
- words (substring string 1))
- (setq words string))
- (when (equal (string-to-char words) ?!)
- (setq todo-only t
- words (substring words 1)))
- (when (equal (string-to-char words) ?:)
- (setq full-words t
- words (substring words 1)))
- (if (or org-agenda-search-view-always-boolean
- (member (string-to-char words) '(?- ?+ ?\{)))
- (setq boolean t))
- (setq words (org-split-string words))
- (let (www w)
- (while (setq w (pop words))
- (while (and (string-match "\\\\\\'" w) words)
- (setq w (concat (substring w 0 -1) " " (pop words))))
- (push w www))
- (setq words (nreverse www) www nil)
- (while (setq w (pop words))
- (when (and (string-match "\\`[-+]?{" w)
- (not (string-match "}\\'" w)))
- (while (and words (not (string-match "}\\'" (car words))))
- (setq w (concat w " " (pop words))))
- (setq w (concat w " " (pop words))))
- (push w www))
- (setq words (nreverse www)))
- (setq org-agenda-last-search-view-search-was-boolean boolean)
- (when boolean
- (let (wds w)
+ (catch 'exit
+ (if org-agenda-sticky
+ (setq org-agenda-buffer-name
+ (if (stringp string)
+ (format "*Org Agenda(%s:%s)*"
+ (or org-keys (or (and todo-only "S") "s")) string)
+ (format "*Org Agenda(%s)*" (or (and todo-only "S") "s")))))
+ (org-agenda-prepare "SEARCH")
+ (org-compile-prefix-format 'search)
+ (org-set-sorting-strategy 'search)
+ (setq org-agenda-redo-command
+ (list 'org-search-view (if todo-only t nil)
+ (list 'if 'current-prefix-arg nil string)))
+ (setq org-agenda-query-string string)
+ (if (equal (string-to-char string) ?*)
+ (setq hdl-only t
+ words (substring string 1))
+ (setq words string))
+ (when (equal (string-to-char words) ?!)
+ (setq todo-only t
+ words (substring words 1)))
+ (when (equal (string-to-char words) ?:)
+ (setq full-words t
+ words (substring words 1)))
+ (if (or org-agenda-search-view-always-boolean
+ (member (string-to-char words) '(?- ?+ ?\{)))
+ (setq boolean t))
+ (setq words (org-split-string words))
+ (let (www w)
(while (setq w (pop words))
- (if (or (equal (substring w 0 1) "\"")
- (and (> (length w) 1)
- (member (substring w 0 1) '("+" "-"))
- (equal (substring w 1 2) "\"")))
- (while (and words (not (equal (substring w -1) "\"")))
- (setq w (concat w " " (pop words)))))
- (and (string-match "\\`\\([-+]?\\)\"" w)
- (setq w (replace-match "\\1" nil nil w)))
- (and (equal (substring w -1) "\"") (setq w (substring w 0 -1)))
- (push w wds))
- (setq words (nreverse wds))))
- (if boolean
- (mapc (lambda (w)
- (setq c (string-to-char w))
- (if (equal c ?-)
- (setq neg t w (substring w 1))
- (if (equal c ?+)
- (setq neg nil w (substring w 1))
- (setq neg nil)))
- (if (string-match "\\`{.*}\\'" w)
- (setq re (substring w 1 -1))
- (if full-words
- (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))
- (setq re (regexp-quote (downcase w)))))
- (if neg (push re regexps-) (push re regexps+)))
- words)
- (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+")
- regexps+))
- (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
- (if (not regexps+)
- (setq regexp org-outline-regexp-bol)
- (setq regexp (pop regexps+))
- (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
- regexp))))
- (setq files (org-agenda-files nil 'ifmode))
- (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
- (pop org-agenda-text-search-extra-files)
- (setq files (org-add-archive-files files)))
- (setq files (append files org-agenda-text-search-extra-files)
- rtnall nil)
- (while (setq file (pop files))
- (setq ee nil)
- (catch 'nextfile
- (org-check-agenda-file file)
- (setq buffer (if (file-exists-p file)
- (org-get-agenda-file-buffer file)
- (error "No such file %s" file)))
- (if (not buffer)
- ;; If file does not exist, make sure an error message is sent
- (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s"
- file))))
- (with-current-buffer buffer
- (with-syntax-table (org-search-syntax-table)
- (unless (eq major-mode 'org-mode)
- (error "Agenda file %s is not in `org-mode'" file))
- (let ((case-fold-search t))
- (save-excursion
- (save-restriction
- (if org-agenda-restrict
- (narrow-to-region org-agenda-restrict-begin
- org-agenda-restrict-end)
- (widen))
- (goto-char (point-min))
- (unless (or (org-at-heading-p)
- (outline-next-heading))
- (throw 'nextfile t))
- (goto-char (max (point-min) (1- (point))))
- (while (re-search-forward regexp nil t)
- (org-back-to-heading t)
- (skip-chars-forward "* ")
- (setq beg (point-at-bol)
- beg1 (point)
- end (progn (outline-next-heading) (point)))
- (catch :skip
- (goto-char beg)
- (org-agenda-skip)
- (setq str (buffer-substring-no-properties
- (point-at-bol)
- (if hdl-only (point-at-eol) end)))
- (mapc (lambda (wr) (when (string-match wr str)
- (goto-char (1- end))
- (throw :skip t)))
- regexps-)
- (mapc (lambda (wr) (unless (string-match wr str)
- (goto-char (1- end))
- (throw :skip t)))
- (if todo-only
- (cons (concat "^\*+[ \t]+" org-not-done-regexp)
- regexps+)
- regexps+))
- (goto-char beg)
- (setq marker (org-agenda-new-marker (point))
- category (org-get-category)
- org-category-pos (get-text-property (point) 'org-category-position)
- tags (org-get-tags-at (point))
- txt (org-agenda-format-item
- ""
- (buffer-substring-no-properties
- beg1 (point-at-eol))
- category tags))
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker marker
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'priority 1000 'org-category category
- 'org-category-position org-category-pos
- 'type "search")
- (push txt ee)
- (goto-char (1- end))))))))))
- (setq rtn (nreverse ee))
- (setq rtnall (append rtnall rtn)))
- (if org-agenda-overriding-header
- (insert (org-add-props (copy-sequence org-agenda-overriding-header)
- nil 'face 'org-agenda-structure) "\n")
- (insert "Search words: ")
- (add-text-properties (point-min) (1- (point))
- (list 'face 'org-agenda-structure))
- (setq pos (point))
- (insert string "\n")
- (add-text-properties pos (1- (point)) (list 'face 'org-warning))
- (setq pos (point))
- (unless org-agenda-multi
- (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n")
- (add-text-properties pos (1- (point))
- (list 'face 'org-agenda-structure))))
- (org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-finalize-agenda-entries rtnall) "\n"))
- (goto-char (point-min))
- (or org-agenda-multi (org-fit-agenda-window))
- (add-text-properties (point-min) (point-max) '(org-agenda-type search))
- (org-finalize-agenda)
- (setq buffer-read-only t)))
+ (while (and (string-match "\\\\\\'" w) words)
+ (setq w (concat (substring w 0 -1) " " (pop words))))
+ (push w www))
+ (setq words (nreverse www) www nil)
+ (while (setq w (pop words))
+ (when (and (string-match "\\`[-+]?{" w)
+ (not (string-match "}\\'" w)))
+ (while (and words (not (string-match "}\\'" (car words))))
+ (setq w (concat w " " (pop words))))
+ (setq w (concat w " " (pop words))))
+ (push w www))
+ (setq words (nreverse www)))
+ (setq org-agenda-last-search-view-search-was-boolean boolean)
+ (when boolean
+ (let (wds w)
+ (while (setq w (pop words))
+ (if (or (equal (substring w 0 1) "\"")
+ (and (> (length w) 1)
+ (member (substring w 0 1) '("+" "-"))
+ (equal (substring w 1 2) "\"")))
+ (while (and words (not (equal (substring w -1) "\"")))
+ (setq w (concat w " " (pop words)))))
+ (and (string-match "\\`\\([-+]?\\)\"" w)
+ (setq w (replace-match "\\1" nil nil w)))
+ (and (equal (substring w -1) "\"") (setq w (substring w 0 -1)))
+ (push w wds))
+ (setq words (nreverse wds))))
+ (if boolean
+ (mapc (lambda (w)
+ (setq c (string-to-char w))
+ (if (equal c ?-)
+ (setq neg t w (substring w 1))
+ (if (equal c ?+)
+ (setq neg nil w (substring w 1))
+ (setq neg nil)))
+ (if (string-match "\\`{.*}\\'" w)
+ (setq re (substring w 1 -1))
+ (if full-words
+ (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))
+ (setq re (regexp-quote (downcase w)))))
+ (if neg (push re regexps-) (push re regexps+)))
+ words)
+ (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+")
+ regexps+))
+ (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
+ (if (not regexps+)
+ (setq regexp org-outline-regexp-bol)
+ (setq regexp (pop regexps+))
+ (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
+ regexp))))
+ (setq files (org-agenda-files nil 'ifmode))
+ (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
+ (pop org-agenda-text-search-extra-files)
+ (setq files (org-add-archive-files files)))
+ (setq files (append files org-agenda-text-search-extra-files)
+ rtnall nil)
+ (while (setq file (pop files))
+ (setq ee nil)
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (setq buffer (if (file-exists-p file)
+ (org-get-agenda-file-buffer file)
+ (error "No such file %s" file)))
+ (if (not buffer)
+ ;; If file does not exist, make sure an error message is sent
+ (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s"
+ file))))
+ (with-current-buffer buffer
+ (with-syntax-table (org-search-syntax-table)
+ (unless (derived-mode-p 'org-mode)
+ (error "Agenda file %s is not in `org-mode'" file))
+ (let ((case-fold-search t))
+ (save-excursion
+ (save-restriction
+ (if org-agenda-restrict
+ (narrow-to-region org-agenda-restrict-begin
+ org-agenda-restrict-end)
+ (widen))
+ (goto-char (point-min))
+ (unless (or (org-at-heading-p)
+ (outline-next-heading))
+ (throw 'nextfile t))
+ (goto-char (max (point-min) (1- (point))))
+ (while (re-search-forward regexp nil t)
+ (org-back-to-heading t)
+ (skip-chars-forward "* ")
+ (setq beg (point-at-bol)
+ beg1 (point)
+ end (progn (outline-next-heading) (point)))
+ (catch :skip
+ (goto-char beg)
+ (org-agenda-skip)
+ (setq str (buffer-substring-no-properties
+ (point-at-bol)
+ (if hdl-only (point-at-eol) end)))
+ (mapc (lambda (wr) (when (string-match wr str)
+ (goto-char (1- end))
+ (throw :skip t)))
+ regexps-)
+ (mapc (lambda (wr) (unless (string-match wr str)
+ (goto-char (1- end))
+ (throw :skip t)))
+ (if todo-only
+ (cons (concat "^\*+[ \t]+" org-not-done-regexp)
+ regexps+)
+ regexps+))
+ (goto-char beg)
+ (setq marker (org-agenda-new-marker (point))
+ category (org-get-category)
+ category-pos (get-text-property (point) 'org-category-position)
+ tags (org-get-tags-at (point))
+ txt (org-agenda-format-item
+ ""
+ (buffer-substring-no-properties
+ beg1 (point-at-eol))
+ category tags t))
+ (org-add-props txt props
+ 'org-marker marker 'org-hd-marker marker
+ 'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'priority 1000 'org-category category
+ 'org-category-position category-pos
+ 'type "search")
+ (push txt ee)
+ (goto-char (1- end))))))))))
+ (setq rtn (nreverse ee))
+ (setq rtnall (append rtnall rtn)))
+ (if org-agenda-overriding-header
+ (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+ nil 'face 'org-agenda-structure) "\n")
+ (insert "Search words: ")
+ (add-text-properties (point-min) (1- (point))
+ (list 'face 'org-agenda-structure))
+ (setq pos (point))
+ (insert string "\n")
+ (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (setq pos (point))
+ (unless org-agenda-multi
+ (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n")
+ (add-text-properties pos (1- (point))
+ (list 'face 'org-agenda-structure))))
+ (org-agenda-mark-header-line (point-min))
+ (when rtnall
+ (insert (org-agenda-finalize-entries rtnall) "\n"))
+ (goto-char (point-min))
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (add-text-properties (point-min) (point-max)
+ `(org-agenda-type search
+ org-last-args (,todo-only ,string ,edit-at)
+ org-redo-cmd ,org-agenda-redo-command
+ org-series-cmd ,org-cmd))
+ (org-agenda-finalize)
+ (setq buffer-read-only t))))
;;; Agenda TODO list
@@ -4038,16 +4334,15 @@ in `org-agenda-text-search-extra-files'."
(defvar org-last-arg nil)
;;;###autoload
-(defun org-todo-list (arg)
+(defun org-todo-list (&optional arg)
"Show all (not done) TODO entries from all agenda file in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
the list to these. When using \\[universal-argument], you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords-1'."
(interactive "P")
- (org-compile-prefix-format 'todo)
- (org-set-sorting-strategy 'todo)
- (org-prepare-agenda "TODO")
+ (if org-agenda-overriding-arguments
+ (setq arg org-agenda-overriding-arguments))
(if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
(let* ((today (org-today))
(date (calendar-gregorian-from-absolute today))
@@ -4061,51 +4356,67 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(when (equal arg '(4))
(setq org-select-this-todo-keyword
(org-icompleting-read "Keyword (or KWD1|K2D2|...): "
- (mapcar 'list kwds) nil nil)))
+ (mapcar 'list kwds) nil nil)))
(and (equal 0 arg) (setq org-select-this-todo-keyword nil))
- (org-set-local 'org-last-arg arg)
- (setq org-agenda-redo-command
- '(org-todo-list (or current-prefix-arg org-last-arg)))
- (setq files (org-agenda-files nil 'ifmode)
- rtnall nil)
- (while (setq file (pop files))
- (catch 'nextfile
- (org-check-agenda-file file)
- (setq rtn (org-agenda-get-day-entries file date :todo))
- (setq rtnall (append rtnall rtn))))
- (if org-agenda-overriding-header
- (insert (org-add-props (copy-sequence org-agenda-overriding-header)
- nil 'face 'org-agenda-structure) "\n")
- (insert "Global list of TODO items of type: ")
- (add-text-properties (point-min) (1- (point))
- (list 'face 'org-agenda-structure
- 'short-heading
- (concat "ToDo: "
- (or org-select-this-todo-keyword "ALL"))))
+ (catch 'exit
+ (if org-agenda-sticky
+ (setq org-agenda-buffer-name
+ (if (stringp org-select-this-todo-keyword)
+ (format "*Org Agenda(%s:%s)*" (or org-keys "t")
+ org-select-this-todo-keyword)
+ (format "*Org Agenda(%s)*" (or org-keys "t")))))
+ (org-agenda-prepare "TODO")
+ (org-compile-prefix-format 'todo)
+ (org-set-sorting-strategy 'todo)
+ (setq org-agenda-redo-command
+ `(org-todo-list (or (and (numberp current-prefix-arg)
+ current-prefix-arg)
+ ,org-select-this-todo-keyword
+ current-prefix-arg ,arg)))
+ (setq files (org-agenda-files nil 'ifmode)
+ rtnall nil)
+ (while (setq file (pop files))
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (setq rtn (org-agenda-get-day-entries file date :todo))
+ (setq rtnall (append rtnall rtn))))
+ (if org-agenda-overriding-header
+ (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+ nil 'face 'org-agenda-structure) "\n")
+ (insert "Global list of TODO items of type: ")
+ (add-text-properties (point-min) (1- (point))
+ (list 'face 'org-agenda-structure
+ 'short-heading
+ (concat "ToDo: "
+ (or org-select-this-todo-keyword "ALL"))))
+ (org-agenda-mark-header-line (point-min))
+ (setq pos (point))
+ (insert (or org-select-this-todo-keyword "ALL") "\n")
+ (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (setq pos (point))
+ (unless org-agenda-multi
+ (insert "Available with `N r': (0)[ALL]")
+ (let ((n 0) s)
+ (mapc (lambda (x)
+ (setq s (format "(%d)%s" (setq n (1+ n)) x))
+ (if (> (+ (current-column) (string-width s) 1) (frame-width))
+ (insert "\n "))
+ (insert " " s))
+ kwds))
+ (insert "\n"))
+ (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
(org-agenda-mark-header-line (point-min))
- (setq pos (point))
- (insert (or org-select-this-todo-keyword "ALL") "\n")
- (add-text-properties pos (1- (point)) (list 'face 'org-warning))
- (setq pos (point))
- (unless org-agenda-multi
- (insert "Available with `N r': (0)ALL")
- (let ((n 0) s)
- (mapc (lambda (x)
- (setq s (format "(%d)%s" (setq n (1+ n)) x))
- (if (> (+ (current-column) (string-width s) 1) (frame-width))
- (insert "\n "))
- (insert " " s))
- kwds))
- (insert "\n"))
- (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
- (org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-finalize-agenda-entries rtnall) "\n"))
- (goto-char (point-min))
- (or org-agenda-multi (org-fit-agenda-window))
- (add-text-properties (point-min) (point-max) '(org-agenda-type todo))
- (org-finalize-agenda)
- (setq buffer-read-only t)))
+ (when rtnall
+ (insert (org-agenda-finalize-entries rtnall) "\n"))
+ (goto-char (point-min))
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (add-text-properties (point-min) (point-max)
+ `(org-agenda-type todo
+ org-last-args ,arg
+ org-redo-cmd ,org-agenda-redo-command
+ org-series-cmd ,org-cmd))
+ (org-agenda-finalize)
+ (setq buffer-read-only t))))
;;; Agenda tags match
@@ -4114,8 +4425,9 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
"Show all headlines for all `org-agenda-files' matching a TAGS criterion.
The prefix arg TODO-ONLY limits the search to TODO entries."
(interactive "P")
- (org-compile-prefix-format 'tags)
- (org-set-sorting-strategy 'tags)
+ (if org-agenda-overriding-arguments
+ (setq todo-only (car org-agenda-overriding-arguments)
+ match (nth 1 org-agenda-overriding-arguments)))
(let* ((org-tags-match-list-sublevels
org-tags-match-list-sublevels)
(completion-ignore-case t)
@@ -4125,58 +4437,71 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(setq match nil))
(setq matcher (org-make-tags-matcher match)
match (car matcher) matcher (cdr matcher))
- (org-prepare-agenda (concat "TAGS " match))
- (setq org-agenda-query-string match)
- (setq org-agenda-redo-command
- (list 'org-tags-view (list 'quote todo-only)
- (list 'if 'current-prefix-arg nil 'org-agenda-query-string)))
- (setq files (org-agenda-files nil 'ifmode)
- rtnall nil)
- (while (setq file (pop files))
- (catch 'nextfile
- (org-check-agenda-file file)
- (setq buffer (if (file-exists-p file)
- (org-get-agenda-file-buffer file)
- (error "No such file %s" file)))
- (if (not buffer)
- ;; If file does not exist, error message to agenda
- (setq rtn (list
- (format "ORG-AGENDA-ERROR: No such org-file %s" file))
- rtnall (append rtnall rtn))
- (with-current-buffer buffer
- (unless (eq major-mode 'org-mode)
- (error "Agenda file %s is not in `org-mode'" file))
- (save-excursion
- (save-restriction
- (if org-agenda-restrict
- (narrow-to-region org-agenda-restrict-begin
- org-agenda-restrict-end)
- (widen))
- (setq rtn (org-scan-tags 'agenda matcher todo-only))
- (setq rtnall (append rtnall rtn))))))))
- (if org-agenda-overriding-header
- (insert (org-add-props (copy-sequence org-agenda-overriding-header)
- nil 'face 'org-agenda-structure) "\n")
- (insert "Headlines with TAGS match: ")
- (add-text-properties (point-min) (1- (point))
- (list 'face 'org-agenda-structure
- 'short-heading
- (concat "Match: " match)))
- (setq pos (point))
- (insert match "\n")
- (add-text-properties pos (1- (point)) (list 'face 'org-warning))
- (setq pos (point))
- (unless org-agenda-multi
- (insert "Press `C-u r' to search again with new search string\n"))
- (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
- (org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-finalize-agenda-entries rtnall) "\n"))
- (goto-char (point-min))
- (or org-agenda-multi (org-fit-agenda-window))
- (add-text-properties (point-min) (point-max) '(org-agenda-type tags))
- (org-finalize-agenda)
- (setq buffer-read-only t)))
+ (catch 'exit
+ (if org-agenda-sticky
+ (setq org-agenda-buffer-name
+ (if (stringp match)
+ (format "*Org Agenda(%s:%s)*"
+ (or org-keys (or (and todo-only "M") "m")) match)
+ (format "*Org Agenda(%s)*" (or (and todo-only "M") "m")))))
+ (org-agenda-prepare (concat "TAGS " match))
+ (org-compile-prefix-format 'tags)
+ (org-set-sorting-strategy 'tags)
+ (setq org-agenda-query-string match)
+ (setq org-agenda-redo-command
+ (list 'org-tags-view `(quote ,todo-only)
+ (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string))))
+ (setq files (org-agenda-files nil 'ifmode)
+ rtnall nil)
+ (while (setq file (pop files))
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (setq buffer (if (file-exists-p file)
+ (org-get-agenda-file-buffer file)
+ (error "No such file %s" file)))
+ (if (not buffer)
+ ;; If file does not exist, error message to agenda
+ (setq rtn (list
+ (format "ORG-AGENDA-ERROR: No such org-file %s" file))
+ rtnall (append rtnall rtn))
+ (with-current-buffer buffer
+ (unless (derived-mode-p 'org-mode)
+ (error "Agenda file %s is not in `org-mode'" file))
+ (save-excursion
+ (save-restriction
+ (if org-agenda-restrict
+ (narrow-to-region org-agenda-restrict-begin
+ org-agenda-restrict-end)
+ (widen))
+ (setq rtn (org-scan-tags 'agenda matcher todo-only))
+ (setq rtnall (append rtnall rtn))))))))
+ (if org-agenda-overriding-header
+ (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+ nil 'face 'org-agenda-structure) "\n")
+ (insert "Headlines with TAGS match: ")
+ (add-text-properties (point-min) (1- (point))
+ (list 'face 'org-agenda-structure
+ 'short-heading
+ (concat "Match: " match)))
+ (setq pos (point))
+ (insert match "\n")
+ (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (setq pos (point))
+ (unless org-agenda-multi
+ (insert "Press `C-u r' to search again with new search string\n"))
+ (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
+ (org-agenda-mark-header-line (point-min))
+ (when rtnall
+ (insert (org-agenda-finalize-entries rtnall) "\n"))
+ (goto-char (point-min))
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (add-text-properties (point-min) (point-max)
+ `(org-agenda-type tags
+ org-last-args (,todo-only ,match)
+ org-redo-cmd ,org-agenda-redo-command
+ org-series-cmd ,org-cmd))
+ (org-agenda-finalize)
+ (setq buffer-read-only t))))
;;; Agenda Finding stuck projects
@@ -4305,15 +4630,18 @@ that can be put into `org-agenda-skip-function' for the duration of a command."
(not (re-search-forward (nth 1 m) end t)))
(and (or
(setq m (memq 'nottodo conditions))
+ (setq m (memq 'todo-unblocked conditions))
+ (setq m (memq 'nottodo-unblocked conditions))
(setq m (memq 'todo conditions)))
(org-agenda-skip-if-todo m end)))
end)))
(defun org-agenda-skip-if-todo (args end)
"Helper function for `org-agenda-skip-if', do not use it directly.
-ARGS is a list with first element either `todo' or `nottodo'.
-The remainder is either a list of TODO keywords, or a state symbol
-`todo' or `done' or `any'."
+ARGS is a list with first element either `todo', `nottodo',
+`todo-unblocked' or `nottodo-unblocked'. The remainder is either
+a list of TODO keywords, or a state symbol `todo' or `done' or
+`any'."
(let ((kw (car args))
(arg (cadr args))
todo-wds todo-re)
@@ -4337,9 +4665,20 @@ The remainder is either a list of TODO keywords, or a state symbol
(concat "^\\*+[ \t]+\\<\\("
(mapconcat 'identity todo-wds "\\|")
"\\)\\>"))
- (if (eq kw 'todo)
- (re-search-forward todo-re end t)
- (not (re-search-forward todo-re end t)))))
+ (cond
+ ((eq kw 'todo) (re-search-forward todo-re end t))
+ ((eq kw 'nottodo) (not (re-search-forward todo-re end t)))
+ ((eq kw 'todo-unblocked)
+ (catch 'unblocked
+ (while (re-search-forward todo-re end t)
+ (or (org-entry-blocked-p) (throw 'unblocked t)))
+ nil))
+ ((eq kw 'nottodo-unblocked)
+ (catch 'unblocked
+ (while (re-search-forward todo-re end t)
+ (or (org-entry-blocked-p) (throw 'unblocked nil)))
+ t))
+ )))
;;;###autoload
(defun org-agenda-list-stuck-projects (&rest ignore)
@@ -4357,7 +4696,7 @@ of what a project is and how to check if it stuck, customize the variable
(todo (nth 1 org-stuck-projects))
(todo-wds (if (member "*" todo)
(progn
- (org-prepare-agenda-buffers (org-agenda-files
+ (org-agenda-prepare-buffers (org-agenda-files
nil 'ifmode))
(org-delete-all
org-done-keywords-for-agenda
@@ -4390,13 +4729,12 @@ of what a project is and how to check if it stuck, customize the variable
(org-tags-view nil matcher)
(with-current-buffer org-agenda-buffer-name
(setq org-agenda-redo-command
- '(org-agenda-list-stuck-projects
- (or current-prefix-arg org-last-arg))))))
+ `(org-agenda-list-stuck-projects ,current-prefix-arg)))))
;;; Diary integration
(defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param.
-(defvar list-diary-entries-hook)
+(defvar diary-list-entries-hook)
(defvar diary-time-regexp)
(defun org-get-entries-from-diary (date)
"Get the (Emacs Calendar) diary entries for DATE."
@@ -4405,8 +4743,8 @@ of what a project is and how to check if it stuck, customize the variable
(diary-display-hook '(fancy-diary-display))
(diary-display-function 'fancy-diary-display)
(pop-up-frames nil)
- (list-diary-entries-hook
- (cons 'org-diary-default-entry list-diary-entries-hook))
+ (diary-list-entries-hook
+ (cons 'org-diary-default-entry diary-list-entries-hook))
(diary-file-name-prefix-function nil) ; turn this feature off
(diary-modify-entry-list-string-function 'org-modify-diary-entry-string)
entries
@@ -4517,7 +4855,7 @@ Needed to avoid empty dates which mess up holiday display."
;;;###autoload
(defun org-diary (&rest args)
- "Return diary information from org-files.
+ "Return diary information from org files.
This function can be used in a \"sexp\" diary entry in the Emacs calendar.
It accesses org files and extracts information from those files to be
listed in the diary. The function accepts arguments specifying what
@@ -4545,6 +4883,8 @@ function from a program - use `org-agenda-get-day-entries' instead."
(when (> (- (org-float-time)
org-agenda-last-marker-time)
5)
+ ;; I am not sure if this works with sticky agendas, because the marker
+ ;; list is then no longer a global variable.
(org-agenda-reset-markers))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
@@ -4558,7 +4898,7 @@ function from a program - use `org-agenda-get-day-entries' instead."
(> (- time
org-diary-last-run-time)
3))
- (org-prepare-agenda-buffers files))
+ (org-agenda-prepare-buffers files))
(setq org-diary-last-run-time time)
;; If this is called during org-agenda, don't return any entries to
;; the calendar. Org Agenda will list these entries itself.
@@ -4567,7 +4907,7 @@ function from a program - use `org-agenda-get-day-entries' instead."
(setq rtn (apply 'org-agenda-get-day-entries file date args))
(setq results (append results rtn)))
(if results
- (concat (org-finalize-agenda-entries results) "\n"))))
+ (concat (org-agenda-finalize-entries results) "\n"))))
;;; Agenda entry finders
@@ -4588,8 +4928,9 @@ the documentation of `org-diary'."
;; If file does not exist, make sure an error message ends up in diary
(list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
(with-current-buffer buffer
- (unless (eq major-mode 'org-mode)
+ (unless (derived-mode-p 'org-mode)
(error "Agenda file %s is not in `org-mode'" file))
+ (setq org-agenda-buffer (or org-agenda-buffer buffer))
(let ((case-fold-search nil))
(save-excursion
(save-restriction
@@ -4608,7 +4949,7 @@ the documentation of `org-diary'."
((eq arg :timestamp)
(setq rtn (org-agenda-get-blocks))
(setq results (append results rtn))
- (setq rtn (org-agenda-get-timestamps))
+ (setq rtn (org-agenda-get-timestamps deadline-results))
(setq results (append results rtn)))
((eq arg :sexp)
(setq rtn (org-agenda-get-sexps))
@@ -4650,7 +4991,7 @@ the documentation of `org-diary'."
"|")
"\\|") "\\)"))
(t org-not-done-regexp))))
- marker priority category org-category-pos tags todo-state
+ marker priority category category-pos tags todo-state
ee txt beg end)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -4666,17 +5007,17 @@ the documentation of `org-diary'."
(goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category)
- org-category-pos (get-text-property (point) 'org-category-position)
+ category-pos (get-text-property (point) 'org-category-position)
txt (org-trim
(buffer-substring (match-beginning 2) (match-end 0)))
tags (org-get-tags-at (point))
- txt (org-agenda-format-item "" txt category tags)
+ txt (org-agenda-format-item "" txt category tags t)
priority (1+ (org-get-priority txt))
todo-state (org-get-todo-state))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
'priority priority 'org-category category
- 'org-category-position org-category-pos
+ 'org-category-position category-pos
'type "todo" 'todo-state todo-state)
(push txt ee)
(if org-agenda-todo-list-sublevels
@@ -4685,7 +5026,7 @@ the documentation of `org-diary'."
(nreverse ee)))
(defun org-agenda-todo-custom-ignore-p (time n)
- "Check whether timestamp is farther away then n number of days.
+ "Check whether timestamp is farther away than n number of days.
This function is invoked if `org-agenda-todo-ignore-deadlines',
`org-agenda-todo-ignore-scheduled' or
`org-agenda-todo-ignore-timestamp' is set to an integer."
@@ -4760,7 +5101,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(defconst org-agenda-no-heading-message
"No heading for this item in buffer or region.")
-(defun org-agenda-get-timestamps ()
+(defun org-agenda-get-timestamps (&optional deadline-results)
"Return the date stamp information for agenda display."
(let* ((props (list 'face 'org-agenda-calendar-event
'org-not-done-regexp org-not-done-regexp
@@ -4771,13 +5112,13 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(d1 (calendar-absolute-from-gregorian date))
- (remove-re
- (concat
- (regexp-quote
- (format-time-string
- "<%Y-%m-%d"
- (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
- ".*?>"))
+ mm
+ (deadline-position-alist
+ (mapcar (lambda (a) (and (setq mm (get-text-property
+ 0 'org-hd-marker a))
+ (cons (marker-position mm) a)))
+ deadline-results))
+ (remove-re org-ts-regexp)
(regexp
(concat
(if org-agenda-include-inactive-timestamps "[[<]" "<")
@@ -4788,11 +5129,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(apply 'encode-time ; DATE bound by calendar
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11))
- "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
+ "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
"\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
marker hdmarker deadlinep scheduledp clockp closedp inactivep
- donep tmp priority category org-category-pos ee txt timestr tags
- b0 b3 e3 head todo-state end-of-match show-all)
+ donep tmp priority category category-pos ee txt timestr tags
+ b0 b3 e3 head todo-state end-of-match show-all warntime)
(goto-char (point-min))
(while (setq end-of-match (re-search-forward regexp nil t))
(setq b0 (match-beginning 0)
@@ -4824,6 +5165,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
clockp (and org-agenda-include-inactive-timestamps
(or (string-match org-clock-string tmp)
(string-match "]-+\\'" tmp)))
+ warntime (org-entry-get (point) "APPT_WARNTIME")
donep (member todo-state org-done-keywords))
(if (or scheduledp deadlinep closedp clockp
(and donep org-agenda-skip-timestamp-if-done))
@@ -4833,11 +5175,14 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq timestr (substring timestr 0 (match-end 0))))
(setq marker (org-agenda-new-marker b0)
category (org-get-category b0)
- org-category-pos (get-text-property b0 'org-category-position))
+ category-pos (get-text-property b0 'org-category-position))
(save-excursion
(if (not (re-search-backward org-outline-regexp-bol nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-beginning 0))
+ (if (and (eq t org-agenda-skip-timestamp-if-deadline-is-shown)
+ (assoc (point) deadline-position-alist))
+ (throw :skip nil))
(setq hdmarker (org-agenda-new-marker)
tags (org-get-tags-at))
(looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
@@ -4845,14 +5190,15 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq txt (org-agenda-format-item
(if inactivep org-agenda-inactive-leader nil)
head category tags timestr
- remove-re)))
+ remove-re t)))
(setq priority (org-get-priority txt))
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker)
(org-add-props txt nil 'priority priority
'org-category category 'date date
- 'org-category-position org-category-pos
+ 'org-category-position category-pos
'todo-state todo-state
+ 'warntime warntime
'type "timestamp")
(push txt ee))
(if org-agenda-skip-additional-timestamps-same-entry
@@ -4869,8 +5215,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp "^&?%%(")
- marker category org-category-pos ee txt tags entry
- result beg b sexp sexp-entry todo-state)
+ marker category extra category-pos ee txt tags entry
+ result beg b sexp sexp-entry todo-state warntime)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -4887,23 +5233,30 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(when result
(setq marker (org-agenda-new-marker beg)
category (org-get-category beg)
- org-category-pos (get-text-property beg 'org-category-position)
- todo-state (org-get-todo-state))
+ category-pos (get-text-property beg 'org-category-position)
+ tags (save-excursion (org-backward-heading-same-level 0)
+ (org-get-tags-at))
+ todo-state (org-get-todo-state)
+ warntime (org-entry-get (point) "APPT_WARNTIME"))
(dolist (r (if (stringp result)
(list result)
result)) ;; we expect a list here
+ (when (and org-agenda-diary-sexp-prefix
+ (string-match org-agenda-diary-sexp-prefix r))
+ (setq extra (match-string 0 r)
+ r (replace-match "" nil nil r)))
(if (string-match "\\S-" r)
(setq txt r)
(setq txt "SEXP entry returned empty string"))
(setq txt (org-agenda-format-item
- "" txt category tags 'time))
+ extra txt category tags 'time))
(org-add-props txt props 'org-marker marker)
(org-add-props txt nil
'org-category category 'date date 'todo-state todo-state
- 'org-category-position org-category-pos
- 'type "sexp")
+ 'org-category-position category-pos 'tags tags
+ 'type "sexp" 'warntime warntime)
(push txt ee)))))
(nreverse ee)))
@@ -4977,6 +5330,7 @@ please use `org-class' instead."
dayname skip-weeks)))
(make-obsolete 'org-diary-class 'org-class "")
+(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
(defalias 'org-get-closed 'org-agenda-get-progress)
(defun org-agenda-get-progress ()
"Return the logged TODO entries for agenda display."
@@ -4987,9 +5341,9 @@ please use `org-class' instead."
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
- (items (if (consp org-agenda-show-log)
- org-agenda-show-log
- (if (eq org-agenda-show-log 'clockcheck)
+ (items (if (consp org-agenda-show-log-scoped)
+ org-agenda-show-log-scoped
+ (if (eq org-agenda-show-log-scoped 'clockcheck)
'(clock)
org-agenda-log-mode-items)))
(parts
@@ -5011,7 +5365,7 @@ please use `org-class' instead."
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11))))
(org-agenda-search-headline-for-time nil)
- marker hdmarker priority category org-category-pos tags closedp
+ marker hdmarker priority category category-pos tags closedp
statep clockp state ee txt extra timestr rest clocked)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5023,7 +5377,7 @@ please use `org-class' instead."
clockp (not (or closedp statep))
state (and statep (match-string 2))
category (org-get-category (match-beginning 0))
- org-category-pos (get-text-property (match-beginning 0) 'org-category-position)
+ category-pos (get-text-property (match-beginning 0) 'org-category-position)
timestr (buffer-substring (match-beginning 0) (point-at-eol)))
(when (string-match "\\]" timestr)
;; substring should only run to end of time stamp
@@ -5061,14 +5415,14 @@ please use `org-class' instead."
(setq txt (org-agenda-format-item
(cond
(closedp "Closed: ")
- (statep (concat "State: (" state ")"))
- (t (concat "Clocked: (" clocked ")")))
+ (statep (concat "State: (" state ")"))
+ (t (concat "Clocked: (" clocked ")")))
txt category tags timestr)))
(setq priority 100000)
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
'priority priority 'org-category category
- 'org-category-position org-category-pos
+ 'org-category-position category-pos
'type "closed" 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done)
(push txt ee))
@@ -5146,7 +5500,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
;; There is a gap, lets see if we need to report it
(unless (org-agenda-check-clock-gap tlend ts gapok)
(setq issue (format "Clocking gap: %d minutes"
- (/ (- ts tlend) 60))
+ (/ (- ts tlend) 60))
face (or (plist-get pl :gap-face) face))))
(t nil)))
(setq tlend (or te tlend) tlstart (or ts tlstart))
@@ -5206,9 +5560,9 @@ See also the user option `org-agenda-clock-consistency-checks'."
(regexp org-deadline-time-regexp)
(todayp (org-agenda-todayp date)) ; DATE bound by calendar
(d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
- d2 diff dfrac wdays pos pos1 category org-category-pos
+ d2 diff dfrac wdays pos pos1 category category-pos
tags suppress-prewarning ee txt head face s todo-state
- show-all upcomingp donep timestr)
+ show-all upcomingp donep timestr warntime)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(setq suppress-prewarning nil)
@@ -5229,7 +5583,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
todo-state (save-match-data (org-get-todo-state))
show-all (or (eq org-agenda-repeating-timestamp-show-all t)
(member todo-state
- org-agenda-repeating-timestamp-show-all))
+ org-agenda-repeating-timestamp-show-all))
d2 (org-time-string-to-absolute
(match-string 1) d1 'past show-all
(current-buffer) pos)
@@ -5254,7 +5608,8 @@ See also the user option `org-agenda-clock-consistency-checks'."
(not (= diff 0))))
(setq txt nil)
(setq category (org-get-category)
- org-category-pos (get-text-property (point) 'org-category-position))
+ warntime (org-entry-get (point) "APPT_WARNTIME")
+ category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-end 0))
@@ -5284,11 +5639,12 @@ See also the user option `org-agenda-clock-consistency-checks'."
(setq face (org-agenda-deadline-face dfrac))
(org-add-props txt props
'org-marker (org-agenda-new-marker pos)
+ 'warntime warntime
'org-hd-marker (org-agenda-new-marker pos1)
'priority (+ (- diff)
(org-get-priority txt))
'org-category category
- 'org-category-position org-category-pos
+ 'org-category-position category-pos
'todo-state todo-state
'type (if upcomingp "upcoming-deadline" "deadline")
'date (if upcomingp date d2)
@@ -5321,11 +5677,12 @@ FRACTION is what fraction of the head-warning time has passed."
mm
(deadline-position-alist
(mapcar (lambda (a) (and (setq mm (get-text-property
- 0 'org-hd-marker a))
- (cons (marker-position mm) a)))
+ 0 'org-hd-marker a))
+ (cons (marker-position mm) a)))
deadline-results))
- d2 diff pos pos1 category org-category-pos tags donep
- ee txt head pastschedp todo-state face timestr s habitp show-all)
+ d2 diff pos pos1 category category-pos tags donep
+ ee txt head pastschedp todo-state face timestr s habitp show-all
+ did-habit-check-p warntime)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -5340,14 +5697,24 @@ FRACTION is what fraction of the head-warning time has passed."
d2 (org-time-string-to-absolute
(match-string 1) d1 'past show-all
(current-buffer) pos)
- diff (- d2 d1))
+ diff (- d2 d1)
+ warntime (org-entry-get (point) "APPT_WARNTIME"))
(setq pastschedp (and todayp (< diff 0)))
+ (setq did-habit-check-p nil)
;; When to show a scheduled item in the calendar:
;; If it is on or past the date.
(when (or (and (< diff 0)
(< (abs diff) org-scheduled-past-days)
(and todayp (not org-agenda-only-exact-dates)))
- (= diff 0))
+ (= diff 0)
+ ;; org-is-habit-p uses org-entry-get, which is expansive
+ ;; so we go extra mile to only call it once
+ (and todayp
+ (boundp 'org-habit-show-all-today)
+ org-habit-show-all-today
+ (setq did-habit-check-p t)
+ (setq habitp (and (functionp 'org-is-habit-p)
+ (org-is-habit-p)))))
(save-excursion
(setq donep (member todo-state org-done-keywords))
(if (and donep
@@ -5356,10 +5723,11 @@ FRACTION is what fraction of the head-warning time has passed."
(and (functionp 'org-is-habit-p)
(org-is-habit-p))))
(setq txt nil)
- (setq habitp (and (functionp 'org-is-habit-p)
- (org-is-habit-p)))
+ (setq habitp (if did-habit-check-p habitp
+ (and (functionp 'org-is-habit-p)
+ (org-is-habit-p))))
(setq category (org-get-category)
- org-category-pos (get-text-property (point) 'org-category-position))
+ category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-end 0))
@@ -5367,6 +5735,7 @@ FRACTION is what fraction of the head-warning time has passed."
(if habitp
(if (or (not org-habit-show-habits)
(and (not todayp)
+ (boundp 'org-habit-show-habits-only-for-today)
org-habit-show-habits-only-for-today))
(throw :skip nil))
(if (and
@@ -5406,11 +5775,12 @@ FRACTION is what fraction of the head-warning time has passed."
'org-hd-marker (org-agenda-new-marker pos1)
'type (if pastschedp "past-scheduled" "scheduled")
'date (if pastschedp d2 date)
+ 'warntime warntime
'priority (if habitp
(org-habit-get-priority habitp)
(+ 94 (- 5 diff) (org-get-priority txt)))
'org-category category
- 'org-category-position org-category-pos
+ 'category-position category-pos
'org-habit-p habitp
'todo-state todo-state)
(push txt ee))))))
@@ -5428,7 +5798,7 @@ FRACTION is what fraction of the head-warning time has passed."
(abbreviate-file-name buffer-file-name))))
(regexp org-tr-regexp)
(d0 (calendar-absolute-from-gregorian date))
- marker hdmarker ee txt d1 d2 s1 s2 category org-category-pos
+ marker hdmarker ee txt d1 d2 s1 s2 category category-pos
todo-state tags pos head donep)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5451,7 +5821,7 @@ FRACTION is what fraction of the head-warning time has passed."
(throw :skip t))
(setq marker (org-agenda-new-marker (point)))
(setq category (org-get-category)
- org-category-pos (get-text-property (point) 'org-category-position))
+ category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-beginning 0))
@@ -5477,15 +5847,14 @@ FRACTION is what fraction of the head-warning time has passed."
((= d1 d0)
(concat "<" start-time ">"))
((= d2 d0)
- (concat "<" end-time ">"))
- (t nil))
- remove-re))))
+ (concat "<" end-time ">")))
+ remove-re t))))
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker
'type "block" 'date date
'todo-state todo-state
'priority (org-get-priority txt) 'org-category category
- 'org-category-position org-category-pos)
+ 'org-category-position category-pos)
(push txt ee))))
(goto-char pos)))
;; Sort the entries by expiration date.
@@ -5513,7 +5882,7 @@ The flag is set if the currently compiled format contains a `%e'.")
(when (org-string-match-p (car entry) category)
(if (listp (cadr entry))
(return (cadr entry))
- (return (apply 'create-image (cdr entry)))))))
+ (return (apply 'create-image (cdr entry)))))))
(defun org-agenda-format-item (extra txt &optional category tags dotime
remove-re habitp)
@@ -5527,151 +5896,163 @@ time-of-day should be extracted from TXT for sorting of this entry, and for
the `%t' specifier in the format. When DOTIME is a string, this string is
searched for a time before TXT is. TAGS can be the tags of the headline.
Any match of REMOVE-RE will be removed from TXT."
- (save-match-data
- ;; Diary entries sometimes have extra whitespace at the beginning
- (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
-
- ;; Fix the tags part in txt
- (setq txt (org-agenda-fix-displayed-tags
- txt tags
- org-agenda-show-inherited-tags
- org-agenda-hide-tags-regexp))
- (let* ((category (or category
- (if (stringp org-category)
- org-category
- (and org-category (symbol-name org-category)))
- (if buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- "")))
- (category-icon (org-agenda-get-category-icon category))
- (category-icon (if category-icon
- (propertize " " 'display category-icon)
- ""))
- ;; time, tag, effort are needed for the eval of the prefix format
- (tag (if tags (nth (1- (length tags)) tags) ""))
- time effort neffort
- (ts (if dotime (concat
- (if (stringp dotime) dotime "")
- (and org-agenda-search-headline-for-time txt))))
- (time-of-day (and dotime (org-get-time-of-day ts)))
- stamp plain s0 s1 s2 rtn srp l
- duration thecategory)
- (and (eq major-mode 'org-mode) buffer-file-name
- (add-to-list 'org-agenda-contributing-files buffer-file-name))
- (when (and dotime time-of-day)
- ;; Extract starting and ending time and move them to prefix
- (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
- (setq plain (string-match org-plain-time-of-day-regexp ts)))
- (setq s0 (match-string 0 ts)
- srp (and stamp (match-end 3))
- s1 (match-string (if plain 1 2) ts)
- s2 (match-string (if plain 8 (if srp 4 6)) ts))
-
- ;; If the times are in TXT (not in DOTIMES), and the prefix will list
- ;; them, we might want to remove them there to avoid duplication.
- ;; The user can turn this off with a variable.
- (if (and org-prefix-has-time
- org-agenda-remove-times-when-in-prefix (or stamp plain)
- (string-match (concat (regexp-quote s0) " *") txt)
- (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
- (if (eq org-agenda-remove-times-when-in-prefix 'beg)
- (= (match-beginning 0) 0)
- t))
- (setq txt (replace-match "" nil nil txt))))
- ;; Normalize the time(s) to 24 hour
- (if s1 (setq s1 (org-get-time-of-day s1 'string t)))
- (if s2 (setq s2 (org-get-time-of-day s2 'string t)))
-
- ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set
- (when (and s1 (not s2) org-agenda-default-appointment-duration)
- (setq s2
- (org-minutes-to-hh:mm-string
- (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration))))
-
- ;; Compute the duration
- (when s2
- (setq duration (- (org-hh:mm-string-to-minutes s2)
- (org-hh:mm-string-to-minutes s1)))))
-
- (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
- txt)
- ;; Tags are in the string
- (if (or (eq org-agenda-remove-tags t)
- (and org-agenda-remove-tags
- org-prefix-has-tag))
- (setq txt (replace-match "" t t txt))
- (setq txt (replace-match
- (concat (make-string (max (- 50 (length txt)) 1) ?\ )
- (match-string 2 txt))
- t t txt))))
- (when (eq major-mode 'org-mode)
- (setq effort
- (condition-case nil
- (org-get-effort
- (or (get-text-property 0 'org-hd-marker txt)
- (get-text-property 0 'org-marker txt)))
- (error nil)))
- (when effort
- (setq neffort (org-duration-string-to-minutes effort)
- effort (setq effort (concat "[" effort "]")))))
- ;; prevent erroring out with %e format when there is no effort
- (or effort (setq effort ""))
-
- (when remove-re
- (while (string-match remove-re txt)
- (setq txt (replace-match "" t t txt))))
-
- ;; Set org-heading property on `txt' to mark the start of the
- ;; heading.
- (add-text-properties 0 (length txt) '(org-heading t) txt)
-
- ;; Prepare the variables needed in the eval of the compiled format
- (setq time (cond (s2 (concat
- (org-agenda-time-of-day-to-ampm-maybe s1)
- "-" (org-agenda-time-of-day-to-ampm-maybe s2)
- (if org-agenda-timegrid-use-ampm " ")))
- (s1 (concat
- (org-agenda-time-of-day-to-ampm-maybe s1)
- (if org-agenda-timegrid-use-ampm
- "........ "
- "......")))
- (t ""))
- extra (or (and (not habitp) extra) "")
- category (if (symbolp category) (symbol-name category) category)
- thecategory (copy-sequence category))
- (if (string-match org-bracket-link-regexp category)
- (progn
- (setq l (if (match-end 3)
- (- (match-end 3) (match-beginning 3))
- (- (match-end 1) (match-beginning 1))))
- (when (< l (or org-prefix-category-length 0))
- (setq category (copy-sequence category))
- (org-add-props category nil
- 'extra-space (make-string
- (- org-prefix-category-length l 1) ?\ ))))
- (if (and org-prefix-category-max-length
- (>= (length category) org-prefix-category-max-length))
- (setq category (substring category 0 (1- org-prefix-category-max-length)))))
- ;; Evaluate the compiled format
- (setq rtn (concat (eval org-prefix-format-compiled) txt))
-
- ;; And finally add the text properties
- (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
- (org-add-props rtn nil
- 'org-category (if thecategory (downcase thecategory) category)
- 'tags (mapcar 'org-downcase-keep-props tags)
- 'org-highest-priority org-highest-priority
- 'org-lowest-priority org-lowest-priority
- 'time-of-day time-of-day
- 'duration duration
- 'effort effort
- 'effort-minutes neffort
- 'txt txt
- 'time time
- 'extra extra
- 'format org-prefix-format-compiled
- 'dotime dotime))))
+ ;; We keep the org-prefix-* variable values along with a compiled
+ ;; formatter, so that multiple agendas existing at the same time, do
+ ;; not step on each other toes.
+ ;;
+ ;; It was inconvenient to make these variables buffer local in
+ ;; Agenda buffers, because this function expects to be called with
+ ;; the buffer where item comes from being current, and not agenda
+ ;; buffer
+ (let* ((bindings (car org-prefix-format-compiled))
+ (formatter (cadr org-prefix-format-compiled)))
+ (loop for (var value) in bindings
+ do (set var value))
+ (save-match-data
+ ;; Diary entries sometimes have extra whitespace at the beginning
+ (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
+
+ ;; Fix the tags part in txt
+ (setq txt (org-agenda-fix-displayed-tags
+ txt tags
+ org-agenda-show-inherited-tags
+ org-agenda-hide-tags-regexp))
+ (let* ((category (or category
+ (if (stringp org-category)
+ org-category
+ (and org-category (symbol-name org-category)))
+ (if buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))
+ "")))
+ (category-icon (org-agenda-get-category-icon category))
+ (category-icon (if category-icon
+ (propertize " " 'display category-icon)
+ ""))
+ ;; time, tag, effort are needed for the eval of the prefix format
+ (tag (if tags (nth (1- (length tags)) tags) ""))
+ time effort neffort
+ (ts (if dotime (concat
+ (if (stringp dotime) dotime "")
+ (and org-agenda-search-headline-for-time txt))))
+ (time-of-day (and dotime (org-get-time-of-day ts)))
+ stamp plain s0 s1 s2 rtn srp l
+ duration thecategory)
+ (and (derived-mode-p 'org-mode) buffer-file-name
+ (add-to-list 'org-agenda-contributing-files buffer-file-name))
+ (when (and dotime time-of-day)
+ ;; Extract starting and ending time and move them to prefix
+ (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
+ (setq plain (string-match org-plain-time-of-day-regexp ts)))
+ (setq s0 (match-string 0 ts)
+ srp (and stamp (match-end 3))
+ s1 (match-string (if plain 1 2) ts)
+ s2 (match-string (if plain 8 (if srp 4 6)) ts))
+
+ ;; If the times are in TXT (not in DOTIMES), and the prefix will list
+ ;; them, we might want to remove them there to avoid duplication.
+ ;; The user can turn this off with a variable.
+ (if (and org-prefix-has-time
+ org-agenda-remove-times-when-in-prefix (or stamp plain)
+ (string-match (concat (regexp-quote s0) " *") txt)
+ (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
+ (if (eq org-agenda-remove-times-when-in-prefix 'beg)
+ (= (match-beginning 0) 0)
+ t))
+ (setq txt (replace-match "" nil nil txt))))
+ ;; Normalize the time(s) to 24 hour
+ (if s1 (setq s1 (org-get-time-of-day s1 'string t)))
+ (if s2 (setq s2 (org-get-time-of-day s2 'string t)))
+
+ ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set
+ (when (and s1 (not s2) org-agenda-default-appointment-duration)
+ (setq s2
+ (org-minutes-to-hh:mm-string
+ (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration))))
+
+ ;; Compute the duration
+ (when s2
+ (setq duration (- (org-hh:mm-string-to-minutes s2)
+ (org-hh:mm-string-to-minutes s1)))))
+
+ (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ txt)
+ ;; Tags are in the string
+ (if (or (eq org-agenda-remove-tags t)
+ (and org-agenda-remove-tags
+ org-prefix-has-tag))
+ (setq txt (replace-match "" t t txt))
+ (setq txt (replace-match
+ (concat (make-string (max (- 50 (length txt)) 1) ?\ )
+ (match-string 2 txt))
+ t t txt))))
+ (when (derived-mode-p 'org-mode)
+ (setq effort
+ (condition-case nil
+ (org-get-effort
+ (or (get-text-property 0 'org-hd-marker txt)
+ (get-text-property 0 'org-marker txt)))
+ (error nil)))
+ (when effort
+ (setq neffort (org-duration-string-to-minutes effort)
+ effort (setq effort (concat "[" effort "]")))))
+ ;; prevent erroring out with %e format when there is no effort
+ (or effort (setq effort ""))
+
+ (when remove-re
+ (while (string-match remove-re txt)
+ (setq txt (replace-match "" t t txt))))
+
+ ;; Set org-heading property on `txt' to mark the start of the
+ ;; heading.
+ (add-text-properties 0 (length txt) '(org-heading t) txt)
+
+ ;; Prepare the variables needed in the eval of the compiled format
+ (setq time (cond (s2 (concat
+ (org-agenda-time-of-day-to-ampm-maybe s1)
+ "-" (org-agenda-time-of-day-to-ampm-maybe s2)
+ (if org-agenda-timegrid-use-ampm " ")))
+ (s1 (concat
+ (org-agenda-time-of-day-to-ampm-maybe s1)
+ (if org-agenda-timegrid-use-ampm
+ "........ "
+ "......")))
+ (t ""))
+ extra (or (and (not habitp) extra) "")
+ category (if (symbolp category) (symbol-name category) category)
+ thecategory (copy-sequence category))
+ (if (string-match org-bracket-link-regexp category)
+ (progn
+ (setq l (if (match-end 3)
+ (- (match-end 3) (match-beginning 3))
+ (- (match-end 1) (match-beginning 1))))
+ (when (< l (or org-prefix-category-length 0))
+ (setq category (copy-sequence category))
+ (org-add-props category nil
+ 'extra-space (make-string
+ (- org-prefix-category-length l 1) ?\ ))))
+ (if (and org-prefix-category-max-length
+ (>= (length category) org-prefix-category-max-length))
+ (setq category (substring category 0 (1- org-prefix-category-max-length)))))
+ ;; Evaluate the compiled format
+ (setq rtn (concat (eval formatter) txt))
+
+ ;; And finally add the text properties
+ (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
+ (org-add-props rtn nil
+ 'org-category (if thecategory (downcase thecategory) category)
+ 'tags (mapcar 'org-downcase-keep-props tags)
+ 'org-highest-priority org-highest-priority
+ 'org-lowest-priority org-lowest-priority
+ 'time-of-day time-of-day
+ 'duration duration
+ 'effort effort
+ 'effort-minutes neffort
+ 'txt txt
+ 'time time
+ 'extra extra
+ 'format org-prefix-format-compiled
+ 'dotime dotime)))))
(defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re)
"Remove tags string from TXT, and add a modified list of tags.
@@ -5703,7 +6084,7 @@ The modified list may contain inherited tags, and tags matched by
x))
tags ":")
(if have-i "::" ":"))))))
- txt)
+ txt)
(defun org-downcase-keep-props (s)
(let ((props (text-properties-at 0 s)))
@@ -5757,8 +6138,8 @@ The modified list may contain inherited tags, and tags matched by
(defun org-compile-prefix-format (key)
"Compile the prefix format into a Lisp form that can be evaluated.
-The resulting form is returned and stored in the variable
-`org-prefix-format-compiled'."
+The resulting form and associated variable bindings is returned
+and stored in the variable `org-prefix-format-compiled'."
(setq org-prefix-has-time nil org-prefix-has-tag nil
org-prefix-category-length nil
org-prefix-has-effort nil)
@@ -5802,7 +6183,14 @@ The resulting form is returned and stored in the variable
(setq s (replace-match "%s" t nil s))
(push varform vars))
(setq vars (nreverse vars))
- (setq org-prefix-format-compiled `(format ,s ,@vars))))
+ (with-current-buffer (or org-agenda-buffer (current-buffer))
+ (setq org-prefix-format-compiled
+ (list
+ `((org-prefix-has-time ,org-prefix-has-time)
+ (org-prefix-has-tag ,org-prefix-has-tag)
+ (org-prefix-category-length ,org-prefix-category-length)
+ (org-prefix-has-effort ,org-prefix-has-effort))
+ `(format ,s ,@vars))))))
(defun org-set-sorting-strategy (key)
(if (symbolp (car org-agenda-sorting-strategy))
@@ -5823,23 +6211,23 @@ HH:MM."
(when
(or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
(string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
- (let* ((h (string-to-number (match-string 1 s)))
- (m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
- (ampm (if (match-end 4) (downcase (match-string 4 s))))
- (am-p (equal ampm "am"))
- (h1 (cond ((not ampm) h)
- ((= h 12) (if am-p 0 12))
- (t (+ h (if am-p 0 12)))))
- (h2 (if (and string mod24 (not (and (= m 0) (= h1 24))))
- (mod h1 24) h1))
- (t0 (+ (* 100 h2) m))
- (t1 (concat (if (>= h1 24) "+" " ")
- (if (and org-agenda-time-leading-zero
- (< t0 1000)) "0" "")
- (if (< t0 100) "0" "")
- (if (< t0 10) "0" "")
- (int-to-string t0))))
- (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
+ (let* ((h (string-to-number (match-string 1 s)))
+ (m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
+ (ampm (if (match-end 4) (downcase (match-string 4 s))))
+ (am-p (equal ampm "am"))
+ (h1 (cond ((not ampm) h)
+ ((= h 12) (if am-p 0 12))
+ (t (+ h (if am-p 0 12)))))
+ (h2 (if (and string mod24 (not (and (= m 0) (= h1 24))))
+ (mod h1 24) h1))
+ (t0 (+ (* 100 h2) m))
+ (t1 (concat (if (>= h1 24) "+" " ")
+ (if (and org-agenda-time-leading-zero
+ (< t0 1000)) "0" "")
+ (if (< t0 100) "0" "")
+ (if (< t0 10) "0" "")
+ (int-to-string t0))))
+ (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
(defvar org-agenda-before-sorting-filter-function nil
"Function to be applied to agenda items prior to sorting.
@@ -5861,7 +6249,7 @@ You can also use this function as a filter, by returning nil for lines
you don't want to have in the agenda at all. For this application, you
could bind the variable in the options section of a custom command.")
-(defun org-finalize-agenda-entries (list &optional nosort)
+(defun org-agenda-finalize-entries (list &optional nosort)
"Sort and concatenate the agenda items."
(setq list (mapcar 'org-agenda-highlight-todo list))
(if nosort
@@ -5918,8 +6306,7 @@ could bind the variable in the options section of a custom command.")
(let ((pa (or (get-text-property 1 'priority a) 0))
(pb (or (get-text-property 1 'priority b) 0)))
(cond ((> pa pb) +1)
- ((< pa pb) -1)
- (t nil))))
+ ((< pa pb) -1))))
(defsubst org-cmp-effort (a b)
"Compare the effort values of string A and B."
@@ -5927,16 +6314,14 @@ could bind the variable in the options section of a custom command.")
(ea (or (get-text-property 1 'effort-minutes a) def))
(eb (or (get-text-property 1 'effort-minutes b) def)))
(cond ((> ea eb) +1)
- ((< ea eb) -1)
- (t nil))))
+ ((< ea eb) -1))))
(defsubst org-cmp-category (a b)
"Compare the string values of categories of strings A and B."
(let ((ca (or (get-text-property 1 'org-category a) ""))
(cb (or (get-text-property 1 'org-category b) "")))
(cond ((string-lessp ca cb) -1)
- ((string-lessp cb ca) +1)
- (t nil))))
+ ((string-lessp cb ca) +1))))
(defsubst org-cmp-todo-state (a b)
"Compare the todo states of strings A and B."
@@ -5958,8 +6343,7 @@ could bind the variable in the options section of a custom command.")
(cond ((and donepa (not donepb)) -1)
((and (not donepa) donepb) +1)
((< la lb) -1)
- ((< lb la) +1)
- (t nil))))
+ ((< lb la) +1))))
(defsubst org-cmp-alpha (a b)
"Compare the headlines, alphabetically."
@@ -5980,8 +6364,7 @@ could bind the variable in the options section of a custom command.")
(cond ((not ta) +1)
((not tb) -1)
((string-lessp ta tb) -1)
- ((string-lessp tb ta) +1)
- (t nil))))
+ ((string-lessp tb ta) +1))))
(defsubst org-cmp-tag (a b)
"Compare the string values of the first tags of A and B."
@@ -5990,8 +6373,7 @@ could bind the variable in the options section of a custom command.")
(cond ((not ta) +1)
((not tb) -1)
((string-lessp ta tb) -1)
- ((string-lessp tb ta) +1)
- (t nil))))
+ ((string-lessp tb ta) +1))))
(defsubst org-cmp-time (a b)
"Compare the time-of-day values of strings A and B."
@@ -5999,16 +6381,14 @@ could bind the variable in the options section of a custom command.")
(ta (or (get-text-property 1 'time-of-day a) def))
(tb (or (get-text-property 1 'time-of-day b) def)))
(cond ((< ta tb) -1)
- ((< tb ta) +1)
- (t nil))))
+ ((< tb ta) +1))))
(defsubst org-cmp-habit-p (a b)
"Compare the todo states of strings A and B."
(let ((ha (get-text-property 1 'org-habit-p a))
(hb (get-text-property 1 'org-habit-p b)))
(cond ((and ha (not hb)) -1)
- ((and (not ha) hb) +1)
- (t nil))))
+ ((and (not ha) hb) +1))))
(defsubst org-em (x y list) (or (memq x list) (memq y list)))
@@ -6131,13 +6511,15 @@ in the file. Otherwise, restriction will be to the current subtree."
(defun org-agenda-check-type (error &rest types)
"Check if agenda buffer is of allowed type.
If ERROR is non-nil, throw an error, otherwise just return nil."
- (if (memq org-agenda-type types)
- t
- (if error
- (error "Not allowed in %s-type agenda buffers" org-agenda-type)
- nil)))
-
-(defun org-agenda-quit ()
+ (if (not org-agenda-type)
+ (error "No Org agenda currently displayed")
+ (if (memq org-agenda-type types)
+ t
+ (if error
+ (error "Not allowed in %s-type agenda buffers" org-agenda-type)
+ nil))))
+
+(defun org-agenda-Quit (&optional arg)
"Exit agenda by removing the window or the buffer."
(interactive)
(if org-agenda-columns-active
@@ -6145,23 +6527,51 @@ If ERROR is non-nil, throw an error, otherwise just return nil."
(let ((buf (current-buffer)))
(if (eq org-agenda-window-setup 'other-frame)
(progn
- (kill-buffer buf)
(org-agenda-reset-markers)
+ (kill-buffer buf)
(org-columns-remove-overlays)
(setq org-agenda-archives-mode nil)
(delete-frame))
(and (not (eq org-agenda-window-setup 'current-window))
(not (one-window-p))
(delete-window))
- (kill-buffer buf)
(org-agenda-reset-markers)
+ (kill-buffer buf)
(org-columns-remove-overlays)
(setq org-agenda-archives-mode nil)))
;; Maybe restore the pre-agenda window configuration.
(and org-agenda-restore-windows-after-quit
(not (eq org-agenda-window-setup 'other-frame))
- org-pre-agenda-window-conf
- (set-window-configuration org-pre-agenda-window-conf))))
+ org-agenda-pre-window-conf
+ (set-window-configuration org-agenda-pre-window-conf)
+ (setq org-agenda-pre-window-conf nil))))
+
+(defun org-agenda-quit ()
+ "Exit agenda by killing agenda buffer or burying it when
+`org-agenda-sticky' is non-NIL"
+ (interactive)
+ (if (and (eq org-indirect-buffer-display 'other-window)
+ org-last-indirect-buffer)
+ (delete-window (get-buffer-window org-last-indirect-buffer)))
+ (if org-agenda-columns-active
+ (org-columns-quit)
+ (if org-agenda-sticky
+ (let ((buf (current-buffer)))
+ (if (eq org-agenda-window-setup 'other-frame)
+ (progn
+ (delete-frame))
+ (and (not (eq org-agenda-window-setup 'current-window))
+ (not (one-window-p))
+ (delete-window)))
+ (with-current-buffer buf
+ (bury-buffer)
+ ;; Maybe restore the pre-agenda window configuration.
+ (and org-agenda-restore-windows-after-quit
+ (not (eq org-agenda-window-setup 'other-frame))
+ org-agenda-pre-window-conf
+ (set-window-configuration org-agenda-pre-window-conf)
+ (setq org-agenda-pre-window-conf nil))))
+ (org-agenda-Quit))))
(defun org-agenda-exit ()
"Exit agenda by removing the window or the buffer.
@@ -6170,7 +6580,18 @@ Org-mode buffers visited directly by the user will not be touched."
(interactive)
(org-release-buffers org-agenda-new-buffers)
(setq org-agenda-new-buffers nil)
- (org-agenda-quit))
+ (org-agenda-Quit))
+
+(defun org-agenda-kill-all-agenda-buffers ()
+ "Kill all buffers in `org-agenda-mode'.
+This is used when toggling sticky agendas. You can also explicitly invoke it
+with `C-c a C-k'."
+ (interactive)
+ (let (blist)
+ (dolist (buf (buffer-list))
+ (when (with-current-buffer buf (eq major-mode 'org-agenda-mode))
+ (push buf blist)))
+ (mapc 'kill-buffer blist)))
(defun org-agenda-execute (arg)
"Execute another agenda command, keeping same window.
@@ -6180,25 +6601,43 @@ in the agenda."
(let ((org-agenda-window-setup 'current-window))
(org-agenda arg)))
-(defun org-agenda-redo ()
- "Rebuild Agenda.
-When this is the global TODO list, a prefix argument will be interpreted."
- (interactive)
- (let* ((org-agenda-keep-modes t)
+(defun org-agenda-redo (&optional all)
+ "Rebuild possibly ALL agenda view(s) in the current buffer."
+ (interactive "P")
+ (let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))
+ (cpa (unless (eq all t) current-prefix-arg))
+ (org-agenda-doing-sticky-redo org-agenda-sticky)
+ (org-agenda-sticky nil)
+ (org-agenda-buffer-name (or org-agenda-this-buffer-name
+ org-agenda-buffer-name))
+ (org-agenda-keep-modes t)
(tag-filter org-agenda-tag-filter)
(tag-preset (get 'org-agenda-tag-filter :preset-filter))
+ (top-cat-filter org-agenda-top-category-filter)
(cat-filter org-agenda-category-filter)
(cat-preset (get 'org-agenda-category-filter :preset-filter))
(org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
- (lprops (get 'org-agenda-redo-command 'org-lprops)))
+ (lprops (get 'org-agenda-redo-command 'org-lprops))
+ (redo-cmd (get-text-property p 'org-redo-cmd))
+ (last-args (get-text-property p 'org-last-args))
+ (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd))
+ (org-agenda-overriding-cmd-arguments
+ (unless (eq all t)
+ (cond ((listp last-args)
+ (cons (or cpa (car last-args)) (cdr last-args)))
+ ((stringp last-args)
+ last-args))))
+ (series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
(put 'org-agenda-tag-filter :preset-filter nil)
(put 'org-agenda-category-filter :preset-filter nil)
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
- (org-let lprops '(eval org-agenda-redo-command))
+ (if series-redo-cmd
+ (eval series-redo-cmd)
+ (org-let lprops '(eval redo-cmd)))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil)
(message "Rebuilding agenda buffer...done")
@@ -6206,6 +6645,7 @@ When this is the global TODO list, a prefix argument will be interpreted."
(put 'org-agenda-category-filter :preset-filter cat-preset)
(and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag))
(and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category))
+ (and top-cat-filter (org-agenda-filter-top-category-apply top-cat-filter))
(and cols (org-called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
(recenter window-line)))
@@ -6218,13 +6658,38 @@ When this is the global TODO list, a prefix argument will be interpreted."
"Keep only those lines in the agenda buffer that have a specific category.
The category is that of the current line."
(interactive "P")
- (if org-agenda-filtered-by-category
+ (if (and org-agenda-filtered-by-category
+ org-agenda-category-filter)
(org-agenda-filter-show-all-cat)
(let ((cat (org-no-properties (get-text-property (point) 'org-category))))
(if cat (org-agenda-filter-apply
(list (concat (if strip "-" "+") cat)) 'category)
(error "No category at point")))))
+(defun org-find-top-category (&optional pos)
+ (save-excursion
+ (with-current-buffer (if pos (marker-buffer pos) (current-buffer))
+ (if pos (goto-char pos))
+ ;; Skip up to the topmost parent
+ (while (ignore-errors (outline-up-heading 1) t))
+ (ignore-errors
+ (nth 4 (org-heading-components))))))
+
+(defvar org-agenda-filtered-by-top-category nil)
+
+(defun org-agenda-filter-by-top-category (strip)
+ "Keep only those lines in the agenda buffer that have a specific category.
+The category is that of the current line."
+ (interactive "P")
+ (if org-agenda-filtered-by-top-category
+ (progn
+ (setq org-agenda-filtered-by-top-category nil
+ org-agenda-top-category-filter nil)
+ (org-agenda-filter-show-all-cat))
+ (let ((cat (org-find-top-category (org-get-at-bol 'org-hd-marker))))
+ (if cat (org-agenda-filter-top-category-apply cat strip)
+ (error "No top-level category at point")))))
+
(defun org-agenda-filter-by-tag (strip &optional char narrow)
"Keep only those lines in the agenda buffer that have a specific tag.
The tag is selected with its fast selection letter, as configured.
@@ -6277,7 +6742,7 @@ to switch to narrowing."
(message "Effort%s: %s " effort-op effort-prompt)
(setq char (read-char-exclusive))
(when (or (< char ?0) (> char ?9))
- (error "Need 1-9,0 to select effort" ))))
+ (error "Need 1-9,0 to select effort"))))
(when (equal char ?\t)
(unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
(org-set-local 'org-global-tags-completion-table
@@ -6420,10 +6885,27 @@ If the line does not have an effort defined, return nil."
(if (get-char-property (point) 'invisible)
(ignore-errors (org-agenda-previous-line)))))
+(defun org-agenda-filter-top-category-apply (category &optional negative)
+ "Set FILTER as the new agenda filter and apply it."
+ (org-agenda-set-mode-name)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((pos (org-get-at-bol 'org-hd-marker))
+ (topcat (and pos (org-find-top-category pos))))
+ (if (and topcat (funcall (if negative 'identity 'not)
+ (string= category topcat)))
+ (org-agenda-filter-hide-line 'category)))
+ (beginning-of-line 2)))
+ (if (get-char-property (point) 'invisible)
+ (org-agenda-previous-line))
+ (setq org-agenda-top-category-filter category
+ org-agenda-filtered-by-top-category t))
+
(defun org-agenda-filter-hide-line (type)
(let (ov)
(setq ov (make-overlay (max (point-min) (1- (point-at-bol)))
- (point-at-eol)))
+ (point-at-eol)))
(overlay-put ov 'invisible t)
(overlay-put ov 'type type)
(if (eq type 'tag)
@@ -6439,7 +6921,7 @@ If the line does not have an effort defined, return nil."
(goto-char pos)
(if (< (overlay-start ov) (point-at-eol))
(move-overlay ov (point-at-eol)
- (overlay-end ov)))))))
+ (overlay-end ov)))))))
(defun org-agenda-filter-show-all-tag nil
(mapc 'delete-overlay org-agenda-tag-filter-overlays)
@@ -6491,36 +6973,58 @@ Negative selection means regexp must not match for selection of an entry."
" "))
(setq org-agenda-redo-command
(list 'org-search-view
- org-todo-only
+ (car (get-text-property (min (1- (point-max)) (point))
+ 'org-last-args))
org-agenda-query-string
(+ (length org-agenda-query-string)
(if (member char '(?\{ ?\})) 0 1))))
(set-register org-agenda-query-register org-agenda-query-string)
- (org-agenda-redo))
+ (let ((org-agenda-overriding-arguments
+ (cdr org-agenda-redo-command)))
+ (org-agenda-redo)))
(t (error "Cannot manipulate query for %s-type agenda buffers"
org-agenda-type))))
(defun org-add-to-string (var string)
(set var (concat (symbol-value var) string)))
-(defun org-agenda-goto-date (date)
+(defun org-agenda-goto-date (span)
"Jump to DATE in agenda."
- (interactive (list (let ((org-read-date-prefer-future
- (eval org-agenda-jump-prefer-future)))
- (org-read-date))))
- (org-agenda-list nil date))
+ (interactive "P")
+ (let* ((org-read-date-prefer-future
+ (eval org-agenda-jump-prefer-future))
+ (date (org-read-date))
+ (org-agenda-sticky-orig org-agenda-sticky)
+ (org-agenda-buffer-tmp-name (buffer-name))
+ (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
+ (0-arg (or current-prefix-arg (car args)))
+ (2-arg (nth 2 args))
+ (newcmd (list 'org-agenda-list 0-arg date
+ (org-agenda-span-to-ndays 2-arg)))
+ (newargs (cdr newcmd))
+ (inhibit-read-only t)
+ org-agenda-sticky)
+ (if (not (org-agenda-check-type t 'agenda))
+ (error "Not available in non-agenda blocks")
+ (add-text-properties (point-min) (point-max)
+ `(org-redo-cmd ,newcmd org-last-args ,newargs))
+ (org-agenda-redo)
+ (setq org-agenda-sticky org-agenda-sticky-orig
+ org-agenda-this-buffer-is-sticky org-agenda-sticky))))
(defun org-agenda-goto-today ()
"Go to today."
(interactive)
(org-agenda-check-type t 'timeline 'agenda)
- (let ((tdpos (text-property-any (point-min) (point-max) 'org-today t)))
+ (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
+ (curspan (nth 2 args))
+ (tdpos (text-property-any (point-min) (point-max) 'org-today t)))
(cond
(tdpos (goto-char tdpos))
((eq org-agenda-type 'agenda)
(let* ((sd (org-agenda-compute-starting-span
- (org-today) (or org-agenda-current-span org-agenda-ndays org-agenda-span)))
- (org-agenda-overriding-arguments org-agenda-last-arguments))
+ (org-today) (or curspan org-agenda-ndays org-agenda-span)))
+ (org-agenda-overriding-arguments args))
(setf (nth 1 org-agenda-overriding-arguments) sd)
(org-agenda-redo)
(org-agenda-find-same-or-today-or-agenda)))
@@ -6531,19 +7035,43 @@ Negative selection means regexp must not match for selection of an entry."
(or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
(text-property-any (point-min) (point-max) 'org-today t)
(text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
+ (and (get-text-property (min (1- (point-max)) (point)) 'org-series)
+ (org-agenda-goto-block-beginning))
(point-min))))
+(defun org-agenda-goto-block-beginning ()
+ "Go the agenda block beginning."
+ (interactive)
+ (if (not (derived-mode-p 'org-agenda-mode))
+ (error "Cannot execute this command outside of org-agenda-mode buffers")
+ (let (dest)
+ (save-excursion
+ (unless (looking-at "\\'")
+ (forward-char))
+ (let* ((prop 'org-agenda-structural-header)
+ (p (previous-single-property-change (point) prop))
+ (n (next-single-property-change (or (and (looking-at "\\`") 1)
+ (1- (point))) prop)))
+ (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p))))))
+ (if (not dest)
+ (error "Cannot find the beginning of the blog")
+ (goto-char dest)
+ (move-beginning-of-line 1)))))
+
(defun org-agenda-later (arg)
"Go forward in time by thee current span.
With prefix ARG, go forward that many times the current span."
(interactive "p")
(org-agenda-check-type t 'agenda)
- (let* ((span org-agenda-current-span)
- (sd org-starting-day)
+ (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
+ (span (or (nth 2 args) org-agenda-current-span))
+ (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day))
(greg (calendar-gregorian-from-absolute sd))
(cnt (org-get-at-bol 'org-day-cnt))
greg2)
(cond
+ ((numberp span)
+ (setq sd (+ span sd)))
((eq span 'day)
(setq sd (+ arg sd)))
((eq span 'week)
@@ -6558,8 +7086,13 @@ With prefix ARG, go forward that many times the current span."
(setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
(t
(setq sd (+ (* span arg) sd))))
- (let ((org-agenda-overriding-arguments
- (list (car org-agenda-last-arguments) sd span t)))
+ (let ((org-agenda-overriding-cmd
+ ;; `cmd' may have been set by `org-agenda-run-series' which
+ ;; uses `org-agenda-overriding-cmd' to decide whether
+ ;; overriding is allowed for `cmd'
+ (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
+ (org-agenda-overriding-arguments
+ (list (car args) sd span)))
(org-agenda-redo)
(org-agenda-find-same-or-today-or-agenda cnt))))
@@ -6572,10 +7105,9 @@ With prefix ARG, go backward that many times the current span."
(defun org-agenda-view-mode-dispatch ()
"Call one of the view mode commands."
(interactive)
- (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort
- time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
- [a]rch-trees [A]rch-files clock[R]eport include[D]iary
- [E]ntryText")
+ (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort
+ time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
+ [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
(let ((a (read-char-exclusive)))
(case a
(?\ (call-interactively 'org-agenda-reset-view))
@@ -6642,18 +7174,22 @@ written as 2-digit years."
"Change the agenda view to SPAN.
SPAN may be `day', `week', `month', `year'."
(org-agenda-check-type t 'agenda)
- (if (and (not n) (equal org-agenda-current-span span))
- (error "Viewing span is already \"%s\"" span))
- (let* ((sd (or (org-get-at-bol 'day)
- org-starting-day))
- (sd (org-agenda-compute-starting-span sd span n))
- (org-agenda-overriding-arguments
- (or org-agenda-overriding-arguments
- (list (car org-agenda-last-arguments) sd span t))))
- (org-agenda-redo)
- (org-agenda-find-same-or-today-or-agenda))
- (org-agenda-set-mode-name)
- (message "Switched to %s view" span))
+ (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
+ (curspan (nth 2 args)))
+ (if (and (not n) (equal curspan span))
+ (error "Viewing span is already \"%s\"" span))
+ (let* ((sd (or (org-get-at-bol 'day)
+ (nth 1 args)
+ org-starting-day))
+ (sd (org-agenda-compute-starting-span sd span n))
+ (org-agenda-overriding-cmd
+ (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
+ (org-agenda-overriding-arguments
+ (list (car args) sd span)))
+ (org-agenda-redo)
+ (org-agenda-find-same-or-today-or-agenda))
+ (org-agenda-set-mode-name)
+ (message "Switched to %s view" span)))
(defun org-agenda-compute-starting-span (sd span &optional n)
"Compute starting date for agenda.
@@ -6732,20 +7268,21 @@ so that the date SD will be in that range."
"Detach overlay INDEX."
(org-detach-overlay org-hl))
-;; FIXME this is currently not used.
-(defun org-highlight-until-next-command (beg end &optional buffer)
- "Move the highlight overlay to BEG/END, remove it before the next command."
- (org-highlight beg end buffer)
- (add-hook 'pre-command-hook 'org-unhighlight-once))
(defun org-unhighlight-once ()
"Remove the highlight from its position, and this function from the hook."
(remove-hook 'pre-command-hook 'org-unhighlight-once)
(org-unhighlight))
+(defvar org-agenda-pre-follow-window-conf nil)
(defun org-agenda-follow-mode ()
"Toggle follow mode in an agenda buffer."
(interactive)
+ (unless org-agenda-follow-mode
+ (setq org-agenda-pre-follow-window-conf
+ (current-window-configuration)))
(setq org-agenda-follow-mode (not org-agenda-follow-mode))
+ (unless org-agenda-follow-mode
+ (set-window-configuration org-agenda-pre-follow-window-conf))
(org-agenda-set-mode-name)
(org-agenda-do-context-action)
(message "Follow mode is %s"
@@ -6883,7 +7420,7 @@ When called with a prefix argument, include all archive files as well."
'help-echo "Category used in filtering"))
"")
(if (or org-agenda-tag-filter (get 'org-agenda-tag-filter
- :preset-filter))
+ :preset-filter))
'(:eval (org-propertize
(concat " {"
(mapconcat
@@ -6907,11 +7444,14 @@ When called with a prefix argument, include all archive files as well."
"")))
(force-mode-line-update))
-(defun org-agenda-post-command-hook ()
+(define-obsolete-function-alias
+ 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3")
+
+(defun org-agenda-update-agenda-type ()
+ "Update the agenda type after each command."
(setq org-agenda-type
(or (get-text-property (point) 'org-agenda-type)
- (get-text-property (max (point-min) (1- (point)))
- 'org-agenda-type))))
+ (get-text-property (max (point-min) (1- (point))) 'org-agenda-type))))
(defun org-agenda-next-line ()
"Move cursor to the next line, and show if follow mode is active."
@@ -6925,25 +7465,40 @@ When called with a prefix argument, include all archive files as well."
(call-interactively 'previous-line)
(org-agenda-do-context-action))
+(defun org-agenda-next-item (n)
+ "Move cursor to next agenda item."
+ (interactive "p")
+ (let ((col (current-column)))
+ (dotimes (c n)
+ (when (next-single-property-change (point-at-eol) 'org-marker)
+ (move-end-of-line 1)
+ (goto-char (next-single-property-change (point) 'org-marker))))
+ (org-move-to-column col))
+ (org-agenda-do-context-action))
+
+(defun org-agenda-previous-item (n)
+ "Move cursor to next agenda item."
+ (interactive "p")
+ (dotimes (c n)
+ (let ((col (current-column))
+ (goto (save-excursion
+ (move-end-of-line 0)
+ (previous-single-property-change (point) 'org-marker))))
+ (if goto (goto-char goto))
+ (org-move-to-column col)))
+ (org-agenda-do-context-action))
+
(defun org-agenda-do-context-action ()
"Show outline path and, maybe, follow mode window."
(let ((m (org-get-at-bol 'org-marker)))
(when (and (markerp m) (marker-buffer m))
(and org-agenda-follow-mode
(if org-agenda-follow-indirect
- (org-agenda-tree-to-indirect-buffer)
+ (org-agenda-tree-to-indirect-buffer nil)
(org-agenda-show)))
(and org-agenda-show-outline-path
(org-with-point-at m (org-display-outline-path t))))))
-(defun org-agenda-show-priority ()
- "Show the priority of the current item.
-This priority is composed of the main priority given with the [#A] cookies,
-and by additional input from the age of a schedules or deadline entry."
- (interactive)
- (let* ((pri (org-get-at-bol 'priority)))
- (message "Priority is %d" (if pri pri -1000))))
-
(defun org-agenda-show-tags ()
"Show the tags applicable to the current item."
(interactive)
@@ -6964,7 +7519,7 @@ and by additional input from the age of a schedules or deadline entry."
(widen)
(push-mark)
(goto-char pos)
- (when (eq major-mode 'org-mode)
+ (when (derived-mode-p 'org-mode)
(org-show-context 'agenda)
(save-excursion
(and (outline-next-heading)
@@ -6983,36 +7538,38 @@ Point is in the buffer where the item originated.")
"Kill the entry or subtree belonging to the current agenda entry."
(interactive)
(or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
- (let* ((marker (or (org-get-at-bol 'org-marker)
+ (let* ((bufname-orig (buffer-name))
+ (marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker))
(type (org-get-at-bol 'type))
dbeg dend (n 0) conf)
(org-with-remote-undo buffer
- (with-current-buffer buffer
- (save-excursion
- (goto-char pos)
- (if (and (eq major-mode 'org-mode) (not (member type '("sexp"))))
- (setq dbeg (progn (org-back-to-heading t) (point))
- dend (org-end-of-subtree t t))
- (setq dbeg (point-at-bol)
- dend (min (point-max) (1+ (point-at-eol)))))
- (goto-char dbeg)
- (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
- (setq conf (or (eq t org-agenda-confirm-kill)
- (and (numberp org-agenda-confirm-kill)
- (> n org-agenda-confirm-kill))))
- (and conf
- (not (y-or-n-p
- (format "Delete entry with %d lines in buffer \"%s\"? "
- n (buffer-name buffer))))
- (error "Abort"))
- (org-remove-subtree-entries-from-agenda buffer dbeg dend)
- (with-current-buffer buffer (delete-region dbeg dend))
- (message "Agenda item and source killed"))))
-
-(defvar org-archive-default-command)
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char pos)
+ (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
+ (setq dbeg (progn (org-back-to-heading t) (point))
+ dend (org-end-of-subtree t t))
+ (setq dbeg (point-at-bol)
+ dend (min (point-max) (1+ (point-at-eol)))))
+ (goto-char dbeg)
+ (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
+ (setq conf (or (eq t org-agenda-confirm-kill)
+ (and (numberp org-agenda-confirm-kill)
+ (> n org-agenda-confirm-kill))))
+ (and conf
+ (not (y-or-n-p
+ (format "Delete entry with %d lines in buffer \"%s\"? "
+ n (buffer-name buffer))))
+ (error "Abort"))
+ (let ((org-agenda-buffer-name bufname-orig))
+ (org-remove-subtree-entries-from-agenda buffer dbeg dend))
+ (with-current-buffer buffer (delete-region dbeg dend))
+ (message "Agenda item and source killed"))))
+
+(defvar org-archive-default-command) ; defined in org-archive.el
(defun org-agenda-archive-default ()
"Archive the entry or subtree belonging to the current agenda entry."
(interactive)
@@ -7039,19 +7596,21 @@ Point is in the buffer where the item originated.")
"Move the entry to the archive sibling."
(interactive)
(or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
- (let* ((marker (or (org-get-at-bol 'org-marker)
+ (let* ((bufname-orig (buffer-name))
+ (marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
(org-with-remote-undo buffer
(with-current-buffer buffer
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(if (and confirm
(not (y-or-n-p "Archive this subtree or entry? ")))
(error "Abort")
(save-excursion
(goto-char pos)
- (org-remove-subtree-entries-from-agenda)
+ (let ((org-agenda-buffer-name bufname-orig))
+ (org-remove-subtree-entries-from-agenda))
(org-back-to-heading t)
(funcall cmd)))
(error "Archiving works only in Org-mode files"))))))
@@ -7086,7 +7645,8 @@ If this information is not given, the function uses the tree at point."
(interactive "P")
(if (equal goto '(16))
(org-refile-goto-last-stored)
- (let* ((marker (or (org-get-at-bol 'org-hd-marker)
+ (let* ((buffer-orig (buffer-name))
+ (marker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker))
@@ -7099,7 +7659,8 @@ If this information is not given, the function uses the tree at point."
(save-restriction
(widen)
(goto-char marker)
- (org-remove-subtree-entries-from-agenda)
+ (let ((org-agenda-buffer-name buffer-orig))
+ (org-remove-subtree-entries-from-agenda))
(org-refile goto buffer rfloc)))))
(unless no-update (org-agenda-redo))))
@@ -7150,13 +7711,14 @@ at the text of the entry itself."
(and delete-other-windows (delete-other-windows))
(widen)
(goto-char pos)
- (when (eq major-mode 'org-mode)
+ (when (derived-mode-p 'org-mode)
(org-show-context 'agenda)
(save-excursion
(and (outline-next-heading)
(org-flag-heading nil))) ; show the next heading
(when (outline-invisible-p)
- (show-entry)))))) ; display invisible text
+ (show-entry)) ; display invisible text
+ (run-hooks 'org-agenda-after-show-hook)))))
(defun org-agenda-goto-mouse (ev)
"Go to the Org-mode file which contains the item at the mouse click."
@@ -7177,10 +7739,13 @@ if it was hidden in the outline."
(select-window win)))
(defvar org-agenda-show-window nil)
-(defun org-agenda-show-and-scroll-up ()
+(defun org-agenda-show-and-scroll-up (&optional arg)
"Display the Org-mode file which contains the item at point.
-When called repeatedly, scroll the window that is displaying the buffer."
- (interactive)
+When called repeatedly, scroll the window that is displaying the buffer.
+With a \\[universal-argument] prefix, use `org-show-entry' instead of
+`show-subtree' to display the item, so that drawers and logbooks stay
+folded."
+ (interactive "P")
(let ((win (selected-window)))
(if (and (window-live-p org-agenda-show-window)
(eq this-command last-command))
@@ -7188,7 +7753,7 @@ When called repeatedly, scroll the window that is displaying the buffer."
(select-window org-agenda-show-window)
(ignore-errors (scroll-up)))
(org-agenda-goto t)
- (show-subtree)
+ (if arg (org-show-entry) (show-subtree))
(setq org-agenda-show-window (selected-window)))
(select-window win)))
@@ -7306,31 +7871,34 @@ docstring of `org-agenda-show-1'."
(defun org-agenda-error ()
(error "Command not allowed in this line"))
-(defun org-agenda-tree-to-indirect-buffer ()
+(defun org-agenda-tree-to-indirect-buffer (arg)
"Show the subtree corresponding to the current entry in an indirect buffer.
-This calls the command `org-tree-to-indirect-buffer' from the original
-Org-mode buffer.
-With numerical prefix arg ARG, go up to this level and then take that tree.
+This calls the command `org-tree-to-indirect-buffer' from the original buffer.
+
+With a numerical prefix ARG, go up to this level and then take that tree.
+With a negative numeric ARG, go up by this number of levels.
With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't
use the dedicated frame)."
- (interactive)
- (if (and current-prefix-arg (listp current-prefix-arg))
- (org-agenda-do-tree-to-indirect-buffer)
- (let ((agenda-window (selected-window))
+ (interactive "P")
+ (if current-prefix-arg
+ (org-agenda-do-tree-to-indirect-buffer arg)
+ (let ((agenda-buffer (buffer-name))
+ (agenda-window (selected-window))
(indirect-window
(and org-last-indirect-buffer
(get-buffer-window org-last-indirect-buffer))))
- (save-window-excursion (org-agenda-do-tree-to-indirect-buffer))
- (unwind-protect
- (progn
- (unless (and indirect-window (window-live-p indirect-window))
- (setq indirect-window (split-window agenda-window)))
- (select-window indirect-window)
- (switch-to-buffer org-last-indirect-buffer :norecord)
- (fit-window-to-buffer indirect-window))
- (select-window (get-buffer-window org-agenda-buffer-name))))))
-
-(defun org-agenda-do-tree-to-indirect-buffer ()
+ (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg))
+ (unless (or (eq org-indirect-buffer-display 'new-frame)
+ (eq org-indirect-buffer-display 'dedicated-frame))
+ (unwind-protect
+ (unless (and indirect-window (window-live-p indirect-window))
+ (setq indirect-window (split-window agenda-window)))
+ (and indirect-window (select-window indirect-window))
+ (switch-to-buffer org-last-indirect-buffer :norecord)
+ (fit-window-to-buffer indirect-window)))
+ (select-window (get-buffer-window agenda-buffer)))))
+
+(defun org-agenda-do-tree-to-indirect-buffer (arg)
"Same as `org-agenda-tree-to-indirect-buffer' without saving window."
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
@@ -7340,7 +7908,7 @@ use the dedicated frame)."
(with-current-buffer buffer
(save-excursion
(goto-char pos)
- (call-interactively 'org-tree-to-indirect-buffer)))))
+ (funcall 'org-tree-to-indirect-buffer arg)))))
(defvar org-last-heading-marker (make-marker)
"Marker pointing to the headline that last changed its TODO state
@@ -7429,6 +7997,7 @@ If JUST-THIS is non-nil, change just the current line, not all.
If FORCE-TAGS is non nil, the car of it returns the new tags."
(let* ((inhibit-read-only t)
(line (org-current-line))
+ (org-agenda-buffer (current-buffer))
(thetags (with-current-buffer (marker-buffer hdmarker)
(save-excursion (save-restriction (widen)
(goto-char hdmarker)
@@ -7448,14 +8017,14 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
tags thetags
new
(let ((org-prefix-format-compiled
- (or (get-text-property (point) 'format)
- org-prefix-format-compiled)))
+ (or (get-text-property (min (1- (point-max)) (point)) 'format)
+ org-prefix-format-compiled))
+ (extra (org-get-at-bol 'extra)))
(with-current-buffer (marker-buffer hdmarker)
(save-excursion
(save-restriction
(widen)
- (org-agenda-format-item (org-get-at-bol 'extra)
- newhead cat tags dotime)))))
+ (org-agenda-format-item extra newhead cat tags dotime)))))
pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
undone-face (org-get-at-bol 'undone-face)
done-face (org-get-at-bol 'done-face))
@@ -7475,9 +8044,11 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
undone-face done-face))))
(org-agenda-highlight-todo 'line)
(beginning-of-line 1))
- (t (error "Line update did not work"))))
- (beginning-of-line 0)))
- (org-finalize-agenda)))
+ (t (error "Line update did not work")))
+ (save-restriction
+ (narrow-to-region (point-at-bol) (point-at-eol))
+ (org-agenda-finalize)))
+ (beginning-of-line 0)))))
(defun org-agenda-align-tags (&optional line)
"Align all tags in agenda items to `org-agenda-tags-column'."
@@ -7517,11 +8088,12 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(interactive)
(org-agenda-priority 'down))
-(defun org-agenda-priority (&optional force-direction)
+(defun org-agenda-priority (&optional force-direction show)
"Set the priority of line at point, also in Org-mode file.
This changes the line at point, all other lines in the agenda referring to
the same tree node, and the headline of the tree node in the Org-mode file."
- (interactive)
+ (interactive "P")
+ (if (equal force-direction '(4)) (setq show t))
(unless org-enable-priority-commands
(error "Priority commands are disabled"))
(org-agenda-check-no-diary)
@@ -7540,7 +8112,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(save-excursion
(and (outline-next-heading)
(org-flag-heading nil))) ; show the next heading
- (funcall 'org-priority force-direction)
+ (funcall 'org-priority force-direction show)
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)
@@ -7832,73 +8404,7 @@ ARG is passed through to `org-deadline'."
(goto-char pos)
(setq ts (org-deadline arg time)))
(org-agenda-show-new-time marker ts "D"))
- (message "Deadline for this item set to %s" ts)))
-
-(defun org-agenda-action ()
- "Select entry for agenda action, or execute an agenda action.
-This command prompts for another letter. Valid inputs are:
-
-m Mark the entry at point for an agenda action
-s Schedule the marked entry to the date at the cursor
-d Set the deadline of the marked entry to the date at the cursor
-r Call `org-remember' with cursor date as the default date
-c Call `org-capture' with cursor date as the default date
-SPC Show marked entry in other window
-TAB Visit marked entry in other window
-
-The cursor may be at a date in the calendar, or in the Org agenda."
- (interactive)
- (let (ans)
- (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [c]apture [ ]show")
- (setq ans (read-char-exclusive))
- (cond
- ((equal ans ?m)
- ;; Mark this entry
- (if (eq major-mode 'org-agenda-mode)
- (let ((m (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker))))
- (if m
- (progn
- (move-marker org-agenda-action-marker
- (marker-position m) (marker-buffer m))
- (message "Entry marked for action; press `k' at desired date in agenda or calendar"))
- (error "Don't know which entry to mark")))
- (error "This command works only in the agenda")))
- ((equal ans ?s)
- (org-agenda-do-action '(org-schedule nil org-overriding-default-time)))
- ((equal ans ?d)
- (org-agenda-do-action '(org-deadline nil org-overriding-default-time)))
- ((equal ans ?r)
- (org-agenda-do-action '(org-remember) t))
- ((equal ans ?c)
- (org-agenda-do-action '(org-capture) t))
- ((equal ans ?\ )
- (let ((cw (selected-window)))
- (org-switch-to-buffer-other-window
- (marker-buffer org-agenda-action-marker))
- (goto-char org-agenda-action-marker)
- (org-show-context 'agenda)
- (select-window cw)))
- ((equal ans ?\C-i)
- (org-switch-to-buffer-other-window
- (marker-buffer org-agenda-action-marker))
- (goto-char org-agenda-action-marker)
- (org-show-context 'agenda))
- (t (error "Invalid agenda action %c" ans)))))
-
-(defun org-agenda-do-action (form &optional current-buffer)
- "Evaluate FORM at the entry pointed to by `org-agenda-action-marker'."
- (let ((org-overriding-default-time (org-get-cursor-date)))
- (if current-buffer
- (eval form)
- (if (not (marker-buffer org-agenda-action-marker))
- (error "No entry has been selected for agenda action")
- (with-current-buffer (marker-buffer org-agenda-action-marker)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char org-agenda-action-marker)
- (eval form))))))))
+ (message "Deadline for this item set to %s" ts)))
(defun org-agenda-clock-in (&optional arg)
"Start the clock on the currently selected item."
@@ -8026,6 +8532,12 @@ top-level as top-level entries at the end of the file."
:version "24.1"
:type 'boolean)
+(defcustom org-agenda-bulk-mark-char ">"
+ "A single-character string to be used as the bulk mark."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'string)
+
(defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
"Add a diary entry with TYPE to `org-agenda-diary-file'.
If TEXT is not empty, it will become the headline of the new entry, and
@@ -8039,12 +8551,12 @@ the resulting entry will not be shown. When TEXT is empty, switch to
(cond
((eq type 'anniversary)
(or (re-search-forward "^*[ \t]+Anniversaries" nil t)
- (progn
- (or (org-at-heading-p t)
- (progn
- (outline-next-heading)
- (insert "* Anniversaries\n\n")
- (beginning-of-line -1)))))
+ (progn
+ (or (org-at-heading-p t)
+ (progn
+ (outline-next-heading)
+ (insert "* Anniversaries\n\n")
+ (beginning-of-line -1)))))
(outline-next-heading)
(org-back-over-empty-lines)
(backward-char 1)
@@ -8183,12 +8695,11 @@ entries in that Org-mode file."
(fset 'calendar-cursor-to-date oldf))))))
(defun org-agenda-execute-calendar-command (cmd)
- "Execute a calendar command from the agenda, with the date associated to
-the cursor position."
+ "Execute a calendar command from the agenda with date from cursor."
(org-agenda-check-type t 'agenda 'timeline)
(require 'diary-lib)
- (unless (get-text-property (point) 'day)
- (error "Don't know which date to use for calendar command"))
+ (unless (get-text-property (min (1- (point-max)) (point)) 'day)
+ (error "Don't know which date to use for the calendar command"))
(let* ((oldf (symbol-function 'calendar-cursor-to-date))
(point (point))
(date (calendar-gregorian-from-absolute
@@ -8196,14 +8707,14 @@ the cursor position."
;; the following 2 vars are needed in the calendar
(displayed-month (car date))
(displayed-year (nth 2 date)))
- (unwind-protect
- (progn
- (fset 'calendar-cursor-to-date
- (lambda (&optional error dummy)
- (calendar-gregorian-from-absolute
- (get-text-property point 'day))))
- (call-interactively cmd))
- (fset 'calendar-cursor-to-date oldf))))
+ (unwind-protect
+ (progn
+ (fset 'calendar-cursor-to-date
+ (lambda (&optional error dummy)
+ (calendar-gregorian-from-absolute
+ (get-text-property point 'day))))
+ (call-interactively cmd))
+ (fset 'calendar-cursor-to-date oldf))))
(defun org-agenda-phases-of-moon ()
"Display the phases of the moon for the 3 months around the cursor date."
@@ -8215,9 +8726,9 @@ the cursor position."
(interactive)
(org-agenda-execute-calendar-command 'list-calendar-holidays))
-(defvar calendar-longitude)
-(defvar calendar-latitude)
-(defvar calendar-location-name)
+(defvar calendar-longitude) ; defined in calendar.el
+(defvar calendar-latitude) ; defined in calendar.el
+(defvar calendar-location-name) ; defined in calendar.el
(defun org-agenda-sunrise-sunset (arg)
"Display sunrise and sunset for the cursor date.
@@ -8236,7 +8747,7 @@ argument, latitude and longitude will be prompted for."
"Open the Emacs calendar with the date at the cursor."
(interactive)
(org-agenda-check-type t 'agenda 'timeline)
- (let* ((day (or (get-text-property (point) 'day)
+ (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
(error "Don't know which date to open in calendar")))
(date (calendar-gregorian-from-absolute day))
(calendar-move-hook nil)
@@ -8257,7 +8768,7 @@ This is a command that has to be installed in `calendar-mode-map'."
(defun org-agenda-convert-date ()
(interactive)
(org-agenda-check-type t 'agenda 'timeline)
- (let ((day (get-text-property (point) 'day))
+ (let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
date s)
(unless day
(error "Don't know which date to convert"))
@@ -8284,9 +8795,6 @@ This is a command that has to be installed in `calendar-mode-map'."
;;; Bulk commands
-(defvar org-agenda-bulk-marked-entries nil
- "List of markers that refer to marked entries in the agenda.")
-
(defun org-agenda-bulk-marked-p ()
(eq (get-char-property (point-at-bol) 'type)
'org-marked-entry-overlay))
@@ -8302,7 +8810,7 @@ This is a command that has to be installed in `calendar-mode-map'."
(unless m (error "Nothing to mark at point"))
(push m org-agenda-bulk-marked-entries)
(setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol))))
- (org-overlay-display ov "> "
+ (org-overlay-display ov (concat org-agenda-bulk-mark-char " ")
(org-get-todo-face "TODO")
'evaporate)
(overlay-put ov 'type 'org-marked-entry-overlay))
@@ -8312,8 +8820,13 @@ This is a command that has to be installed in `calendar-mode-map'."
(message "%d entries marked for bulk action"
(length org-agenda-bulk-marked-entries))))))
+(defun org-agenda-bulk-mark-all ()
+ "Mark all entries for future agenda bulk action."
+ (interactive)
+ (org-agenda-bulk-mark-regexp "."))
+
(defun org-agenda-bulk-mark-regexp (regexp)
- "Mark entries match REGEXP."
+ "Mark entries matching REGEXP for future agenda bulk action."
(interactive "sMark entries matching regexp: ")
(let ((entries-marked 0))
(save-excursion
@@ -8326,27 +8839,30 @@ This is a command that has to be installed in `calendar-mode-map'."
(if (not entries-marked)
(message "No entry matching this regexp."))))
-(defun org-agenda-bulk-unmark ()
+(defun org-agenda-bulk-unmark (&optional arg)
"Unmark the entry at point for future bulk action."
- (interactive)
- (when (org-agenda-bulk-marked-p)
- (org-agenda-bulk-remove-overlays
- (point-at-bol) (+ 2 (point-at-bol)))
- (setq org-agenda-bulk-marked-entries
- (delete (org-get-at-bol 'org-hd-marker)
- org-agenda-bulk-marked-entries)))
- (beginning-of-line 2)
- (while (and (get-char-property (point) 'invisible) (not (eobp)))
- (beginning-of-line 2))
- (message "%d entries marked for bulk action"
- (length org-agenda-bulk-marked-entries)))
+ (interactive "P")
+ (if arg
+ (org-agenda-bulk-unmark-all)
+ (cond ((org-agenda-bulk-marked-p)
+ (org-agenda-bulk-remove-overlays
+ (point-at-bol) (+ 2 (point-at-bol)))
+ (setq org-agenda-bulk-marked-entries
+ (delete (org-get-at-bol 'org-hd-marker)
+ org-agenda-bulk-marked-entries))
+ (beginning-of-line 2)
+ (while (and (get-char-property (point) 'invisible) (not (eobp)))
+ (beginning-of-line 2))
+ (message "%d entries left marked for bulk action"
+ (length org-agenda-bulk-marked-entries)))
+ (t (message "No entry to unmark here")))))
(defun org-agenda-bulk-toggle ()
- "Toggle marking the entry at point for bulk action."
- (interactive)
- (if (org-agenda-bulk-marked-p)
- (org-agenda-bulk-unmark)
- (org-agenda-bulk-mark)))
+ "Toggle marking the entry at point for bulk action."
+ (interactive)
+ (if (org-agenda-bulk-marked-p)
+ (org-agenda-bulk-unmark)
+ (org-agenda-bulk-mark)))
(defun org-agenda-bulk-remove-overlays (&optional beg end)
"Remove the mark overlays between BEG and END in the agenda buffer.
@@ -8360,13 +8876,23 @@ from the list in `org-agenda-bulk-marked-entries'."
(delete-overlay ov)))
(overlays-in (or beg (point-min)) (or end (point-max)))))
-(defun org-agenda-bulk-remove-all-marks ()
+(defun org-agenda-bulk-unmark-all ()
"Remove all marks in the agenda buffer.
-This will remove the markers, and the overlays."
+This will remove the markers and the overlays."
(interactive)
- (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries)
- (setq org-agenda-bulk-marked-entries nil)
- (org-agenda-bulk-remove-overlays (point-min) (point-max)))
+ (if (null org-agenda-bulk-marked-entries)
+ (message "No entry to unmark")
+ (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries)
+ (setq org-agenda-bulk-marked-entries nil)
+ (org-agenda-bulk-remove-overlays (point-min) (point-max))))
+
+(defcustom org-agenda-persistent-marks nil
+ "Non-nil means marked items will stay marked after a bulk action.
+You can toggle this interactively by typing `p' when prompted for a
+bulk action."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'boolean)
(defun org-agenda-bulk-action (&optional arg)
"Execute an remote-editing action on all marked entries.
@@ -8384,148 +8910,161 @@ The prefix arg is passed through to the command if possible."
org-agenda-bulk-marked-entries)
;; Prompt for the bulk command
- (message (concat "Bulk: [r]efile [$]arch [A]rch->sib [t]odo"
- " [+/-]tag [s]chd [S]catter [d]eadline [f]unction"
- (when org-agenda-bulk-custom-functions
- (concat " Custom: ["
- (mapconcat (lambda(f) (char-to-string (car f)))
- org-agenda-bulk-custom-functions "")
- "]"))))
- (let* ((action (read-char-exclusive))
- (org-log-refile (if org-log-refile 'time nil))
- (entries (reverse org-agenda-bulk-marked-entries))
- redo-at-end
- cmd rfloc state e tag pos (cnt 0) (cntskip 0))
- (cond
- ((equal action ?$)
- (setq cmd '(org-agenda-archive)))
-
- ((equal action ?A)
- (setq cmd '(org-agenda-archive-to-archive-sibling)))
-
- ((member action '(?r ?w))
- (setq rfloc (org-refile-get-location
- "Refile to"
- (marker-buffer (car org-agenda-bulk-marked-entries))
- org-refile-allow-creating-parent-nodes))
- (if (nth 3 rfloc)
- (setcar (nthcdr 3 rfloc)
- (move-marker (make-marker) (nth 3 rfloc)
- (or (get-file-buffer (nth 1 rfloc))
- (find-buffer-visiting (nth 1 rfloc))
- (error "This should not happen")))))
-
- (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t)
- redo-at-end t))
-
- ((equal action ?t)
- (setq state (org-icompleting-read
- "Todo state: "
- (with-current-buffer (marker-buffer (car entries))
- (mapcar 'list org-todo-keywords-1))))
- (setq cmd `(let ((org-inhibit-blocking t)
- (org-inhibit-logging 'note))
- (org-agenda-todo ,state))))
-
- ((memq action '(?- ?+))
- (setq tag (org-icompleting-read
- (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
- (with-current-buffer (marker-buffer (car entries))
- (delq nil
- (mapcar (lambda (x)
- (if (stringp (car x)) x)) org-tag-alist)))))
- (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
-
- ((memq action '(?s ?d))
- (let* ((date (unless arg
- (org-read-date
- nil nil nil
- (if (eq action ?s) "(Re)Schedule to" "Set Deadline to"))))
- (ans (if arg nil org-read-date-final-answer))
- (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline)))
- (setq cmd `(let* ((bound (fboundp 'read-string))
- (old (and bound (symbol-function 'read-string))))
- (unwind-protect
- (progn
- (fset 'read-string (lambda (&rest ignore) ,ans))
- (eval '(,c1 arg)))
- (if bound
- (fset 'read-string old)
- (fmakunbound 'read-string)))))))
-
- ((equal action ?S)
- (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo))
- (error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)
- (let ((days (read-number
- (format "Scatter tasks across how many %sdays: "
- (if arg "week" "")) 7)))
- (setq cmd
- `(let ((distance (1+ (random ,days))))
- (if arg
- (let ((dist distance)
- (day-of-week
- (calendar-day-of-week
- (calendar-gregorian-from-absolute (org-today)))))
- (dotimes (i (1+ dist))
- (while (member day-of-week org-agenda-weekend-days)
- (incf distance)
- (incf day-of-week)
- (if (= day-of-week 7)
- (setq day-of-week 0)))
- (incf day-of-week)
- (if (= day-of-week 7)
- (setq day-of-week 0)))))
- ;; silently fail when try to replan a sexp entry
- (condition-case nil
- (let* ((date (calendar-gregorian-from-absolute
- (+ (org-today) distance)))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
- (nth 2 date))))
- (org-agenda-schedule nil time))
- (error nil)))))))
-
- ((assoc action org-agenda-bulk-custom-functions)
- (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions)))
- redo-at-end t))
-
- ((equal action ?f)
- (setq cmd (list (intern
- (org-icompleting-read "Function: "
- obarray 'fboundp t nil nil)))))
-
- (t (error "Invalid bulk action")))
-
- ;; Sort the markers, to make sure that parents are handled before children
- (setq entries (sort entries
- (lambda (a b)
- (cond
- ((equal (marker-buffer a) (marker-buffer b))
- (< (marker-position a) (marker-position b)))
- (t
- (string< (buffer-name (marker-buffer a))
- (buffer-name (marker-buffer b))))))))
-
- ;; Now loop over all markers and apply cmd
- (while (setq e (pop entries))
- (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e))
- (if (not pos)
- (progn (message "Skipping removed entry at %s" e)
- (setq cntskip (1+ cntskip)))
- (goto-char pos)
- (let (org-loop-over-headlines-in-active-region)
- (eval cmd))
- (setq org-agenda-bulk-marked-entries
- (delete e org-agenda-bulk-marked-entries))
- (setq cnt (1+ cnt))))
- (setq org-agenda-bulk-marked-entries nil)
- (org-agenda-bulk-remove-all-marks)
- (when redo-at-end (org-agenda-redo))
- (message "Acted on %d entries%s"
- cnt
- (if (= cntskip 0)
- ""
- (format ", skipped %d (disappeared before their turn)"
- cntskip)))))
+ (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")))
+ (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
+ "[S]catter [f]unction "
+ (when org-agenda-bulk-custom-functions
+ (concat " Custom: ["
+ (mapconcat (lambda(f) (char-to-string (car f)))
+ org-agenda-bulk-custom-functions "")
+ "]"))))
+ (catch 'exit
+ (let* ((action (read-char-exclusive))
+ (org-log-refile (if org-log-refile 'time nil))
+ (entries (reverse org-agenda-bulk-marked-entries))
+ (org-overriding-default-time
+ (if (get-text-property (point) 'org-agenda-date-header)
+ (org-get-cursor-date)))
+ redo-at-end
+ cmd rfloc state e tag pos (cnt 0) (cntskip 0))
+ (cond
+ ((equal action ?p)
+ (let ((org-agenda-persistent-marks
+ (not org-agenda-persistent-marks)))
+ (org-agenda-bulk-action)
+ (throw 'exit nil)))
+
+ ((equal action ?$)
+ (setq cmd '(org-agenda-archive)))
+
+ ((equal action ?A)
+ (setq cmd '(org-agenda-archive-to-archive-sibling)))
+
+ ((member action '(?r ?w))
+ (setq rfloc (org-refile-get-location
+ "Refile to"
+ (marker-buffer (car entries))
+ org-refile-allow-creating-parent-nodes))
+ (if (nth 3 rfloc)
+ (setcar (nthcdr 3 rfloc)
+ (move-marker (make-marker) (nth 3 rfloc)
+ (or (get-file-buffer (nth 1 rfloc))
+ (find-buffer-visiting (nth 1 rfloc))
+ (error "This should not happen")))))
+
+ (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t)
+ redo-at-end t))
+
+ ((equal action ?t)
+ (setq state (org-icompleting-read
+ "Todo state: "
+ (with-current-buffer (marker-buffer (car entries))
+ (mapcar 'list org-todo-keywords-1))))
+ (setq cmd `(let ((org-inhibit-blocking t)
+ (org-inhibit-logging 'note))
+ (org-agenda-todo ,state))))
+
+ ((memq action '(?- ?+))
+ (setq tag (org-icompleting-read
+ (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
+ (with-current-buffer (marker-buffer (car entries))
+ (delq nil
+ (mapcar (lambda (x)
+ (if (stringp (car x)) x)) org-tag-alist)))))
+ (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
+
+ ((memq action '(?s ?d))
+ (let* ((time
+ (unless arg
+ (org-read-date
+ nil nil nil
+ (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to")
+ org-overriding-default-time)))
+ (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline)))
+ (setq cmd `(eval '(,c1 arg ,time)))))
+
+ ((equal action ?S)
+ (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo))
+ (error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)
+ (let ((days (read-number
+ (format "Scatter tasks across how many %sdays: "
+ (if arg "week" "")) 7)))
+ (setq cmd
+ `(let ((distance (1+ (random ,days))))
+ (if arg
+ (let ((dist distance)
+ (day-of-week
+ (calendar-day-of-week
+ (calendar-gregorian-from-absolute (org-today)))))
+ (dotimes (i (1+ dist))
+ (while (member day-of-week org-agenda-weekend-days)
+ (incf distance)
+ (incf day-of-week)
+ (if (= day-of-week 7)
+ (setq day-of-week 0)))
+ (incf day-of-week)
+ (if (= day-of-week 7)
+ (setq day-of-week 0)))))
+ ;; silently fail when try to replan a sexp entry
+ (condition-case nil
+ (let* ((date (calendar-gregorian-from-absolute
+ (+ (org-today) distance)))
+ (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
+ (nth 2 date))))
+ (org-agenda-schedule nil time))
+ (error nil)))))))
+
+ ((assoc action org-agenda-bulk-custom-functions)
+ (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions)))
+ redo-at-end t))
+
+ ((equal action ?f)
+ (setq cmd (list (intern
+ (org-icompleting-read "Function: "
+ obarray 'fboundp t nil nil)))))
+
+ (t (error "Invalid bulk action")))
+
+ ;; Sort the markers, to make sure that parents are handled before children
+ (setq entries (sort entries
+ (lambda (a b)
+ (cond
+ ((equal (marker-buffer a) (marker-buffer b))
+ (< (marker-position a) (marker-position b)))
+ (t
+ (string< (buffer-name (marker-buffer a))
+ (buffer-name (marker-buffer b))))))))
+
+ ;; Now loop over all markers and apply cmd
+ (while (setq e (pop entries))
+ (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e))
+ (if (not pos)
+ (progn (message "Skipping removed entry at %s" e)
+ (setq cntskip (1+ cntskip)))
+ (goto-char pos)
+ (let (org-loop-over-headlines-in-active-region)
+ (eval cmd))
+ (setq cnt (1+ cnt))))
+ (when redo-at-end (org-agenda-redo))
+ (unless org-agenda-persistent-marks
+ (org-agenda-bulk-unmark-all))
+ (message "Acted on %d entries%s%s"
+ cnt
+ (if (= cntskip 0)
+ ""
+ (format ", skipped %d (disappeared before their turn)"
+ cntskip))
+ (if (not org-agenda-persistent-marks)
+ "" " (kept marked)"))))))
+
+(defun org-agenda-capture ()
+ "Call `org-capture' with the date at point."
+ (interactive)
+ (if (not (eq major-mode 'org-agenda-mode))
+ (error "You cannot do this outside of agenda buffers")
+ (let ((org-overriding-default-time
+ (org-get-cursor-date)))
+ (call-interactively 'org-capture))))
;;; Flagging notes
@@ -8576,7 +9115,7 @@ tag and (if present) the flagging note."
;;; Appointment reminders
-(defvar appt-time-msg-list)
+(defvar appt-time-msg-list) ; defined in appt.el
;;;###autoload
(defun org-agenda-to-appt (&optional refresh filter &rest args)
@@ -8606,7 +9145,10 @@ belonging to the \"Work\" category.
ARGS are symbols indicating what kind of entries to consider.
By default `org-agenda-to-appt' will use :deadline, :scheduled
and :timestamp entries. See the docstring of `org-diary' for
-details and examples."
+details and examples.
+
+If an entry as a APPT_WARNTIME property, its value will be used
+to override `appt-message-warning-time'."
(interactive "P")
(if refresh (setq appt-time-msg-list nil))
(if (eq filter t)
@@ -8621,9 +9163,10 @@ details and examples."
(today (org-date-to-gregorian
(time-to-days (current-time))))
(org-agenda-restrict nil)
- (files (org-agenda-files 'unrestricted)) entries file)
+ (files (org-agenda-files 'unrestricted)) entries file
+ (org-agenda-buffer nil))
;; Get all entries which may contain an appt
- (org-prepare-agenda-buffers files)
+ (org-agenda-prepare-buffers files)
(while (setq file (pop files))
(setq entries
(delq nil
@@ -8645,7 +9188,8 @@ details and examples."
(or (and (stringp cat-filter)
(string-match cat-filter cat))
(and (stringp evt-filter)
- (string-match evt-filter evt))))))))
+ (string-match evt-filter evt)))))))
+ (wrn (get-text-property 1 'warntime x)))
;; FIXME: Shall we remove text-properties for the appt text?
;; (setq evt (set-text-properties 0 (length evt) nil evt))
(when (and ok tod)
@@ -8654,7 +9198,9 @@ details and examples."
"\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
(concat (match-string 1 tod) ":"
(match-string 2 tod))))
- (appt-add tod evt)
+ (if (version< emacs-version "23.3")
+ (appt-add tod evt)
+ (appt-add tod evt wrn))
(setq cnt (1+ cnt))))) entries)
(org-release-buffers org-agenda-new-buffers)
(if (eq cnt 0)
@@ -8669,7 +9215,7 @@ details and examples."
(eq date today)))
(defun org-agenda-todo-yesterday (&optional arg)
- "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday"
+ "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday."
(interactive "P")
(let* ((hour (third (decode-time
(org-current-time))))
diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el
index db3b8250bc0..29b883824ef 100644
--- a/lisp/org/org-archive.el
+++ b/lisp/org/org-archive.el
@@ -31,6 +31,7 @@
(require 'org)
(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
(defcustom org-archive-default-command 'org-archive-subtree
"The default archiving command."
@@ -100,14 +101,14 @@ the archived entry, with a prefix \"ARCHIVE_\", to remember this
information."
:group 'org-archive
:type '(set :greedy t
- (const :tag "Time" time)
- (const :tag "File" file)
- (const :tag "Category" category)
- (const :tag "TODO state" todo)
- (const :tag "Priority" priority)
- (const :tag "Inherited tags" itags)
- (const :tag "Outline path" olpath)
- (const :tag "Local tags" ltags)))
+ (const :tag "Time" time)
+ (const :tag "File" file)
+ (const :tag "Category" category)
+ (const :tag "TODO state" todo)
+ (const :tag "Priority" priority)
+ (const :tag "Inherited tags" itags)
+ (const :tag "Outline path" olpath)
+ (const :tag "Local tags" ltags)))
(defun org-get-local-archive-location ()
"Get the archive location applicable at point."
@@ -223,13 +224,14 @@ this heading."
(current-time)))
category todo priority ltags itags atags
;; end of variables that will be used for saving context
- location afile heading buffer level newfile-p infile-p visiting)
+ location afile heading buffer level newfile-p infile-p visiting
+ datetree-date datetree-subheading-p)
;; Find the local archive location
(setq location (org-get-local-archive-location)
afile (org-extract-archive-file location)
heading (org-extract-archive-heading location)
- infile-p (equal file (abbreviate-file-name afile)))
+ infile-p (equal file (abbreviate-file-name (or afile ""))))
(unless afile
(error "Invalid `org-archive-location'"))
@@ -240,6 +242,13 @@ this heading."
(setq buffer (current-buffer)))
(unless buffer
(error "Cannot access file \"%s\"" afile))
+ (when (string-match "\\`datetree/" heading)
+ ;; Replace with ***, to represent the 3 levels of headings the
+ ;; datetree has.
+ (setq heading (replace-regexp-in-string "\\`datetree/" "***" heading))
+ (setq datetree-subheading-p (> (length heading) 3))
+ (setq datetree-date (org-date-to-gregorian
+ (or (org-entry-get nil "CLOSED" t) time))))
(if (and (> (length heading) 0)
(string-match "^\\*+" heading))
(setq level (match-end 0))
@@ -263,7 +272,7 @@ this heading."
(let (this-command) (org-copy-subtree 1 nil t))
(set-buffer buffer)
;; Enforce org-mode for the archive buffer
- (if (not (eq major-mode 'org-mode))
+ (if (not (derived-mode-p 'org-mode))
;; Force the mode for future visits.
(let ((org-insert-mode-line-in-empty-file t)
(org-inhibit-startup t))
@@ -272,6 +281,10 @@ this heading."
(goto-char (point-max))
(insert (format "\nArchived entries from file %s\n\n"
(buffer-file-name this-buffer))))
+ (when datetree-date
+ (require 'org-datetree)
+ (org-datetree-find-date-create datetree-date)
+ (org-narrow-to-subtree))
;; Force the TODO keywords of the original buffer
(let ((org-todo-line-regexp tr-org-todo-line-regexp)
(org-todo-keywords-1 tr-org-todo-keywords-1)
@@ -285,7 +298,7 @@ this heading."
tr-org-odd-levels-only)))
(goto-char (point-min))
(show-all)
- (if heading
+ (if (and heading (not (and datetree-date (not datetree-subheading-p))))
(progn
(if (re-search-forward
(concat "^" (regexp-quote heading)
@@ -295,7 +308,8 @@ this heading."
;; Heading not found, just insert it at the end
(goto-char (point-max))
(or (bolp) (insert "\n"))
- (insert "\n" heading "\n")
+ ;; datetrees don't need too much spacing
+ (insert (if datetree-date "" "\n") heading "\n")
(end-of-line 0))
;; Make the subtree visible
(show-subtree)
@@ -306,9 +320,10 @@ this heading."
(org-end-of-subtree t))
(skip-chars-backward " \t\r\n")
(and (looking-at "[ \t\r\n]*")
- (replace-match "\n\n")))
+ ;; datetree archives don't need so much spacing.
+ (replace-match (if datetree-date "\n" "\n\n"))))
;; No specific heading, just go to end of file.
- (goto-char (point-max)) (insert "\n"))
+ (goto-char (point-max)) (unless datetree-date (insert "\n")))
;; Paste
(org-paste-subtree (org-get-valid-level level (and heading 1)))
;; Shall we append inherited tags?
@@ -336,6 +351,7 @@ this heading."
(setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
(org-entry-put (point) n v)))))
+ (widen)
;; Save and kill the buffer, if it is not the same buffer.
(when (not (eq this-buffer buffer))
(save-buffer))))
diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el
index 61cbe1560a4..655b8db668d 100644
--- a/lisp/org/org-ascii.el
+++ b/lisp/org/org-ascii.el
@@ -36,7 +36,7 @@
:tag "Org Export ASCII"
:group 'org-export)
-(defcustom org-export-ascii-underline '(?\- ?\= ?\~ ?^ ?\# ?\$)
+(defcustom org-export-ascii-underline '(?\= ?\- ?\~ ?\^ ?\. ?\# ?\$)
"Characters for underlining headings in ASCII export.
In the given sequence, these characters will be used for level 1, 2, ..."
:group 'org-export-ascii
@@ -144,9 +144,9 @@ command to convert it."
(interactive "r")
(let (reg ascii buf pop-up-frames)
(save-window-excursion
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(setq ascii (org-export-region-as-ascii
- beg end t 'string))
+ beg end t 'string))
(setq reg (buffer-substring beg end)
buf (get-buffer-create "*Org tmp*"))
(with-current-buffer buf
@@ -154,7 +154,7 @@ command to convert it."
(insert reg)
(org-mode)
(setq ascii (org-export-region-as-ascii
- (point-min) (point-max) t 'string)))
+ (point-min) (point-max) t 'string)))
(kill-buffer buf)))
(delete-region beg end)
(insert ascii)))
@@ -193,7 +193,7 @@ in a window. A non-interactive call will only return the buffer."
;;;###autoload
(defun org-export-as-ascii (arg &optional hidden ext-plist
- to-buffer body-only pub-dir)
+ to-buffer body-only pub-dir)
"Export the outline as a pretty ASCII file.
If there is an active region, export only the region.
The prefix ARG specifies how many levels of the outline should become
@@ -373,54 +373,54 @@ publishing directory."
(push (concat (make-string (string-width (nth 3 lang-words)) ?=)
"\n") thetoc)
(mapc #'(lambda (line)
- (if (string-match org-todo-line-regexp
- line)
- ;; This is a headline
- (progn
- (setq have-headings t)
- (setq level (- (match-end 1) (match-beginning 1)
- level-offset)
- level (org-tr-level level)
- txt (match-string 3 line)
- todo
- (or (and org-export-mark-todo-in-toc
- (match-beginning 2)
- (not (member (match-string 2 line)
- org-done-keywords)))
+ (if (string-match org-todo-line-regexp
+ line)
+ ;; This is a headline
+ (progn
+ (setq have-headings t)
+ (setq level (- (match-end 1) (match-beginning 1)
+ level-offset)
+ level (org-tr-level level)
+ txt (match-string 3 line)
+ todo
+ (or (and org-export-mark-todo-in-toc
+ (match-beginning 2)
+ (not (member (match-string 2 line)
+ org-done-keywords)))
; TODO, not DONE
- (and org-export-mark-todo-in-toc
- (= level umax-toc)
- (org-search-todo-below
- line lines level))))
- (setq txt (org-html-expand-for-ascii txt))
-
- (while (string-match org-bracket-link-regexp txt)
- (setq txt
- (replace-match
- (match-string (if (match-end 2) 3 1) txt)
- t t txt)))
-
- (if (and (memq org-export-with-tags '(not-in-toc nil))
- (string-match
- (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
- txt))
- (setq txt (replace-match "" t t txt)))
- (if (string-match quote-re0 txt)
- (setq txt (replace-match "" t t txt 1)))
-
- (if org-export-with-section-numbers
- (setq txt (concat (org-section-number level)
- " " txt)))
- (if (<= level umax-toc)
- (progn
- (push
- (concat
- (make-string
- (* (max 0 (- level org-min-level)) 4) ?\ )
- (format (if todo "%s (*)\n" "%s\n") txt))
- thetoc)
- (setq org-last-level level))
- ))))
+ (and org-export-mark-todo-in-toc
+ (= level umax-toc)
+ (org-search-todo-below
+ line lines level))))
+ (setq txt (org-html-expand-for-ascii txt))
+
+ (while (string-match org-bracket-link-regexp txt)
+ (setq txt
+ (replace-match
+ (match-string (if (match-end 2) 3 1) txt)
+ t t txt)))
+
+ (if (and (memq org-export-with-tags '(not-in-toc nil))
+ (string-match
+ (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
+ txt))
+ (setq txt (replace-match "" t t txt)))
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt 1)))
+
+ (if org-export-with-section-numbers
+ (setq txt (concat (org-section-number level)
+ " " txt)))
+ (if (<= level umax-toc)
+ (progn
+ (push
+ (concat
+ (make-string
+ (* (max 0 (- level org-min-level)) 4) ?\ )
+ (format (if todo "%s (*)\n" "%s\n") txt))
+ thetoc)
+ (setq org-last-level level))
+ ))))
lines)
(setq thetoc (if have-headings (nreverse thetoc) nil))))
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
index a87993f4b2e..e02d7e07a4c 100644
--- a/lisp/org/org-attach.el
+++ b/lisp/org/org-attach.el
@@ -78,12 +78,15 @@ Allowed values are:
mv rename the file to move it into the attachment directory
cp copy the file
ln create a hard link. Note that this is not supported
+ on all systems, and then the result is not defined.
+lns create a symbol link. Note that this is not supported
on all systems, and then the result is not defined."
:group 'org-attach
:type '(choice
(const :tag "Copy" cp)
(const :tag "Move/Rename" mv)
- (const :tag "Link" ln)))
+ (const :tag "Hard Link" ln)
+ (const :tag "Symbol Link" lns)))
(defcustom org-attach-expert nil
"Non-nil means do not show the splash buffer with the attach dispatcher."
@@ -130,7 +133,7 @@ Shows a list of commands and prompts for another key to execute a command."
(princ "Select an Attachment Command:
a Select a file and attach it to the task, using `org-attach-method'.
-c/m/l Attach a file using copy/move/link method.
+c/m/l/y Attach a file using copy/move/link/symbolic-link method.
n Create a new attachment, as an Emacs buffer.
z Synchronize the current task with its attachment
directory, in case you added attachments yourself.
@@ -158,6 +161,8 @@ i Make children of the current entry inherit its attachment directory.")))
(let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach)))
((memq c '(?l ?\C-l))
(let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
+ ((memq c '(?y ?\C-y))
+ (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new))
((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
@@ -254,9 +259,9 @@ This checks for the existence of a \".git\" directory in that directory."
(shell-command "git add .")
(shell-command "git ls-files --deleted" t)
(mapc #'(lambda (file)
- (unless (string= file "")
- (shell-command
- (concat "git rm \"" file "\""))))
+ (unless (string= file "")
+ (shell-command
+ (concat "git rm \"" file "\""))))
(split-string (buffer-string) "\n"))
(shell-command "git commit -m 'Synchronized attachments'")))))
@@ -282,7 +287,8 @@ Only do this when `org-attach-store-link-p' is non-nil."
(defun org-attach-attach (file &optional visit-dir method)
"Move/copy/link FILE into the attachment directory of the current task.
If VISIT-DIR is non-nil, visit the directory with dired.
-METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'."
+METHOD may be `cp', `mv', `ln', or `lns' default taken from
+`org-attach-method'."
(interactive "fFile to keep as an attachment: \nP")
(setq method (or method org-attach-method))
(let ((basename (file-name-nondirectory file)))
@@ -294,7 +300,8 @@ METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'."
(cond
((eq method 'mv) (rename-file file fname))
((eq method 'cp) (copy-file file fname))
- ((eq method 'ln) (add-name-to-file file fname)))
+ ((eq method 'ln) (add-name-to-file file fname))
+ ((eq method 'lns) (make-symbolic-link file fname)))
(org-attach-commit)
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
@@ -319,6 +326,13 @@ Beware that this does not work on systems that do not support hard links.
On some systems, this apparently does copy the file instead."
(interactive)
(let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
+(defun org-attach-attach-lns ()
+ "Attach a file by creating a symbolic link to it.
+
+Beware that this does not work on systems that do not support symbolic links.
+On some systems, this apparently does copy the file instead."
+ (interactive)
+ (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
(defun org-attach-new (file)
"Create a new attachment FILE for the current task.
@@ -415,7 +429,7 @@ If IN-EMACS is non-nil, force opening in Emacs."
(file (if (= (length files) 1)
(car files)
(org-icompleting-read "Open attachment: "
- (mapcar 'list files) nil t))))
+ (mapcar 'list files) nil t))))
(org-open-file (expand-file-name file attach-dir) in-emacs)))
(defun org-attach-open-in-emacs ()
diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el
index 04af6969de5..be395ad3927 100644
--- a/lisp/org/org-bbdb.el
+++ b/lisp/org/org-bbdb.el
@@ -109,17 +109,20 @@
(declare-function bbdb-record-getprop "ext:bbdb" (record property))
(declare-function bbdb-record-name "ext:bbdb" (record))
(declare-function bbdb-records "ext:bbdb"
- (&optional dont-check-disk already-in-db-buffer))
+ (&optional dont-check-disk already-in-db-buffer))
(declare-function bbdb-split "ext:bbdb" (string separators))
(declare-function bbdb-string-trim "ext:bbdb" (string))
(declare-function bbdb-record-get-field "ext:bbdb" (record field))
(declare-function bbdb-search-name "ext:bbdb-com" (regexp &optional layout))
(declare-function bbdb-search-organization "ext:bbdb-com" (regexp &optional layout))
+;; `bbdb-record-note' is part of BBDB v3.x
+(declare-function bbdb-record-note "ext:bbdb" (record label))
+
(declare-function calendar-leap-year-p "calendar" (year))
(declare-function diary-ordinal-suffix "diary-lib" (n))
-(defvar date) ;; dynamically scoped from Org
+(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
;; Customization
@@ -134,30 +137,31 @@
:require 'bbdb)
(defcustom org-bbdb-anniversary-format-alist
- '(("birthday" lambda
- (name years suffix)
- (concat "Birthday: [[bbdb:" name "][" name " ("
- (format "%s" years) ; handles numbers as well as strings
- suffix ")]]"))
- ("wedding" lambda
- (name years suffix)
- (concat "[[bbdb:" name "][" name "'s "
- (format "%s" years)
- suffix " wedding anniversary]]")))
+ '(("birthday" .
+ (lambda (name years suffix)
+ (concat "Birthday: [[bbdb:" name "][" name " ("
+ (format "%s" years) ; handles numbers as well as strings
+ suffix ")]]")))
+ ("wedding" .
+ (lambda (name years suffix)
+ (concat "[[bbdb:" name "][" name "'s "
+ (format "%s" years)
+ suffix " wedding anniversary]]"))))
"How different types of anniversaries should be formatted.
An alist of elements (STRING . FORMAT) where STRING is the name of an
anniversary class and format is either:
1) A format string with the following substitutions (in order):
- * the name of the record containing this anniversary
- * the number of years
- * an ordinal suffix (st, nd, rd, th) for the year
+ - the name of the record containing this anniversary
+ - the number of years
+ - an ordinal suffix (st, nd, rd, th) for the year
2) A function to be called with three arguments: NAME YEARS SUFFIX
(string int string) returning a string for the diary or nil.
3) An Emacs Lisp form that should evaluate to a string (or nil) in the
scope of variables NAME, YEARS and SUFFIX (among others)."
- :type 'sexp
+ :type '(alist :key-type (string :tag "Class")
+ :value-type (function :tag "Function"))
:group 'org-bbdb-anniversaries
:require 'bbdb)
@@ -203,7 +207,7 @@ date year)."
(company (if (fboundp 'bbdb-record-getprop)
(bbdb-record-getprop rec 'company)
(car (bbdb-record-get-field rec 'organization))))
- (link (org-make-link "bbdb:" name)))
+ (link (concat "bbdb:" name)))
(org-store-link-props :type "bbdb" :name name :company company
:link link :description name)
link)))
@@ -217,6 +221,8 @@ italicized, in all other cases it is left unchanged."
(cond
((eq format 'html) (format "<i>%s</i>" desc))
((eq format 'latex) (format "\\textit{%s}" desc))
+ ((eq format 'odt)
+ (format "<text:span text:style-name=\"Emphasis\">%s</text:span>" desc))
(t desc)))
(defun org-bbdb-open (name)
@@ -272,7 +278,7 @@ italicized, in all other cases it is left unchanged."
"Convert YYYY-MM-DD to (month date year).
Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted
it will be considered unknown."
- (multiple-value-bind (a b c) (values-list (bbdb-split time-str "-"))
+ (multiple-value-bind (a b c) (values-list (org-split-string time-str "-"))
(if (eq c nil)
(list (string-to-number a)
(string-to-number b)
@@ -299,13 +305,19 @@ The hash table is created on first use.")
(defun org-bbdb-make-anniv-hash ()
"Create a hash with anniversaries extracted from BBDB, for fast access.
The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
-
- (let (split tmp annivs)
+ (let ((old-bbdb (fboundp 'bbdb-record-getprop))
+ split tmp annivs)
(clrhash org-bbdb-anniv-hash)
(dolist (rec (bbdb-records))
- (when (setq annivs (bbdb-record-getprop
- rec org-bbdb-anniversary-field))
- (setq annivs (bbdb-split annivs "\n"))
+ (when (setq annivs (if old-bbdb
+ (bbdb-record-getprop
+ rec org-bbdb-anniversary-field)
+ (bbdb-record-note
+ rec org-bbdb-anniversary-field)))
+ (setq annivs (if old-bbdb
+ (bbdb-split annivs "\n")
+ ;; parameter order is reversed in new bbdb
+ (bbdb-split "\n" annivs)))
(while annivs
(setq split (org-bbdb-anniv-split (pop annivs)))
(multiple-value-bind (m d y)
diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el
index 041a9154095..b5f3013e000 100644
--- a/lisp/org/org-beamer.el
+++ b/lisp/org/org-beamer.el
@@ -87,7 +87,7 @@ BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}."
(defconst org-beamer-column-widths
"0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC"
-"The column widths that should be installed as allowed property values.")
+ "The column widths that should be installed as allowed property values.")
(defconst org-beamer-transitions
"\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC"
@@ -107,6 +107,7 @@ These are just a completion help.")
("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}")
("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}")
("example" "e" "\\begin{example}%a%U%x" "\\end{example}")
+ ("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}")
("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}")
("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}")
("normal" "h" "%h" "") ; Emit the heading as normal text
@@ -117,7 +118,7 @@ These are just a completion help.")
These are the defaults - for user definitions, see
`org-beamer-environments-extra'.
\"normal\" is a special fake environment, which emit the heading as
-normal text. It is needed when an environment should be surrounded
+normal text. It is needed when an environment should be surrounded
by normal text. Since beamer export converts nodes into environments,
you need to have a node to end the environment.
For example
@@ -155,6 +156,12 @@ close The closing string of the environment."
(string :tag "Begin")
(string :tag "End"))))
+(defcustom org-beamer-inherited-properties nil
+ "Properties that should be inherited during beamer export."
+ :group 'org-beamer
+ :type '(repeat
+ (string :tag "Property")))
+
(defvar org-beamer-frame-level-now nil)
(defvar org-beamer-header-extra nil)
(defvar org-beamer-export-is-beamer-p nil)
@@ -488,6 +495,12 @@ The effect is that these values will be accessible during export."
(if (and (not (assoc "BEAMER_env" props))
(looking-at ".*?:B_\\(note\\(NH\\)?\\):"))
(push (cons "BEAMER_env" (match-string 1)) props))
+ (when (org-bound-and-true-p org-beamer-inherited-properties)
+ (mapc (lambda (p)
+ (unless (assoc p props)
+ (let ((v (org-entry-get nil p 'inherit)))
+ (and v (push (cons p v) props)))))
+ org-beamer-inherited-properties))
(put-text-property (point-at-bol) (point-at-eol) 'org-props props)))
(setq org-export-latex-options-plist
(plist-put org-export-latex-options-plist :tags nil))))))
@@ -502,7 +515,7 @@ This function will run in the final LaTeX document."
(while (re-search-forward org-beamer-fragile-re nil t)
(save-excursion
;; Are we inside a frame here?
- (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}"
+ (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}\\(<[^>]*>\\)?"
nil t)
(equal (match-string 1) "begin"))
;; yes, inside a frame, make sure "fragile" is one of the options
@@ -520,7 +533,7 @@ This function will run in the final LaTeX document."
:group 'org-beamer
:version "24.1"
:type '(string :tag "Outline frame title")
-)
+ )
(defcustom org-beamer-outline-frame-options nil
"Outline frame options appended after \\begin{frame}.
@@ -529,7 +542,7 @@ include square brackets."
:group 'org-beamer
:version "24.1"
:type '(string :tag "Outline frame options")
-)
+ )
(defun org-beamer-fix-toc ()
"Fix the table of contents by removing the vspace line."
diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el
index 4c852fcb875..f8e07adcd8a 100644
--- a/lisp/org/org-bibtex.el
+++ b/lisp/org/org-bibtex.el
@@ -111,6 +111,7 @@
(require 'bibtex)
(eval-when-compile
(require 'cl))
+(require 'org-compat)
(defvar org-bibtex-description nil) ; dynamically scoped from org.el
(defvar org-id-locations)
@@ -184,33 +185,33 @@
"Bibtex entry types with required and optional parameters.")
(defvar org-bibtex-fields
- '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.")
- (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.")
+ '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.")
+ (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.")
(:author . "The name(s) of the author(s), in the format described in the LaTeX book. Remember, all names are separated with the and keyword, and not commas.")
- (:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.")
+ (:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.")
(:chapter . "A chapter (or section or whatever) number.")
(:crossref . "The database key of the entry being cross referenced.")
- (:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.")
- (:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.")
- (:howpublished . "How something strange has been published. The first word should be capitalized.")
+ (:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.")
+ (:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.")
+ (:howpublished . "How something strange has been published. The first word should be capitalized.")
(:institution . "The sponsoring institution of a technical report.")
(:journal . "A journal name.")
- (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.")
- (:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,")
- (:note . "Any additional information that can help the reader. The first word should be capitalized.")
- (:number . "Any additional information that can help the reader. The first word should be capitalized.")
+ (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.")
+ (:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,")
+ (:note . "Any additional information that can help the reader. The first word should be capitalized.")
+ (:number . "Any additional information that can help the reader. The first word should be capitalized.")
(:organization . "The organization that sponsors a conference or that publishes a manual.")
(:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).")
(:publisher . "The publisher’s name.")
(:school . "The name of the school where a thesis was written.")
- (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
+ (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
(:title . "The work’s title, typed as explained in the LaTeX book.")
(:type . "The type of a technical report for example, 'Research Note'.")
(:volume . "The volume of a journal or multi-volume book.")
(:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'"))
"Bibtex fields with descriptions.")
-(defvar *org-bibtex-entries* nil
+(defvar org-bibtex-entries nil
"List to hold parsed bibtex entries.")
(defcustom org-bibtex-autogen-keys nil
@@ -229,7 +230,7 @@ For example setting to 'BIB_' would allow interoperability with fireforg."
(defcustom org-bibtex-treat-headline-as-title t
"Treat headline text as title if title property is absent.
If an entry is missing a title property, use the headline text as
-the property. If this value is t, `org-bibtex-check' will ignore
+the property. If this value is t, `org-bibtex-check' will ignore
a missing title field."
:group 'org-bibtex
:version "24.1"
@@ -247,7 +248,7 @@ not placed in the exported bibtex entry."
(defcustom org-bibtex-key-property "CUSTOM_ID"
"Property that holds the bibtex key.
By default, this is CUSTOM_ID, which enables easy linking to
-bibtex headlines from within an org file. This can be set to ID
+bibtex headlines from within an org file. This can be set to ID
to enable global links, but only with great caution, as global
IDs must be unique."
:group 'org-bibtex
@@ -263,12 +264,12 @@ IDs must be unique."
(defcustom org-bibtex-tags-are-keywords nil
"Convert the value of the keywords field to tags and vice versa.
If set to t, comma-separated entries in a bibtex entry's keywords
-field will be converted to org tags. Note: spaces will be escaped
+field will be converted to org tags. Note: spaces will be escaped
with underscores, and characters that are not permitted in org
tags will be removed.
If t, local tags in an org entry will be exported as a
-comma-separated string of keywords when exported to bibtex. Tags
+comma-separated string of keywords when exported to bibtex. Tags
defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will
not be exported."
:group 'org-bibtex
@@ -277,7 +278,7 @@ not be exported."
(defcustom org-bibtex-no-export-tags nil
"List of tag(s) that should not be converted to keywords.
-This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
+This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
:group 'org-bibtex
:version "24.1"
:type '(repeat :tag "Tag" (string)))
@@ -309,71 +310,72 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
(defun org-bibtex-headline ()
"Return a bibtex entry of the given headline as a string."
- (flet ((val (key lst) (cdr (assoc key lst)))
- (to (string) (intern (concat ":" string)))
- (from (key) (substring (symbol-name key) 1))
- (flatten (&rest lsts)
- (apply #'append (mapcar
- (lambda (e)
- (if (listp e) (apply #'flatten e) (list e)))
- lsts))))
- (let ((notes (buffer-string))
- (id (org-bibtex-get org-bibtex-key-property))
- (type (org-bibtex-get org-bibtex-type-property-name))
- (tags (when org-bibtex-tags-are-keywords
- (delq nil
- (mapcar
- (lambda (tag)
- (unless (member tag
- (append org-bibtex-tags
- org-bibtex-no-export-tags))
- tag))
- (org-get-local-tags-at))))))
- (when type
- (let ((entry (format
- "@%s{%s,\n%s\n}\n" type id
- (mapconcat
- (lambda (pair)
- (format " %s={%s}" (car pair) (cdr pair)))
- (remove nil
- (if (and org-bibtex-export-arbitrary-fields
- org-bibtex-prefix)
- (mapcar
- (lambda (kv)
- (let ((key (car kv)) (val (cdr kv)))
- (when (and
- (string-match org-bibtex-prefix key)
- (not (string=
- (downcase (concat org-bibtex-prefix
- org-bibtex-type-property-name))
- (downcase key))))
- (cons (downcase (replace-regexp-in-string
- org-bibtex-prefix "" key))
- val))))
- (org-entry-properties nil 'standard))
- (mapcar
- (lambda (field)
- (let ((value (or (org-bibtex-get (from field))
- (and (equal :title field)
- (nth 4 (org-heading-components))))))
- (when value (cons (from field) value))))
- (flatten
- (val :required (val (to type) org-bibtex-types))
- (val :optional (val (to type) org-bibtex-types))))))
- ",\n"))))
- (with-temp-buffer
- (insert entry)
- (when tags
- (bibtex-beginning-of-entry)
- (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t)
- (progn (goto-char (match-end 1)) (insert ", "))
- (bibtex-make-field "keywords" t t))
- (insert (mapconcat #'identity tags ", ")))
- (buffer-string)))))))
+ (let* ((val (lambda (key lst) (cdr (assoc key lst))))
+ (to (lambda (string) (intern (concat ":" string))))
+ (from (lambda (key) (substring (symbol-name key) 1)))
+ flatten ; silent compiler warning
+ (flatten (lambda (&rest lsts)
+ (apply #'append (mapcar
+ (lambda (e)
+ (if (listp e) (apply flatten e) (list e)))
+ lsts))))
+ (notes (buffer-string))
+ (id (org-bibtex-get org-bibtex-key-property))
+ (type (org-bibtex-get org-bibtex-type-property-name))
+ (tags (when org-bibtex-tags-are-keywords
+ (delq nil
+ (mapcar
+ (lambda (tag)
+ (unless (member tag
+ (append org-bibtex-tags
+ org-bibtex-no-export-tags))
+ tag))
+ (org-get-local-tags-at))))))
+ (when type
+ (let ((entry (format
+ "@%s{%s,\n%s\n}\n" type id
+ (mapconcat
+ (lambda (pair)
+ (format " %s={%s}" (car pair) (cdr pair)))
+ (remove nil
+ (if (and org-bibtex-export-arbitrary-fields
+ org-bibtex-prefix)
+ (mapcar
+ (lambda (kv)
+ (let ((key (car kv)) (val0 (cdr kv)))
+ (when (and
+ (string-match org-bibtex-prefix key)
+ (not (string=
+ (downcase (concat org-bibtex-prefix
+ org-bibtex-type-property-name))
+ (downcase key))))
+ (cons (downcase (replace-regexp-in-string
+ org-bibtex-prefix "" key))
+ val0))))
+ (org-entry-properties nil 'standard))
+ (mapcar
+ (lambda (field)
+ (let ((value (or (org-bibtex-get (funcall from field))
+ (and (equal :title field)
+ (nth 4 (org-heading-components))))))
+ (when value (cons (funcall from field) value))))
+ (funcall flatten
+ (funcall val :required (funcall val (funcall to type) org-bibtex-types))
+ (funcall val :optional (funcall val (funcall to type) org-bibtex-types))))))
+ ",\n"))))
+ (with-temp-buffer
+ (insert entry)
+ (when tags
+ (bibtex-beginning-of-entry)
+ (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t)
+ (progn (goto-char (match-end 1)) (insert ", "))
+ (bibtex-make-field "keywords" t t))
+ (insert (mapconcat #'identity tags ", ")))
+ (buffer-string))))))
(defun org-bibtex-ask (field)
(unless (assoc field org-bibtex-fields)
- (error "field:%s is not known" field))
+ (error "Field:%s is not known" field))
(save-window-excursion
(let* ((name (substring (symbol-name field) 1))
(buf-name (format "*Bibtex Help %s*" name)))
@@ -385,7 +387,7 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
(read-from-minibuffer (format "%s: " name))))))
(defun org-bibtex-autokey ()
- "Generate an autokey for the current headline"
+ "Generate an autokey for the current headline."
(org-bibtex-put org-bibtex-key-property
(if org-bibtex-autogen-keys
(let* ((entry (org-bibtex-headline))
@@ -404,24 +406,26 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
(read-from-minibuffer "id: "))))
(defun org-bibtex-fleshout (type &optional optional)
- "Fleshout the current heading, ensuring that all required fields are present.
+ "Fleshout current heading, ensuring all required fields are present.
With optional argument OPTIONAL, also prompt for optional fields."
- (flet ((val (key lst) (cdr (assoc key lst)))
- (keyword (name) (intern (concat ":" (downcase name))))
- (name (keyword) (substring (symbol-name keyword) 1)))
+ (let ((val (lambda (key lst) (cdr (assoc key lst))))
+ (keyword (lambda (name) (intern (concat ":" (downcase name)))))
+ (name (lambda (keyword) (substring (symbol-name keyword) 1))))
(dolist (field (append
(if org-bibtex-treat-headline-as-title
- (remove :title (val :required (val type org-bibtex-types)))
- (val :required (val type org-bibtex-types)))
- (when optional (val :optional (val type org-bibtex-types)))))
+ (remove :title (funcall val :required (funcall val type org-bibtex-types)))
+ (funcall val :required (funcall val type org-bibtex-types)))
+ (when optional (funcall val :optional (funcall val type org-bibtex-types)))))
(when (consp field) ; or'd pair of fields e.g., (:editor :author)
- (let ((present (first (remove nil
- (mapcar
- (lambda (f) (when (org-bibtex-get (name f)) f))
- field)))))
- (setf field (or present (keyword (org-icompleting-read
- "Field: " (mapcar #'name field)))))))
- (let ((name (name field)))
+ (let ((present (first (remove
+ nil
+ (mapcar
+ (lambda (f) (when (org-bibtex-get (funcall name f)) f))
+ field)))))
+ (setf field (or present (funcall keyword
+ (org-icompleting-read
+ "Field: " (mapcar name field)))))))
+ (let ((name (funcall name field)))
(unless (org-bibtex-get name)
(let ((prop (org-bibtex-ask field)))
(when prop (org-bibtex-put name prop)))))))
@@ -546,7 +550,7 @@ Headlines are exported using `org-bibtex-export-headline'."
(error (throw 'bib (point)))))))))
(with-temp-file filename
(insert (mapconcat #'identity bibtex-entries "\n")))
- (message "Successfully exported %d bibtex entries to %s"
+ (message "Successfully exported %d BibTeX entries to %s"
(length bibtex-entries) filename) nil))))
(defun org-bibtex-check (&optional optional)
@@ -578,7 +582,7 @@ If nonew is t, add data to the headline of the entry at point."
(type (if (keywordp type) type (intern (concat ":" type))))
(org-bibtex-treat-headline-as-title (if nonew nil t)))
(unless (assoc type org-bibtex-types)
- (error "type:%s is not known" type))
+ (error "Type:%s is not known" type))
(if nonew
(org-back-to-heading)
(org-insert-heading)
@@ -597,57 +601,60 @@ With a prefix arg, query for optional fields."
(org-bibtex-create arg t))
(defun org-bibtex-read ()
- "Read a bibtex entry and save to `*org-bibtex-entries*'.
+ "Read a bibtex entry and save to `org-bibtex-entries'.
This uses `bibtex-parse-entry'."
(interactive)
- (flet ((keyword (str) (intern (concat ":" (downcase str))))
- (clean-space (str) (replace-regexp-in-string
- "[[:space:]\n\r]+" " " str))
- (strip-delim (str) ; strip enclosing "..." and {...}
- (dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
- (when (and (= (aref str 0) (car pair))
- (= (aref str (1- (length str))) (cdr pair)))
- (setf str (substring str 1 (1- (length str)))))) str))
+ (let ((keyword (lambda (str) (intern (concat ":" (downcase str)))))
+ (clean-space (lambda (str) (replace-regexp-in-string
+ "[[:space:]\n\r]+" " " str)))
+ (strip-delim
+ (lambda (str) ; strip enclosing "..." and {...}
+ (dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
+ (when (and (= (aref str 0) (car pair))
+ (= (aref str (1- (length str))) (cdr pair)))
+ (setf str (substring str 1 (1- (length str)))))) str)))
(push (mapcar
(lambda (pair)
- (cons (let ((field (keyword (car pair))))
+ (cons (let ((field (funcall keyword (car pair))))
(case field
(:=type= :type)
(:=key= :key)
(otherwise field)))
- (clean-space (strip-delim (cdr pair)))))
+ (funcall clean-space (funcall strip-delim (cdr pair)))))
(save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
- *org-bibtex-entries*)))
+ org-bibtex-entries)))
(defun org-bibtex-write ()
- "Insert a heading built from the first element of `*org-bibtex-entries*'."
+ "Insert a heading built from the first element of `org-bibtex-entries'."
(interactive)
- (when (= (length *org-bibtex-entries*) 0)
- (error "No entries in `*org-bibtex-entries*'."))
- (let ((entry (pop *org-bibtex-entries*))
- (org-special-properties nil)) ; avoids errors with `org-entry-put'
- (flet ((val (field) (cdr (assoc field entry)))
- (togtag (tag) (org-toggle-tag tag 'on)))
- (org-insert-heading)
- (insert (val :title))
- (org-bibtex-put "TITLE" (val :title))
- (org-bibtex-put org-bibtex-type-property-name (downcase (val :type)))
- (dolist (pair entry)
- (case (car pair)
- (:title nil)
- (:type nil)
- (:key (org-bibtex-put org-bibtex-key-property (cdr pair)))
- (:keywords (if org-bibtex-tags-are-keywords
- (mapc
- (lambda (kw)
- (togtag
- (replace-regexp-in-string
- "[^[:alnum:]_@#%]" ""
- (replace-regexp-in-string "[ \t]+" "_" kw))))
- (split-string (cdr pair) ", *"))
- (org-bibtex-put (car pair) (cdr pair))))
- (otherwise (org-bibtex-put (car pair) (cdr pair)))))
- (mapc #'togtag org-bibtex-tags))))
+ (when (= (length org-bibtex-entries) 0)
+ (error "No entries in `org-bibtex-entries'"))
+ (let* ((entry (pop org-bibtex-entries))
+ (org-special-properties nil) ; avoids errors with `org-entry-put'
+ (val (lambda (field) (cdr (assoc field entry))))
+ (togtag (lambda (tag) (org-toggle-tag tag 'on))))
+ (org-insert-heading)
+ (insert (funcall val :title))
+ (org-bibtex-put "TITLE" (funcall val :title))
+ (org-bibtex-put org-bibtex-type-property-name
+ (downcase (funcall val :type)))
+ (dolist (pair entry)
+ (case (car pair)
+ (:title nil)
+ (:type nil)
+ (:key (org-bibtex-put org-bibtex-key-property (cdr pair)))
+ (:keywords (if org-bibtex-tags-are-keywords
+ (mapc
+ (lambda (kw)
+ (funcall
+ togtag
+ (replace-regexp-in-string
+ "[^[:alnum:]_@#%]" ""
+ (replace-regexp-in-string "[ \t]+" "_" kw))))
+ (split-string (cdr pair) ", *"))
+ (org-bibtex-put (car pair) (cdr pair))))
+ (otherwise (org-bibtex-put (car pair) (cdr pair)))))
+ (mapc togtag org-bibtex-tags)))
(defun org-bibtex-yank ()
"If kill ring holds a bibtex entry yank it as an Org-mode headline."
@@ -656,7 +663,7 @@ This uses `bibtex-parse-entry'."
(with-temp-buffer (yank 1) (setf entry (org-bibtex-read)))
(if entry
(org-bibtex-write)
- (error "yanked text does not appear to contain a bibtex entry"))))
+ (error "Yanked text does not appear to contain a BibTeX entry"))))
(defun org-bibtex-export-to-kill-ring ()
"Export current headline to kill ring as bibtex entry."
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index 454463f7086..9d20814a2ca 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -58,6 +58,9 @@
(declare-function org-table-goto-line "org-table" (N))
(declare-function org-pop-to-buffer-same-window "org-compat"
(&optional buffer-or-name norecord label))
+(declare-function org-at-encrypted-entry-p "org-crypt" ())
+(declare-function org-encrypt-entry "org-crypt" ())
+(declare-function org-decrypt-entry "org-crypt" ())
(defvar org-remember-default-headline)
(defvar org-remember-templates)
@@ -101,7 +104,7 @@ description A short string describing the template, will be shown during
selection.
type The type of entry. Valid types are:
- entry an Org-mode node, with a headline. Will be
+ entry an Org-mode node, with a headline. Will be
filed as the child of the target entry or as
a top-level entry.
item a plain list item, will be placed in the
@@ -183,6 +186,14 @@ properties are:
before and after the new item. Default 0, only common
other value is 1.
+ :empty-lines-before Set this to the number of lines the should be inserted
+ before the new item. Overrides :empty-lines for the
+ number lines inserted before.
+
+ :empty-lines-after Set this to the number of lines the should be inserted
+ after the new item. Overrides :empty-lines for the
+ number of lines inserted after.
+
:clock-in Start the clock in this item.
:clock-keep Keep the clock running when filing the captured entry.
@@ -211,51 +222,53 @@ will be filed as a child of the target headline. It can also be
freely formatted text. Furthermore, the following %-escapes will
be replaced with content and expanded in this order:
- %[pathname] insert the contents of the file given by `pathname'.
- %(sexp) evaluate elisp `(sexp)' and replace with the result.
- %<...> the result of format-time-string on the ... format specification.
- %t time stamp, date only.
- %T time stamp with date and time.
- %u, %U like the above, but inactive time stamps.
- %a annotation, normally the link created with `org-store-link'.
- %i initial content, copied from the active region. If %i is
+ %[pathname] Insert the contents of the file given by `pathname'.
+ %(sexp) Evaluate elisp `(sexp)' and replace with the result.
+ %<...> The result of format-time-string on the ... format specification.
+ %t Time stamp, date only.
+ %T Time stamp with date and time.
+ %u, %U Like the above, but inactive time stamps.
+ %i Initial content, copied from the active region. If %i is
indented, the entire inserted text will be indented as well.
- %A like %a, but prompt for the description part.
- %c current kill ring head.
- %x content of the X clipboard.
- %k title of currently clocked task.
- %K link to currently clocked task.
- %n user name (taken from `user-full-name').
- %f file visited by current buffer when org-capture was called.
- %F full path of the file or directory visited by current buffer.
- %:keyword specific information for certain link types, see below.
- %^g prompt for tags, with completion on tags in target file.
- %^G prompt for tags, with completion on all tags in all agenda files.
- %^t like %t, but prompt for date. Similarly %^T, %^u, %^U.
- You may define a prompt like %^{Please specify birthday.
- %^C interactive selection of which kill or clip to use.
- %^L like %^C, but insert as link.
- %^{prop}p prompt the user for a value for property `prop'.
- %^{prompt} prompt the user for a string and replace this sequence with it.
+ %a Annotation, normally the link created with `org-store-link'.
+ %A Like %a, but prompt for the description part.
+ %l Like %a, but only insert the literal link.
+ %c Current kill ring head.
+ %x Content of the X clipboard.
+ %k Title of currently clocked task.
+ %K Link to currently clocked task.
+ %n User name (taken from `user-full-name').
+ %f File visited by current buffer when org-capture was called.
+ %F Full path of the file or directory visited by current buffer.
+ %:keyword Specific information for certain link types, see below.
+ %^g Prompt for tags, with completion on tags in target file.
+ %^G Prompt for tags, with completion on all tags in all agenda files.
+ %^t Like %t, but prompt for date. Similarly %^T, %^u, %^U.
+ You may define a prompt like: %^{Please specify birthday}t
+ %^C Interactive selection of which kill or clip to use.
+ %^L Like %^C, but insert as link.
+ %^{prop}p Prompt the user for a value for property `prop'.
+ %^{prompt} Prompt the user for a string and replace this sequence with it.
A default value and a completion table ca be specified like this:
%^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here.
+ %\\n Insert the text entered at the nth %^{prompt}, where `n' is
+ a number, starting from 1.
-Apart from these general escapes, you can access information specific to the
-link type that is created. For example, calling `org-capture' in emails
-or gnus will record the author and the subject of the message, which you
+Apart from these general escapes, you can access information specific to
+the link type that is created. For example, calling `org-capture' in emails
+or in Gnus will record the author and the subject of the message, which you
can access with \"%:from\" and \"%:subject\", respectively. Here is a
complete list of what is recorded for each link type.
Link type | Available information
------------------------+------------------------------------------------------
bbdb | %:type %:name %:company
-vm, wl, mh, mew, rmail | %:type %:subject %:message-id
- | %:from %:fromname %:fromaddress
+vm, wl, mh, mew, rmail, | %:type %:subject %:message-id
+gnus | %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
- | %:date
- | %:date-timestamp (as active timestamp)
+ | %:date %:date-timestamp (as active timestamp)
| %:date-timestamp-inactive (as inactive timestamp)
gnus | %:group, for messages also all email fields
w3, w3m | %:type %:url
@@ -266,71 +279,71 @@ calendar | %:type %:date"
:type
'(repeat
(choice :value ("" "" entry (file "~/org/notes.org") "")
- (list :tag "Multikey description"
- (string :tag "Keys ")
- (string :tag "Description"))
- (list :tag "Template entry"
- (string :tag "Keys ")
- (string :tag "Description ")
- (choice :tag "Capture Type " :value entry
- (const :tag "Org entry" entry)
- (const :tag "Plain list item" item)
- (const :tag "Checkbox item" checkitem)
- (const :tag "Plain text" plain)
- (const :tag "Table line" table-line))
- (choice :tag "Target location"
- (list :tag "File"
- (const :format "" file)
- (file :tag " File"))
- (list :tag "ID"
- (const :format "" id)
- (string :tag " ID"))
- (list :tag "File & Headline"
- (const :format "" file+headline)
- (file :tag " File ")
- (string :tag " Headline"))
- (list :tag "File & Outline path"
- (const :format "" file+olp)
- (file :tag " File ")
- (repeat :tag "Outline path" :inline t
- (string :tag "Headline")))
- (list :tag "File & Regexp"
- (const :format "" file+regexp)
- (file :tag " File ")
- (regexp :tag " Regexp"))
- (list :tag "File & Date tree"
- (const :format "" file+datetree)
- (file :tag " File"))
- (list :tag "File & Date tree, prompt for date"
- (const :format "" file+datetree+prompt)
- (file :tag " File"))
- (list :tag "File & function"
- (const :format "" file+function)
- (file :tag " File ")
- (sexp :tag " Function"))
- (list :tag "Current clocking task"
- (const :format "" clock))
- (list :tag "Function"
- (const :format "" function)
- (sexp :tag " Function")))
- (choice :tag "Template"
- (string)
- (list :tag "File"
- (const :format "" file)
- (file :tag "Template file"))
- (list :tag "Function"
- (const :format "" function)
- (function :tag "Template function")))
- (plist :inline t
- ;; Give the most common options as checkboxes
- :options (((const :format "%v " :prepend) (const t))
- ((const :format "%v " :immediate-finish) (const t))
- ((const :format "%v " :empty-lines) (const 1))
- ((const :format "%v " :clock-in) (const t))
- ((const :format "%v " :clock-keep) (const t))
- ((const :format "%v " :clock-resume) (const t))
- ((const :format "%v " :unnarrowed) (const t))
- ((const :format "%v " :kill-buffer) (const t))))))))
+ (list :tag "Multikey description"
+ (string :tag "Keys ")
+ (string :tag "Description"))
+ (list :tag "Template entry"
+ (string :tag "Keys ")
+ (string :tag "Description ")
+ (choice :tag "Capture Type " :value entry
+ (const :tag "Org entry" entry)
+ (const :tag "Plain list item" item)
+ (const :tag "Checkbox item" checkitem)
+ (const :tag "Plain text" plain)
+ (const :tag "Table line" table-line))
+ (choice :tag "Target location"
+ (list :tag "File"
+ (const :format "" file)
+ (file :tag " File"))
+ (list :tag "ID"
+ (const :format "" id)
+ (string :tag " ID"))
+ (list :tag "File & Headline"
+ (const :format "" file+headline)
+ (file :tag " File ")
+ (string :tag " Headline"))
+ (list :tag "File & Outline path"
+ (const :format "" file+olp)
+ (file :tag " File ")
+ (repeat :tag "Outline path" :inline t
+ (string :tag "Headline")))
+ (list :tag "File & Regexp"
+ (const :format "" file+regexp)
+ (file :tag " File ")
+ (regexp :tag " Regexp"))
+ (list :tag "File & Date tree"
+ (const :format "" file+datetree)
+ (file :tag " File"))
+ (list :tag "File & Date tree, prompt for date"
+ (const :format "" file+datetree+prompt)
+ (file :tag " File"))
+ (list :tag "File & function"
+ (const :format "" file+function)
+ (file :tag " File ")
+ (sexp :tag " Function"))
+ (list :tag "Current clocking task"
+ (const :format "" clock))
+ (list :tag "Function"
+ (const :format "" function)
+ (sexp :tag " Function")))
+ (choice :tag "Template"
+ (string)
+ (list :tag "File"
+ (const :format "" file)
+ (file :tag "Template file"))
+ (list :tag "Function"
+ (const :format "" function)
+ (function :tag "Template function")))
+ (plist :inline t
+ ;; Give the most common options as checkboxes
+ :options (((const :format "%v " :prepend) (const t))
+ ((const :format "%v " :immediate-finish) (const t))
+ ((const :format "%v " :empty-lines) (const 1))
+ ((const :format "%v " :clock-in) (const t))
+ ((const :format "%v " :clock-keep) (const t))
+ ((const :format "%v " :clock-resume) (const t))
+ ((const :format "%v " :unnarrowed) (const t))
+ ((const :format "%v " :kill-buffer) (const t))))))))
(defcustom org-capture-before-finalize-hook nil
"Hook that is run right before a capture process is finalized.
@@ -342,11 +355,25 @@ widened to the entire buffer."
(defcustom org-capture-after-finalize-hook nil
"Hook that is run right after a capture process is finalized.
- Suitable for window cleanup"
+Suitable for window cleanup."
+ :group 'org-capture
+ :version "24.1"
+ :type 'hook)
+
+(defcustom org-capture-prepare-finalize-hook nil
+ "Hook that is run before the finalization starts.
+The capture buffer is current and still narrowed."
:group 'org-capture
:version "24.1"
:type 'hook)
+(defcustom org-capture-bookmark t
+ "When non-nil, add a bookmark pointing at the last stored
+position when capturing."
+ :group 'org-capture
+ :version "24.3"
+ :type 'boolean)
+
;;; The property list for keeping information about the capture process
(defvar org-capture-plist nil
@@ -394,12 +421,13 @@ for a capture buffer.")
"Hook for the minor `org-capture-mode'.")
(define-minor-mode org-capture-mode
- "Minor mode for special key bindings in a capture buffer."
+ "Minor mode for special key bindings in a capture buffer.
+
+Turning on this mode runs the normal hook `org-capture-mode-hook'."
nil " Rem" org-capture-mode-map
(org-set-local
'header-line-format
- "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")
- (run-hooks 'org-capture-mode-hook))
+ "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'."))
(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize)
(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill)
(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile)
@@ -407,6 +435,67 @@ for a capture buffer.")
;;; The main commands
;;;###autoload
+(defvar org-capture-initial nil)
+(defvar org-capture-entry nil)
+(defun org-capture-string (string &optional keys)
+ (interactive "sInitial text: \n")
+ (let ((org-capture-initial string)
+ (org-capture-entry (org-capture-select-template keys)))
+ (org-capture)))
+
+(defcustom org-capture-templates-contexts nil
+ "Alist of capture templates and valid contexts.
+
+For example, if you have a capture template \"c\" and you want
+this template to be accessible only from `message-mode' buffers,
+use this:
+
+ '((\"c\" (in-mode . \"message-mode\")))
+
+Here are the available contexts definitions:
+
+ in-file: command displayed only in matching files
+ in-mode: command displayed only in matching modes
+ not-in-file: command not displayed in matching files
+ not-in-mode: command not displayed in matching modes
+ [function]: a custom function taking no argument
+
+If you define several checks, the agenda command will be
+accessible if there is at least one valid check.
+
+You can also bind a key to another agenda custom command
+depending on contextual rules.
+
+ '((\"c\" \"d\" (in-mode . \"message-mode\")))
+
+Here it means: in `message-mode buffers', use \"d\" as the
+key for the capture template otherwise associated with \"d\".
+\(The template originally associated with \"q\" is not displayed
+to avoid duplicates.)"
+ :version "24.3"
+ :group 'org-capture
+ :type '(repeat (list :tag "Rule"
+ (string :tag " Capture key")
+ (string :tag "Replace by template")
+ (repeat :tag "Available when"
+ (choice
+ (cons :tag "Condition"
+ (choice
+ (const :tag "In file" in-file)
+ (const :tag "Not in file" not-in-file)
+ (const :tag "In mode" in-mode)
+ (const :tag "Not in mode" not-in-mode))
+ (regexp))
+ (function :tag "Custom function"))))))
+
+(defcustom org-capture-use-agenda-date nil
+ "Non-nil means use the date at point when capturing from agendas.
+When nil, you can still capturing using the date at point with \\[org-agenda-capture]]."
+ :group 'org-capture
+ :version "24.3"
+ :type 'boolean)
+
+;;;###autoload
(defun org-capture (&optional goto keys)
"Capture something.
\\<org-capture-mode-map>
@@ -424,10 +513,17 @@ stored.
When called with a `C-0' (zero) prefix, insert a template at point.
-Lisp programs can set KEYS to a string associated with a template in
-`org-capture-templates'. In this case, interactive selection will be
-bypassed."
+Lisp programs can set KEYS to a string associated with a template
+in `org-capture-templates'. In this case, interactive selection
+will be bypassed.
+
+If `org-capture-use-agenda-date' is non-nil, capturing from the
+agenda will use the date at point as the default date."
(interactive "P")
+ (when (and org-capture-use-agenda-date
+ (eq major-mode 'org-agenda-mode))
+ (setq org-overriding-default-time
+ (org-get-cursor-date)))
(cond
((equal goto '(4)) (org-capture-goto-target))
((equal goto '(16)) (org-capture-goto-last-stored))
@@ -438,9 +534,11 @@ bypassed."
org-capture-link-is-already-stored)
(plist-get org-store-link-plist :annotation)
(ignore-errors (org-store-link nil))))
- (initial (and (org-region-active-p)
- (buffer-substring (point) (mark))))
- (entry (org-capture-select-template keys)))
+ (entry (or org-capture-entry (org-capture-select-template keys)))
+ initial)
+ (setq initial (or org-capture-initial
+ (and (org-region-active-p)
+ (buffer-substring (point) (mark)))))
(when (stringp initial)
(remove-text-properties 0 (length initial) '(read-only t) initial))
(when (stringp annotation)
@@ -489,7 +587,7 @@ bypassed."
(error "Capture template `%s': %s"
(org-capture-get :key)
(nth 1 error))))
- (if (and (eq major-mode 'org-mode)
+ (if (and (derived-mode-p 'org-mode)
(org-capture-get :clock-in))
(condition-case nil
(progn
@@ -530,6 +628,8 @@ captured item after finalizing."
(buffer-base-buffer (current-buffer)))
(error "This does not seem to be a capture buffer for Org-mode"))
+ (run-hooks 'org-capture-prepare-finalize-hook)
+
;; Did we start the clock in this capture buffer?
(when (and org-capture-clock-was-started
org-clock-marker (marker-buffer org-clock-marker)
@@ -577,9 +677,10 @@ captured item after finalizing."
(goto-char end)
(or (bolp) (newline))
(org-capture-empty-lines-after
- (or (org-capture-get :empty-lines 'local) 0))))
+ (or (org-capture-get :empty-lines-after 'local)
+ (org-capture-get :empty-lines 'local) 0))))
;; Postprocessing: Update Statistics cookies, do the sorting
- (when (eq major-mode 'org-mode)
+ (when (derived-mode-p 'org-mode)
(save-excursion
(when (ignore-errors (org-back-to-heading))
(org-update-parent-todo-statistics)
@@ -594,11 +695,17 @@ captured item after finalizing."
;; Store this place as the last one where we stored something
;; Do the marking in the base buffer, so that it makes sense after
;; the indirect buffer has been killed.
- (org-capture-bookmark-last-stored-position)
+ (when org-capture-bookmark
+ (org-capture-bookmark-last-stored-position))
;; Run the hook
(run-hooks 'org-capture-before-finalize-hook))
+ (when (org-capture-get :decrypted)
+ (save-excursion
+ (goto-char (org-capture-get :decrypted))
+ (org-encrypt-entry)))
+
;; Kill the indirect buffer
(save-buffer)
(let ((return-wconf (org-capture-get :return-to-wconf 'local))
@@ -675,8 +782,8 @@ already gone. Any prefix argument will be passed to the refile command."
(defun org-capture-kill ()
"Abort the current capture process."
(interactive)
- ;; FIXME: This does not do the right thing, we need to remove the new stuff
- ;; By hand it is easy: undo, then kill the buffer
+ ;; FIXME: This does not do the right thing, we need to remove the
+ ;; new stuff by hand it is easy: undo, then kill the buffer
(let ((org-note-abort t)
(org-capture-before-finalize-hook nil))
(org-capture-finalize)))
@@ -700,9 +807,11 @@ already gone. Any prefix argument will be passed to the refile command."
;; store the current point
(org-capture-put :initial-target-position (point)))
+(defvar org-time-was-given) ; dynamically scoped parameter
(defun org-capture-set-target-location (&optional target)
- "Find target buffer and position and store then in the property list."
- (let ((target-entry-p t))
+ "Find TARGET buffer and position.
+Store them in the capture property list."
+ (let ((target-entry-p t) decrypted-hl-pos)
(setq target (or target (org-capture-get :target)))
(save-excursion
(cond
@@ -727,7 +836,7 @@ already gone. Any prefix argument will be passed to the refile command."
(widen)
(let ((hd (nth 2 target)))
(goto-char (point-min))
- (unless (eq major-mode 'org-mode)
+ (unless (derived-mode-p 'org-mode)
(error
"Target buffer \"%s\" for file+headline should be in Org mode"
(current-buffer)))
@@ -759,7 +868,7 @@ already gone. Any prefix argument will be passed to the refile command."
(goto-char (if (org-capture-get :prepend)
(match-beginning 0) (match-end 0)))
(org-capture-put :exact-position (point))
- (setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p))))
+ (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
(error "No match for target regexp in file %s" (nth 1 target))))
((memq (car target) '(file+datetree file+datetree+prompt))
@@ -781,11 +890,22 @@ already gone. Any prefix argument will be passed to the refile command."
(let ((prompt-time (org-read-date
nil t nil "Date for tree entry:"
(current-time))))
- (org-capture-put :prompt-time prompt-time
- :default-time prompt-time)
+ (org-capture-put
+ :default-time
+ (cond ((and (not org-time-was-given)
+ (not (= (time-to-days prompt-time) (org-today))))
+ ;; Use 00:00 when no time is given for another date than today?
+ (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time)))))
+ ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer)
+ ;; Replace any time range by its start
+ (apply 'encode-time
+ (org-read-date-analyze
+ (replace-match "\\1 \\2" nil nil org-read-date-final-answer)
+ prompt-time (decode-time prompt-time))))
+ (t prompt-time)))
(time-to-days prompt-time)))
(t
- ;; current date, possible corrected for late night workers
+ ;; current date, possibly corrected for late night workers
(org-today))))))
((eq (car target) 'file+function)
@@ -794,12 +914,12 @@ already gone. Any prefix argument will be passed to the refile command."
(widen)
(funcall (nth 2 target))
(org-capture-put :exact-position (point))
- (setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p))))
+ (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
((eq (car target) 'function)
(funcall (nth 1 target))
(org-capture-put :exact-position (point))
- (setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p))))
+ (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
((eq (car target) 'clock)
(if (and (markerp org-clock-hd-marker)
@@ -812,8 +932,14 @@ already gone. Any prefix argument will be passed to the refile command."
(t (error "Invalid capture target specification")))
+ (when (and (featurep 'org-crypt) (org-at-encrypted-entry-p))
+ (org-decrypt-entry)
+ (setq decrypted-hl-pos
+ (save-excursion (and (org-back-to-heading t) (point)))))
+
(org-capture-put :buffer (current-buffer) :pos (point)
- :target-entry-p target-entry-p))))
+ :target-entry-p target-entry-p
+ :decrypted decrypted-hl-pos))))
(defun org-capture-expand-file (file)
"Expand functions and symbols for FILE.
@@ -893,7 +1019,7 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(progn
(outline-next-heading)
(or (bolp) (insert "\n")))
- (org-end-of-subtree t t)
+ (org-end-of-subtree t nil)
(or (bolp) (insert "\n")))))
(org-capture-empty-lines-before)
(setq beg (point))
@@ -905,8 +1031,9 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(setq end (point))
(org-capture-mark-kill-region beg (1- end))
(org-capture-narrow beg (1- end))
- (goto-char beg)
- (if (re-search-forward "%\\?" end t) (replace-match ""))))
+ (if (or (re-search-backward "%\\?" beg t)
+ (re-search-forward "%\\?" end t))
+ (replace-match ""))))
(defun org-capture-place-item ()
"Place the template as a new plain list item."
@@ -962,7 +1089,9 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(setq end (point))
(org-capture-mark-kill-region beg (1- end))
(org-capture-narrow beg (1- end))
- (if (re-search-forward "%\\?" end t) (replace-match ""))))
+ (if (or (re-search-backward "%\\?" beg t)
+ (re-search-forward "%\\?" end t))
+ (replace-match ""))))
(defun org-capture-place-table-line ()
"Place the template as a table line."
@@ -982,9 +1111,9 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(setq beg (1+ (point-at-eol))
end (save-excursion (outline-next-heading) (point)))))
(if (re-search-forward org-table-dataline-regexp end t)
- (let ((b (org-table-begin)) (e (org-table-end)))
+ (let ((b (org-table-begin)) (e (org-table-end)) (case-fold-search t))
(goto-char e)
- (if (looking-at "[ \t]*#\\+TBLFM:")
+ (if (looking-at "[ \t]*#\\+tblfm:")
(forward-line 1))
(narrow-to-region b (point)))
(goto-char end)
@@ -1040,7 +1169,9 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(setq end (point))))
(goto-char beg)
(org-capture-position-for-last-stored 'table-line)
- (if (re-search-forward "%\\?" end t) (replace-match ""))
+ (if (or (re-search-backward "%\\?" beg t)
+ (re-search-forward "%\\?" end t))
+ (replace-match ""))
(org-table-align)))
(defun org-capture-place-plain-text ()
@@ -1075,7 +1206,9 @@ Of course, if exact position has been required, just put it there."
(setq end (point))
(org-capture-mark-kill-region beg (1- end))
(org-capture-narrow beg (1- end))
- (if (re-search-forward "%\\?" end t) (replace-match ""))))
+ (if (or (re-search-backward "%\\?" beg t)
+ (re-search-forward "%\\?" end t))
+ (replace-match ""))))
(defun org-capture-mark-kill-region (beg end)
"Mark the region that will have to be killed when aborting capture."
@@ -1128,7 +1261,8 @@ Of course, if exact position has been required, just put it there."
(defun org-capture-empty-lines-before (&optional n)
"Arrange for the correct number of empty lines before the insertion point.
Point will be after the empty lines, so insertion can directly be done."
- (setq n (or n (org-capture-get :empty-lines) 0))
+ (setq n (or n (org-capture-get :empty-lines-before)
+ (org-capture-get :empty-lines) 0))
(let ((pos (point)))
(org-back-over-empty-lines)
(delete-region (point) pos)
@@ -1137,7 +1271,8 @@ Point will be after the empty lines, so insertion can directly be done."
(defun org-capture-empty-lines-after (&optional n)
"Arrange for the correct number of empty lines after the inserted string.
Point will remain at the first line after the inserted text."
- (setq n (or n (org-capture-get :empty-lines) 0))
+ (setq n (or n (org-capture-get :empty-lines-after)
+ (org-capture-get :empty-lines) 0))
(org-back-over-empty-lines)
(while (looking-at "[ \t]*\n") (replace-match ""))
(let ((pos (point)))
@@ -1153,11 +1288,11 @@ Point will remain at the first line after the inserted text."
(or (bolp) (newline))
(setq beg (point))
(cond
- ((and (eq type 'entry) (eq major-mode 'org-mode))
+ ((and (eq type 'entry) (derived-mode-p 'org-mode))
(org-capture-verify-tree (org-capture-get :template))
(org-paste-subtree nil template t))
((and (memq type '(item checkitem))
- (eq major-mode 'org-mode)
+ (derived-mode-p 'org-mode)
(save-excursion (skip-chars-backward " \t\n")
(setq pp (point))
(org-in-item-p)))
@@ -1225,7 +1360,7 @@ Use PREFIX as a prefix for the name of the indirect buffer."
buf)))))
(defun org-capture-verify-tree (tree)
- "Throw error if TREE is not a valid tree"
+ "Throw error if TREE is not a valid tree."
(unless (org-kill-is-subtree-p tree)
(error "Template is not a valid Org entry or tree")))
@@ -1235,7 +1370,8 @@ Use PREFIX as a prefix for the name of the indirect buffer."
"Select a capture template.
Lisp programs can force the template by setting KEYS to a string."
(let ((org-capture-templates
- (or org-capture-templates
+ (or (org-contextualize-keys
+ org-capture-templates org-capture-templates-contexts)
'(("t" "Task" entry (file+headline "" "Tasks")
"* TODO %?\n %u\n %a")))))
(if keys
@@ -1252,8 +1388,7 @@ Lisp programs can force the template by setting KEYS to a string."
The template may still contain \"%?\" for cursor positioning."
(setq template (or template (org-capture-get :template)))
(when (stringp initial)
- (setq initial (org-no-properties initial))
- (remove-text-properties 0 (length initial) '(read-only t) initial))
+ (setq initial (org-no-properties initial)))
(let* ((buffer (org-capture-get :buffer))
(file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
(ct (org-capture-get :default-time))
@@ -1288,14 +1423,16 @@ The template may still contain \"%?\" for cursor positioning."
(org-get-x-clipboard 'CLIPBOARD)
(org-get-x-clipboard 'SECONDARY)
v-c)))
- (v-A (if (and v-a
- (string-match
- "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a))
- (replace-match "[\\1[%^{Link description}]]" nil nil v-a)
+ (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]")
+ (v-A (if (and v-a (string-match l-re v-a))
+ (replace-match "[[\\1][%^{Link description}]]" nil nil v-a)
+ v-a))
+ (v-l (if (and v-a (string-match l-re v-a))
+ (replace-match "\\1" nil nil v-a)
v-a))
(v-n user-full-name)
(v-k (if (marker-buffer org-clock-marker)
- (org-substring-no-properties org-clock-heading)))
+ (org-no-properties org-clock-heading)))
(v-K (if (marker-buffer org-clock-marker)
(org-make-link-string
(buffer-file-name (marker-buffer org-clock-marker))
@@ -1306,7 +1443,7 @@ The template may still contain \"%?\" for cursor positioning."
(org-startup-folded nil)
(org-inhibit-startup t)
org-time-was-given org-end-time-was-given x
- prompt completions char time pos default histvar)
+ prompt completions char time pos default histvar strings)
(setq org-store-link-plist
(plist-put org-store-link-plist :annotation v-a)
@@ -1339,15 +1476,7 @@ The template may still contain \"%?\" for cursor positioning."
(error (insert (format "%%![Couldn't insert %s: %s]"
filename error)))))))
;; %() embedded elisp
- (goto-char (point-min))
- (while (re-search-forward "%\\((.+)\\)" nil t)
- (unless (org-capture-escaped-%)
- (goto-char (match-beginning 0))
- (let ((template-start (point)))
- (forward-char 1)
- (let ((result (org-eval (read (current-buffer)))))
- (delete-region template-start (point))
- (insert result)))))
+ (org-capture-expand-embedded-elisp)
;; The current time
(goto-char (point-min))
@@ -1356,7 +1485,7 @@ The template may still contain \"%?\" for cursor positioning."
;; Simple %-escapes
(goto-char (point-min))
- (while (re-search-forward "%\\([tTuUaiAcxkKInfF]\\)" nil t)
+ (while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t)
(unless (org-capture-escaped-%)
(when (and initial (equal (match-string 0) "%i"))
(save-match-data
@@ -1366,7 +1495,8 @@ The template may still contain \"%?\" for cursor positioning."
(org-split-string initial "\n")
(concat "\n" lead))))))
(replace-match
- (or (eval (intern (concat "v-" (match-string 1)))) "")
+ (or (org-add-props (eval (intern (concat "v-" (match-string 1))))
+ '(org-protected t)) "")
t t)))
;; From the property list
@@ -1383,8 +1513,8 @@ The template may still contain \"%?\" for cursor positioning."
(let ((org-inhibit-startup t)) (org-mode))
;; Interactive template entries
(goto-char (point-min))
- (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?"
- nil t)
+ (while (and (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
+ (not (get-text-property (1- (point)) 'org-protected)))
(unless (org-capture-escaped-%)
(setq char (if (match-end 3) (match-string-no-properties 3))
prompt (if (match-end 2) (match-string-no-properties 2)))
@@ -1415,7 +1545,7 @@ The template may still contain \"%?\" for cursor positioning."
(setq ins (mapconcat 'identity
(org-split-string
ins (org-re "[^[:alnum:]_@#%]+"))
- ":"))
+ ":"))
(when (string-match "\\S-" ins)
(or (equal (char-before) ?:) (insert ":"))
(insert ins)
@@ -1436,7 +1566,7 @@ The template may still contain \"%?\" for cursor positioning."
'(clipboards . 1)
(car clipboards))))))
((equal char "p")
- (org-set-property (org-substring-no-properties prompt) nil))
+ (org-set-property (org-no-properties prompt) nil))
(char
;; These are the date/time related ones
(setq org-time-was-given (equal (upcase char) char))
@@ -1448,11 +1578,21 @@ The template may still contain \"%?\" for cursor positioning."
nil nil (list org-end-time-was-given)))
(t
(let (org-completion-use-ido)
- (insert (org-completing-read-no-i
- (concat (if prompt prompt "Enter string")
- (if default (concat " [" default "]"))
- ": ")
- completions nil nil nil histvar default)))))))
+ (push (org-completing-read-no-i
+ (concat (if prompt prompt "Enter string")
+ (if default (concat " [" default "]"))
+ ": ")
+ completions nil nil nil histvar default)
+ strings)
+ (insert (car strings)))))))
+ ;; Replace %n escapes with nth %^{...} string
+ (setq strings (nreverse strings))
+ (goto-char (point-min))
+ (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t)
+ (unless (org-capture-escaped-%)
+ (replace-match
+ (nth (1- (string-to-number (match-string 1))) strings)
+ nil t)))
;; Make sure there are no empty lines before the text, and that
;; it ends with a newline character
(goto-char (point-min))
@@ -1471,6 +1611,34 @@ The template may still contain \"%?\" for cursor positioning."
t)
nil))
+(defun org-capture-expand-embedded-elisp ()
+ "Evaluate embedded elisp %(sexp) and replace with the result."
+ (goto-char (point-min))
+ (while (re-search-forward "%(" nil t)
+ (unless (org-capture-escaped-%)
+ (goto-char (match-beginning 0))
+ (let ((template-start (point)))
+ (forward-char 1)
+ (let ((result (org-eval (read (current-buffer)))))
+ (delete-region template-start (point))
+ (insert result))))))
+
+(defun org-capture-inside-embedded-elisp-p ()
+ "Return non-nil if point is inside of embedded elisp %(sexp)."
+ (let (beg end)
+ (with-syntax-table emacs-lisp-mode-syntax-table
+ (save-excursion
+ ;; `looking-at' and `search-backward' below do not match the "%(" if
+ ;; point is in its middle
+ (when (equal (char-before) ?%)
+ (backward-char))
+ (save-match-data
+ (when (or (looking-at "%(") (search-backward "%(" nil t))
+ (setq beg (point))
+ (setq end (progn (forward-char) (forward-sexp) (1- (point)))))))
+ (when (and beg end)
+ (and (<= (point) end) (>= (point) beg))))))
+
;;;###autoload
(defun org-capture-import-remember-templates ()
"Set org-capture-templates to be similar to `org-remember-templates'."
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index c39fb249e74..bb6f2b955b3 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -26,7 +26,6 @@
;; This file contains the time clocking code for Org-mode
-(require 'org)
(require 'org-exp)
;;; Code:
@@ -38,6 +37,7 @@
(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
(defvar org-time-stamp-formats)
(defvar org-ts-what)
+(defvar org-frame-title-format-backup frame-title-format)
(defgroup org-clock nil
"Options concerning clocking working time in Org-mode."
@@ -247,26 +247,26 @@ string as argument."
:group 'org-clock)
(defcustom org-clocktable-defaults
- `(list
- :maxlevel 2
- :lang ,org-export-default-language
- :scope 'file
- :block nil
- :tstart nil
- :tend nil
- :step nil
- :stepskip0 nil
- :fileskip0 nil
- :tags nil
- :emphasize nil
- :link nil
- :narrow '40!
- :indent t
- :formula nil
- :timestamp nil
- :level nil
- :tcolumns nil
- :formatter nil)
+ (list
+ :maxlevel 2
+ :lang org-export-default-language
+ :scope 'file
+ :block nil
+ :tstart nil
+ :tend nil
+ :step nil
+ :stepskip0 nil
+ :fileskip0 nil
+ :tags nil
+ :emphasize nil
+ :link nil
+ :narrow '40!
+ :indent t
+ :formula nil
+ :timestamp nil
+ :level nil
+ :tcolumns nil
+ :formatter nil)
"Default properties for clock tables."
:group 'org-clock
:version "24.1"
@@ -324,6 +324,53 @@ play with them."
:version "24.1"
:type 'boolean)
+(defcustom org-clock-continuously nil
+ "Non-nil means to start clocking from the last clock-out time, if any."
+ :type 'boolean
+ :version "24.1"
+ :group 'org-clock)
+
+(defcustom org-clock-total-time-cell-format "*%s*"
+ "Format string for the total time cells."
+ :group 'org-clock
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-clock-file-time-cell-format "*%s*"
+ "Format string for the file time cells."
+ :group 'org-clock
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-clock-clocked-in-display 'mode-line
+ "When clocked in for a task, org-mode can display the current
+task and accumulated time in the mode line and/or frame title.
+Allowed values are:
+
+both displays in both mode line and frame title
+mode-line displays only in mode line (default)
+frame-title displays only in frame title
+nil current clock is not displayed"
+ :group 'org-clock
+ :type '(choice
+ (const :tag "Mode line" mode-line)
+ (const :tag "Frame title" frame-title)
+ (const :tag "Both" both)
+ (const :tag "None" nil)))
+
+(defcustom org-clock-frame-title-format '(t org-mode-line-string)
+ "The value for `frame-title-format' when clocking in.
+
+When `org-clock-clocked-in-display' is set to 'frame-title
+or 'both, clocking in will replace `frame-title-format' with
+this value. Clocking out will restore `frame-title-format'.
+
+`org-frame-title-string' is a format string using the same
+specifications than `frame-title-format', which see."
+ :version "24.1"
+ :group 'org-clock
+ :type 'sexp)
+
(defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock.
This hook is run before anything happens to the task that
@@ -521,7 +568,7 @@ If not, show simply the clocked time like 01:50."
'org-mode-line-clock-overrun 'org-mode-line-clock)))
(effort-str (format org-time-clocksum-format effort-h effort-m))
(clockstr (org-propertize
- (concat "[%s/" effort-str
+ (concat " [%s/" effort-str
"] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")")
'face 'org-mode-line-clock)))
(format clockstr work-done-str))
@@ -545,8 +592,7 @@ If not, show simply the clocked time like 01:50."
'help-echo (concat help-text ": " org-clock-heading))
(org-propertize clock-string 'help-echo help-text)))
'local-map org-clock-mode-line-map
- 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)
- ))
+ 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)))
(if (and org-clock-task-overrun org-clock-task-overrun-text)
(setq org-mode-line-string
(concat (org-propertize
@@ -564,39 +610,40 @@ previous clocking intervals."
(+ currently-clocked-time (or org-clock-total-time 0))))
(defun org-clock-modify-effort-estimate (&optional value)
- "Add to or set the effort estimate of the item currently being clocked.
+ "Add to or set the effort estimate of the item currently being clocked.
VALUE can be a number of minutes, or a string with format hh:mm or mm.
When the string starts with a + or a - sign, the current value of the effort
property will be changed by that amount.
This will update the \"Effort\" property of currently clocked item, and
the mode line."
- (interactive)
- (when (org-clock-is-active)
- (let ((current org-clock-effort) sign)
- (unless value
- ;; Prompt user for a value or a change
- (setq value
- (read-string
- (format "Set effort (hh:mm or mm%s): "
- (if current
- (format ", prefix + to add to %s" org-clock-effort)
- "")))))
- (when (stringp value)
- ;; A string. See if it is a delta
- (setq sign (string-to-char value))
- (if (member sign '(?- ?+))
- (setq current (org-duration-string-to-minutes current)
- value (substring value 1))
- (setq current 0))
- (setq value (org-duration-string-to-minutes value))
- (if (equal ?- sign)
- (setq value (- current value))
- (if (equal ?+ sign) (setq value (+ current value)))))
- (setq value (max 0 value)
- org-clock-effort (org-minutes-to-hh:mm-string value))
- (org-entry-put org-clock-marker "Effort" org-clock-effort)
- (org-clock-update-mode-line)
- (message "Effort is now %s" org-clock-effort))))
+ (interactive)
+ (if (org-clock-is-active)
+ (let ((current org-clock-effort) sign)
+ (unless value
+ ;; Prompt user for a value or a change
+ (setq value
+ (read-string
+ (format "Set effort (hh:mm or mm%s): "
+ (if current
+ (format ", prefix + to add to %s" org-clock-effort)
+ "")))))
+ (when (stringp value)
+ ;; A string. See if it is a delta
+ (setq sign (string-to-char value))
+ (if (member sign '(?- ?+))
+ (setq current (org-duration-string-to-minutes current)
+ value (substring value 1))
+ (setq current 0))
+ (setq value (org-duration-string-to-minutes value))
+ (if (equal ?- sign)
+ (setq value (- current value))
+ (if (equal ?+ sign) (setq value (+ current value)))))
+ (setq value (max 0 value)
+ org-clock-effort (org-minutes-to-hh:mm-string value))
+ (org-entry-put org-clock-marker "Effort" org-clock-effort)
+ (org-clock-update-mode-line)
+ (message "Effort is now %s" org-clock-effort))
+ (message "Clock is not currently active")))
(defvar org-clock-notification-was-shown nil
"Shows if we have shown notification already.")
@@ -632,15 +679,14 @@ use libnotify if available, or fall back on a message."
((stringp org-show-notification-handler)
(start-process "emacs-timer-notification" nil
org-show-notification-handler notification))
- ((featurep 'notifications)
- (require 'notifications)
+ ((fboundp 'notifications-notify)
(notifications-notify
:title "Org-mode message"
:body notification
;; FIXME how to link to the Org icon?
;; :app-icon "~/.emacs.d/icons/mail.png"
:urgency 'low))
- ((org-program-exists "notify-send")
+ ((executable-find "notify-send")
(start-process "emacs-timer-notification" nil
"notify-send" notification))
;; Maybe the handler will send a message, so only use message as
@@ -656,18 +702,13 @@ Use alsa's aplay tool if available."
((stringp org-clock-sound)
(let ((file (expand-file-name org-clock-sound)))
(if (file-exists-p file)
- (if (org-program-exists "aplay")
+ (if (executable-find "aplay")
(start-process "org-clock-play-notification" nil
"aplay" file)
(condition-case nil
(play-sound-file file)
(error (beep t) (beep t)))))))))
-(defun org-program-exists (program-name)
- "Checks whenever we can locate PROGRAM-NAME using the `which' executable."
- (if (member system-type '(gnu/linux darwin))
- (= 0 (call-process "which" nil nil nil program-name))))
-
(defvar org-clock-mode-line-entry nil
"Information for the mode line about the running clock.")
@@ -729,9 +770,9 @@ If necessary, clock-out of the currently active clock."
(let ((temp (copy-marker (car clock)
(marker-insertion-type (car clock)))))
(if (org-is-active-clock clock)
- (org-clock-out fail-quietly at-time)
+ (org-clock-out nil fail-quietly at-time)
(org-with-clock clock
- (org-clock-out fail-quietly at-time)))
+ (org-clock-out nil fail-quietly at-time)))
(setcar clock temp)))
(defsubst org-clock-clock-cancel (clock)
@@ -934,18 +975,18 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(let ((dangling (or (not (org-clock-is-active))
(/= (car clock) org-clock-marker))))
(if (or (not only-dangling-p) dangling)
- (org-clock-resolve
- clock
- (or prompt-fn
- (function
- (lambda (clock)
- (format
- "Dangling clock started %d mins ago"
- (floor
- (/ (- (org-float-time (current-time))
- (org-float-time (cdr clock))) 60))))))
- (or last-valid
- (cdr clock)))))))))))
+ (org-clock-resolve
+ clock
+ (or prompt-fn
+ (function
+ (lambda (clock)
+ (format
+ "Dangling clock started %d mins ago"
+ (floor
+ (/ (- (org-float-time (current-time))
+ (org-float-time (cdr clock))) 60))))))
+ (or last-valid
+ (cdr clock)))))))))))
(defun org-emacs-idle-seconds ()
"Return the current Emacs idle time in seconds, or nil if not idle."
@@ -958,6 +999,13 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
"Return the current Mac idle time in seconds."
(string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'")))
+(defvar org-x11idle-exists-p
+ ;; Check that x11idle exists
+ (and (eq window-system 'x)
+ (eq (call-process-shell-command "command" nil nil nil "-v" "x11idle") 0)
+ ;; Check that x11idle can retrieve the idle time
+ (eq (call-process-shell-command "x11idle" nil nil nil) 0)))
+
(defun org-x11-idle-seconds ()
"Return the current X11 idle time in seconds."
(/ (string-to-number (shell-command-to-string "x11idle")) 1000))
@@ -968,7 +1016,7 @@ This routine returns a floating point number."
(cond
((eq system-type 'darwin)
(org-mac-idle-seconds))
- ((eq window-system 'x)
+ ((and (eq window-system 'x) org-x11idle-exists-p)
(org-x11-idle-seconds))
(t
(org-emacs-idle-seconds))))
@@ -1010,15 +1058,18 @@ so long."
"Reset `org-clock-current-task' to nil."
(setq org-clock-current-task nil))
+(defvar org-clock-out-time nil) ; store the time of the last clock-out
(defun org-clock-in (&optional select start-time)
"Start the clock on the current item.
If necessary, clock-out of the currently active clock.
-With a prefix argument SELECT (\\[universal-argument]), offer a list of \
-recently clocked tasks to
-clock into. When SELECT is \\[universal-argument] \\[universal-argument], \
-clock into the current task and mark
-is as the default task, a special task that will always be offered in
-the clocking selection, associated with the letter `d'."
+With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked
+tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task
+and mark it as the default task, a special task that will always be offered
+in the clocking selection, associated with the letter `d'.
+When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \
+clock in by using the last clock-out
+time as the start time \(see `org-clock-continuously' to
+make this the default behavior.)"
(interactive "P")
(setq org-clock-notification-was-shown nil)
(catch 'abort
@@ -1026,7 +1077,7 @@ the clocking selection, associated with the letter `d'."
(org-clocking-p)))
ts selected-task target-pos (msg-extra "")
(leftover (and (not org-clock-resolving-clocks)
- org-clock-leftover-time)))
+ org-clock-leftover-time)))
(when (and org-clock-auto-clock-resolution
(or (not interrupting)
@@ -1037,6 +1088,11 @@ the clocking selection, associated with the letter `d'."
(let ((org-clock-clocking-in t))
(org-resolve-clocks))) ; check if any clocks are dangling
+ (when (equal select '(64))
+ ;; Set start-time to `org-clock-out-time'
+ (let ((org-clock-continuously t))
+ (org-clock-in nil org-clock-out-time)))
+
(when (equal select '(4))
(setq selected-task (org-clock-select-task "Clock-in on task: "))
(if selected-task
@@ -1069,7 +1125,7 @@ the clocking selection, associated with the letter `d'."
(marker-position org-clock-marker)
(marker-buffer org-clock-marker))
(let ((org-clock-clocking-in t))
- (org-clock-out t)))
+ (org-clock-out nil t)))
;; Clock in at which position?
(setq target-pos
@@ -1090,7 +1146,12 @@ the clocking selection, associated with the letter `d'."
(goto-char target-pos)
(org-back-to-heading t)
(or interrupting (move-marker org-clock-interrupted-task nil))
- (org-clock-history-push)
+ (save-excursion
+ (forward-char) ;; make sure the marker is not at the
+ ;; beginning of the heading, since the
+ ;; user is liking to insert stuff here
+ ;; manually
+ (org-clock-history-push))
(org-clock-set-current)
(cond ((functionp org-clock-in-switch-to-state)
(looking-at org-complex-heading-regexp)
@@ -1111,7 +1172,8 @@ the clocking selection, associated with the letter `d'."
(cond ((and org-clock-heading-function
(functionp org-clock-heading-function))
(funcall org-clock-heading-function))
- ((looking-at org-complex-heading-regexp)
+ ((and (looking-at org-complex-heading-regexp)
+ (match-string 4))
(replace-regexp-in-string
"\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1"
(match-string 4)))
@@ -1144,7 +1206,7 @@ the clocking selection, associated with the letter `d'."
(t
(insert-before-markers "\n")
(backward-char 1)
- (org-indent-line-function)
+ (org-indent-line)
(when (and (save-excursion
(end-of-line 0)
(org-in-item-p)))
@@ -1155,7 +1217,8 @@ the clocking selection, associated with the letter `d'."
(setq org-clock-total-time (org-clock-sum-current-item
(org-clock-get-sum-start)))
(setq org-clock-start-time
- (or (and leftover
+ (or (and org-clock-continuously org-clock-out-time)
+ (and leftover
(y-or-n-p
(format
"You stopped another clock %d mins ago; start this one from then? "
@@ -1171,18 +1234,26 @@ the clocking selection, associated with the letter `d'."
(save-excursion (org-back-to-heading t) (point))
(buffer-base-buffer))
(setq org-clock-has-been-used t)
- (or global-mode-string (setq global-mode-string '("")))
- (or (memq 'org-mode-line-string global-mode-string)
- (setq global-mode-string
- (append global-mode-string '(org-mode-line-string))))
+ ;; add to mode line
+ (when (or (eq org-clock-clocked-in-display 'mode-line)
+ (eq org-clock-clocked-in-display 'both))
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'org-mode-line-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(org-mode-line-string)))))
+ ;; add to frame title
+ (when (or (eq org-clock-clocked-in-display 'frame-title)
+ (eq org-clock-clocked-in-display 'both))
+ (setq frame-title-format org-clock-frame-title-format))
(org-clock-update-mode-line)
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
(setq org-clock-mode-line-timer nil))
- (setq org-clock-mode-line-timer
- (run-with-timer org-clock-update-period
- org-clock-update-period
- 'org-clock-update-mode-line))
+ (when org-clock-clocked-in-display
+ (setq org-clock-mode-line-timer
+ (run-with-timer org-clock-update-period
+ org-clock-update-period
+ 'org-clock-update-mode-line)))
(when org-clock-idle-timer
(cancel-timer org-clock-idle-timer)
(setq org-clock-idle-timer nil))
@@ -1191,6 +1262,41 @@ the clocking selection, associated with the letter `d'."
(message "Clock starts at %s - %s" ts msg-extra)
(run-hooks 'org-clock-in-hook)))))))
+;;;###autoload
+(defun org-clock-in-last (&optional arg)
+ "Clock in the last closed clocked item.
+When already clocking in, send an warning.
+With a universal prefix argument, select the task you want to
+clock in from the last clocked in tasks.
+With two universal prefix arguments, start clocking using the
+last clock-out time, if any.
+With three universal prefix arguments, interactively prompt
+for a todo state to switch to, overriding the existing value
+`org-clock-in-switch-to-state'."
+ (interactive "P")
+ (if (equal arg '(4))
+ (org-clock-in (org-clock-select-task))
+ (let ((start-time (if (or org-clock-continuously (equal arg '(16)))
+ (or org-clock-out-time (current-time))
+ (current-time))))
+ (if (null org-clock-history)
+ (message "No last clock")
+ (let ((org-clock-in-switch-to-state
+ (if (and (not org-clock-current-task) (equal arg '(64)))
+ (completing-read "Switch to state: "
+ (and org-clock-history
+ (with-current-buffer
+ (marker-buffer (car org-clock-history))
+ org-todo-keywords-1)))
+ org-clock-in-switch-to-state))
+ (already-clocking org-clock-current-task))
+ (org-clock-clock-in (list (car org-clock-history)) nil start-time)
+ (or already-clocking
+ ;; Don't display a message if we are already clocking in
+ (message "Clocking back: %s (in %s)"
+ org-clock-current-task
+ (buffer-name (marker-buffer org-clock-marker)))))))))
+
(defun org-clock-mark-default-task ()
"Mark current task as default task."
(interactive)
@@ -1284,7 +1390,7 @@ line and position cursor in that line."
(if (and (>= (org-get-indentation) ind-last)
(org-at-item-p))
(when (and (>= (org-get-indentation) ind-last)
- (org-at-item-p))
+ (org-at-item-p))
(let ((struct (org-list-struct)))
(goto-char (org-list-get-bottom-point struct)))))
(insert ":END:\n")
@@ -1293,7 +1399,7 @@ line and position cursor in that line."
(goto-char first)
(insert ":" drawer ":\n")
(beginning-of-line 0)
- (org-indent-line-function)
+ (org-indent-line)
(org-flag-drawer t)
(beginning-of-line 2)
(or org-log-states-order-reversed
@@ -1313,28 +1419,41 @@ line and position cursor in that line."
(< org-clock-into-drawer 2)))
(insert ":" drawer ":\n:END:\n")
(beginning-of-line -1)
- (org-indent-line-function)
+ (org-indent-line)
(org-flag-drawer t)
(beginning-of-line 2)
- (org-indent-line-function)
+ (org-indent-line)
(beginning-of-line)
(or org-log-states-order-reversed
(and (re-search-forward org-property-end-re nil t)
(goto-char (match-beginning 0))))))))
-(defun org-clock-out (&optional fail-quietly at-time)
+(defun org-clock-out (&optional switch-to-state fail-quietly at-time)
"Stop the currently running clock.
-If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
- (interactive)
+Throw an error if there is no running clock and FAIL-QUIETLY is nil.
+With a universal prefix, prompt for a state to switch the clocked out task
+to, overriding the existing value of `org-clock-out-switch-to-state'."
+ (interactive "P")
(catch 'exit
(when (not (org-clocking-p))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
+ (setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(if fail-quietly (throw 'exit t) (error "No active clock")))
- (let (ts te s h m remove)
+ (let ((org-clock-out-switch-to-state
+ (if switch-to-state
+ (completing-read "Switch to state: "
+ (with-current-buffer
+ (marker-buffer org-clock-marker)
+ org-todo-keywords-1)
+ nil t "DONE")
+ org-clock-out-switch-to-state))
+ (now (current-time))
+ ts te s h m remove)
+ (setq org-clock-out-time now)
(save-excursion ; Do not replace this with `with-current-buffer'.
- (with-no-warnings (set-buffer (org-clocking-buffer)))
+ (org-no-warnings (set-buffer (org-clocking-buffer)))
(save-restriction
(widen)
(goto-char org-clock-marker)
@@ -1346,8 +1465,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(goto-char (match-end 0))
(delete-region (point) (point-at-eol))
(insert "--")
- (setq te (org-insert-time-stamp (or at-time (current-time))
- 'with-hm 'inactive))
+ (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
(setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te)))
(org-float-time (apply 'encode-time (org-parse-time-string ts))))
h (floor (/ s 3600))
@@ -1374,6 +1492,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(setq org-clock-idle-timer nil))
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
+ (setq frame-title-format org-frame-title-format-backup)
(when org-clock-out-switch-to-state
(save-excursion
(org-back-to-heading t)
@@ -1394,7 +1513,8 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m
(if remove " => LINE REMOVED" ""))
(run-hooks 'org-clock-out-hook)
- (org-clock-delete-current))))))
+ (unless (org-clocking-p)
+ (org-clock-delete-current)))))))
(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer)
@@ -1407,7 +1527,8 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
(when clock-drawer
(save-excursion
(org-back-to-heading t)
- (while (search-forward clock-drawer end t)
+ (while (and (< (point) end)
+ (search-forward clock-drawer end t))
(goto-char (match-beginning 0))
(org-remove-empty-drawer-at clock-drawer (point))
(forward-line 1))))))
@@ -1471,19 +1592,23 @@ UPDOWN tells whether to change 'up or 'down."
(interactive)
(when (not (org-clocking-p))
(setq global-mode-string
- (delq 'org-mode-line-string global-mode-string))
+ (delq 'org-mode-line-string global-mode-string))
+ (setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(error "No active clock"))
(save-excursion ; Do not replace this with `with-current-buffer'.
- (with-no-warnings (set-buffer (org-clocking-buffer)))
+ (org-no-warnings (set-buffer (org-clocking-buffer)))
(goto-char org-clock-marker)
- (delete-region (1- (point-at-bol)) (point-at-eol))
- ;; Just in case, remove any empty LOGBOOK left over
- (org-remove-empty-drawer-at "LOGBOOK" (point)))
+ (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*"))
+ (progn (delete-region (1- (point-at-bol)) (point-at-eol))
+ (org-remove-empty-drawer-at "LOGBOOK" (point)))
+ (message "Clock gone, cancel the timer anyway")
+ (sit-for 2)))
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
(setq global-mode-string
(delq 'org-mode-line-string global-mode-string))
+ (setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(message "Clock canceled")
(run-hooks 'org-clock-cancel-hook))
@@ -1520,13 +1645,20 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
"Holds the file total time in minutes, after a call to `org-clock-sum'.")
(make-variable-buffer-local 'org-clock-file-total-minutes)
-(defun org-clock-sum (&optional tstart tend headline-filter)
+(defun org-clock-sum-today (&optional headline-filter)
+ "Sum the times for each subtree for today."
+ (interactive)
+ (let ((range (org-clock-special-range 'today)))
+ (org-clock-sum (car range) (cadr range) nil :org-clock-minutes-today)))
+
+(defun org-clock-sum (&optional tstart tend headline-filter propname)
"Sum the times for each subtree.
Puts the resulting times in minutes as a text property on each headline.
-TSTART and TEND can mark a time range to be considered. HEADLINE-FILTER is a
-zero-arg function that, if specified, is called for each headline in the time
-range with point at the headline. Headlines for which HEADLINE-FILTER returns
-nil are excluded from the clock summation."
+TSTART and TEND can mark a time range to be considered.
+HEADLINE-FILTER is a zero-arg function that, if specified, is called for
+each headline in the time range with point at the headline. Headlines for
+which HEADLINE-FILTER returns nil are excluded from the clock summation.
+PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(interactive)
(let* ((bmp (buffer-modified-p))
(re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
@@ -1543,7 +1675,7 @@ nil are excluded from the clock summation."
(if (consp tstart) (setq tstart (org-float-time tstart)))
(if (consp tend) (setq tend (org-float-time tend)))
(remove-text-properties (point-min) (point-max)
- '(:org-clock-minutes t
+ `(,(or propname :org-clock-minutes) t
:org-clock-force-headline-inclusion t))
(save-excursion
(goto-char (point-max))
@@ -1592,7 +1724,8 @@ nil are excluded from the clock summation."
(aset ltimes l (+ (aref ltimes l) t1))))
(setq time (aref ltimes level))
(goto-char (match-beginning 0))
- (put-text-property (point) (point-at-eol) :org-clock-minutes time)
+ (put-text-property (point) (point-at-eol)
+ (or propname :org-clock-minutes) time)
(if headline-filter
(save-excursion
(save-match-data
@@ -1667,8 +1800,8 @@ will be easy to remove."
(org-move-to-column c)
(unless (eolp) (skip-chars-backward "^ \t"))
(skip-chars-backward " \t")
- (setq ov (make-overlay (1- (point)) (point-at-eol))
- tx (concat (buffer-substring (1- (point)) (point))
+ (setq ov (make-overlay (point-at-bol) (point-at-eol))
+ tx (concat (buffer-substring (point-at-bol) (point))
(make-string (+ off (max 0 (- c (current-column)))) ?.)
(org-add-props (if org-time-clocksum-use-fractional
(format fmt
@@ -1864,13 +1997,13 @@ the returned times will be formatted strings."
(setq d (nth 1 date) month (car date) y (nth 2 date)
dow 1
key 'week))
- ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
- (require 'cal-iso)
- (setq y (string-to-number (match-string 1 skey)))
- (setq q (string-to-number (match-string 2 skey)))
- (setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (org-quarter-to-date q y))))
- (setq d (nth 1 date) month (car date) y (nth 2 date)
+ ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
+ (require 'cal-iso)
+ (setq y (string-to-number (match-string 1 skey)))
+ (setq q (string-to-number (match-string 2 skey)))
+ (setq date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso (org-quarter-to-date q y))))
+ (setq d (nth 1 date) month (car date) y (nth 2 date)
dow 1
key 'quarter))
((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey)
@@ -1881,12 +2014,11 @@ the returned times will be formatted strings."
((string-match "\\([-+][0-9]+\\)$" skey)
(setq shift (string-to-number (match-string 1 skey))
key (intern (substring skey 0 (match-beginning 1))))
- (if(and (memq key '(quarter thisq)) (> shift 0))
- (error "Looking forward with quarters isn't implemented.")
- ())))
+ (if (and (memq key '(quarter thisq)) (> shift 0))
+ (error "Looking forward with quarters isn't implemented"))))
(when (= shift 0)
- (cond ((eq key 'yesterday) (setq key 'today shift -1))
+ (cond ((eq key 'yesterday) (setq key 'today shift -1))
((eq key 'lastweek) (setq key 'week shift -1))
((eq key 'lastmonth) (setq key 'month shift -1))
((eq key 'lastyear) (setq key 'year shift -1))
@@ -1900,27 +2032,27 @@ the returned times will be formatted strings."
((memq key '(month thismonth))
(setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0))
((memq key '(quarter thisq))
- ; compute if this shift remains in this year
- ; if not, compute how many years and quarters we have to shift (via floor*)
- ; and compute the shifted years, months and quarters
+ ; compute if this shift remains in this year
+ ; if not, compute how many years and quarters we have to shift (via floor*)
+ ; and compute the shifted years, months and quarters
(cond
((< (+ (- q 1) shift) 0) ; shift not in this year
- (setq interval (* -1 (+ (- q 1) shift)))
- ; set tmp to ((years to shift) (quarters to shift))
- (setq tmp (org-floor* interval 4))
- ; due to the use of floor, 0 quarters actually means 4
- (if (= 0 (nth 1 tmp))
- (setq shiftedy (- y (nth 0 tmp))
- shiftedm 1
- shiftedq 1)
- (setq shiftedy (- y (+ 1 (nth 0 tmp)))
- shiftedm (- 13 (* 3 (nth 1 tmp)))
- shiftedq (- 5 (nth 1 tmp))))
- (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy))
+ (setq interval (* -1 (+ (- q 1) shift)))
+ ; set tmp to ((years to shift) (quarters to shift))
+ (setq tmp (org-floor* interval 4))
+ ; due to the use of floor, 0 quarters actually means 4
+ (if (= 0 (nth 1 tmp))
+ (setq shiftedy (- y (nth 0 tmp))
+ shiftedm 1
+ shiftedq 1)
+ (setq shiftedy (- y (+ 1 (nth 0 tmp)))
+ shiftedm (- 13 (* 3 (nth 1 tmp)))
+ shiftedq (- 5 (nth 1 tmp))))
+ (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy))
((> (+ q shift) 0) ; shift is within this year
- (setq shiftedq (+ q shift))
- (setq shiftedy y)
- (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
+ (setq shiftedq (+ q shift))
+ (setq shiftedy y)
+ (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
((memq key '(year thisyear))
(setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
(t (error "No such time block %s" key)))
@@ -1938,7 +2070,7 @@ the returned times will be formatted strings."
((memq key '(year thisyear))
(setq txt (format-time-string "the year %Y" ts)))
((memq key '(quarter thisq))
- (setq txt (concatenate 'string (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))
+ (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))
)
(if as-strings
(list (format-time-string fm ts) (format-time-string fm te) txt)
@@ -1976,62 +2108,62 @@ the currently selected interval size."
((equal s "lastyear") (setq s "thisyear-1"))
((equal s "lastq") (setq s "thisq-1")))
- (cond
- ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s)
- (setq block (match-string 1 s)
- shift (if (match-end 2)
- (string-to-number (match-string 2 s))
- 0))
- (setq shift (+ shift n))
- (setq ins (if (= shift 0) block (format "%s%+d" block shift))))
- ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
- ;; 1 1 2 3 3 4 4 5 6 6 5 2
- (setq y (string-to-number (match-string 1 s))
- wp (and (match-end 3) (match-string 3 s))
- mw (and (match-end 4) (string-to-number (match-string 4 s)))
- d (and (match-end 6) (string-to-number (match-string 6 s))))
- (cond
- (d (setq ins (format-time-string
- "%Y-%m-%d"
- (encode-time 0 0 0 (+ d n) m y))))
- ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
- (require 'cal-iso)
- (setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (list (+ mw n) 1 y))))
- (setq ins (format-time-string
- "%G-W%V"
- (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
- ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
- (require 'cal-iso)
- ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year
- (if (> (+ mw n) 4)
- (setq mw 0
- y (+ 1 y))
- ())
- ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year
- (if (= (+ mw n) 0)
- (setq mw 5
- y (- y 1))
- ())
- (setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y))))
- (setq ins (format-time-string
- (concatenate 'string (number-to-string y) "-Q" (number-to-string (+ mw n)))
- (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
- (mw
- (setq ins (format-time-string
- "%Y-%m"
- (encode-time 0 0 0 1 (+ mw n) y))))
- (y
- (setq ins (number-to-string (+ y n))))))
- (t (error "Cannot shift clocktable block")))
- (when ins
- (goto-char b)
- (insert ins)
- (delete-region (point) (+ (point) (- e b)))
- (beginning-of-line 1)
- (org-update-dblock)
- t)))))
+ (cond
+ ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s)
+ (setq block (match-string 1 s)
+ shift (if (match-end 2)
+ (string-to-number (match-string 2 s))
+ 0))
+ (setq shift (+ shift n))
+ (setq ins (if (= shift 0) block (format "%s%+d" block shift))))
+ ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
+ ;; 1 1 2 3 3 4 4 5 6 6 5 2
+ (setq y (string-to-number (match-string 1 s))
+ wp (and (match-end 3) (match-string 3 s))
+ mw (and (match-end 4) (string-to-number (match-string 4 s)))
+ d (and (match-end 6) (string-to-number (match-string 6 s))))
+ (cond
+ (d (setq ins (format-time-string
+ "%Y-%m-%d"
+ (encode-time 0 0 0 (+ d n) m y))))
+ ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
+ (require 'cal-iso)
+ (setq date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso (list (+ mw n) 1 y))))
+ (setq ins (format-time-string
+ "%G-W%V"
+ (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
+ ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
+ (require 'cal-iso)
+ ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year
+ (if (> (+ mw n) 4)
+ (setq mw 0
+ y (+ 1 y))
+ ())
+ ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year
+ (if (= (+ mw n) 0)
+ (setq mw 5
+ y (- y 1))
+ ())
+ (setq date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y))))
+ (setq ins (format-time-string
+ (concat (number-to-string y) "-Q" (number-to-string (+ mw n)))
+ (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
+ (mw
+ (setq ins (format-time-string
+ "%Y-%m"
+ (encode-time 0 0 0 1 (+ mw n) y))))
+ (y
+ (setq ins (number-to-string (+ y n))))))
+ (t (error "Cannot shift clocktable block")))
+ (when ins
+ (goto-char b)
+ (insert ins)
+ (delete-region (point) (+ (point) (- e b)))
+ (beginning-of-line 1)
+ (org-update-dblock)
+ t)))))
(defun org-dblock-write:clocktable (params)
"Write the standard clocktable."
@@ -2082,7 +2214,7 @@ the currently selected interval size."
;; we collect from several files
(let* ((files scope)
file)
- (org-prepare-agenda-buffers files)
+ (org-agenda-prepare-buffers files)
(while (setq file (pop files))
(with-current-buffer (find-buffer-visiting file)
(save-excursion
@@ -2091,7 +2223,7 @@ the currently selected interval size."
;; Just from the current file
(save-restriction
;; get the right range into the restriction
- (org-prepare-agenda-buffers (list (buffer-file-name)))
+ (org-agenda-prepare-buffers (list (buffer-file-name)))
(cond
((not scope)) ; use the restriction as it is now
((eq scope 'file) (widen))
@@ -2150,6 +2282,7 @@ from the dynamic block definition."
(ntcol (max 1 (or (plist-get params :tcolumns) 100)))
(rm-file-column (plist-get params :one-file-with-archives))
(indent (plist-get params :indent))
+ (case-fold-search t)
range-text total-time tbl level hlc formula pcol
file-time entries entry headline
recalc content narrow-cut-p tcol)
@@ -2159,192 +2292,196 @@ from the dynamic block definition."
(setq level nil indent t narrow (or narrow '40!) ntcol 1))
;; Some consistency test for parameters
- (unless (integerp ntcol)
- (setq params (plist-put params :tcolumns (setq ntcol 100))))
-
- (when (and narrow (integerp narrow) link)
- ;; We cannot have both integer narrow and link
- (message
- "Using hard narrowing in clocktable to allow for links")
- (setq narrow (intern (format "%d!" narrow))))
+ (unless (integerp ntcol)
+ (setq params (plist-put params :tcolumns (setq ntcol 100))))
- (when narrow
- (cond
- ((integerp narrow))
- ((and (symbolp narrow)
- (string-match "\\`[0-9]+!\\'" (symbol-name narrow)))
- (setq narrow-cut-p t
- narrow (string-to-number (substring (symbol-name narrow)
- 0 -1))))
- (t
- (error "Invalid value %s of :narrow property in clock table"
- narrow))))
+ (when (and narrow (integerp narrow) link)
+ ;; We cannot have both integer narrow and link
+ (message
+ "Using hard narrowing in clocktable to allow for links")
+ (setq narrow (intern (format "%d!" narrow))))
- (when block
- ;; Get the range text for the header
- (setq range-text (nth 2 (org-clock-special-range block nil t))))
-
- ;; Compute the total time
- (setq total-time (apply '+ (mapcar 'cadr tables)))
-
- ;; Now we need to output this tsuff
- (goto-char ipos)
+ (when narrow
+ (cond
+ ((integerp narrow))
+ ((and (symbolp narrow)
+ (string-match "\\`[0-9]+!\\'" (symbol-name narrow)))
+ (setq narrow-cut-p t
+ narrow (string-to-number (substring (symbol-name narrow)
+ 0 -1))))
+ (t
+ (error "Invalid value %s of :narrow property in clock table"
+ narrow))))
- ;; Insert the text *before* the actual table
- (insert-before-markers
- (or header
- ;; Format the standard header
- (concat
- (nth 9 lwords) " ["
- (substring
- (format-time-string (cdr org-time-stamp-formats))
- 1 -1)
- "]"
- (if block (concat ", for " range-text ".") "")
- "\n\n")))
-
- ;; Insert the narrowing line
- (when (and narrow (integerp narrow) (not narrow-cut-p))
- (insert-before-markers
- "|" ; table line starter
- (if multifile "|" "") ; file column, maybe
- (if level-p "|" "") ; level column, maybe
- (if timestamp "|" "") ; timestamp column, maybe
- (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
- (format "<%d>| |\n" narrow))) ; headline and time columns
-
- ;; Insert the table header line
- (insert-before-markers
- "|" ; table line starter
- (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe
- (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe
- (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe
- (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe
- (concat (nth 4 lwords) "|"
- (nth 5 lwords) "|\n")) ; headline and time columns
-
- ;; Insert the total time in the table
+ (when block
+ ;; Get the range text for the header
+ (setq range-text (nth 2 (org-clock-special-range block nil t))))
+
+ ;; Compute the total time
+ (setq total-time (apply '+ (mapcar 'cadr tables)))
+
+ ;; Now we need to output this tsuff
+ (goto-char ipos)
+
+ ;; Insert the text *before* the actual table
+ (insert-before-markers
+ (or header
+ ;; Format the standard header
+ (concat
+ (nth 9 lwords) " ["
+ (substring
+ (format-time-string (cdr org-time-stamp-formats))
+ 1 -1)
+ "]"
+ (if block (concat ", for " range-text ".") "")
+ "\n\n")))
+
+ ;; Insert the narrowing line
+ (when (and narrow (integerp narrow) (not narrow-cut-p))
(insert-before-markers
- "|-\n" ; a hline
- "|" ; table line starter
- (if multifile (concat "| " (nth 6 lwords) " ") "")
- ; file column, maybe
- (if level-p "|" "") ; level column, maybe
- (if timestamp "|" "") ; timestamp column, maybe
+ "|" ; table line starter
+ (if multifile "|" "") ; file column, maybe
+ (if level-p "|" "") ; level column, maybe
+ (if timestamp "|" "") ; timestamp column, maybe
(if properties (make-string (length properties) ?|) "") ;properties columns, maybe
- (concat "*" (nth 7 lwords) "*| ") ; instead of a headline
- "*"
- (org-minutes-to-hh:mm-string (or total-time 0)) ; the time
- "*|\n") ; close line
-
- ;; Now iterate over the tables and insert the data
- ;; but only if any time has been collected
- (when (and total-time (> total-time 0))
-
- (while (setq tbl (pop tables))
- ;; now tbl is the table resulting from one file.
- (setq file-time (nth 1 tbl))
- (when (or (and file-time (> file-time 0))
- (not (plist-get params :fileskip0)))
- (insert-before-markers "|-\n") ; a hline because a new file starts
- ;; First the file time, if we have multiple files
- (when multifile
- ;; Summarize the time collected from this file
- (insert-before-markers
- (format (concat "| %s %s | %s%s*" (nth 8 lwords) "* | *%s*|\n")
- (file-name-nondirectory (car tbl))
- (if level-p "| " "") ; level column, maybe
- (if timestamp "| " "") ; timestamp column, maybe
- (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
- (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time
-
- ;; Get the list of node entries and iterate over it
- (setq entries (nth 2 tbl))
- (while (setq entry (pop entries))
- (setq level (car entry)
- headline (nth 1 entry)
- hlc (if emph (or (cdr (assoc level hlchars)) "") ""))
- (when narrow-cut-p
- (if (and (string-match (concat "\\`" org-bracket-link-regexp
- "\\'")
- headline)
- (match-end 3))
- (setq headline
- (format "[[%s][%s]]"
- (match-string 1 headline)
- (org-shorten-string (match-string 3 headline)
- narrow)))
- (setq headline (org-shorten-string headline narrow))))
- (insert-before-markers
- "|" ; start the table line
- (if multifile "|" "") ; free space for file name column?
- (if level-p (format "%d|" (car entry)) "") ; level, maybe
- (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe
- (if properties
- (concat
- (mapconcat
- (lambda (p) (or (cdr (assoc p (nth 4 entry))) ""))
- properties "|") "|") "") ;properties columns, maybe
- (if indent (org-clocktable-indent-string level) "") ; indentation
- hlc headline hlc "|" ; headline
- (make-string (min (1- ntcol) (or (- level 1))) ?|)
+ (format "<%d>| |\n" narrow))) ; headline and time columns
+
+ ;; Insert the table header line
+ (insert-before-markers
+ "|" ; table line starter
+ (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe
+ (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe
+ (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe
+ (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe
+ (concat (nth 4 lwords) "|"
+ (nth 5 lwords) "|\n")) ; headline and time columns
+
+ ;; Insert the total time in the table
+ (insert-before-markers
+ "|-\n" ; a hline
+ "|" ; table line starter
+ (if multifile (concat "| " (nth 6 lwords) " ") "")
+ ; file column, maybe
+ (if level-p "|" "") ; level column, maybe
+ (if timestamp "|" "") ; timestamp column, maybe
+ (if properties (make-string (length properties) ?|) "") ; properties columns, maybe
+ (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline
+ (format org-clock-total-time-cell-format
+ (org-minutes-to-hh:mm-string (or total-time 0))) ; the time
+ "|\n") ; close line
+
+ ;; Now iterate over the tables and insert the data
+ ;; but only if any time has been collected
+ (when (and total-time (> total-time 0))
+
+ (while (setq tbl (pop tables))
+ ;; now tbl is the table resulting from one file.
+ (setq file-time (nth 1 tbl))
+ (when (or (and file-time (> file-time 0))
+ (not (plist-get params :fileskip0)))
+ (insert-before-markers "|-\n") ; a hline because a new file starts
+ ;; First the file time, if we have multiple files
+ (when multifile
+ ;; Summarize the time collected from this file
+ (insert-before-markers
+ (format (concat "| %s %s | %s%s"
+ (format org-clock-file-time-cell-format (nth 8 lwords))
+ " | *%s*|\n")
+ (file-name-nondirectory (car tbl))
+ (if level-p "| " "") ; level column, maybe
+ (if timestamp "| " "") ; timestamp column, maybe
+ (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
+ (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time
+
+ ;; Get the list of node entries and iterate over it
+ (setq entries (nth 2 tbl))
+ (while (setq entry (pop entries))
+ (setq level (car entry)
+ headline (nth 1 entry)
+ hlc (if emph (or (cdr (assoc level hlchars)) "") ""))
+ (when narrow-cut-p
+ (if (and (string-match (concat "\\`" org-bracket-link-regexp
+ "\\'")
+ headline)
+ (match-end 3))
+ (setq headline
+ (format "[[%s][%s]]"
+ (match-string 1 headline)
+ (org-shorten-string (match-string 3 headline)
+ narrow)))
+ (setq headline (org-shorten-string headline narrow))))
+ (insert-before-markers
+ "|" ; start the table line
+ (if multifile "|" "") ; free space for file name column?
+ (if level-p (format "%d|" (car entry)) "") ; level, maybe
+ (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe
+ (if properties
+ (concat
+ (mapconcat
+ (lambda (p) (or (cdr (assoc p (nth 4 entry))) ""))
+ properties "|") "|") "") ;properties columns, maybe
+ (if indent (org-clocktable-indent-string level) "") ; indentation
+ hlc headline hlc "|" ; headline
+ (make-string (min (1- ntcol) (or (- level 1))) ?|)
; empty fields for higher levels
- hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time
- "|\n" ; close line
- )))))
- (backward-delete-char 1)
- (if (setq formula (plist-get params :formula))
- (cond
- ((eq formula '%)
- ;; compute the column where the % numbers need to go
- (setq pcol (+ 2
- (if multifile 1 0)
- (if level-p 1 0)
- (if timestamp 1 0)
- (min maxlevel (or ntcol 100))))
- ;; compute the column where the total time is
- (setq tcol (+ 2
- (if multifile 1 0)
- (if level-p 1 0)
- (if timestamp 1 0)))
- (insert
- (format
- "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
- pcol ; the column where the % numbers should go
- (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time
- tcol ; column of the total time
- tcol (1- pcol) ; range of columns where times can be found
- ))
- (setq recalc t))
- ((stringp formula)
- (insert "\n#+TBLFM: " formula)
- (setq recalc t))
- (t (error "invalid formula in clocktable")))
- ;; Should we rescue an old formula?
- (when (stringp (setq content (plist-get params :content)))
- (when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content)
- (setq recalc t)
- (insert "\n" (match-string 1 (plist-get params :content)))
- (beginning-of-line 0))))
- ;; Back to beginning, align the table, recalculate if necessary
- (goto-char ipos)
- (skip-chars-forward "^|")
- (org-table-align)
- (when org-hide-emphasis-markers
- ;; we need to align a second time
- (org-table-align))
- (when recalc
- (if (eq formula '%)
- (save-excursion
- (if (and narrow (not narrow-cut-p)) (beginning-of-line 2))
- (org-table-goto-column pcol nil 'force)
- (insert "%")))
- (org-table-recalculate 'all))
- (when rm-file-column
- ;; The file column is actually not wanted
- (forward-char 1)
- (org-table-delete-column))
- total-time))
+ hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time
+ "|\n" ; close line
+ )))))
+ ;; When exporting subtrees or regions the region might be
+ ;; activated, so let's disable ̀delete-active-region'
+ (let ((delete-active-region nil)) (backward-delete-char 1))
+ (if (setq formula (plist-get params :formula))
+ (cond
+ ((eq formula '%)
+ ;; compute the column where the % numbers need to go
+ (setq pcol (+ 2
+ (if multifile 1 0)
+ (if level-p 1 0)
+ (if timestamp 1 0)
+ (min maxlevel (or ntcol 100))))
+ ;; compute the column where the total time is
+ (setq tcol (+ 2
+ (if multifile 1 0)
+ (if level-p 1 0)
+ (if timestamp 1 0)))
+ (insert
+ (format
+ "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
+ pcol ; the column where the % numbers should go
+ (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time
+ tcol ; column of the total time
+ tcol (1- pcol) ; range of columns where times can be found
+ ))
+ (setq recalc t))
+ ((stringp formula)
+ (insert "\n#+TBLFM: " formula)
+ (setq recalc t))
+ (t (error "Invalid formula in clocktable")))
+ ;; Should we rescue an old formula?
+ (when (stringp (setq content (plist-get params :content)))
+ (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content)
+ (setq recalc t)
+ (insert "\n" (match-string 1 (plist-get params :content)))
+ (beginning-of-line 0))))
+ ;; Back to beginning, align the table, recalculate if necessary
+ (goto-char ipos)
+ (skip-chars-forward "^|")
+ (org-table-align)
+ (when org-hide-emphasis-markers
+ ;; we need to align a second time
+ (org-table-align))
+ (when recalc
+ (if (eq formula '%)
+ (save-excursion
+ (if (and narrow (not narrow-cut-p)) (beginning-of-line 2))
+ (org-table-goto-column pcol nil 'force)
+ (insert "%")))
+ (org-table-recalculate 'all))
+ (when rm-file-column
+ ;; The file column is actually not wanted
+ (forward-char 1)
+ (org-table-delete-column))
+ total-time))
(defun org-clocktable-indent-string (level)
(if (= level 1)
@@ -2464,7 +2601,9 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(org-clock-sum ts te
(unless (null matcher)
(lambda ()
- (let ((tags-list (org-get-tags-at)))
+ (let* ((tags-list (org-get-tags-at))
+ (org-scanner-tags tags-list)
+ (org-trust-scanner-tags t))
(eval matcher)))))
(goto-char (point-min))
(setq st t)
@@ -2496,13 +2635,13 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(cdr (assoc "DEADLINE" props))
(cdr (assoc "TIMESTAMP" props))
(cdr (assoc "TIMESTAMP_IA" props))))
- props (when properties
- (remove nil
- (mapcar
- (lambda (p)
- (when (org-entry-get (point) p inherit-property-p)
- (cons p (org-entry-get (point) p inherit-property-p))))
- properties))))
+ props (when properties
+ (remove nil
+ (mapcar
+ (lambda (p)
+ (when (org-entry-get (point) p inherit-property-p)
+ (cons p (org-entry-get (point) p inherit-property-p))))
+ properties))))
(when (> time 0) (push (list level hdl tsp time props) tbl))))))
(setq tbl (nreverse tbl))
(list file org-clock-file-total-minutes tbl))))
@@ -2566,7 +2705,7 @@ The details of what will be saved are regulated by the variable
(buffer-file-name (org-clocking-buffer))
"\" . " (int-to-string (marker-position org-clock-marker))
"))\n"))
- ;; Store clocked task history. Tasks are stored reversed to make
+ ;; Store clocked task history. Tasks are stored reversed to make
;; reading simpler
(when (and (memq org-clock-persist '(t history))
org-clock-history)
diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index 5cec355d738..e17210b7ff5 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -33,9 +33,10 @@
(declare-function org-agenda-redo "org-agenda" ())
(declare-function org-agenda-do-context-action "org-agenda" ())
+(declare-function org-clock-sum-today "org-clock" (&optional headline-filter))
(when (featurep 'xemacs)
- (error "Do not load this file into XEmacs, use 'org-colview-xemacs.el'."))
+ (error "Do not load this file into XEmacs, use `org-colview-xemacs.el'"))
;;; Column View
@@ -149,6 +150,7 @@ This is the compiled version of the format.")
"Create a new column overlay and add it to the list."
(let ((ov (make-overlay beg end)))
(overlay-put ov 'face (or face 'secondary-selection))
+ (remove-text-properties 0 (length string) '(face nil) string)
(org-overlay-display ov string face)
(push ov org-columns-overlays)
ov))
@@ -186,17 +188,15 @@ This is the compiled version of the format.")
(cons "ITEM"
;; When in a buffer, get the whole line,
;; we'll clean it later…
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(save-match-data
- (org-no-properties
- (org-remove-tabs
- (buffer-substring-no-properties
- (point-at-bol) (point-at-eol)))))
+ (org-remove-tabs
+ (buffer-substring-no-properties
+ (point-at-bol) (point-at-eol))))
;; In agenda, just get the `txt' property
- (org-no-properties
- (or (org-get-at-bol 'txt)
- (buffer-substring
- (point) (progn (end-of-line) (point)))))))
+ (or (org-get-at-bol 'txt)
+ (buffer-substring-no-properties
+ (point) (progn (end-of-line) (point))))))
(assoc property props))
width (or (cdr (assoc property org-columns-current-maxwidths))
(nth 2 column)
@@ -240,20 +240,20 @@ This is the compiled version of the format.")
(save-excursion
(goto-char beg)
(org-unmodified (insert " ")))))) ;; FIXME: add props and remove later?
- ;; Make the rest of the line disappear.
- (org-unmodified
- (setq ov (org-columns-new-overlay beg (point-at-eol)))
- (overlay-put ov 'invisible t)
- (overlay-put ov 'keymap org-columns-map)
- (overlay-put ov 'intangible t)
- (overlay-put ov 'line-prefix "")
- (overlay-put ov 'wrap-prefix "")
- (push ov org-columns-overlays)
- (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
- (overlay-put ov 'keymap org-columns-map)
- (push ov org-columns-overlays)
- (let ((inhibit-read-only t))
- (put-text-property (max (point-min) (1- (point-at-bol)))
+ ;; Make the rest of the line disappear.
+ (org-unmodified
+ (setq ov (org-columns-new-overlay beg (point-at-eol)))
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'keymap org-columns-map)
+ (overlay-put ov 'intangible t)
+ (overlay-put ov 'line-prefix "")
+ (overlay-put ov 'wrap-prefix "")
+ (push ov org-columns-overlays)
+ (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
+ (overlay-put ov 'keymap org-columns-map)
+ (push ov org-columns-overlays)
+ (let ((inhibit-read-only t))
+ (put-text-property (max (point-min) (1- (point-at-bol)))
(min (point-max) (1+ (point-at-eol)))
'read-only "Type `e' to edit property")))))
@@ -304,7 +304,7 @@ for the duration of the command.")
(org-set-local 'org-columns-current-widths (nreverse widths))
(setq org-columns-full-header-line-format title)
(setq org-columns-previous-hscroll -1)
-; (org-columns-hscoll-title)
+ ; (org-columns-hscoll-title)
(org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local)))
(defun org-columns-hscoll-title ()
@@ -442,8 +442,8 @@ Where possible, use the standard interface for changing this line."
(org-edit-headline))))
((equal key "TODO")
(setq eval '(org-with-point-at
- pom
- (call-interactively 'org-todo))))
+ pom
+ (call-interactively 'org-todo))))
((equal key "PRIORITY")
(setq eval '(org-with-point-at pom
(call-interactively 'org-priority))))
@@ -499,7 +499,7 @@ Where possible, use the standard interface for changing this line."
(org-columns-eval eval))
(org-columns-display-here)))
(org-move-to-column col)
- (if (and (eq major-mode 'org-mode)
+ (if (and (derived-mode-p 'org-mode)
(nth 3 (assoc key org-columns-current-fmt-compiled)))
(org-columns-update key)))))))
@@ -665,27 +665,38 @@ around it."
(org-open-link-from-string value arg)))
(defun org-columns-get-format-and-top-level ()
- (let (fmt)
+ (let ((fmt (org-columns-get-format)))
+ (org-columns-goto-top-level)
+ fmt))
+
+(defun org-columns-get-format (&optional fmt-string)
+ (interactive)
+ (let (fmt-as-property fmt)
(when (condition-case nil (org-back-to-heading) (error nil))
- (setq fmt (org-entry-get nil "COLUMNS" t)))
- (setq fmt (or fmt org-columns-default-format))
+ (setq fmt-as-property (org-entry-get nil "COLUMNS" t)))
+ (setq fmt (or fmt-string fmt-as-property org-columns-default-format))
(org-set-local 'org-columns-current-fmt fmt)
(org-columns-compile-format fmt)
- (if (marker-position org-entry-property-inherited-from)
- (move-marker org-columns-top-level-marker
- org-entry-property-inherited-from)
- (move-marker org-columns-top-level-marker (point)))
fmt))
-(defun org-columns ()
- "Turn on column view on an org-mode file."
+(defun org-columns-goto-top-level ()
+ (when (condition-case nil (org-back-to-heading) (error nil))
+ (org-entry-get nil "COLUMNS" t))
+ (if (marker-position org-entry-property-inherited-from)
+ (move-marker org-columns-top-level-marker org-entry-property-inherited-from)
+ (move-marker org-columns-top-level-marker (point))))
+
+(defun org-columns (&optional columns-fmt-string)
+ "Turn on column view on an org-mode file.
+When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(interactive)
(org-verify-version 'columns)
(org-columns-remove-overlays)
(move-marker org-columns-begin-marker (point))
(let ((org-columns-time (time-to-number-of-days (current-time)))
beg end fmt cache maxwidths)
- (setq fmt (org-columns-get-format-and-top-level))
+ (org-columns-goto-top-level)
+ (setq fmt (org-columns-get-format columns-fmt-string))
(save-excursion
(goto-char org-columns-top-level-marker)
(setq beg (point))
@@ -700,6 +711,11 @@ around it."
(save-restriction
(narrow-to-region beg end)
(org-clock-sum))))
+ (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (org-clock-sum-today))))
(while (re-search-forward org-outline-regexp-bol end t)
(if (and org-columns-skip-archived-trees
(looking-at (concat ".*:" org-archive-tag ":")))
@@ -1014,7 +1030,7 @@ Don't set this, this is meant for dynamic scoping.")
(if (marker-position org-columns-begin-marker)
(goto-char org-columns-begin-marker))
(org-columns-remove-overlays)
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(call-interactively 'org-columns)
(org-agenda-redo)
(call-interactively 'org-agenda-columns)))
@@ -1083,6 +1099,14 @@ Don't set this, this is meant for dynamic scoping.")
(while l
(setq sum (+ (string-to-number (pop l)) (/ sum 60))))
sum))
+ ((string-match (concat "\\([0-9.]+\\) *\\("
+ (regexp-opt (mapcar 'car org-effort-durations))
+ "\\)") s)
+ (setq s (concat "0:" (org-duration-string-to-minutes s t)))
+ (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
+ (while l
+ (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
+ sum))
((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
(if (equal s "[X]") 1. 0.000001))
((memq fmt '(estimate)) (org-string-to-estimate s))
@@ -1215,13 +1239,16 @@ PARAMS is a property list of parameters:
:vlines When t, make each column a colgroup to enforce vertical lines.
:maxlevel When set to a number, don't capture headlines below this level.
:skip-empty-rows
- When t, skip rows where all specifiers other than ITEM are empty."
+ When t, skip rows where all specifiers other than ITEM are empty.
+:format When non-nil, specify the column view format to use."
(let ((pos (move-marker (make-marker) (point)))
(hlines (plist-get params :hlines))
(vlines (plist-get params :vlines))
(maxlevel (plist-get params :maxlevel))
(content-lines (org-split-string (plist-get params :content) "\n"))
(skip-empty-rows (plist-get params :skip-empty-rows))
+ (columns-fmt (plist-get params :format))
+ (case-fold-search t)
tbl id idpos nfields tmp recalc line
id-as-string view-file view-pos)
(when (setq id (plist-get params :id))
@@ -1250,7 +1277,7 @@ PARAMS is a property list of parameters:
(save-restriction
(widen)
(goto-char (or view-pos (point)))
- (org-columns)
+ (org-columns columns-fmt)
(setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
(setq nfields (length (car tbl)))
(org-columns-quit))))
@@ -1287,7 +1314,7 @@ PARAMS is a property list of parameters:
(while (setq line (pop content-lines))
(when (string-match "^#" line)
(insert "\n" line)
- (when (string-match "^[ \t]*#\\+TBLFM" line)
+ (when (string-match "^[ \t]*#\\+tblfm" line)
(setq recalc t))))
(if recalc
(progn (goto-char pos) (org-table-recalculate 'all))
@@ -1337,12 +1364,11 @@ and tailing newline characters."
(org-columns-remove-overlays)
(move-marker org-columns-begin-marker (point))
(let ((org-columns-time (time-to-number-of-days (current-time)))
- cache maxwidths m p a d fmt)
+ cache maxwidths m p a d fmt)
(cond
((and (boundp 'org-agenda-overriding-columns-format)
org-agenda-overriding-columns-format)
- (setq fmt org-agenda-overriding-columns-format)
- (org-set-local 'org-agenda-overriding-columns-format fmt))
+ (setq fmt org-agenda-overriding-columns-format))
((setq m (org-get-at-bol 'org-hd-marker))
(setq fmt (or (org-entry-get m "COLUMNS" t)
(with-current-buffer (marker-buffer m)
@@ -1370,7 +1396,7 @@ and tailing newline characters."
(setq p (org-entry-properties m))
(when (or (not (setq a (assoc org-effort-property p)))
- (not (string-match "\\S-" (or (cdr a) ""))))
+ (not (string-match "\\S-" (or (cdr a) ""))))
;; OK, the property is not defined. Use appointment duration?
(when (and org-agenda-columns-add-appointments-to-effort-sum
(setq d (get-text-property (point) 'duration)))
@@ -1397,8 +1423,9 @@ and tailing newline characters."
"Summarize the summarizable columns in column view in the agenda.
This will add overlays to the date lines, to show the summary for each day."
(let* ((fmt (mapcar (lambda (x)
- (if (equal (car x) "CLOCKSUM")
- (list "CLOCKSUM" (nth 1 x) (nth 2 x) ":" 'add_times
+ (if (string-match "CLOCKSUM.*" (car x))
+ (list (match-string 0 (car x))
+ (nth 1 x) (nth 2 x) ":" 'add_times
nil '+ nil)
x))
org-columns-current-fmt-compiled))
@@ -1485,23 +1512,25 @@ This will add overlays to the date lines, to show the summary for each day."
(goto-char (point-min))
(org-columns-get-format-and-top-level)
(while (setq fm (pop fmt))
- (if (equal (car fm) "CLOCKSUM")
- (org-clock-sum)
- (when (and (nth 4 fm)
- (setq a (assoc (car fm)
- org-columns-current-fmt-compiled))
- (equal (nth 4 a) (nth 4 fm)))
- (org-columns-compute (car fm)))))))))))
+ (cond ((equal (car fm) "CLOCKSUM")
+ (org-clock-sum))
+ ((equal (car fm) "CLOCKSUM_T")
+ (org-clock-sum-today))
+ ((and (nth 4 fm)
+ (setq a (assoc (car fm)
+ org-columns-current-fmt-compiled))
+ (equal (nth 4 a) (nth 4 fm)))
+ (org-columns-compute (car fm)))))))))))
(defun org-format-time-period (interval)
"Convert time in fractional days to days/hours/minutes/seconds."
(if (numberp interval)
- (let* ((days (floor interval))
- (frac-hours (* 24 (- interval days)))
- (hours (floor frac-hours))
- (minutes (floor (* 60 (- frac-hours hours))))
- (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes)))))
- (format "%dd %02dh %02dm %02ds" days hours minutes seconds))
+ (let* ((days (floor interval))
+ (frac-hours (* 24 (- interval days)))
+ (hours (floor frac-hours))
+ (minutes (floor (* 60 (- frac-hours hours))))
+ (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes)))))
+ (format "%dd %02dh %02dm %02ds" days hours minutes seconds))
""))
(defun org-estimate-mean-and-var (v)
@@ -1519,10 +1548,10 @@ and variances (respectively) of the individual estimates."
(let ((mean 0)
(var 0))
(mapc (lambda (e)
- (let ((stats (org-estimate-mean-and-var e)))
- (setq mean (+ mean (car stats)))
- (setq var (+ var (cadr stats)))))
- el)
+ (let ((stats (org-estimate-mean-and-var e)))
+ (setq mean (+ mean (car stats)))
+ (setq var (+ var (cadr stats)))))
+ el)
(let ((stdev (sqrt var)))
(list (- mean stdev) (+ mean stdev)))))
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index ce72e25d991..76042849663 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -34,7 +34,6 @@
(require 'org-macs)
-(declare-function find-library-name "find-func" (library))
(declare-function w32-focus-frame "term/w32-win" (frame))
;; The following constant is for backward compatibility. We do not use
@@ -111,6 +110,7 @@ any other entries, and any resulting duplicates will be removed entirely."
t))
t)))
+
;;;; Emacs/XEmacs compatibility
;; Keys
@@ -326,20 +326,8 @@ Works on both Emacs and XEmacs."
string)
(apply 'propertize string properties)))
-(defun org-substring-no-properties (string &optional from to)
- (if (featurep 'xemacs)
- (org-no-properties (substring string (or from 0) to))
- (substring-no-properties string from to)))
-
-(defun org-find-library-name (library)
- (if (fboundp 'find-library-name)
- (file-name-directory (find-library-name library))
- ; XEmacs does not have `find-library-name'
- (flet ((find-library-name-helper (filename ignored-codesys)
- filename)
- (find-library-name (library)
- (find-library library nil 'find-library-name-helper)))
- (file-name-directory (find-library-name library)))))
+(defmacro org-find-library-dir (library)
+ `(file-name-directory (locate-library ,library)))
(defun org-count-lines (s)
"How many lines in string S?"
@@ -396,7 +384,7 @@ TIME defaults to the current time."
(save-match-data
(apply 'looking-at args))))
-; XEmacs does not have `looking-back'.
+ ; XEmacs does not have `looking-back'.
(if (fboundp 'looking-back)
(defalias 'org-looking-back 'looking-back)
(defun org-looking-back (regexp &optional limit greedy)
@@ -436,7 +424,7 @@ With two arguments, return floor and remainder of their quotient."
(let ((q (floor x y)))
(list q (- x (if y (* y q) q)))))
-;; `pop-to-buffer-same-window' has been introduced with Emacs 24.1.
+;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1.
(defun org-pop-to-buffer-same-window
(&optional buffer-or-name norecord label)
"Pop to buffer specified by BUFFER-OR-NAME in the selected window."
@@ -445,6 +433,33 @@ With two arguments, return floor and remainder of their quotient."
'pop-to-buffer-same-window buffer-or-name norecord)
(funcall 'switch-to-buffer buffer-or-name norecord)))
+;; `condition-case-unless-debug' has been introduced in Emacs 24.1
+;; `condition-case-no-debug' has been introduced in Emacs 23.1
+(defalias 'org-condition-case-unless-debug
+ (or (and (fboundp 'condition-case-unless-debug)
+ 'condition-case-unless-debug)
+ (and (fboundp 'condition-case-no-debug)
+ 'condition-case-no-debug)
+ 'condition-case))
+
+;;;###autoload
+(defmacro org-check-version ()
+ "Try very hard to provide sensible version strings."
+ (let* ((org-dir (org-find-library-dir "org"))
+ (org-version.el (concat org-dir "org-version.el"))
+ (org-fixup.el (concat org-dir "../mk/org-fixup.el")))
+ (if (require 'org-version org-version.el 'noerror)
+ '(progn
+ (autoload 'org-release "org-version.el")
+ (autoload 'org-git-version "org-version.el"))
+ (if (require 'org-fixup org-fixup.el 'noerror)
+ '(org-fixup)
+ ;; provide fallback definitions and complain
+ (warn "Could not define org version correctly. Check installation!")
+ '(progn
+ (defun org-release () "N/A")
+ (defun org-git-version () "N/A !!check installation!!"))))))
+
(provide 'org-compat)
;;; org-compat.el ends here
diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el
index c613ba20e48..a187d2facfe 100644
--- a/lisp/org/org-crypt.el
+++ b/lisp/org/org-crypt.el
@@ -75,7 +75,7 @@
(context plain recipients &optional sign always-trust))
(defgroup org-crypt nil
- "Org Crypt"
+ "Org Crypt."
:tag "Org Crypt"
:group 'org)
@@ -111,6 +111,7 @@ nil : Leave auto-save-mode enabled.
NOTE: This only works for entries which have a tag
that matches `org-crypt-tag-matcher'."
:group 'org-crypt
+ :version "24.1"
:type '(choice (const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "Ask" ask)
@@ -129,13 +130,13 @@ See `org-crypt-disable-auto-save'."
(eq org-crypt-disable-auto-save t)
(and
(eq org-crypt-disable-auto-save 'ask)
- (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? ")))
+ (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? ")))
(message (concat "org-decrypt: Disabling auto-save-mode for " (or (buffer-file-name) (current-buffer))))
- ; The argument to auto-save-mode has to be "-1", since
- ; giving a "nil" argument toggles instead of disabling.
+ ; The argument to auto-save-mode has to be "-1", since
+ ; giving a "nil" argument toggles instead of disabling.
(auto-save-mode -1))
((eq org-crypt-disable-auto-save nil)
- (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage."))
+ (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage."))
((eq org-crypt-disable-auto-save 'encrypt)
(message "org-decrypt: Enabling re-encryption on auto-save.")
(add-hook 'auto-save-hook
@@ -221,7 +222,7 @@ See `org-crypt-disable-auto-save'."
;; outline property starts at the \n of the heading.
(delete-region (1- (point)) end)
;; Store a checksum of the decrypted and the encrypted
- ;; text value. This allow to reuse the same encrypted text
+ ;; text value. This allow to reuse the same encrypted text
;; if the text does not change, and therefore avoid a
;; re-encryption process.
(insert "\n" (propertize decrypted-text
@@ -251,6 +252,14 @@ See `org-crypt-disable-auto-save'."
(cdr (org-make-tags-matcher org-crypt-tag-matcher))
todo-only)))
+(defun org-at-encrypted-entry-p ()
+ "Is the current entry encrypted?"
+ (unless (org-before-first-heading-p)
+ (save-excursion
+ (org-back-to-heading t)
+ (search-forward "-----BEGIN PGP MESSAGE-----"
+ (save-excursion (org-end-of-subtree t)) t))))
+
(defun org-crypt-use-before-save-magic ()
"Add a hook to automatically encrypt entries before a file is saved to disk."
(add-hook
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index 48656190a0c..a951cf99648 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -26,18 +26,18 @@
;; Synopsis
;; ========
;;
-;; Allows org-mode to make use of the Emacs `etags' system. Defines tag
+;; Allows org-mode to make use of the Emacs `etags' system. Defines tag
;; destinations in org-mode files as any text between <<double angled
;; brackets>>. This allows the tags-generation program `exuberant ctags' to
;; parse these files and create tag tables that record where these
-;; destinations are found. Plain [[links]] in org mode files which do not have
+;; destinations are found. Plain [[links]] in org mode files which do not have
;; <<matching destinations>> within the same file will then be interpreted as
;; links to these 'tagged' destinations, allowing seamless navigation between
-;; multiple org-mode files. Topics can be created in any org mode file and
-;; will always be found by plain links from other files. Other file types
+;; multiple org-mode files. Topics can be created in any org mode file and
+;; will always be found by plain links from other files. Other file types
;; recognized by ctags (source code files, latex files, etc) will also be
;; available as destinations for plain links, and similarly, org-mode links
-;; will be available as tags from source files. Finally, the function
+;; will be available as tags from source files. Finally, the function
;; `org-ctags-find-tag-interactive' lets you choose any known tag, using
;; autocompletion, and quickly jump to it.
;;
@@ -82,25 +82,25 @@
;; =====
;;
;; When you click on a link "[[foo]]" and org cannot find a matching "<<foo>>"
-;; in the current buffer, the tags facility will take over. The file TAGS in
+;; in the current buffer, the tags facility will take over. The file TAGS in
;; the active directory is examined to see if the tags facility knows about
-;; "<<foo>>" in any other files. If it does, the matching file will be opened
+;; "<<foo>>" in any other files. If it does, the matching file will be opened
;; and the cursor will jump to the position of "<<foo>>" in that file.
;;
;; User-visible functions:
;; - `org-ctags-find-tag-interactive': type a tag (plain link) name and visit
-;; it. With autocompletion. Bound to ctrl-O in the above setup.
-;; - All the etags functions should work. These include:
+;; it. With autocompletion. Bound to ctrl-O in the above setup.
+;; - All the etags functions should work. These include:
;;
;; M-. `find-tag' -- finds the tag at point
;;
;; C-M-. find-tag based on regular expression
;;
;; M-x tags-search RET -- like C-M-. but searches through ENTIRE TEXT
-;; of ALL the files referenced in the TAGS file. A quick way to
+;; of ALL the files referenced in the TAGS file. A quick way to
;; search through an entire 'project'.
;;
-;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'.
+;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'.
;; You may need to bind this key yourself with (eg)
;; (global-set-key (kbd "<M-kp-multiply>") 'pop-tag-mark)
;;
@@ -116,8 +116,8 @@
;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file.
;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in
;; your `org-open-link-functions' list, as is done in the setup
-;; above. This will cause the TAGS file to be rebuilt whenever a link
-;; cannot be found. This may be slow with large file collections however.
+;; above. This will cause the TAGS file to be rebuilt whenever a link
+;; cannot be found. This may be slow with large file collections however.
;; 3. You run the following from the command line (all 1 line):
;;
;; ctags --langdef=orgmode --langmap=orgmode:.org
@@ -126,7 +126,7 @@
;;
;; If you are paranoid, you might want to run (org-ctags-create-tags
;; "/path/to/org/files") at startup, by including the following toplevel form
-;; in .emacs. However this can cause a pause of several seconds if ctags has
+;; in .emacs. However this can cause a pause of several seconds if ctags has
;; to scan lots of files.
;;
;; (progn
@@ -193,6 +193,7 @@ Created as a local variable in each buffer.")
The following patterns are replaced in the string:
`%t' - replaced with the capitalized title of the hyperlink"
:group 'org-ctags
+ :version "24.1"
:type 'string)
@@ -247,7 +248,7 @@ buffer position where the tag is found."
((re-search-backward " \n\\(.*\\),[0-9]+\n")
(list (match-string 1) line pos))
(t ; can't find a file name preceding the matched
- ; tag??
+ ; tag??
(error "Malformed TAGS file: %s" (buffer-name))))))
(t ; tag not found
nil))))))
@@ -308,7 +309,7 @@ The new topic will be titled NAME (or TITLE if supplied)."
activate compile)
"Before trying to find a tag, save our current position on org mark ring."
(save-excursion
- (if (and (eq major-mode 'org-mode) org-ctags-enabled-p)
+ (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p)
(org-mark-ring-push))))
@@ -411,7 +412,7 @@ asked before creating a new file."
(defun org-ctags-append-topic (name &optional narrowp)
"This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
-Append a new toplevel heading to the end of the current buffer. The
+Append a new toplevel heading to the end of the current buffer. The
heading contains NAME surrounded by <<angular brackets>>, thus making
the heading a destination for the tag `NAME'."
(interactive "sTopic: ")
@@ -456,12 +457,12 @@ to rebuild (update) the TAGS file."
"This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
Wrapper for org-ctags-rebuild-tags-file-then-find-tag."
(if (and (buffer-file-name)
- (y-or-n-p
- (format
- "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?"
- name
- (file-name-directory (buffer-file-name)))))
- (org-ctags-rebuild-tags-file-then-find-tag name)
+ (y-or-n-p
+ (format
+ "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?"
+ name
+ (file-name-directory (buffer-file-name)))))
+ (org-ctags-rebuild-tags-file-then-find-tag name)
nil))
@@ -533,7 +534,7 @@ a new topic."
(t
;; New tag
(run-hook-with-args-until-success
- 'org-open-link-functions tag))))))
+ 'org-open-link-functions tag))))))
(org-ctags-enable)
diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el
index 192d1d6e6df..4ff8e7d00d0 100644
--- a/lisp/org/org-datetree.el
+++ b/lisp/org/org-datetree.el
@@ -38,6 +38,15 @@ This is normally one, but if the buffer has an entry with a DATE_TREE
property (any value), the date tree will become a subtree under that entry,
so the base level will be properly adjusted.")
+(defcustom org-datetree-add-timestamp nil
+ "When non-nil, add a time stamp when create a datetree entry."
+ :group 'org-capture
+ :version "24.3"
+ :type '(choice
+ (const :tag "Do not add a time stamp" nil)
+ (const :tag "Add an inactive time stamp" inactive)
+ (const :tag "Add an active time stamp" active)))
+
;;;###autoload
(defun org-datetree-find-date-create (date &optional keep-restriction)
"Find or create an entry for DATE.
@@ -63,7 +72,7 @@ tree can be found."
(goto-char (prog1 (point) (widen))))))
(defun org-datetree-find-year-create (year)
- (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)$")
+ (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)\\s-*$")
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
@@ -119,7 +128,7 @@ tree can be found."
(org-datetree-insert-line year month day)))))
(defun org-datetree-insert-line (year &optional month day)
- (let ((pos (point)))
+ (let ((pos (point)) ts-type)
(skip-chars-backward " \t\n")
(delete-region (point) pos)
(insert "\n" (make-string org-datetree-base-level ?*) " \n")
@@ -136,6 +145,10 @@ tree can be found."
(insert (format " %s"
(format-time-string
"%B" (encode-time 0 0 0 1 month year))))))
+ (when (and day (setq ts-type org-datetree-add-timestamp))
+ (insert "\n")
+ (org-indent-line)
+ (org-insert-time-stamp (encode-time 0 0 0 day month year) nil ts-type))
(beginning-of-line 1)))
(defun org-datetree-file-entry-under (txt date)
@@ -155,42 +168,42 @@ before running this command, even though the command tries to be smart."
(let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'"))
(sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'"))
dct ts tmp date year month day pos hdl-pos)
- (while (re-search-forward org-ts-regexp nil t)
- (catch 'next
- (setq ts (match-string 0))
- (setq tmp (buffer-substring
- (max (point-at-bol) (- (match-beginning 0)
- org-ds-keyword-length))
- (match-beginning 0)))
- (if (or (string-match "-\\'" tmp)
- (string-match dre tmp)
- (string-match sre tmp))
+ (while (re-search-forward org-ts-regexp nil t)
+ (catch 'next
+ (setq ts (match-string 0))
+ (setq tmp (buffer-substring
+ (max (point-at-bol) (- (match-beginning 0)
+ org-ds-keyword-length))
+ (match-beginning 0)))
+ (if (or (string-match "-\\'" tmp)
+ (string-match dre tmp)
+ (string-match sre tmp))
+ (throw 'next nil))
+ (setq dct (decode-time (org-time-string-to-time (match-string 0)))
+ date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))
+ year (nth 2 date)
+ month (car date)
+ day (nth 1 date)
+ pos (point))
+ (org-back-to-heading t)
+ (setq hdl-pos (point))
+ (unless (org-up-heading-safe)
+ ;; No parent, we are not in a date tree
+ (goto-char pos)
+ (throw 'next nil))
+ (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
+ ;; Parent looks wrong, we are not in a date tree
+ (goto-char pos)
(throw 'next nil))
- (setq dct (decode-time (org-time-string-to-time (match-string 0)))
- date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))
- year (nth 2 date)
- month (car date)
- day (nth 1 date)
- pos (point))
- (org-back-to-heading t)
- (setq hdl-pos (point))
- (unless (org-up-heading-safe)
- ;; No parent, we are not in a date tree
- (goto-char pos)
- (throw 'next nil))
- (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
- ;; Parent looks wrong, we are not in a date tree
- (goto-char pos)
- (throw 'next nil))
- (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
- ;; At correct date already, do nothing
+ (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
+ ;; At correct date already, do nothing
(progn (goto-char pos) (throw 'next nil)))
- ;; OK, we need to refile this entry
- (goto-char hdl-pos)
- (org-cut-subtree)
- (save-excursion
- (save-restriction
- (org-datetree-file-entry-under (current-kill 0) date)))))))
+ ;; OK, we need to refile this entry
+ (goto-char hdl-pos)
+ (org-cut-subtree)
+ (save-excursion
+ (save-restriction
+ (org-datetree-file-entry-under (current-kill 0) date)))))))
(provide 'org-datetree)
diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el
index c3fd62c1fe2..22cc5a7cdac 100644
--- a/lisp/org/org-docbook.el
+++ b/lisp/org/org-docbook.el
@@ -163,7 +163,7 @@ avoid same set of footnote IDs being used multiple times."
"A list of DocBook expressions to convert emphasis fontifiers.
Each element of the list is a list of three elements.
The first element is the character used as a marker for fontification.
-The second element is a formatting string to wrap fontified text with.
+The second element is a format string to wrap fontified text with.
The third element decides whether to protect converted text from other
conversions."
:group 'org-export-docbook
@@ -295,7 +295,7 @@ then use this command to convert it."
(interactive "r")
(let (reg docbook buf)
(save-window-excursion
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(setq docbook (org-export-region-as-docbook
beg end t 'string))
(setq reg (buffer-substring beg end)
@@ -629,7 +629,7 @@ publishing directory."
(insert org-export-docbook-doctype))
(insert "<!-- Date: " date " -->\n")
(insert (format "<!-- DocBook XML file generated by Org-mode %s Emacs %s -->\n"
- org-version emacs-major-version))
+ (org-version) emacs-major-version))
(insert org-export-docbook-article-header)
(insert (format
"\n <title>%s</title>
@@ -1018,11 +1018,11 @@ publishing directory."
(t
;; This line either is list item or end a list.
(when (when (get-text-property 0 'list-item line)
- (setq line (org-export-docbook-list-line
- line
- (get-text-property 0 'list-item line)
- (get-text-property 0 'list-struct line)
- (get-text-property 0 'list-prevs line)))))
+ (setq line (org-export-docbook-list-line
+ line
+ (get-text-property 0 'list-item line)
+ (get-text-property 0 'list-struct line)
+ (get-text-property 0 'list-prevs line)))))
;; Empty lines start a new paragraph. If hand-formatted lists
;; are not fully interpreted, lines starting with "-", "+", "*"
@@ -1066,7 +1066,7 @@ publishing directory."
(if (eq major-mode (default-value 'major-mode))
(nxml-mode)))
- ;; Remove empty paragraphs. Replace them with a newline.
+ ;; Remove empty paragraphs. Replace them with a newline.
(goto-char (point-min))
(while (re-search-forward
"[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t)
@@ -1355,10 +1355,10 @@ that need to be preserved in later phase of DocBook exporting."
(concat replaced line)))
(defun org-export-docbook-list-line (line pos struct prevs)
- "Insert list syntax in export buffer. Return LINE, maybe modified.
+ "Insert list syntax in export buffer. Return LINE, maybe modified.
POS is the item position or line position the line had before
-modifications to buffer. STRUCT is the list structure. PREVS is
+modifications to buffer. STRUCT is the list structure. PREVS is
the alist of previous items."
(let* ((get-type
(function
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
new file mode 100644
index 00000000000..8b44d4936f5
--- /dev/null
+++ b/lisp/org/org-element.el
@@ -0,0 +1,4356 @@
+;;; org-element.el --- Parser And Applications for Org syntax
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Org syntax can be divided into three categories: "Greater
+;; elements", "Elements" and "Objects".
+;;
+;; Elements are related to the structure of the document. Indeed, all
+;; elements are a cover for the document: each position within belongs
+;; to at least one element.
+;;
+;; An element always starts and ends at the beginning of a line. With
+;; a few exceptions (namely `babel-call', `clock', `headline', `item',
+;; `keyword', `planning', `property-drawer' and `section' types), it
+;; can also accept a fixed set of keywords as attributes. Those are
+;; called "affiliated keywords" to distinguish them from other
+;; keywords, which are full-fledged elements. Almost all affiliated
+;; keywords are referenced in `org-element-affiliated-keywords'; the
+;; others are export attributes and start with "ATTR_" prefix.
+;;
+;; Element containing other elements (and only elements) are called
+;; greater elements. Concerned types are: `center-block', `drawer',
+;; `dynamic-block', `footnote-definition', `headline', `inlinetask',
+;; `item', `plain-list', `quote-block', `section' and `special-block'.
+;;
+;; Other element types are: `babel-call', `clock', `comment',
+;; `comment-block', `example-block', `export-block', `fixed-width',
+;; `horizontal-rule', `keyword', `latex-environment', `paragraph',
+;; `planning', `property-drawer', `quote-section', `src-block',
+;; `table', `table-row' and `verse-block'. Among them, `paragraph'
+;; and `verse-block' types can contain Org objects and plain text.
+;;
+;; Objects are related to document's contents. Some of them are
+;; recursive. Associated types are of the following: `bold', `code',
+;; `entity', `export-snippet', `footnote-reference',
+;; `inline-babel-call', `inline-src-block', `italic',
+;; `latex-fragment', `line-break', `link', `macro', `radio-target',
+;; `statistics-cookie', `strike-through', `subscript', `superscript',
+;; `table-cell', `target', `timestamp', `underline' and `verbatim'.
+;;
+;; Some elements also have special properties whose value can hold
+;; objects themselves (i.e. an item tag or an headline name). Such
+;; values are called "secondary strings". Any object belongs to
+;; either an element or a secondary string.
+;;
+;; Notwithstanding affiliated keywords, each greater element, element
+;; and object has a fixed set of properties attached to it. Among
+;; them, four are shared by all types: `:begin' and `:end', which
+;; refer to the beginning and ending buffer positions of the
+;; considered element or object, `:post-blank', which holds the number
+;; of blank lines, or white spaces, at its end and `:parent' which
+;; refers to the element or object containing it. Greater elements
+;; and elements containing objects will also have `:contents-begin'
+;; and `:contents-end' properties to delimit contents.
+;;
+;; Lisp-wise, an element or an object can be represented as a list.
+;; It follows the pattern (TYPE PROPERTIES CONTENTS), where:
+;; TYPE is a symbol describing the Org element or object.
+;; PROPERTIES is the property list attached to it. See docstring of
+;; appropriate parsing function to get an exhaustive
+;; list.
+;; CONTENTS is a list of elements, objects or raw strings contained
+;; in the current element or object, when applicable.
+;;
+;; An Org buffer is a nested list of such elements and objects, whose
+;; type is `org-data' and properties is nil.
+;;
+;; The first part of this file defines Org syntax, while the second
+;; one provide accessors and setters functions.
+;;
+;; The next part implements a parser and an interpreter for each
+;; element and object type in Org syntax.
+;;
+;; The following part creates a fully recursive buffer parser. It
+;; also provides a tool to map a function to elements or objects
+;; matching some criteria in the parse tree. Functions of interest
+;; are `org-element-parse-buffer', `org-element-map' and, to a lesser
+;; extent, `org-element-parse-secondary-string'.
+;;
+;; The penultimate part is the cradle of an interpreter for the
+;; obtained parse tree: `org-element-interpret-data'.
+;;
+;; The library ends by furnishing `org-element-at-point' function, and
+;; a way to give information about document structure around point
+;; with `org-element-context'.
+
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'org)
+
+
+;;; Definitions And Rules
+;;
+;; Define elements, greater elements and specify recursive objects,
+;; along with the affiliated keywords recognized. Also set up
+;; restrictions on recursive objects combinations.
+;;
+;; These variables really act as a control center for the parsing
+;; process.
+
+(defconst org-element-paragraph-separate
+ (concat "^\\(?:"
+ ;; Headlines, inlinetasks.
+ org-outline-regexp "\\|"
+ ;; Footnote definitions.
+ "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
+ "[ \t]*\\(?:"
+ ;; Empty lines.
+ "$" "\\|"
+ ;; Tables (any type).
+ "\\(?:|\\|\\+-[-+]\\)" "\\|"
+ ;; Blocks (any type), Babel calls, drawers (any type),
+ ;; fixed-width areas and keywords. Note: this is only an
+ ;; indication and need some thorough check.
+ "[#:]" "\\|"
+ ;; Horizontal rules.
+ "-\\{5,\\}[ \t]*$" "\\|"
+ ;; LaTeX environments.
+ "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|"
+ ;; Planning and Clock lines.
+ (regexp-opt (list org-scheduled-string
+ org-deadline-string
+ org-closed-string
+ org-clock-string))
+ "\\|"
+ ;; Lists.
+ (let ((term (case org-plain-list-ordered-item-terminator
+ (?\) ")") (?. "\\.") (otherwise "[.)]")))
+ (alpha (and org-alphabetical-lists "\\|[A-Za-z]")))
+ (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
+ "\\(?:[ \t]\\|$\\)"))
+ "\\)\\)")
+ "Regexp to separate paragraphs in an Org buffer.
+In the case of lines starting with \"#\" and \":\", this regexp
+is not sufficient to know if point is at a paragraph ending. See
+`org-element-paragraph-parser' for more information.")
+
+(defconst org-element-all-elements
+ '(center-block clock comment comment-block drawer dynamic-block example-block
+ export-block fixed-width footnote-definition headline
+ horizontal-rule inlinetask item keyword latex-environment
+ babel-call paragraph plain-list planning property-drawer
+ quote-block quote-section section special-block src-block table
+ table-row verse-block)
+ "Complete list of element types.")
+
+(defconst org-element-greater-elements
+ '(center-block drawer dynamic-block footnote-definition headline inlinetask
+ item plain-list quote-block section special-block table)
+ "List of recursive element types aka Greater Elements.")
+
+(defconst org-element-all-successors
+ '(export-snippet footnote-reference inline-babel-call inline-src-block
+ latex-or-entity line-break link macro radio-target
+ statistics-cookie sub/superscript table-cell target
+ text-markup timestamp)
+ "Complete list of successors.")
+
+(defconst org-element-object-successor-alist
+ '((subscript . sub/superscript) (superscript . sub/superscript)
+ (bold . text-markup) (code . text-markup) (italic . text-markup)
+ (strike-through . text-markup) (underline . text-markup)
+ (verbatim . text-markup) (entity . latex-or-entity)
+ (latex-fragment . latex-or-entity))
+ "Alist of translations between object type and successor name.
+
+Sharing the same successor comes handy when, for example, the
+regexp matching one object can also match the other object.")
+
+(defconst org-element-all-objects
+ '(bold code entity export-snippet footnote-reference inline-babel-call
+ inline-src-block italic line-break latex-fragment link macro
+ radio-target statistics-cookie strike-through subscript superscript
+ table-cell target timestamp underline verbatim)
+ "Complete list of object types.")
+
+(defconst org-element-recursive-objects
+ '(bold italic link macro subscript radio-target strike-through superscript
+ table-cell underline)
+ "List of recursive object types.")
+
+(defconst org-element-block-name-alist
+ '(("CENTER" . org-element-center-block-parser)
+ ("COMMENT" . org-element-comment-block-parser)
+ ("EXAMPLE" . org-element-example-block-parser)
+ ("QUOTE" . org-element-quote-block-parser)
+ ("SRC" . org-element-src-block-parser)
+ ("VERSE" . org-element-verse-block-parser))
+ "Alist between block names and the associated parsing function.
+Names must be uppercase. Any block whose name has no association
+is parsed with `org-element-special-block-parser'.")
+
+(defconst org-element-affiliated-keywords
+ '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
+ "RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
+ "List of affiliated keywords as strings.
+By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
+are affiliated keywords and need not to be in this list.")
+
+(defconst org-element--affiliated-re
+ (format "[ \t]*#\\+%s:"
+ ;; Regular affiliated keywords.
+ (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?"
+ (regexp-opt org-element-affiliated-keywords)))
+ "Regexp matching any affiliated keyword.
+
+Keyword name is put in match group 1. Moreover, if keyword
+belongs to `org-element-dual-keywords', put the dual value in
+match group 2.
+
+Don't modify it, set `org-element-affiliated-keywords' instead.")
+
+(defconst org-element-keyword-translation-alist
+ '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME")
+ ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME")
+ ("RESULT" . "RESULTS") ("HEADERS" . "HEADER"))
+ "Alist of usual translations for keywords.
+The key is the old name and the value the new one. The property
+holding their value will be named after the translated name.")
+
+(defconst org-element-multiple-keywords '("HEADER")
+ "List of affiliated keywords that can occur more that once in an element.
+
+Their value will be consed into a list of strings, which will be
+returned as the value of the property.
+
+This list is checked after translations have been applied. See
+`org-element-keyword-translation-alist'.
+
+By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
+allow multiple occurrences and need not to be in this list.")
+
+(defconst org-element-parsed-keywords '("AUTHOR" "CAPTION" "DATE" "TITLE")
+ "List of keywords whose value can be parsed.
+
+Their value will be stored as a secondary string: a list of
+strings and objects.
+
+This list is checked after translations have been applied. See
+`org-element-keyword-translation-alist'.")
+
+(defconst org-element-dual-keywords '("CAPTION" "RESULTS")
+ "List of keywords which can have a secondary value.
+
+In Org syntax, they can be written with optional square brackets
+before the colons. For example, results keyword can be
+associated to a hash value with the following:
+
+ #+RESULTS[hash-string]: some-source
+
+This list is checked after translations have been applied. See
+`org-element-keyword-translation-alist'.")
+
+(defconst org-element-object-restrictions
+ '((bold export-snippet inline-babel-call inline-src-block latex-or-entity link
+ radio-target sub/superscript target text-markup timestamp)
+ (footnote-reference export-snippet footnote-reference inline-babel-call
+ inline-src-block latex-or-entity line-break link macro
+ radio-target sub/superscript target text-markup
+ timestamp)
+ (headline inline-babel-call inline-src-block latex-or-entity link macro
+ radio-target statistics-cookie sub/superscript target text-markup
+ timestamp)
+ (inlinetask inline-babel-call inline-src-block latex-or-entity link macro
+ radio-target sub/superscript target text-markup timestamp)
+ (italic export-snippet inline-babel-call inline-src-block latex-or-entity
+ link radio-target sub/superscript target text-markup timestamp)
+ (item export-snippet footnote-reference inline-babel-call latex-or-entity
+ link macro radio-target sub/superscript target text-markup)
+ (keyword latex-or-entity macro sub/superscript text-markup)
+ (link export-snippet inline-babel-call inline-src-block latex-or-entity link
+ sub/superscript text-markup)
+ (macro macro)
+ (paragraph export-snippet footnote-reference inline-babel-call
+ inline-src-block latex-or-entity line-break link macro
+ radio-target statistics-cookie sub/superscript target text-markup
+ timestamp)
+ (radio-target export-snippet latex-or-entity sub/superscript)
+ (strike-through export-snippet inline-babel-call inline-src-block
+ latex-or-entity link radio-target sub/superscript target
+ text-markup timestamp)
+ (subscript export-snippet inline-babel-call inline-src-block latex-or-entity
+ sub/superscript target text-markup)
+ (superscript export-snippet inline-babel-call inline-src-block
+ latex-or-entity sub/superscript target text-markup)
+ (table-cell export-snippet latex-or-entity link macro radio-target
+ sub/superscript target text-markup timestamp)
+ (table-row table-cell)
+ (underline export-snippet inline-babel-call inline-src-block latex-or-entity
+ link radio-target sub/superscript target text-markup timestamp)
+ (verse-block footnote-reference inline-babel-call inline-src-block
+ latex-or-entity line-break link macro radio-target
+ sub/superscript target text-markup timestamp))
+ "Alist of objects restrictions.
+
+CAR is an element or object type containing objects and CDR is
+a list of successors that will be called within an element or
+object of such type.
+
+For example, in a `radio-target' object, one can only find
+entities, export snippets, latex-fragments, subscript and
+superscript.
+
+This alist also applies to secondary string. For example, an
+`headline' type element doesn't directly contain objects, but
+still has an entry since one of its properties (`:title') does.")
+
+(defconst org-element-secondary-value-alist
+ '((headline . :title)
+ (inlinetask . :title)
+ (item . :tag)
+ (footnote-reference . :inline-definition))
+ "Alist between element types and location of secondary value.")
+
+
+
+;;; Accessors and Setters
+;;
+;; Provide four accessors: `org-element-type', `org-element-property'
+;; `org-element-contents' and `org-element-restriction'.
+;;
+;; Setter functions allow to modify elements by side effect. There is
+;; `org-element-put-property', `org-element-set-contents',
+;; `org-element-set-element' and `org-element-adopt-element'. Note
+;; that `org-element-set-element' and `org-element-adopt-elements' are
+;; higher level functions since also update `:parent' property.
+
+(defsubst org-element-type (element)
+ "Return type of ELEMENT.
+
+The function returns the type of the element or object provided.
+It can also return the following special value:
+ `plain-text' for a string
+ `org-data' for a complete document
+ nil in any other case."
+ (cond
+ ((not (consp element)) (and (stringp element) 'plain-text))
+ ((symbolp (car element)) (car element))))
+
+(defsubst org-element-property (property element)
+ "Extract the value from the PROPERTY of an ELEMENT."
+ (plist-get (nth 1 element) property))
+
+(defsubst org-element-contents (element)
+ "Extract contents from an ELEMENT."
+ (and (consp element) (nthcdr 2 element)))
+
+(defsubst org-element-restriction (element)
+ "Return restriction associated to ELEMENT.
+ELEMENT can be an element, an object or a symbol representing an
+element or object type."
+ (cdr (assq (if (symbolp element) element (org-element-type element))
+ org-element-object-restrictions)))
+
+(defsubst org-element-put-property (element property value)
+ "In ELEMENT set PROPERTY to VALUE.
+Return modified element."
+ (when (consp element)
+ (setcar (cdr element) (plist-put (nth 1 element) property value)))
+ element)
+
+(defsubst org-element-set-contents (element &rest contents)
+ "Set ELEMENT contents to CONTENTS.
+Return modified element."
+ (cond ((not element) (list contents))
+ ((cdr element) (setcdr (cdr element) contents))
+ (t (nconc element contents))))
+
+(defsubst org-element-set-element (old new)
+ "Replace element or object OLD with element or object NEW.
+The function takes care of setting `:parent' property for NEW."
+ ;; Since OLD is going to be changed into NEW by side-effect, first
+ ;; make sure that every element or object within NEW has OLD as
+ ;; parent.
+ (mapc (lambda (blob) (org-element-put-property blob :parent old))
+ (org-element-contents new))
+ ;; Transfer contents.
+ (apply 'org-element-set-contents old (org-element-contents new))
+ ;; Ensure NEW has same parent as OLD, then overwrite OLD properties
+ ;; with NEW's.
+ (org-element-put-property new :parent (org-element-property :parent old))
+ (setcar (cdr old) (nth 1 new))
+ ;; Transfer type.
+ (setcar old (car new)))
+
+(defsubst org-element-adopt-elements (parent &rest children)
+ "Append elements to the contents of another element.
+
+PARENT is an element or object. CHILDREN can be elements,
+objects, or a strings.
+
+The function takes care of setting `:parent' property for CHILD.
+Return parent element."
+ (if (not parent) children
+ ;; Link every child to PARENT.
+ (mapc (lambda (child)
+ (unless (stringp child)
+ (org-element-put-property child :parent parent)))
+ children)
+ ;; Add CHILDREN at the end of PARENT contents.
+ (apply 'org-element-set-contents
+ parent
+ (nconc (org-element-contents parent) children))
+ ;; Return modified PARENT element.
+ parent))
+
+
+
+;;; Greater elements
+;;
+;; For each greater element type, we define a parser and an
+;; interpreter.
+;;
+;; A parser returns the element or object as the list described above.
+;; Most of them accepts no argument. Though, exceptions exist. Hence
+;; every element containing a secondary string (see
+;; `org-element-secondary-value-alist') will accept an optional
+;; argument to toggle parsing of that secondary string. Moreover,
+;; `item' parser requires current list's structure as its first
+;; element.
+;;
+;; An interpreter accepts two arguments: the list representation of
+;; the element or object, and its contents. The latter may be nil,
+;; depending on the element or object considered. It returns the
+;; appropriate Org syntax, as a string.
+;;
+;; Parsing functions must follow the naming convention:
+;; org-element-TYPE-parser, where TYPE is greater element's type, as
+;; defined in `org-element-greater-elements'.
+;;
+;; Similarly, interpreting functions must follow the naming
+;; convention: org-element-TYPE-interpreter.
+;;
+;; With the exception of `headline' and `item' types, greater elements
+;; cannot contain other greater elements of their own type.
+;;
+;; Beside implementing a parser and an interpreter, adding a new
+;; greater element requires to tweak `org-element--current-element'.
+;; Moreover, the newly defined type must be added to both
+;; `org-element-all-elements' and `org-element-greater-elements'.
+
+
+;;;; Center Block
+
+(defun org-element-center-block-parser (limit)
+ "Parse a center block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `center-block' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the block."
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*#\\+END_CENTER" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((block-end-line (match-beginning 0)))
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ ;; Empty blocks have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point))))
+ (contents-end (and contents-begin block-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point)))
+ (end (save-excursion (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'center-block
+ (nconc
+ (list :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords))))))))
+
+(defun org-element-center-block-interpreter (center-block contents)
+ "Interpret CENTER-BLOCK element as Org syntax.
+CONTENTS is the contents of the element."
+ (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents))
+
+
+;;;; Drawer
+
+(defun org-element-drawer-parser (limit)
+ "Parse a drawer.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `drawer' and CDR is a plist containing
+`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end' and `:post-blank' keywords.
+
+Assume point is at beginning of drawer."
+ (let ((case-fold-search t))
+ (if (not (save-excursion (re-search-forward "^[ \t]*:END:" limit t)))
+ ;; Incomplete drawer: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((drawer-end-line (match-beginning 0)))
+ (save-excursion
+ (let* ((case-fold-search t)
+ (name (progn (looking-at org-drawer-regexp)
+ (org-match-string-no-properties 1)))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ ;; Empty drawers have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) drawer-end-line)
+ (point))))
+ (contents-end (and contents-begin drawer-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char drawer-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'drawer
+ (nconc
+ (list :begin begin
+ :end end
+ :drawer-name name
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-drawer-interpreter (drawer contents)
+ "Interpret DRAWER element as Org syntax.
+CONTENTS is the contents of the element."
+ (format ":%s:\n%s:END:"
+ (org-element-property :drawer-name drawer)
+ contents))
+
+
+;;;; Dynamic Block
+
+(defun org-element-dynamic-block-parser (limit)
+ "Parse a dynamic block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `dynamic-block' and CDR is a plist
+containing `:block-name', `:begin', `:end', `:hiddenp',
+`:contents-begin', `:contents-end', `:arguments' and
+`:post-blank' keywords.
+
+Assume point is at beginning of dynamic block."
+ (let ((case-fold-search t))
+ (if (not (save-excursion (re-search-forward org-dblock-end-re limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((block-end-line (match-beginning 0)))
+ (save-excursion
+ (let* ((name (progn (looking-at org-dblock-start-re)
+ (org-match-string-no-properties 1)))
+ (arguments (org-match-string-no-properties 3))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ ;; Empty blocks have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point))))
+ (contents-end (and contents-begin block-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'dynamic-block
+ (nconc
+ (list :begin begin
+ :end end
+ :block-name name
+ :arguments arguments
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-dynamic-block-interpreter (dynamic-block contents)
+ "Interpret DYNAMIC-BLOCK element as Org syntax.
+CONTENTS is the contents of the element."
+ (format "#+BEGIN: %s%s\n%s#+END:"
+ (org-element-property :block-name dynamic-block)
+ (let ((args (org-element-property :arguments dynamic-block)))
+ (and args (concat " " args)))
+ contents))
+
+
+;;;; Footnote Definition
+
+(defun org-element-footnote-definition-parser (limit)
+ "Parse a footnote definition.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `footnote-definition' and CDR is
+a plist containing `:label', `:begin' `:end', `:contents-begin',
+`:contents-end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the footnote definition."
+ (save-excursion
+ (let* ((label (progn (looking-at org-footnote-definition-re)
+ (org-match-string-no-properties 1)))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (ending (save-excursion
+ (if (progn
+ (end-of-line)
+ (re-search-forward
+ (concat org-outline-regexp-bol "\\|"
+ org-footnote-definition-re "\\|"
+ "^[ \t]*$") limit 'move))
+ (match-beginning 0)
+ (point))))
+ (contents-begin (progn (search-forward "]")
+ (skip-chars-forward " \r\t\n" ending)
+ (and (/= (point) ending) (point))))
+ (contents-end (and contents-begin ending))
+ (end (progn (goto-char ending)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'footnote-definition
+ (nconc
+ (list :label label
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines ending end))
+ (cadr keywords))))))
+
+(defun org-element-footnote-definition-interpreter (footnote-definition contents)
+ "Interpret FOOTNOTE-DEFINITION element as Org syntax.
+CONTENTS is the contents of the footnote-definition."
+ (concat (format "[%s]" (org-element-property :label footnote-definition))
+ " "
+ contents))
+
+
+;;;; Headline
+
+(defun org-element-headline-parser (limit &optional raw-secondary-p)
+ "Parse an headline.
+
+Return a list whose CAR is `headline' and CDR is a plist
+containing `:raw-value', `:title', `:begin', `:end',
+`:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end',
+`:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
+`:scheduled', `:deadline', `:timestamp', `:clock', `:category',
+`:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p'
+keywords.
+
+The plist also contains any property set in the property drawer,
+with its name in lowercase, the underscores replaced with hyphens
+and colons at the beginning (i.e. `:custom-id').
+
+When RAW-SECONDARY-P is non-nil, headline's title will not be
+parsed as a secondary string, but as a plain string instead.
+
+Assume point is at beginning of the headline."
+ (save-excursion
+ (let* ((components (org-heading-components))
+ (level (nth 1 components))
+ (todo (nth 2 components))
+ (todo-type
+ (and todo (if (member todo org-done-keywords) 'done 'todo)))
+ (tags (let ((raw-tags (nth 5 components)))
+ (and raw-tags (org-split-string raw-tags ":"))))
+ (raw-value (or (nth 4 components) ""))
+ (quotedp
+ (let ((case-fold-search nil))
+ (string-match (format "^%s\\( \\|$\\)" org-quote-string)
+ raw-value)))
+ (commentedp
+ (let ((case-fold-search nil))
+ (string-match (format "^%s\\( \\|$\\)" org-comment-string)
+ raw-value)))
+ (archivedp (member org-archive-tag tags))
+ (footnote-section-p (and org-footnote-section
+ (string= org-footnote-section raw-value)))
+ ;; Normalize property names: ":SOME_PROP:" becomes
+ ;; ":some-prop".
+ (standard-props (let (plist)
+ (mapc
+ (lambda (p)
+ (let ((p-name (downcase (car p))))
+ (while (string-match "_" p-name)
+ (setq p-name
+ (replace-match "-" nil nil p-name)))
+ (setq p-name (intern (concat ":" p-name)))
+ (setq plist
+ (plist-put plist p-name (cdr p)))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props (org-entry-properties nil 'special "CLOCK"))
+ (scheduled (cdr (assoc "SCHEDULED" time-props)))
+ (deadline (cdr (assoc "DEADLINE" time-props)))
+ (clock (cdr (assoc "CLOCK" time-props)))
+ (timestamp (cdr (assoc "TIMESTAMP" time-props)))
+ (begin (point))
+ (end (save-excursion (goto-char (org-end-of-subtree t t))))
+ (pos-after-head (progn (forward-line) (point)))
+ (contents-begin (save-excursion
+ (skip-chars-forward " \r\t\n" end)
+ (and (/= (point) end) (line-beginning-position))))
+ (hidden (org-invisible-p2))
+ (contents-end (and contents-begin
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point)))))
+ ;; Clean RAW-VALUE from any quote or comment string.
+ (when (or quotedp commentedp)
+ (let ((case-fold-search nil))
+ (setq raw-value
+ (replace-regexp-in-string
+ (concat
+ (regexp-opt (list org-quote-string org-comment-string))
+ "\\(?: \\|$\\)")
+ ""
+ raw-value))))
+ ;; Clean TAGS from archive tag, if any.
+ (when archivedp (setq tags (delete org-archive-tag tags)))
+ (let ((headline
+ (list 'headline
+ (nconc
+ (list :raw-value raw-value
+ :begin begin
+ :end end
+ :pre-blank
+ (if (not contents-begin) 0
+ (count-lines pos-after-head contents-begin))
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :level level
+ :priority (nth 3 components)
+ :tags tags
+ :todo-keyword todo
+ :todo-type todo-type
+ :scheduled scheduled
+ :deadline deadline
+ :timestamp timestamp
+ :clock clock
+ :post-blank (count-lines
+ (if (not contents-end) pos-after-head
+ (goto-char contents-end)
+ (forward-line)
+ (point))
+ end)
+ :footnote-section-p footnote-section-p
+ :archivedp archivedp
+ :commentedp commentedp
+ :quotedp quotedp)
+ standard-props))))
+ (org-element-put-property
+ headline :title
+ (if raw-secondary-p raw-value
+ (org-element-parse-secondary-string
+ raw-value (org-element-restriction 'headline) headline)))))))
+
+(defun org-element-headline-interpreter (headline contents)
+ "Interpret HEADLINE element as Org syntax.
+CONTENTS is the contents of the element."
+ (let* ((level (org-element-property :level headline))
+ (todo (org-element-property :todo-keyword headline))
+ (priority (org-element-property :priority headline))
+ (title (org-element-interpret-data
+ (org-element-property :title headline)))
+ (tags (let ((tag-list (if (org-element-property :archivedp headline)
+ (cons org-archive-tag
+ (org-element-property :tags headline))
+ (org-element-property :tags headline))))
+ (and tag-list
+ (format ":%s:" (mapconcat 'identity tag-list ":")))))
+ (commentedp (org-element-property :commentedp headline))
+ (quotedp (org-element-property :quotedp headline))
+ (pre-blank (or (org-element-property :pre-blank headline) 0))
+ (heading (concat (make-string level ?*)
+ (and todo (concat " " todo))
+ (and quotedp (concat " " org-quote-string))
+ (and commentedp (concat " " org-comment-string))
+ (and priority
+ (format " [#%s]" (char-to-string priority)))
+ (cond ((and org-footnote-section
+ (org-element-property
+ :footnote-section-p headline))
+ (concat " " org-footnote-section))
+ (title (concat " " title))))))
+ (concat heading
+ ;; Align tags.
+ (when tags
+ (cond
+ ((zerop org-tags-column) (format " %s" tags))
+ ((< org-tags-column 0)
+ (concat
+ (make-string
+ (max (- (+ org-tags-column (length heading) (length tags))) 1)
+ ? )
+ tags))
+ (t
+ (concat
+ (make-string (max (- org-tags-column (length heading)) 1) ? )
+ tags))))
+ (make-string (1+ pre-blank) 10)
+ contents)))
+
+
+;;;; Inlinetask
+
+(defun org-element-inlinetask-parser (limit &optional raw-secondary-p)
+ "Parse an inline task.
+
+Return a list whose CAR is `inlinetask' and CDR is a plist
+containing `:title', `:begin', `:end', `:hiddenp',
+`:contents-begin' and `:contents-end', `:level', `:priority',
+`:raw-value', `:tags', `:todo-keyword', `:todo-type',
+`:scheduled', `:deadline', `:timestamp', `:clock' and
+`:post-blank' keywords.
+
+The plist also contains any property set in the property drawer,
+with its name in lowercase, the underscores replaced with hyphens
+and colons at the beginning (i.e. `:custom-id').
+
+When optional argument RAW-SECONDARY-P is non-nil, inline-task's
+title will not be parsed as a secondary string, but as a plain
+string instead.
+
+Assume point is at beginning of the inline task."
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (components (org-heading-components))
+ (todo (nth 2 components))
+ (todo-type (and todo
+ (if (member todo org-done-keywords) 'done 'todo)))
+ (tags (let ((raw-tags (nth 5 components)))
+ (and raw-tags (org-split-string raw-tags ":"))))
+ (raw-value (or (nth 4 components) ""))
+ ;; Normalize property names: ":SOME_PROP:" becomes
+ ;; ":some-prop".
+ (standard-props (let (plist)
+ (mapc
+ (lambda (p)
+ (let ((p-name (downcase (car p))))
+ (while (string-match "_" p-name)
+ (setq p-name
+ (replace-match "-" nil nil p-name)))
+ (setq p-name (intern (concat ":" p-name)))
+ (setq plist
+ (plist-put plist p-name (cdr p)))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props (org-entry-properties nil 'special "CLOCK"))
+ (scheduled (cdr (assoc "SCHEDULED" time-props)))
+ (deadline (cdr (assoc "DEADLINE" time-props)))
+ (clock (cdr (assoc "CLOCK" time-props)))
+ (timestamp (cdr (assoc "TIMESTAMP" time-props)))
+ (task-end (save-excursion
+ (end-of-line)
+ (and (re-search-forward "^\\*+ END" limit t)
+ (match-beginning 0))))
+ (contents-begin (progn (forward-line)
+ (and task-end (< (point) task-end) (point))))
+ (hidden (and contents-begin (org-invisible-p2)))
+ (contents-end (and contents-begin task-end))
+ (before-blank (if (not task-end) (point)
+ (goto-char task-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol))))
+ (inlinetask
+ (list 'inlinetask
+ (nconc
+ (list :raw-value raw-value
+ :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :level (nth 1 components)
+ :priority (nth 3 components)
+ :tags tags
+ :todo-keyword todo
+ :todo-type todo-type
+ :scheduled scheduled
+ :deadline deadline
+ :timestamp timestamp
+ :clock clock
+ :post-blank (count-lines before-blank end))
+ standard-props
+ (cadr keywords)))))
+ (org-element-put-property
+ inlinetask :title
+ (if raw-secondary-p raw-value
+ (org-element-parse-secondary-string
+ raw-value
+ (org-element-restriction 'inlinetask)
+ inlinetask))))))
+
+(defun org-element-inlinetask-interpreter (inlinetask contents)
+ "Interpret INLINETASK element as Org syntax.
+CONTENTS is the contents of inlinetask."
+ (let* ((level (org-element-property :level inlinetask))
+ (todo (org-element-property :todo-keyword inlinetask))
+ (priority (org-element-property :priority inlinetask))
+ (title (org-element-interpret-data
+ (org-element-property :title inlinetask)))
+ (tags (let ((tag-list (org-element-property :tags inlinetask)))
+ (and tag-list
+ (format ":%s:" (mapconcat 'identity tag-list ":")))))
+ (task (concat (make-string level ?*)
+ (and todo (concat " " todo))
+ (and priority
+ (format " [#%s]" (char-to-string priority)))
+ (and title (concat " " title)))))
+ (concat task
+ ;; Align tags.
+ (when tags
+ (cond
+ ((zerop org-tags-column) (format " %s" tags))
+ ((< org-tags-column 0)
+ (concat
+ (make-string
+ (max (- (+ org-tags-column (length task) (length tags))) 1)
+ ? )
+ tags))
+ (t
+ (concat
+ (make-string (max (- org-tags-column (length task)) 1) ? )
+ tags))))
+ ;; Prefer degenerate inlinetasks when there are no
+ ;; contents.
+ (when contents
+ (concat "\n"
+ contents
+ (make-string level ?*) " END")))))
+
+
+;;;; Item
+
+(defun org-element-item-parser (limit struct &optional raw-secondary-p)
+ "Parse an item.
+
+STRUCT is the structure of the plain list.
+
+Return a list whose CAR is `item' and CDR is a plist containing
+`:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
+`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and
+`:post-blank' keywords.
+
+When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
+any, will not be parsed as a secondary string, but as a plain
+string instead.
+
+Assume point is at the beginning of the item."
+ (save-excursion
+ (beginning-of-line)
+ (looking-at org-list-full-item-re)
+ (let* ((begin (point))
+ (bullet (org-match-string-no-properties 1))
+ (checkbox (let ((box (org-match-string-no-properties 3)))
+ (cond ((equal "[ ]" box) 'off)
+ ((equal "[X]" box) 'on)
+ ((equal "[-]" box) 'trans))))
+ (counter (let ((c (org-match-string-no-properties 2)))
+ (save-match-data
+ (cond
+ ((not c) nil)
+ ((string-match "[A-Za-z]" c)
+ (- (string-to-char (upcase (match-string 0 c)))
+ 64))
+ ((string-match "[0-9]+" c)
+ (string-to-number (match-string 0 c)))))))
+ (end (save-excursion (goto-char (org-list-get-item-end begin struct))
+ (unless (bolp) (forward-line))
+ (point)))
+ (contents-begin
+ (progn (goto-char
+ ;; Ignore tags in un-ordered lists: they are just
+ ;; a part of item's body.
+ (if (and (match-beginning 4)
+ (save-match-data (string-match "[.)]" bullet)))
+ (match-beginning 4)
+ (match-end 0)))
+ (skip-chars-forward " \r\t\n" limit)
+ ;; If first line isn't empty, contents really start
+ ;; at the text after item's meta-data.
+ (if (= (point-at-bol) begin) (point) (point-at-bol))))
+ (hidden (progn (forward-line)
+ (and (not (= (point) end)) (org-invisible-p2))))
+ (contents-end (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point)))
+ (item
+ (list 'item
+ (list :bullet bullet
+ :begin begin
+ :end end
+ ;; CONTENTS-BEGIN and CONTENTS-END may be
+ ;; mixed up in the case of an empty item
+ ;; separated from the next by a blank line.
+ ;; Thus ensure the former is always the
+ ;; smallest.
+ :contents-begin (min contents-begin contents-end)
+ :contents-end (max contents-begin contents-end)
+ :checkbox checkbox
+ :counter counter
+ :hiddenp hidden
+ :structure struct
+ :post-blank (count-lines contents-end end)))))
+ (org-element-put-property
+ item :tag
+ (let ((raw-tag (org-list-get-tag begin struct)))
+ (and raw-tag
+ (if raw-secondary-p raw-tag
+ (org-element-parse-secondary-string
+ raw-tag (org-element-restriction 'item) item))))))))
+
+(defun org-element-item-interpreter (item contents)
+ "Interpret ITEM element as Org syntax.
+CONTENTS is the contents of the element."
+ (let* ((bullet (org-list-bullet-string (org-element-property :bullet item)))
+ (checkbox (org-element-property :checkbox item))
+ (counter (org-element-property :counter item))
+ (tag (let ((tag (org-element-property :tag item)))
+ (and tag (org-element-interpret-data tag))))
+ ;; Compute indentation.
+ (ind (make-string (length bullet) 32))
+ (item-starts-with-par-p
+ (eq (org-element-type (car (org-element-contents item)))
+ 'paragraph)))
+ ;; Indent contents.
+ (concat
+ bullet
+ (and counter (format "[@%d] " counter))
+ (case checkbox
+ (on "[X] ")
+ (off "[ ] ")
+ (trans "[-] "))
+ (and tag (format "%s :: " tag))
+ (let ((contents (replace-regexp-in-string
+ "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
+ (if item-starts-with-par-p (org-trim contents)
+ (concat "\n" contents))))))
+
+
+;;;; Plain List
+
+(defun org-element-plain-list-parser (limit &optional structure)
+ "Parse a plain list.
+
+Optional argument STRUCTURE, when non-nil, is the structure of
+the plain list being parsed.
+
+Return a list whose CAR is `plain-list' and CDR is a plist
+containing `:type', `:begin', `:end', `:contents-begin' and
+`:contents-end', `:structure' and `:post-blank' keywords.
+
+Assume point is at the beginning of the list."
+ (save-excursion
+ (let* ((struct (or structure (org-list-struct)))
+ (prevs (org-list-prevs-alist struct))
+ (parents (org-list-parents-alist struct))
+ (type (org-list-get-list-type (point) struct prevs))
+ (contents-begin (point))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (contents-end
+ (progn (goto-char (org-list-get-list-end (point) struct prevs))
+ (unless (bolp) (forward-line))
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ ;; Return value.
+ (list 'plain-list
+ (nconc
+ (list :type type
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :structure struct
+ :post-blank (count-lines contents-end end))
+ (cadr keywords))))))
+
+(defun org-element-plain-list-interpreter (plain-list contents)
+ "Interpret PLAIN-LIST element as Org syntax.
+CONTENTS is the contents of the element."
+ (with-temp-buffer
+ (insert contents)
+ (goto-char (point-min))
+ (org-list-repair)
+ (buffer-string)))
+
+
+;;;; Quote Block
+
+(defun org-element-quote-block-parser (limit)
+ "Parse a quote block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `quote-block' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the block."
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*#\\+END_QUOTE" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((block-end-line (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ ;; Empty blocks have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point))))
+ (contents-end (and contents-begin block-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'quote-block
+ (nconc
+ (list :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-quote-block-interpreter (quote-block contents)
+ "Interpret QUOTE-BLOCK element as Org syntax.
+CONTENTS is the contents of the element."
+ (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents))
+
+
+;;;; Section
+
+(defun org-element-section-parser (limit)
+ "Parse a section.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `section' and CDR is a plist
+containing `:begin', `:end', `:contents-begin', `contents-end'
+and `:post-blank' keywords."
+ (save-excursion
+ ;; Beginning of section is the beginning of the first non-blank
+ ;; line after previous headline.
+ (let ((begin (point))
+ (end (progn (org-with-limited-levels (outline-next-heading))
+ (point)))
+ (pos-before-blank (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))
+ (list 'section
+ (list :begin begin
+ :end end
+ :contents-begin begin
+ :contents-end pos-before-blank
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-section-interpreter (section contents)
+ "Interpret SECTION element as Org syntax.
+CONTENTS is the contents of the element."
+ contents)
+
+
+;;;; Special Block
+
+(defun org-element-special-block-parser (limit)
+ "Parse a special block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `special-block' and CDR is a plist
+containing `:type', `:begin', `:end', `:hiddenp',
+`:contents-begin', `:contents-end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the block."
+ (let* ((case-fold-search t)
+ (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(S-+\\)")
+ (upcase (match-string-no-properties 1)))))
+ (if (not (save-excursion
+ (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((block-end-line (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ ;; Empty blocks have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point))))
+ (contents-end (and contents-begin block-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (org-skip-whitespace)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'special-block
+ (nconc
+ (list :type type
+ :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-special-block-interpreter (special-block contents)
+ "Interpret SPECIAL-BLOCK element as Org syntax.
+CONTENTS is the contents of the element."
+ (let ((block-type (org-element-property :type special-block)))
+ (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type)))
+
+
+
+;;; Elements
+;;
+;; For each element, a parser and an interpreter are also defined.
+;; Both follow the same naming convention used for greater elements.
+;;
+;; Also, as for greater elements, adding a new element type is done
+;; through the following steps: implement a parser and an interpreter,
+;; tweak `org-element--current-element' so that it recognizes the new
+;; type and add that new type to `org-element-all-elements'.
+;;
+;; As a special case, when the newly defined type is a block type,
+;; `org-element-block-name-alist' has to be modified accordingly.
+
+
+;;;; Babel Call
+
+(defun org-element-babel-call-parser (limit)
+ "Parse a babel call.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `babel-call' and CDR is a plist
+containing `:begin', `:end', `:info' and `:post-blank' as
+keywords."
+ (save-excursion
+ (let ((case-fold-search t)
+ (info (progn (looking-at org-babel-block-lob-one-liner-regexp)
+ (org-babel-lob-get-info)))
+ (begin (point-at-bol))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'babel-call
+ (list :begin begin
+ :end end
+ :info info
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-babel-call-interpreter (babel-call contents)
+ "Interpret BABEL-CALL element as Org syntax.
+CONTENTS is nil."
+ (let* ((babel-info (org-element-property :info babel-call))
+ (main (car babel-info))
+ (post-options (nth 1 babel-info)))
+ (concat "#+CALL: "
+ (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main
+ ;; Remove redundant square brackets.
+ (replace-match (match-string 1 main) nil nil main))
+ (and post-options (format "[%s]" post-options)))))
+
+
+;;;; Clock
+
+(defun org-element-clock-parser (limit)
+ "Parse a clock.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `clock' and CDR is a plist containing
+`:status', `:value', `:time', `:begin', `:end' and `:post-blank'
+as keywords."
+ (save-excursion
+ (let* ((case-fold-search nil)
+ (begin (point))
+ (value (progn (search-forward org-clock-string (line-end-position) t)
+ (org-skip-whitespace)
+ (looking-at "\\[.*\\]")
+ (org-match-string-no-properties 0)))
+ (time (and (progn (goto-char (match-end 0))
+ (looking-at " +=> +\\(\\S-+\\)[ \t]*$"))
+ (org-match-string-no-properties 1)))
+ (status (if time 'closed 'running))
+ (post-blank (let ((before-blank (progn (forward-line) (point))))
+ (skip-chars-forward " \r\t\n" limit)
+ (unless (eobp) (beginning-of-line))
+ (count-lines before-blank (point))))
+ (end (point)))
+ (list 'clock
+ (list :status status
+ :value value
+ :time time
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-clock-interpreter (clock contents)
+ "Interpret CLOCK element as Org syntax.
+CONTENTS is nil."
+ (concat org-clock-string " "
+ (org-element-property :value clock)
+ (let ((time (org-element-property :time clock)))
+ (and time
+ (concat " => "
+ (apply 'format
+ "%2s:%02s"
+ (org-split-string time ":")))))))
+
+
+;;;; Comment
+
+(defun org-element-comment-parser (limit)
+ "Parse a comment.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `comment' and CDR is a plist
+containing `:begin', `:end', `:value' and `:post-blank'
+keywords.
+
+Assume point is at comment beginning."
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (value (prog2 (looking-at "[ \t]*# ?")
+ (buffer-substring-no-properties
+ (match-end 0) (line-end-position))
+ (forward-line)))
+ (com-end
+ ;; Get comments ending.
+ (progn
+ (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)"))
+ ;; Accumulate lines without leading hash and first
+ ;; whitespace.
+ (setq value
+ (concat value
+ "\n"
+ (buffer-substring-no-properties
+ (match-end 0) (line-end-position))))
+ (forward-line))
+ (point)))
+ (end (progn (goto-char com-end)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'comment
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines com-end end))
+ (cadr keywords))))))
+
+(defun org-element-comment-interpreter (comment contents)
+ "Interpret COMMENT element as Org syntax.
+CONTENTS is nil."
+ (replace-regexp-in-string "^" "# " (org-element-property :value comment)))
+
+
+;;;; Comment Block
+
+(defun org-element-comment-block-parser (limit)
+ "Parse an export block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `comment-block' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:value' and
+`:post-blank' keywords.
+
+Assume point is at comment block beginning."
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*#\\+END_COMMENT" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (contents-begin (progn (forward-line) (point)))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol))))
+ (value (buffer-substring-no-properties
+ contents-begin contents-end)))
+ (list 'comment-block
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :hiddenp hidden
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-comment-block-interpreter (comment-block contents)
+ "Interpret COMMENT-BLOCK element as Org syntax.
+CONTENTS is nil."
+ (format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
+ (org-remove-indentation (org-element-property :value comment-block))))
+
+
+;;;; Example Block
+
+(defun org-element-example-block-parser (limit)
+ "Parse an example block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `example-block' and CDR is a plist
+containing `:begin', `:end', `:number-lines', `:preserve-indent',
+`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
+`:switches', `:value' and `:post-blank' keywords."
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*#\\+END_EXAMPLE" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (let* ((switches
+ (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
+ (org-match-string-no-properties 1)))
+ ;; Switches analysis
+ (number-lines (cond ((not switches) nil)
+ ((string-match "-n\\>" switches) 'new)
+ ((string-match "+n\\>" switches) 'continued)))
+ (preserve-indent (and switches (string-match "-i\\>" switches)))
+ ;; Should labels be retained in (or stripped from) example
+ ;; blocks?
+ (retain-labels
+ (or (not switches)
+ (not (string-match "-r\\>" switches))
+ (and number-lines (string-match "-k\\>" switches))))
+ ;; What should code-references use - labels or
+ ;; line-numbers?
+ (use-labels
+ (or (not switches)
+ (and retain-labels (not (string-match "-k\\>" switches)))))
+ (label-fmt (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches)))
+ ;; Standard block parsing.
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (contents-begin (progn (forward-line) (point)))
+ (hidden (org-invisible-p2))
+ (value (buffer-substring-no-properties contents-begin contents-end))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'example-block
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :switches switches
+ :number-lines number-lines
+ :preserve-indent preserve-indent
+ :retain-labels retain-labels
+ :use-labels use-labels
+ :label-fmt label-fmt
+ :hiddenp hidden
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-example-block-interpreter (example-block contents)
+ "Interpret EXAMPLE-BLOCK element as Org syntax.
+CONTENTS is nil."
+ (let ((switches (org-element-property :switches example-block)))
+ (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
+ (org-remove-indentation
+ (org-element-property :value example-block))
+ "#+END_EXAMPLE")))
+
+
+;;;; Export Block
+
+(defun org-element-export-block-parser (limit)
+ "Parse an export block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `export-block' and CDR is a plist
+containing `:begin', `:end', `:type', `:hiddenp', `:value' and
+`:post-blank' keywords.
+
+Assume point is at export-block beginning."
+ (let* ((case-fold-search t)
+ (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (upcase (org-match-string-no-properties 1)))))
+ (if (not (save-excursion
+ (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (contents-begin (progn (forward-line) (point)))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol))))
+ (value (buffer-substring-no-properties contents-begin
+ contents-end)))
+ (list 'export-block
+ (nconc
+ (list :begin begin
+ :end end
+ :type type
+ :value value
+ :hiddenp hidden
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-export-block-interpreter (export-block contents)
+ "Interpret EXPORT-BLOCK element as Org syntax.
+CONTENTS is nil."
+ (let ((type (org-element-property :type export-block)))
+ (concat (format "#+BEGIN_%s\n" type)
+ (org-element-property :value export-block)
+ (format "#+END_%s" type))))
+
+
+;;;; Fixed-width
+
+(defun org-element-fixed-width-parser (limit)
+ "Parse a fixed-width section.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `fixed-width' and CDR is a plist
+containing `:begin', `:end', `:value' and `:post-blank' keywords.
+
+Assume point is at the beginning of the fixed-width area."
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ value
+ (end-area
+ (progn
+ (while (and (< (point) limit)
+ (looking-at "[ \t]*:\\( \\|$\\)"))
+ ;; Accumulate text without starting colons.
+ (setq value
+ (concat value
+ (buffer-substring-no-properties
+ (match-end 0) (point-at-eol))
+ "\n"))
+ (forward-line))
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'fixed-width
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines end-area end))
+ (cadr keywords))))))
+
+(defun org-element-fixed-width-interpreter (fixed-width contents)
+ "Interpret FIXED-WIDTH element as Org syntax.
+CONTENTS is nil."
+ (replace-regexp-in-string
+ "^" ": " (substring (org-element-property :value fixed-width) 0 -1)))
+
+
+;;;; Horizontal Rule
+
+(defun org-element-horizontal-rule-parser (limit)
+ "Parse an horizontal rule.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `horizontal-rule' and CDR is a plist
+containing `:begin', `:end' and `:post-blank' keywords."
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (post-hr (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'horizontal-rule
+ (nconc
+ (list :begin begin
+ :end end
+ :post-blank (count-lines post-hr end))
+ (cadr keywords))))))
+
+(defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
+ "Interpret HORIZONTAL-RULE element as Org syntax.
+CONTENTS is nil."
+ "-----")
+
+
+;;;; Keyword
+
+(defun org-element-keyword-parser (limit)
+ "Parse a keyword at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `keyword' and CDR is a plist
+containing `:key', `:value', `:begin', `:end' and `:post-blank'
+keywords."
+ (save-excursion
+ (let* ((case-fold-search t)
+ (begin (point))
+ (key (progn (looking-at "[ \t]*#\\+\\(\\S-+\\):")
+ (upcase (org-match-string-no-properties 1))))
+ (value (org-trim (buffer-substring-no-properties
+ (match-end 0) (point-at-eol))))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'keyword
+ (list :key key
+ :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-keyword-interpreter (keyword contents)
+ "Interpret KEYWORD element as Org syntax.
+CONTENTS is nil."
+ (format "#+%s: %s"
+ (org-element-property :key keyword)
+ (org-element-property :value keyword)))
+
+
+;;;; Latex Environment
+
+(defun org-element-latex-environment-parser (limit)
+ "Parse a LaTeX environment.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `latex-environment' and CDR is a plist
+containing `:begin', `:end', `:value' and `:post-blank'
+keywords.
+
+Assume point is at the beginning of the latex environment."
+ (save-excursion
+ (let* ((case-fold-search t)
+ (code-begin (point))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (env (progn (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
+ (regexp-quote (match-string 1))))
+ (code-end
+ (progn (re-search-forward (format "^[ \t]*\\\\end{%s}" env) limit t)
+ (forward-line)
+ (point)))
+ (value (buffer-substring-no-properties code-begin code-end))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'latex-environment
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines code-end end))
+ (cadr keywords))))))
+
+(defun org-element-latex-environment-interpreter (latex-environment contents)
+ "Interpret LATEX-ENVIRONMENT element as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value latex-environment))
+
+
+;;;; Paragraph
+
+(defun org-element-paragraph-parser (limit)
+ "Parse a paragraph.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `paragraph' and CDR is a plist
+containing `:begin', `:end', `:contents-begin' and
+`:contents-end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the paragraph."
+ (save-excursion
+ (let* (;; INNER-PAR-P is non-nil when paragraph is at the
+ ;; beginning of an item or a footnote reference. In that
+ ;; case, we mustn't look for affiliated keywords since they
+ ;; belong to the container.
+ (inner-par-p (not (bolp)))
+ (contents-begin (point))
+ (keywords (unless inner-par-p
+ (org-element--collect-affiliated-keywords)))
+ (begin (if inner-par-p contents-begin (car keywords)))
+ (before-blank
+ (let ((case-fold-search t))
+ (end-of-line)
+ (re-search-forward org-element-paragraph-separate limit 'm)
+ (while (and (/= (point) limit)
+ (cond
+ ;; Skip non-existent or incomplete drawer.
+ ((save-excursion
+ (beginning-of-line)
+ (and (looking-at "[ \t]*:\\S-")
+ (or (not (looking-at org-drawer-regexp))
+ (not (save-excursion
+ (re-search-forward
+ "^[ \t]*:END:" limit t)))))))
+ ;; Stop at comments.
+ ((save-excursion
+ (beginning-of-line)
+ (not (looking-at "[ \t]*#\\S-"))) nil)
+ ;; Skip incomplete dynamic blocks.
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*#\\+BEGIN: "))
+ (not (save-excursion
+ (re-search-forward
+ "^[ \t]*\\+END:" limit t))))
+ ;; Skip incomplete blocks.
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)"))
+ (not (save-excursion
+ (re-search-forward
+ (concat "^[ \t]*#\\+END_"
+ (match-string 1))
+ limit t))))
+ ;; Skip incomplete latex environments.
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}"))
+ (not (save-excursion
+ (re-search-forward
+ (format "^[ \t]*\\\\end{%s}"
+ (match-string 1))
+ limit t))))
+ ;; Skip ill-formed keywords.
+ ((not (save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*#\\+\\S-+:"))))))
+ (re-search-forward org-element-paragraph-separate limit 'm))
+ (if (eobp) (point) (goto-char (line-beginning-position)))))
+ (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'paragraph
+ (nconc
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines before-blank end))
+ (cadr keywords))))))
+
+(defun org-element-paragraph-interpreter (paragraph contents)
+ "Interpret PARAGRAPH element as Org syntax.
+CONTENTS is the contents of the element."
+ contents)
+
+
+;;;; Planning
+
+(defun org-element-planning-parser (limit)
+ "Parse a planning.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `planning' and CDR is a plist
+containing `:closed', `:deadline', `:scheduled', `:begin', `:end'
+and `:post-blank' keywords."
+ (save-excursion
+ (let* ((case-fold-search nil)
+ (begin (point))
+ (post-blank (let ((before-blank (progn (forward-line) (point))))
+ (skip-chars-forward " \r\t\n" limit)
+ (unless (eobp) (beginning-of-line))
+ (count-lines before-blank (point))))
+ (end (point))
+ closed deadline scheduled)
+ (goto-char begin)
+ (while (re-search-forward org-keyword-time-not-clock-regexp
+ (line-end-position) t)
+ (goto-char (match-end 1))
+ (org-skip-whitespace)
+ (let ((time (buffer-substring-no-properties
+ (1+ (point)) (1- (match-end 0))))
+ (keyword (match-string 1)))
+ (cond ((equal keyword org-closed-string) (setq closed time))
+ ((equal keyword org-deadline-string) (setq deadline time))
+ (t (setq scheduled time)))))
+ (list 'planning
+ (list :closed closed
+ :deadline deadline
+ :scheduled scheduled
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-planning-interpreter (planning contents)
+ "Interpret PLANNING element as Org syntax.
+CONTENTS is nil."
+ (mapconcat
+ 'identity
+ (delq nil
+ (list (let ((closed (org-element-property :closed planning)))
+ (when closed (concat org-closed-string " [" closed "]")))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline (concat org-deadline-string " <" deadline ">")))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat org-scheduled-string " <" scheduled ">")))))
+ " "))
+
+
+;;;; Property Drawer
+
+(defun org-element-property-drawer-parser (limit)
+ "Parse a property drawer.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `property-drawer' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end', `:properties' and `:post-blank' keywords.
+
+Assume point is at the beginning of the property drawer."
+ (save-excursion
+ (let ((case-fold-search t)
+ (begin (point))
+ (prop-begin (progn (forward-line) (point)))
+ (hidden (org-invisible-p2))
+ (properties
+ (let (val)
+ (while (not (looking-at "^[ \t]*:END:"))
+ (when (looking-at "[ \t]*:\\([A-Za-z][-_A-Za-z0-9]*\\):")
+ (push (cons (org-match-string-no-properties 1)
+ (org-trim
+ (buffer-substring-no-properties
+ (match-end 0) (point-at-eol))))
+ val))
+ (forward-line))
+ val))
+ (prop-end (progn (re-search-forward "^[ \t]*:END:" limit t)
+ (point-at-bol)))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'property-drawer
+ (list :begin begin
+ :end end
+ :hiddenp hidden
+ :properties properties
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-property-drawer-interpreter (property-drawer contents)
+ "Interpret PROPERTY-DRAWER element as Org syntax.
+CONTENTS is nil."
+ (let ((props (org-element-property :properties property-drawer)))
+ (concat
+ ":PROPERTIES:\n"
+ (mapconcat (lambda (p)
+ (format org-property-format (format ":%s:" (car p)) (cdr p)))
+ (nreverse props) "\n")
+ "\n:END:")))
+
+
+;;;; Quote Section
+
+(defun org-element-quote-section-parser (limit)
+ "Parse a quote section.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `quote-section' and CDR is a plist
+containing `:begin', `:end', `:value' and `:post-blank' keywords.
+
+Assume point is at beginning of the section."
+ (save-excursion
+ (let* ((begin (point))
+ (end (progn (org-with-limited-levels (outline-next-heading))
+ (point)))
+ (pos-before-blank (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point)))
+ (value (buffer-substring-no-properties begin pos-before-blank)))
+ (list 'quote-section
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-quote-section-interpreter (quote-section contents)
+ "Interpret QUOTE-SECTION element as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value quote-section))
+
+
+;;;; Src Block
+
+(defun org-element-src-block-parser (limit)
+ "Parse a src block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `src-block' and CDR is a plist
+containing `:language', `:switches', `:parameters', `:begin',
+`:end', `:hiddenp', `:number-lines', `:retain-labels',
+`:use-labels', `:label-fmt', `:preserve-indent', `:value' and
+`:post-blank' keywords.
+
+Assume point is at the beginning of the block."
+ (let ((case-fold-search t))
+ (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ ;; Get beginning position.
+ (begin (car keywords))
+ ;; Get language as a string.
+ (language
+ (progn
+ (looking-at
+ (concat "^[ \t]*#\\+BEGIN_SRC"
+ "\\(?: +\\(\\S-+\\)\\)?"
+ "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?"
+ "\\(.*\\)[ \t]*$"))
+ (org-match-string-no-properties 1)))
+ ;; Get switches.
+ (switches (org-match-string-no-properties 2))
+ ;; Get parameters.
+ (parameters (org-match-string-no-properties 3))
+ ;; Switches analysis
+ (number-lines (cond ((not switches) nil)
+ ((string-match "-n\\>" switches) 'new)
+ ((string-match "+n\\>" switches) 'continued)))
+ (preserve-indent (and switches (string-match "-i\\>" switches)))
+ (label-fmt (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches)))
+ ;; Should labels be retained in (or stripped from)
+ ;; src blocks?
+ (retain-labels
+ (or (not switches)
+ (not (string-match "-r\\>" switches))
+ (and number-lines (string-match "-k\\>" switches))))
+ ;; What should code-references use - labels or
+ ;; line-numbers?
+ (use-labels
+ (or (not switches)
+ (and retain-labels (not (string-match "-k\\>" switches)))))
+ ;; Get visibility status.
+ (hidden (progn (forward-line) (org-invisible-p2)))
+ ;; Retrieve code.
+ (value (buffer-substring-no-properties (point) contents-end))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ ;; Get position after ending blank lines.
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'src-block
+ (nconc
+ (list :language language
+ :switches (and (org-string-nw-p switches)
+ (org-trim switches))
+ :parameters (and (org-string-nw-p parameters)
+ (org-trim parameters))
+ :begin begin
+ :end end
+ :number-lines number-lines
+ :preserve-indent preserve-indent
+ :retain-labels retain-labels
+ :use-labels use-labels
+ :label-fmt label-fmt
+ :hiddenp hidden
+ :value value
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-src-block-interpreter (src-block contents)
+ "Interpret SRC-BLOCK element as Org syntax.
+CONTENTS is nil."
+ (let ((lang (org-element-property :language src-block))
+ (switches (org-element-property :switches src-block))
+ (params (org-element-property :parameters src-block))
+ (value (let ((val (org-element-property :value src-block)))
+ (cond
+
+ (org-src-preserve-indentation val)
+ ((zerop org-edit-src-content-indentation)
+ (org-remove-indentation val))
+ (t
+ (let ((ind (make-string
+ org-edit-src-content-indentation 32)))
+ (replace-regexp-in-string
+ "\\(^\\)[ \t]*\\S-" ind
+ (org-remove-indentation val) nil nil 1)))))))
+ (concat (format "#+BEGIN_SRC%s\n"
+ (concat (and lang (concat " " lang))
+ (and switches (concat " " switches))
+ (and params (concat " " params))))
+ value
+ "#+END_SRC")))
+
+
+;;;; Table
+
+(defun org-element-table-parser (limit)
+ "Parse a table at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `table' and CDR is a plist containing
+`:begin', `:end', `:tblfm', `:type', `:contents-begin',
+`:contents-end', `:value' and `:post-blank' keywords.
+
+Assume point is at the beginning of the table."
+ (save-excursion
+ (let* ((case-fold-search t)
+ (table-begin (point))
+ (type (if (org-at-table.el-p) 'table.el 'org))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (table-end (goto-char (marker-position (org-table-end t))))
+ (tblfm (let (acc)
+ (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
+ (push (org-match-string-no-properties 1) acc)
+ (forward-line))
+ acc))
+ (pos-before-blank (point))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'table
+ (nconc
+ (list :begin begin
+ :end end
+ :type type
+ :tblfm tblfm
+ ;; Only `org' tables have contents. `table.el' tables
+ ;; use a `:value' property to store raw table as
+ ;; a string.
+ :contents-begin (and (eq type 'org) table-begin)
+ :contents-end (and (eq type 'org) table-end)
+ :value (and (eq type 'table.el)
+ (buffer-substring-no-properties
+ table-begin table-end))
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords))))))
+
+(defun org-element-table-interpreter (table contents)
+ "Interpret TABLE element as Org syntax.
+CONTENTS is nil."
+ (if (eq (org-element-property :type table) 'table.el)
+ (org-remove-indentation (org-element-property :value table))
+ (concat (with-temp-buffer (insert contents)
+ (org-table-align)
+ (buffer-string))
+ (mapconcat (lambda (fm) (concat "#+TBLFM: " fm))
+ (reverse (org-element-property :tblfm table))
+ "\n"))))
+
+
+;;;; Table Row
+
+(defun org-element-table-row-parser (limit)
+ "Parse table row at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `table-row' and CDR is a plist
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:type' and `:post-blank' keywords."
+ (save-excursion
+ (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
+ (begin (point))
+ ;; A table rule has no contents. In that case, ensure
+ ;; CONTENTS-BEGIN matches CONTENTS-END.
+ (contents-begin (and (eq type 'standard)
+ (search-forward "|")
+ (point)))
+ (contents-end (and (eq type 'standard)
+ (progn
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (point))))
+ (end (progn (forward-line) (point))))
+ (list 'table-row
+ (list :type type
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank 0)))))
+
+(defun org-element-table-row-interpreter (table-row contents)
+ "Interpret TABLE-ROW element as Org syntax.
+CONTENTS is the contents of the table row."
+ (if (eq (org-element-property :type table-row) 'rule) "|-"
+ (concat "| " contents)))
+
+
+;;;; Verse Block
+
+(defun org-element-verse-block-parser (limit)
+ "Parse a verse block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `verse-block' and CDR is a plist
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:hiddenp' and `:post-blank' keywords.
+
+Assume point is at beginning of the block."
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*#\\+END_VERSE" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (hidden (progn (forward-line) (org-invisible-p2)))
+ (contents-begin (point))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'verse-block
+ (nconc
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :hiddenp hidden
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-verse-block-interpreter (verse-block contents)
+ "Interpret VERSE-BLOCK element as Org syntax.
+CONTENTS is verse block contents."
+ (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents))
+
+
+
+;;; Objects
+;;
+;; Unlike to elements, interstices can be found between objects.
+;; That's why, along with the parser, successor functions are provided
+;; for each object. Some objects share the same successor (i.e. `code'
+;; and `verbatim' objects).
+;;
+;; A successor must accept a single argument bounding the search. It
+;; will return either a cons cell whose CAR is the object's type, as
+;; a symbol, and CDR the position of its next occurrence, or nil.
+;;
+;; Successors follow the naming convention:
+;; org-element-NAME-successor, where NAME is the name of the
+;; successor, as defined in `org-element-all-successors'.
+;;
+;; Some object types (i.e. `italic') are recursive. Restrictions on
+;; object types they can contain will be specified in
+;; `org-element-object-restrictions'.
+;;
+;; Adding a new type of object is simple. Implement a successor,
+;; a parser, and an interpreter for it, all following the naming
+;; convention. Register type in `org-element-all-objects' and
+;; successor in `org-element-all-successors'. Maybe tweak
+;; restrictions about it, and that's it.
+
+
+;;;; Bold
+
+(defun org-element-bold-parser ()
+ "Parse bold object at point.
+
+Return a list whose CAR is `bold' and CDR is a plist with
+`:begin', `:end', `:contents-begin' and `:contents-end' and
+`:post-blank' keywords.
+
+Assume point is at the first star marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'bold
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-bold-interpreter (bold contents)
+ "Interpret BOLD object as Org syntax.
+CONTENTS is the contents of the object."
+ (format "*%s*" contents))
+
+(defun org-element-text-markup-successor (limit)
+ "Search for the next text-markup object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is a symbol among `bold',
+`italic', `underline', `strike-through', `code' and `verbatim'
+and CDR is beginning position."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (when (re-search-forward org-emph-re limit t)
+ (let ((marker (match-string 3)))
+ (cons (cond
+ ((equal marker "*") 'bold)
+ ((equal marker "/") 'italic)
+ ((equal marker "_") 'underline)
+ ((equal marker "+") 'strike-through)
+ ((equal marker "~") 'code)
+ ((equal marker "=") 'verbatim)
+ (t (error "Unknown marker at %d" (match-beginning 3))))
+ (match-beginning 2))))))
+
+
+;;;; Code
+
+(defun org-element-code-parser ()
+ "Parse code object at point.
+
+Return a list whose CAR is `code' and CDR is a plist with
+`:value', `:begin', `:end' and `:post-blank' keywords.
+
+Assume point is at the first tilde marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (value (org-match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'code
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-code-interpreter (code contents)
+ "Interpret CODE object as Org syntax.
+CONTENTS is nil."
+ (format "~%s~" (org-element-property :value code)))
+
+
+;;;; Entity
+
+(defun org-element-entity-parser ()
+ "Parse entity at point.
+
+Return a list whose CAR is `entity' and CDR a plist with
+`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1',
+`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
+keywords.
+
+Assume point is at the beginning of the entity."
+ (save-excursion
+ (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
+ (let* ((value (org-entity-get (match-string 1)))
+ (begin (match-beginning 0))
+ (bracketsp (string= (match-string 2) "{}"))
+ (post-blank (progn (goto-char (match-end 1))
+ (when bracketsp (forward-char 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'entity
+ (list :name (car value)
+ :latex (nth 1 value)
+ :latex-math-p (nth 2 value)
+ :html (nth 3 value)
+ :ascii (nth 4 value)
+ :latin1 (nth 5 value)
+ :utf-8 (nth 6 value)
+ :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :post-blank post-blank)))))
+
+(defun org-element-entity-interpreter (entity contents)
+ "Interpret ENTITY object as Org syntax.
+CONTENTS is nil."
+ (concat "\\"
+ (org-element-property :name entity)
+ (when (org-element-property :use-brackets-p entity) "{}")))
+
+(defun org-element-latex-or-entity-successor (limit)
+ "Search for the next latex-fragment or entity object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `entity' or
+`latex-fragment' and CDR is beginning position."
+ (save-excursion
+ (let ((matchers
+ (remove "begin" (plist-get org-format-latex-options :matchers)))
+ ;; ENTITY-RE matches both LaTeX commands and Org entities.
+ (entity-re
+ "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
+ (when (re-search-forward
+ (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
+ matchers "\\|")
+ "\\|" entity-re)
+ limit t)
+ (goto-char (match-beginning 0))
+ (if (looking-at entity-re)
+ ;; Determine if it's a real entity or a LaTeX command.
+ (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment)
+ (match-beginning 0))
+ ;; No entity nor command: point is at a LaTeX fragment.
+ ;; Determine its type to get the correct beginning position.
+ (cons 'latex-fragment
+ (catch 'return
+ (mapc (lambda (e)
+ (when (looking-at (nth 1 (assoc e org-latex-regexps)))
+ (throw 'return
+ (match-beginning
+ (nth 2 (assoc e org-latex-regexps))))))
+ matchers)
+ (point))))))))
+
+
+;;;; Export Snippet
+
+(defun org-element-export-snippet-parser ()
+ "Parse export snippet at point.
+
+Return a list whose CAR is `export-snippet' and CDR a plist with
+`:begin', `:end', `:back-end', `:value' and `:post-blank' as
+keywords.
+
+Assume point is at the beginning of the snippet."
+ (save-excursion
+ (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t)
+ (let* ((begin (match-beginning 0))
+ (back-end (org-match-string-no-properties 1))
+ (value (buffer-substring-no-properties
+ (point)
+ (progn (re-search-forward "@@" nil t) (match-beginning 0))))
+ (post-blank (skip-chars-forward " \t"))
+ (end (point)))
+ (list 'export-snippet
+ (list :back-end back-end
+ :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-export-snippet-interpreter (export-snippet contents)
+ "Interpret EXPORT-SNIPPET object as Org syntax.
+CONTENTS is nil."
+ (format "@@%s:%s@@"
+ (org-element-property :back-end export-snippet)
+ (org-element-property :value export-snippet)))
+
+(defun org-element-export-snippet-successor (limit)
+ "Search for the next export-snippet object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `export-snippet' and CDR
+its beginning position."
+ (save-excursion
+ (let (beg)
+ (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t)
+ (setq beg (match-beginning 0))
+ (search-forward "@@" limit t))
+ (cons 'export-snippet beg)))))
+
+
+;;;; Footnote Reference
+
+(defun org-element-footnote-reference-parser ()
+ "Parse footnote reference at point.
+
+Return a list whose CAR is `footnote-reference' and CDR a plist
+with `:label', `:type', `:inline-definition', `:begin', `:end'
+and `:post-blank' as keywords."
+ (save-excursion
+ (looking-at org-footnote-re)
+ (let* ((begin (point))
+ (label (or (org-match-string-no-properties 2)
+ (org-match-string-no-properties 3)
+ (and (match-string 1)
+ (concat "fn:" (org-match-string-no-properties 1)))))
+ (type (if (or (not label) (match-string 1)) 'inline 'standard))
+ (inner-begin (match-end 0))
+ (inner-end
+ (let ((count 1))
+ (forward-char)
+ (while (and (> count 0) (re-search-forward "[][]" nil t))
+ (if (equal (match-string 0) "[") (incf count) (decf count)))
+ (1- (point))))
+ (post-blank (progn (goto-char (1+ inner-end))
+ (skip-chars-forward " \t")))
+ (end (point))
+ (footnote-reference
+ (list 'footnote-reference
+ (list :label label
+ :type type
+ :begin begin
+ :end end
+ :post-blank post-blank))))
+ (org-element-put-property
+ footnote-reference :inline-definition
+ (and (eq type 'inline)
+ (org-element-parse-secondary-string
+ (buffer-substring inner-begin inner-end)
+ (org-element-restriction 'footnote-reference)
+ footnote-reference))))))
+
+(defun org-element-footnote-reference-interpreter (footnote-reference contents)
+ "Interpret FOOTNOTE-REFERENCE object as Org syntax.
+CONTENTS is nil."
+ (let ((label (or (org-element-property :label footnote-reference) "fn:"))
+ (def
+ (let ((inline-def
+ (org-element-property :inline-definition footnote-reference)))
+ (if (not inline-def) ""
+ (concat ":" (org-element-interpret-data inline-def))))))
+ (format "[%s]" (concat label def))))
+
+(defun org-element-footnote-reference-successor (limit)
+ "Search for the next footnote-reference object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `footnote-reference' and
+CDR is beginning position."
+ (save-excursion
+ (catch 'exit
+ (while (re-search-forward org-footnote-re limit t)
+ (save-excursion
+ (let ((beg (match-beginning 0))
+ (count 1))
+ (backward-char)
+ (while (re-search-forward "[][]" limit t)
+ (if (equal (match-string 0) "[") (incf count) (decf count))
+ (when (zerop count)
+ (throw 'exit (cons 'footnote-reference beg))))))))))
+
+
+;;;; Inline Babel Call
+
+(defun org-element-inline-babel-call-parser ()
+ "Parse inline babel call at point.
+
+Return a list whose CAR is `inline-babel-call' and CDR a plist
+with `:begin', `:end', `:info' and `:post-blank' as keywords.
+
+Assume point is at the beginning of the babel call."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (looking-at org-babel-inline-lob-one-liner-regexp)
+ (let ((info (save-match-data (org-babel-lob-get-info)))
+ (begin (match-end 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'inline-babel-call
+ (list :begin begin
+ :end end
+ :info info
+ :post-blank post-blank)))))
+
+(defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
+ "Interpret INLINE-BABEL-CALL object as Org syntax.
+CONTENTS is nil."
+ (let* ((babel-info (org-element-property :info inline-babel-call))
+ (main-source (car babel-info))
+ (post-options (nth 1 babel-info)))
+ (concat "call_"
+ (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source)
+ ;; Remove redundant square brackets.
+ (replace-match
+ (match-string 1 main-source) nil nil main-source)
+ main-source)
+ (and post-options (format "[%s]" post-options)))))
+
+(defun org-element-inline-babel-call-successor (limit)
+ "Search for the next inline-babel-call object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `inline-babel-call' and
+CDR is beginning position."
+ (save-excursion
+ ;; Use a simplified version of
+ ;; `org-babel-inline-lob-one-liner-regexp'.
+ (when (re-search-forward
+ "call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?"
+ limit t)
+ (cons 'inline-babel-call (match-beginning 0)))))
+
+
+;;;; Inline Src Block
+
+(defun org-element-inline-src-block-parser ()
+ "Parse inline source block at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `inline-src-block' and CDR a plist
+with `:begin', `:end', `:language', `:value', `:parameters' and
+`:post-blank' as keywords.
+
+Assume point is at the beginning of the inline src block."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (looking-at org-babel-inline-src-block-regexp)
+ (let ((begin (match-beginning 1))
+ (language (org-match-string-no-properties 2))
+ (parameters (org-match-string-no-properties 4))
+ (value (org-match-string-no-properties 5))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'inline-src-block
+ (list :language language
+ :value value
+ :parameters parameters
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-inline-src-block-interpreter (inline-src-block contents)
+ "Interpret INLINE-SRC-BLOCK object as Org syntax.
+CONTENTS is nil."
+ (let ((language (org-element-property :language inline-src-block))
+ (arguments (org-element-property :parameters inline-src-block))
+ (body (org-element-property :value inline-src-block)))
+ (format "src_%s%s{%s}"
+ language
+ (if arguments (format "[%s]" arguments) "")
+ body)))
+
+(defun org-element-inline-src-block-successor (limit)
+ "Search for the next inline-babel-call element.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `inline-babel-call' and
+CDR is beginning position."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (when (re-search-forward org-babel-inline-src-block-regexp limit t)
+ (cons 'inline-src-block (match-beginning 1)))))
+
+;;;; Italic
+
+(defun org-element-italic-parser ()
+ "Parse italic object at point.
+
+Return a list whose CAR is `italic' and CDR is a plist with
+`:begin', `:end', `:contents-begin' and `:contents-end' and
+`:post-blank' keywords.
+
+Assume point is at the first slash marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'italic
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-italic-interpreter (italic contents)
+ "Interpret ITALIC object as Org syntax.
+CONTENTS is the contents of the object."
+ (format "/%s/" contents))
+
+
+;;;; Latex Fragment
+
+(defun org-element-latex-fragment-parser ()
+ "Parse latex fragment at point.
+
+Return a list whose CAR is `latex-fragment' and CDR a plist with
+`:value', `:begin', `:end', and `:post-blank' as keywords.
+
+Assume point is at the beginning of the latex fragment."
+ (save-excursion
+ (let* ((begin (point))
+ (substring-match
+ (catch 'exit
+ (mapc (lambda (e)
+ (let ((latex-regexp (nth 1 (assoc e org-latex-regexps))))
+ (when (or (looking-at latex-regexp)
+ (and (not (bobp))
+ (save-excursion
+ (backward-char)
+ (looking-at latex-regexp))))
+ (throw 'exit (nth 2 (assoc e org-latex-regexps))))))
+ (plist-get org-format-latex-options :matchers))
+ ;; None found: it's a macro.
+ (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
+ 0))
+ (value (match-string-no-properties substring-match))
+ (post-blank (progn (goto-char (match-end substring-match))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'latex-fragment
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-latex-fragment-interpreter (latex-fragment contents)
+ "Interpret LATEX-FRAGMENT object as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value latex-fragment))
+
+;;;; Line Break
+
+(defun org-element-line-break-parser ()
+ "Parse line break at point.
+
+Return a list whose CAR is `line-break', and CDR a plist with
+`:begin', `:end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the line break."
+ (list 'line-break (list :begin (point) :end (point-at-eol) :post-blank 0)))
+
+(defun org-element-line-break-interpreter (line-break contents)
+ "Interpret LINE-BREAK object as Org syntax.
+CONTENTS is nil."
+ "\\\\")
+
+(defun org-element-line-break-successor (limit)
+ "Search for the next line-break object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `line-break' and CDR is
+beginning position."
+ (save-excursion
+ (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
+ (goto-char (match-beginning 1)))))
+ ;; A line break can only happen on a non-empty line.
+ (when (and beg (re-search-backward "\\S-" (point-at-bol) t))
+ (cons 'line-break beg)))))
+
+
+;;;; Link
+
+(defun org-element-link-parser ()
+ "Parse link at point.
+
+Return a list whose CAR is `link' and CDR a plist with `:type',
+`:path', `:raw-link', `:begin', `:end', `:contents-begin',
+`:contents-end' and `:post-blank' as keywords.
+
+Assume point is at the beginning of the link."
+ (save-excursion
+ (let ((begin (point))
+ end contents-begin contents-end link-end post-blank path type
+ raw-link link)
+ (cond
+ ;; Type 1: Text targeted from a radio target.
+ ((and org-target-link-regexp (looking-at org-target-link-regexp))
+ (setq type "radio"
+ link-end (match-end 0)
+ path (org-match-string-no-properties 0)))
+ ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
+ ((looking-at org-bracket-link-regexp)
+ (setq contents-begin (match-beginning 3)
+ contents-end (match-end 3)
+ link-end (match-end 0)
+ ;; RAW-LINK is the original link.
+ raw-link (org-match-string-no-properties 1)
+ link (org-translate-link
+ (org-link-expand-abbrev
+ (org-link-unescape raw-link))))
+ ;; Determine TYPE of link and set PATH accordingly.
+ (cond
+ ;; File type.
+ ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link))
+ (setq type "file" path link))
+ ;; Explicit type (http, irc, bbdb...). See `org-link-types'.
+ ((string-match org-link-re-with-space3 link)
+ (setq type (match-string 1 link) path (match-string 2 link)))
+ ;; Id type: PATH is the id.
+ ((string-match "^id:\\([-a-f0-9]+\\)" link)
+ (setq type "id" path (match-string 1 link)))
+ ;; Code-ref type: PATH is the name of the reference.
+ ((string-match "^(\\(.*\\))$" link)
+ (setq type "coderef" path (match-string 1 link)))
+ ;; Custom-id type: PATH is the name of the custom id.
+ ((= (aref link 0) ?#)
+ (setq type "custom-id" path (substring link 1)))
+ ;; Fuzzy type: Internal link either matches a target, an
+ ;; headline name or nothing. PATH is the target or
+ ;; headline's name.
+ (t (setq type "fuzzy" path link))))
+ ;; Type 3: Plain link, i.e. http://orgmode.org
+ ((looking-at org-plain-link-re)
+ (setq raw-link (org-match-string-no-properties 0)
+ type (org-match-string-no-properties 1)
+ path (org-match-string-no-properties 2)
+ link-end (match-end 0)))
+ ;; Type 4: Angular link, i.e. <http://orgmode.org>
+ ((looking-at org-angle-link-re)
+ (setq raw-link (buffer-substring-no-properties
+ (match-beginning 1) (match-end 2))
+ type (org-match-string-no-properties 1)
+ path (org-match-string-no-properties 2)
+ link-end (match-end 0))))
+ ;; In any case, deduce end point after trailing white space from
+ ;; LINK-END variable.
+ (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
+ end (point))
+ (list 'link
+ (list :type type
+ :path path
+ :raw-link (or raw-link path)
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-link-interpreter (link contents)
+ "Interpret LINK object as Org syntax.
+CONTENTS is the contents of the object, or nil."
+ (let ((type (org-element-property :type link))
+ (raw-link (org-element-property :raw-link link)))
+ (if (string= type "radio") raw-link
+ (format "[[%s]%s]"
+ raw-link
+ (if contents (format "[%s]" contents) "")))))
+
+(defun org-element-link-successor (limit)
+ "Search for the next link object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `link' and CDR is
+beginning position."
+ (save-excursion
+ (let ((link-regexp
+ (if (not org-target-link-regexp) org-any-link-re
+ (concat org-any-link-re "\\|" org-target-link-regexp))))
+ (when (re-search-forward link-regexp limit t)
+ (cons 'link (match-beginning 0))))))
+
+
+;;;; Macro
+
+(defun org-element-macro-parser ()
+ "Parse macro at point.
+
+Return a list whose CAR is `macro' and CDR a plist with `:key',
+`:args', `:begin', `:end', `:value' and `:post-blank' as
+keywords.
+
+Assume point is at the macro."
+ (save-excursion
+ (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
+ (let ((begin (point))
+ (key (downcase (org-match-string-no-properties 1)))
+ (value (org-match-string-no-properties 0))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point))
+ (args (let ((args (org-match-string-no-properties 3)) args2)
+ (when args
+ (setq args (org-split-string args ","))
+ (while args
+ (while (string-match "\\\\\\'" (car args))
+ ;; Repair bad splits.
+ (setcar (cdr args) (concat (substring (car args) 0 -1)
+ "," (nth 1 args)))
+ (pop args))
+ (push (pop args) args2))
+ (mapcar 'org-trim (nreverse args2))))))
+ (list 'macro
+ (list :key key
+ :value value
+ :args args
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-macro-interpreter (macro contents)
+ "Interpret MACRO object as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value macro))
+
+(defun org-element-macro-successor (limit)
+ "Search for the next macro object.
+
+LIMIT bounds the search.
+
+Return value is cons cell whose CAR is `macro' and CDR is
+beginning position."
+ (save-excursion
+ (when (re-search-forward
+ "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
+ limit t)
+ (cons 'macro (match-beginning 0)))))
+
+
+;;;; Radio-target
+
+(defun org-element-radio-target-parser ()
+ "Parse radio target at point.
+
+Return a list whose CAR is `radio-target' and CDR a plist with
+`:begin', `:end', `:contents-begin', `:contents-end', `:value'
+and `:post-blank' as keywords.
+
+Assume point is at the radio target."
+ (save-excursion
+ (looking-at org-radio-target-regexp)
+ (let ((begin (point))
+ (contents-begin (match-beginning 1))
+ (contents-end (match-end 1))
+ (value (org-match-string-no-properties 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'radio-target
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank
+ :value value)))))
+
+(defun org-element-radio-target-interpreter (target contents)
+ "Interpret TARGET object as Org syntax.
+CONTENTS is the contents of the object."
+ (concat "<<<" contents ">>>"))
+
+(defun org-element-radio-target-successor (limit)
+ "Search for the next radio-target object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `radio-target' and CDR
+is beginning position."
+ (save-excursion
+ (when (re-search-forward org-radio-target-regexp limit t)
+ (cons 'radio-target (match-beginning 0)))))
+
+
+;;;; Statistics Cookie
+
+(defun org-element-statistics-cookie-parser ()
+ "Parse statistics cookie at point.
+
+Return a list whose CAR is `statistics-cookie', and CDR a plist
+with `:begin', `:end', `:value' and `:post-blank' keywords.
+
+Assume point is at the beginning of the statistics-cookie."
+ (save-excursion
+ (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
+ (let* ((begin (point))
+ (value (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'statistics-cookie
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank)))))
+
+(defun org-element-statistics-cookie-interpreter (statistics-cookie contents)
+ "Interpret STATISTICS-COOKIE object as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value statistics-cookie))
+
+(defun org-element-statistics-cookie-successor (limit)
+ "Search for the next statistics cookie object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `statistics-cookie' and
+CDR is beginning position."
+ (save-excursion
+ (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
+ (cons 'statistics-cookie (match-beginning 0)))))
+
+
+;;;; Strike-Through
+
+(defun org-element-strike-through-parser ()
+ "Parse strike-through object at point.
+
+Return a list whose CAR is `strike-through' and CDR is a plist
+with `:begin', `:end', `:contents-begin' and `:contents-end' and
+`:post-blank' keywords.
+
+Assume point is at the first plus sign marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'strike-through
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-strike-through-interpreter (strike-through contents)
+ "Interpret STRIKE-THROUGH object as Org syntax.
+CONTENTS is the contents of the object."
+ (format "+%s+" contents))
+
+
+;;;; Subscript
+
+(defun org-element-subscript-parser ()
+ "Parse subscript at point.
+
+Return a list whose CAR is `subscript' and CDR a plist with
+`:begin', `:end', `:contents-begin', `:contents-end',
+`:use-brackets-p' and `:post-blank' as keywords.
+
+Assume point is at the underscore."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp)
+ t
+ (not (looking-at org-match-substring-regexp))))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 5)
+ (match-beginning 3)))
+ (contents-end (or (match-end 5) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'subscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-subscript-interpreter (subscript contents)
+ "Interpret SUBSCRIPT object as Org syntax.
+CONTENTS is the contents of the object."
+ (format
+ (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
+ contents))
+
+(defun org-element-sub/superscript-successor (limit)
+ "Search for the next sub/superscript object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is either `subscript' or
+`superscript' and CDR is beginning position."
+ (save-excursion
+ (when (re-search-forward org-match-substring-regexp limit t)
+ (cons (if (string= (match-string 2) "_") 'subscript 'superscript)
+ (match-beginning 2)))))
+
+
+;;;; Superscript
+
+(defun org-element-superscript-parser ()
+ "Parse superscript at point.
+
+Return a list whose CAR is `superscript' and CDR a plist with
+`:begin', `:end', `:contents-begin', `:contents-end',
+`:use-brackets-p' and `:post-blank' as keywords.
+
+Assume point is at the caret."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t
+ (not (looking-at org-match-substring-regexp))))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 5)
+ (match-beginning 3)))
+ (contents-end (or (match-end 5) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'superscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-superscript-interpreter (superscript contents)
+ "Interpret SUPERSCRIPT object as Org syntax.
+CONTENTS is the contents of the object."
+ (format
+ (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s")
+ contents))
+
+
+;;;; Table Cell
+
+(defun org-element-table-cell-parser ()
+ "Parse table cell at point.
+
+Return a list whose CAR is `table-cell' and CDR is a plist
+containing `:begin', `:end', `:contents-begin', `:contents-end'
+and `:post-blank' keywords."
+ (looking-at "[ \t]*\\(.*?\\)[ \t]*|")
+ (let* ((begin (match-beginning 0))
+ (end (match-end 0))
+ (contents-begin (match-beginning 1))
+ (contents-end (match-end 1)))
+ (list 'table-cell
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank 0))))
+
+(defun org-element-table-cell-interpreter (table-cell contents)
+ "Interpret TABLE-CELL element as Org syntax.
+CONTENTS is the contents of the cell, or nil."
+ (concat " " contents " |"))
+
+(defun org-element-table-cell-successor (limit)
+ "Search for the next table-cell object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `table-cell' and CDR is
+beginning position."
+ (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point))))
+
+
+;;;; Target
+
+(defun org-element-target-parser ()
+ "Parse target at point.
+
+Return a list whose CAR is `target' and CDR a plist with
+`:begin', `:end', `:value' and `:post-blank' as keywords.
+
+Assume point is at the target."
+ (save-excursion
+ (looking-at org-target-regexp)
+ (let ((begin (point))
+ (value (org-match-string-no-properties 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'target
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank)))))
+
+(defun org-element-target-interpreter (target contents)
+ "Interpret TARGET object as Org syntax.
+CONTENTS is nil."
+ (format "<<%s>>" (org-element-property :value target)))
+
+(defun org-element-target-successor (limit)
+ "Search for the next target object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `target' and CDR is
+beginning position."
+ (save-excursion
+ (when (re-search-forward org-target-regexp limit t)
+ (cons 'target (match-beginning 0)))))
+
+
+;;;; Timestamp
+
+(defun org-element-timestamp-parser ()
+ "Parse time stamp at point.
+
+Return a list whose CAR is `timestamp', and CDR a plist with
+`:type', `:begin', `:end', `:value' and `:post-blank' keywords.
+
+Assume point is at the beginning of the timestamp."
+ (save-excursion
+ (let* ((begin (point))
+ (activep (eq (char-after) ?<))
+ (main-value
+ (progn
+ (looking-at "[<[]\\(\\(%%\\)?.*?\\)[]>]\\(?:--[<[]\\(.*?\\)[]>]\\)?")
+ (match-string-no-properties 1)))
+ (range-end (match-string-no-properties 3))
+ (type (cond ((match-string 2) 'diary)
+ ((and activep range-end) 'active-range)
+ (activep 'active)
+ (range-end 'inactive-range)
+ (t 'inactive)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'timestamp
+ (list :type type
+ :value main-value
+ :range-end range-end
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-timestamp-interpreter (timestamp contents)
+ "Interpret TIMESTAMP object as Org syntax.
+CONTENTS is nil."
+ (let ((type (org-element-property :type timestamp) ))
+ (concat
+ (format (if (memq type '(inactive inactive-range)) "[%s]" "<%s>")
+ (org-element-property :value timestamp))
+ (let ((range-end (org-element-property :range-end timestamp)))
+ (when range-end
+ (concat "--"
+ (format (if (eq type 'inactive-range) "[%s]" "<%s>")
+ range-end)))))))
+
+(defun org-element-timestamp-successor (limit)
+ "Search for the next timestamp object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `timestamp' and CDR is
+beginning position."
+ (save-excursion
+ (when (re-search-forward
+ (concat org-ts-regexp-both
+ "\\|"
+ "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
+ "\\|"
+ "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
+ limit t)
+ (cons 'timestamp (match-beginning 0)))))
+
+
+;;;; Underline
+
+(defun org-element-underline-parser ()
+ "Parse underline object at point.
+
+Return a list whose CAR is `underline' and CDR is a plist with
+`:begin', `:end', `:contents-begin' and `:contents-end' and
+`:post-blank' keywords.
+
+Assume point is at the first underscore marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'underline
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-underline-interpreter (underline contents)
+ "Interpret UNDERLINE object as Org syntax.
+CONTENTS is the contents of the object."
+ (format "_%s_" contents))
+
+
+;;;; Verbatim
+
+(defun org-element-verbatim-parser ()
+ "Parse verbatim object at point.
+
+Return a list whose CAR is `verbatim' and CDR is a plist with
+`:value', `:begin', `:end' and `:post-blank' keywords.
+
+Assume point is at the first equal sign marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (value (org-match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'verbatim
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-verbatim-interpreter (verbatim contents)
+ "Interpret VERBATIM object as Org syntax.
+CONTENTS is nil."
+ (format "=%s=" (org-element-property :value verbatim)))
+
+
+
+;;; Parsing Element Starting At Point
+;;
+;; `org-element--current-element' is the core function of this section.
+;; It returns the Lisp representation of the element starting at
+;; point.
+;;
+;; `org-element--current-element' makes use of special modes. They
+;; are activated for fixed element chaining (i.e. `plain-list' >
+;; `item') or fixed conditional element chaining (i.e. `headline' >
+;; `section'). Special modes are: `first-section', `section',
+;; `quote-section', `item' and `table-row'.
+
+(defun org-element--current-element
+ (limit &optional granularity special structure)
+ "Parse the element starting at point.
+
+LIMIT bounds the search.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+of the element and PROPS a plist of properties associated to the
+element.
+
+Possible types are defined in `org-element-all-elements'.
+
+Optional argument GRANULARITY determines the depth of the
+recursion. Allowed values are `headline', `greater-element',
+`element', `object' or nil. When it is broader than `object' (or
+nil), secondary values will not be parsed, since they only
+contain objects.
+
+Optional argument SPECIAL, when non-nil, can be either
+`first-section', `section', `quote-section', `table-row' and
+`item'.
+
+If STRUCTURE isn't provided but SPECIAL is set to `item', it will
+be computed.
+
+This function assumes point is always at the beginning of the
+element it has to parse."
+ (save-excursion
+ ;; If point is at an affiliated keyword, try moving to the
+ ;; beginning of the associated element. If none is found, the
+ ;; keyword is orphaned and will be treated as plain text.
+ (when (looking-at org-element--affiliated-re)
+ (let ((opoint (point)))
+ (while (looking-at org-element--affiliated-re) (forward-line))
+ (when (looking-at "[ \t]*$") (goto-char opoint))))
+ (let ((case-fold-search t)
+ ;; Determine if parsing depth allows for secondary strings
+ ;; parsing. It only applies to elements referenced in
+ ;; `org-element-secondary-value-alist'.
+ (raw-secondary-p (and granularity (not (eq granularity 'object)))))
+ (cond
+ ;; Item.
+ ((eq special 'item)
+ (org-element-item-parser limit structure raw-secondary-p))
+ ;; Table Row.
+ ((eq special 'table-row) (org-element-table-row-parser limit))
+ ;; Headline.
+ ((org-with-limited-levels (org-at-heading-p))
+ (org-element-headline-parser limit raw-secondary-p))
+ ;; Sections (must be checked after headline).
+ ((eq special 'section) (org-element-section-parser limit))
+ ((eq special 'quote-section) (org-element-quote-section-parser limit))
+ ((eq special 'first-section)
+ (org-element-section-parser
+ (or (save-excursion (org-with-limited-levels (outline-next-heading)))
+ limit)))
+ ;; When not at bol, point is at the beginning of an item or
+ ;; a footnote definition: next item is always a paragraph.
+ ((not (bolp)) (org-element-paragraph-parser limit))
+ ;; Planning and Clock.
+ ((and (looking-at org-planning-or-clock-line-re))
+ (if (equal (match-string 1) org-clock-string)
+ (org-element-clock-parser limit)
+ (org-element-planning-parser limit)))
+ ;; Inlinetask.
+ ((org-at-heading-p)
+ (org-element-inlinetask-parser limit raw-secondary-p))
+ ;; LaTeX Environment.
+ ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}")
+ (if (save-excursion
+ (re-search-forward
+ (format "[ \t]*\\\\end{%s}[ \t]*"
+ (regexp-quote (match-string 1)))
+ nil t))
+ (org-element-latex-environment-parser limit)
+ (org-element-paragraph-parser limit)))
+ ;; Drawer and Property Drawer.
+ ((looking-at org-drawer-regexp)
+ (let ((name (match-string 1)))
+ (cond
+ ((not (save-excursion
+ (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)))
+ (org-element-paragraph-parser limit))
+ ((equal "PROPERTIES" name)
+ (org-element-property-drawer-parser limit))
+ (t (org-element-drawer-parser limit)))))
+ ;; Fixed Width
+ ((looking-at "[ \t]*:\\( \\|$\\)")
+ (org-element-fixed-width-parser limit))
+ ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
+ ;; Keywords.
+ ((looking-at "[ \t]*#")
+ (goto-char (match-end 0))
+ (cond ((looking-at "\\(?: \\|$\\)")
+ (beginning-of-line)
+ (org-element-comment-parser limit))
+ ((looking-at "\\+BEGIN_\\(\\S-+\\)")
+ (beginning-of-line)
+ (let ((parser (assoc (upcase (match-string 1))
+ org-element-block-name-alist)))
+ (if parser (funcall (cdr parser) limit)
+ (org-element-special-block-parser limit))))
+ ((looking-at "\\+CALL:")
+ (beginning-of-line)
+ (org-element-babel-call-parser limit))
+ ((looking-at "\\+BEGIN:? ")
+ (beginning-of-line)
+ (org-element-dynamic-block-parser limit))
+ ((looking-at "\\+\\S-+:")
+ (beginning-of-line)
+ (org-element-keyword-parser limit))
+ (t
+ (beginning-of-line)
+ (org-element-paragraph-parser limit))))
+ ;; Footnote Definition.
+ ((looking-at org-footnote-definition-re)
+ (org-element-footnote-definition-parser limit))
+ ;; Horizontal Rule.
+ ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
+ (org-element-horizontal-rule-parser limit))
+ ;; Table.
+ ((org-at-table-p t) (org-element-table-parser limit))
+ ;; List.
+ ((looking-at (org-item-re))
+ (org-element-plain-list-parser limit (or structure (org-list-struct))))
+ ;; Default element: Paragraph.
+ (t (org-element-paragraph-parser limit))))))
+
+
+;; Most elements can have affiliated keywords. When looking for an
+;; element beginning, we want to move before them, as they belong to
+;; that element, and, in the meantime, collect information they give
+;; into appropriate properties. Hence the following function.
+;;
+;; Usage of optional arguments may not be obvious at first glance:
+;;
+;; - TRANS-LIST is used to polish keywords names that have evolved
+;; during Org history. In example, even though =result= and
+;; =results= coexist, we want to have them under the same =result=
+;; property. It's also true for "srcname" and "name", where the
+;; latter seems to be preferred nowadays (thus the "name" property).
+;;
+;; - CONSED allows to regroup multi-lines keywords under the same
+;; property, while preserving their own identity. This is mostly
+;; used for "attr_latex" and al.
+;;
+;; - PARSED prepares a keyword value for export. This is useful for
+;; "caption". Objects restrictions for such keywords are defined in
+;; `org-element-object-restrictions'.
+;;
+;; - DUALS is used to take care of keywords accepting a main and an
+;; optional secondary values. For example "results" has its
+;; source's name as the main value, and may have an hash string in
+;; optional square brackets as the secondary one.
+;;
+;; A keyword may belong to more than one category.
+
+(defun org-element--collect-affiliated-keywords
+ (&optional key-re trans-list consed parsed duals)
+ "Collect affiliated keywords before point.
+
+Optional argument KEY-RE is a regexp matching keywords, which
+puts matched keyword in group 1. It defaults to
+`org-element--affiliated-re'.
+
+TRANS-LIST is an alist where key is the keyword and value the
+property name it should be translated to, without the colons. It
+defaults to `org-element-keyword-translation-alist'.
+
+CONSED is a list of strings. Any keyword belonging to that list
+will have its value consed. The check is done after keyword
+translation. It defaults to `org-element-multiple-keywords'.
+
+PARSED is a list of strings. Any keyword member of this list
+will have its value parsed. The check is done after keyword
+translation. If a keyword is a member of both CONSED and PARSED,
+it's value will be a list of parsed strings. It defaults to
+`org-element-parsed-keywords'.
+
+DUALS is a list of strings. Any keyword member of this list can
+have two parts: one mandatory and one optional. Its value is
+a cons cell whose CAR is the former, and the CDR the latter. If
+a keyword is a member of both PARSED and DUALS, both values will
+be parsed. It defaults to `org-element-dual-keywords'.
+
+Return a list whose CAR is the position at the first of them and
+CDR a plist of keywords and values."
+ (save-excursion
+ (let ((case-fold-search t)
+ (key-re (or key-re org-element--affiliated-re))
+ (trans-list (or trans-list org-element-keyword-translation-alist))
+ (consed (or consed org-element-multiple-keywords))
+ (parsed (or parsed org-element-parsed-keywords))
+ (duals (or duals org-element-dual-keywords))
+ ;; RESTRICT is the list of objects allowed in parsed
+ ;; keywords value.
+ (restrict (org-element-restriction 'keyword))
+ output)
+ (unless (bobp)
+ (while (and (not (bobp)) (progn (forward-line -1) (looking-at key-re)))
+ (let* ((raw-kwd (upcase (match-string 1)))
+ ;; Apply translation to RAW-KWD. From there, KWD is
+ ;; the official keyword.
+ (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd))
+ ;; Find main value for any keyword.
+ (value
+ (save-match-data
+ (org-trim
+ (buffer-substring-no-properties
+ (match-end 0) (point-at-eol)))))
+ ;; If KWD is a dual keyword, find its secondary
+ ;; value. Maybe parse it.
+ (dual-value
+ (and (member kwd duals)
+ (let ((sec (org-match-string-no-properties 2)))
+ (if (or (not sec) (not (member kwd parsed))) sec
+ (org-element-parse-secondary-string sec restrict)))))
+ ;; Attribute a property name to KWD.
+ (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
+ ;; Now set final shape for VALUE.
+ (when (member kwd parsed)
+ (setq value (org-element-parse-secondary-string value restrict)))
+ (when (member kwd duals)
+ ;; VALUE is mandatory. Set it to nil if there is none.
+ (setq value (and value (cons value dual-value))))
+ ;; Attributes are always consed.
+ (when (or (member kwd consed) (string-match "^ATTR_" kwd))
+ (setq value (cons value (plist-get output kwd-sym))))
+ ;; Eventually store the new value in OUTPUT.
+ (setq output (plist-put output kwd-sym value))))
+ (unless (looking-at key-re) (forward-line 1)))
+ (list (point) output))))
+
+
+
+;;; The Org Parser
+;;
+;; The two major functions here are `org-element-parse-buffer', which
+;; parses Org syntax inside the current buffer, taking into account
+;; region, narrowing, or even visibility if specified, and
+;; `org-element-parse-secondary-string', which parses objects within
+;; a given string.
+;;
+;; The (almost) almighty `org-element-map' allows to apply a function
+;; on elements or objects matching some type, and accumulate the
+;; resulting values. In an export situation, it also skips unneeded
+;; parts of the parse tree.
+
+(defun org-element-parse-buffer (&optional granularity visible-only)
+ "Recursively parse the buffer and return structure.
+If narrowing is in effect, only parse the visible part of the
+buffer.
+
+Optional argument GRANULARITY determines the depth of the
+recursion. It can be set to the following symbols:
+
+`headline' Only parse headlines.
+`greater-element' Don't recurse into greater elements excepted
+ headlines and sections. Thus, elements
+ parsed are the top-level ones.
+`element' Parse everything but objects and plain text.
+`object' Parse the complete buffer (default).
+
+When VISIBLE-ONLY is non-nil, don't parse contents of hidden
+elements.
+
+Assume buffer is in Org mode."
+ (save-excursion
+ (goto-char (point-min))
+ (org-skip-whitespace)
+ (org-element--parse-elements
+ (point-at-bol) (point-max)
+ ;; Start in `first-section' mode so text before the first
+ ;; headline belongs to a section.
+ 'first-section nil granularity visible-only (list 'org-data nil))))
+
+(defun org-element-parse-secondary-string (string restriction &optional parent)
+ "Recursively parse objects in STRING and return structure.
+
+RESTRICTION is a symbol limiting the object types that will be
+looked after.
+
+Optional argument PARENT, when non-nil, is the element or object
+containing the secondary string. It is used to set correctly
+`:parent' property within the string."
+ (with-temp-buffer
+ (insert string)
+ (let ((secondary (org-element--parse-objects
+ (point-min) (point-max) nil restriction)))
+ (mapc (lambda (obj) (org-element-put-property obj :parent parent))
+ secondary))))
+
+(defun org-element-map (data types fun &optional info first-match no-recursion)
+ "Map a function on selected elements or objects.
+
+DATA is the parsed tree, as returned by, i.e,
+`org-element-parse-buffer'. TYPES is a symbol or list of symbols
+of elements or objects types. FUN is the function called on the
+matching element or object. It must accept one arguments: the
+element or object itself.
+
+When optional argument INFO is non-nil, it should be a plist
+holding export options. In that case, parts of the parse tree
+not exportable according to that property list will be skipped.
+
+When optional argument FIRST-MATCH is non-nil, stop at the first
+match for which FUN doesn't return nil, and return that value.
+
+Optional argument NO-RECURSION is a symbol or a list of symbols
+representing elements or objects types. `org-element-map' won't
+enter any recursive element or object whose type belongs to that
+list. Though, FUN can still be applied on them.
+
+Nil values returned from FUN do not appear in the results."
+ ;; Ensure TYPES and NO-RECURSION are a list, even of one element.
+ (unless (listp types) (setq types (list types)))
+ (unless (listp no-recursion) (setq no-recursion (list no-recursion)))
+ ;; Recursion depth is determined by --CATEGORY.
+ (let* ((--category
+ (catch 'found
+ (let ((category 'greater-elements))
+ (mapc (lambda (type)
+ (cond ((or (memq type org-element-all-objects)
+ (eq type 'plain-text))
+ ;; If one object is found, the function
+ ;; has to recurse into every object.
+ (throw 'found 'objects))
+ ((not (memq type org-element-greater-elements))
+ ;; If one regular element is found, the
+ ;; function has to recurse, at least,
+ ;; into every element it encounters.
+ (and (not (eq category 'elements))
+ (setq category 'elements)))))
+ types)
+ category)))
+ --acc
+ --walk-tree
+ (--walk-tree
+ (function
+ (lambda (--data)
+ ;; Recursively walk DATA. INFO, if non-nil, is a plist
+ ;; holding contextual information.
+ (let ((--type (org-element-type --data)))
+ (cond
+ ((not --data))
+ ;; Ignored element in an export context.
+ ((and info (memq --data (plist-get info :ignore-list))))
+ ;; Secondary string: only objects can be found there.
+ ((not --type)
+ (when (eq --category 'objects) (mapc --walk-tree --data)))
+ ;; Unconditionally enter parse trees.
+ ((eq --type 'org-data)
+ (mapc --walk-tree (org-element-contents --data)))
+ (t
+ ;; Check if TYPE is matching among TYPES. If so,
+ ;; apply FUN to --DATA and accumulate return value
+ ;; into --ACC (or exit if FIRST-MATCH is non-nil).
+ (when (memq --type types)
+ (let ((result (funcall fun --data)))
+ (cond ((not result))
+ (first-match (throw '--map-first-match result))
+ (t (push result --acc)))))
+ ;; If --DATA has a secondary string that can contain
+ ;; objects with their type among TYPES, look into it.
+ (when (eq --category 'objects)
+ (let ((sec-prop
+ (assq --type org-element-secondary-value-alist)))
+ (when sec-prop
+ (funcall --walk-tree
+ (org-element-property (cdr sec-prop) --data)))))
+ ;; Determine if a recursion into --DATA is possible.
+ (cond
+ ;; --TYPE is explicitly removed from recursion.
+ ((memq --type no-recursion))
+ ;; --DATA has no contents.
+ ((not (org-element-contents --data)))
+ ;; Looking for greater elements but --DATA is simply
+ ;; an element or an object.
+ ((and (eq --category 'greater-elements)
+ (not (memq --type org-element-greater-elements))))
+ ;; Looking for elements but --DATA is an object.
+ ((and (eq --category 'elements)
+ (memq --type org-element-all-objects)))
+ ;; In any other case, map contents.
+ (t (mapc --walk-tree (org-element-contents --data)))))))))))
+ (catch '--map-first-match
+ (funcall --walk-tree data)
+ ;; Return value in a proper order.
+ (nreverse --acc))))
+
+;; The following functions are internal parts of the parser.
+;;
+;; The first one, `org-element--parse-elements' acts at the element's
+;; level.
+;;
+;; The second one, `org-element--parse-objects' applies on all objects
+;; of a paragraph or a secondary string. It uses
+;; `org-element--get-next-object-candidates' to optimize the search of
+;; the next object in the buffer.
+;;
+;; More precisely, that function looks for every allowed object type
+;; first. Then, it discards failed searches, keeps further matches,
+;; and searches again types matched behind point, for subsequent
+;; calls. Thus, searching for a given type fails only once, and every
+;; object is searched only once at top level (but sometimes more for
+;; nested types).
+
+(defun org-element--parse-elements
+ (beg end special structure granularity visible-only acc)
+ "Parse elements between BEG and END positions.
+
+SPECIAL prioritize some elements over the others. It can be set
+to `first-section', `quote-section', `section' `item' or
+`table-row'.
+
+When value is `item', STRUCTURE will be used as the current list
+structure.
+
+GRANULARITY determines the depth of the recursion. See
+`org-element-parse-buffer' for more information.
+
+When VISIBLE-ONLY is non-nil, don't parse contents of hidden
+elements.
+
+Elements are accumulated into ACC."
+ (save-excursion
+ (goto-char beg)
+ ;; When parsing only headlines, skip any text before first one.
+ (when (and (eq granularity 'headline) (not (org-at-heading-p)))
+ (org-with-limited-levels (outline-next-heading)))
+ ;; Main loop start.
+ (while (< (point) end)
+ ;; Find current element's type and parse it accordingly to
+ ;; its category.
+ (let* ((element (org-element--current-element
+ end granularity special structure))
+ (type (org-element-type element))
+ (cbeg (org-element-property :contents-begin element)))
+ (goto-char (org-element-property :end element))
+ ;; Fill ELEMENT contents by side-effect.
+ (cond
+ ;; If VISIBLE-ONLY is true and element is hidden or if it has
+ ;; no contents, don't modify it.
+ ((or (and visible-only (org-element-property :hiddenp element))
+ (not cbeg)))
+ ;; Greater element: parse it between `contents-begin' and
+ ;; `contents-end'. Make sure GRANULARITY allows the
+ ;; recursion, or ELEMENT is an headline, in which case going
+ ;; inside is mandatory, in order to get sub-level headings.
+ ((and (memq type org-element-greater-elements)
+ (or (memq granularity '(element object nil))
+ (and (eq granularity 'greater-element)
+ (eq type 'section))
+ (eq type 'headline)))
+ (org-element--parse-elements
+ cbeg (org-element-property :contents-end element)
+ ;; Possibly switch to a special mode.
+ (case type
+ (headline
+ (if (org-element-property :quotedp element) 'quote-section
+ 'section))
+ (plain-list 'item)
+ (table 'table-row))
+ (org-element-property :structure element)
+ granularity visible-only element))
+ ;; ELEMENT has contents. Parse objects inside, if
+ ;; GRANULARITY allows it.
+ ((memq granularity '(object nil))
+ (org-element--parse-objects
+ cbeg (org-element-property :contents-end element) element
+ (org-element-restriction type))))
+ (org-element-adopt-elements acc element)))
+ ;; Return result.
+ acc))
+
+(defun org-element--parse-objects (beg end acc restriction)
+ "Parse objects between BEG and END and return recursive structure.
+
+Objects are accumulated in ACC.
+
+RESTRICTION is a list of object types which are allowed in the
+current object."
+ (let (candidates)
+ (save-excursion
+ (goto-char beg)
+ (while (and (< (point) end)
+ (setq candidates (org-element--get-next-object-candidates
+ end restriction candidates)))
+ (let ((next-object
+ (let ((pos (apply 'min (mapcar 'cdr candidates))))
+ (save-excursion
+ (goto-char pos)
+ (funcall (intern (format "org-element-%s-parser"
+ (car (rassq pos candidates)))))))))
+ ;; 1. Text before any object. Untabify it.
+ (let ((obj-beg (org-element-property :begin next-object)))
+ (unless (= (point) obj-beg)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) obj-beg))))))
+ ;; 2. Object...
+ (let ((obj-end (org-element-property :end next-object))
+ (cont-beg (org-element-property :contents-begin next-object)))
+ ;; Fill contents of NEXT-OBJECT by side-effect, if it has
+ ;; a recursive type.
+ (when (and cont-beg
+ (memq (car next-object) org-element-recursive-objects))
+ (save-restriction
+ (narrow-to-region
+ cont-beg
+ (org-element-property :contents-end next-object))
+ (org-element--parse-objects
+ (point-min) (point-max) next-object
+ (org-element-restriction next-object))))
+ (setq acc (org-element-adopt-elements acc next-object))
+ (goto-char obj-end))))
+ ;; 3. Text after last object. Untabify it.
+ (unless (= (point) end)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) end)))))
+ ;; Result.
+ acc)))
+
+(defun org-element--get-next-object-candidates (limit restriction objects)
+ "Return an alist of candidates for the next object.
+
+LIMIT bounds the search, and RESTRICTION narrows candidates to
+some object types.
+
+Return value is an alist whose CAR is position and CDR the object
+type, as a symbol.
+
+OBJECTS is the previous candidates alist."
+ (let (next-candidates types-to-search)
+ ;; If no previous result, search every object type in RESTRICTION.
+ ;; Otherwise, keep potential candidates (old objects located after
+ ;; point) and ask to search again those which had matched before.
+ (if (not objects) (setq types-to-search restriction)
+ (mapc (lambda (obj)
+ (if (< (cdr obj) (point)) (push (car obj) types-to-search)
+ (push obj next-candidates)))
+ objects))
+ ;; Call the appropriate successor function for each type to search
+ ;; and accumulate matches.
+ (mapc
+ (lambda (type)
+ (let* ((successor-fun
+ (intern
+ (format "org-element-%s-successor"
+ (or (cdr (assq type org-element-object-successor-alist))
+ type))))
+ (obj (funcall successor-fun limit)))
+ (and obj (push obj next-candidates))))
+ types-to-search)
+ ;; Return alist.
+ next-candidates))
+
+
+
+;;; Towards A Bijective Process
+;;
+;; The parse tree obtained with `org-element-parse-buffer' is really
+;; a snapshot of the corresponding Org buffer. Therefore, it can be
+;; interpreted and expanded into a string with canonical Org syntax.
+;; Hence `org-element-interpret-data'.
+;;
+;; The function relies internally on
+;; `org-element--interpret-affiliated-keywords'.
+
+;;;###autoload
+(defun org-element-interpret-data (data &optional parent)
+ "Interpret DATA as Org syntax.
+
+DATA is a parse tree, an element, an object or a secondary string
+to interpret.
+
+Optional argument PARENT is used for recursive calls. It contains
+the element or object containing data, or nil.
+
+Return Org syntax as a string."
+ (let* ((type (org-element-type data))
+ (results
+ (cond
+ ;; Secondary string.
+ ((not type)
+ (mapconcat
+ (lambda (obj) (org-element-interpret-data obj parent))
+ data ""))
+ ;; Full Org document.
+ ((eq type 'org-data)
+ (mapconcat
+ (lambda (obj) (org-element-interpret-data obj parent))
+ (org-element-contents data) ""))
+ ;; Plain text.
+ ((stringp data) data)
+ ;; Element/Object without contents.
+ ((not (org-element-contents data))
+ (funcall (intern (format "org-element-%s-interpreter" type))
+ data nil))
+ ;; Element/Object with contents.
+ (t
+ (let* ((greaterp (memq type org-element-greater-elements))
+ (objectp (and (not greaterp)
+ (memq type org-element-recursive-objects)))
+ (contents
+ (mapconcat
+ (lambda (obj) (org-element-interpret-data obj data))
+ (org-element-contents
+ (if (or greaterp objectp) data
+ ;; Elements directly containing objects must
+ ;; have their indentation normalized first.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing first paragraph of an
+ ;; item or a footnote-definition, ignore
+ ;; first line's indentation.
+ (and (eq type 'paragraph)
+ (equal data (car (org-element-contents parent)))
+ (memq (org-element-type parent)
+ '(footnote-definition item))))))
+ "")))
+ (funcall (intern (format "org-element-%s-interpreter" type))
+ data
+ (if greaterp (org-element-normalize-contents contents)
+ contents)))))))
+ (if (memq type '(org-data plain-text nil)) results
+ ;; Build white spaces. If no `:post-blank' property is
+ ;; specified, assume its value is 0.
+ (let ((post-blank (or (org-element-property :post-blank data) 0)))
+ (if (memq type org-element-all-objects)
+ (concat results (make-string post-blank 32))
+ (concat
+ (org-element--interpret-affiliated-keywords data)
+ (org-element-normalize-string results)
+ (make-string post-blank 10)))))))
+
+(defun org-element--interpret-affiliated-keywords (element)
+ "Return ELEMENT's affiliated keywords as Org syntax.
+If there is no affiliated keyword, return the empty string."
+ (let ((keyword-to-org
+ (function
+ (lambda (key value)
+ (let (dual)
+ (when (member key org-element-dual-keywords)
+ (setq dual (cdr value) value (car value)))
+ (concat "#+" key
+ (and dual
+ (format "[%s]" (org-element-interpret-data dual)))
+ ": "
+ (if (member key org-element-parsed-keywords)
+ (org-element-interpret-data value)
+ value)
+ "\n"))))))
+ (mapconcat
+ (lambda (prop)
+ (let ((value (org-element-property prop element))
+ (keyword (upcase (substring (symbol-name prop) 1))))
+ (when value
+ (if (or (member keyword org-element-multiple-keywords)
+ ;; All attribute keywords can have multiple lines.
+ (string-match "^ATTR_" keyword))
+ (mapconcat (lambda (line) (funcall keyword-to-org keyword line))
+ value
+ "")
+ (funcall keyword-to-org keyword value)))))
+ ;; List all ELEMENT's properties matching an attribute line or an
+ ;; affiliated keyword, but ignore translated keywords since they
+ ;; cannot belong to the property list.
+ (loop for prop in (nth 1 element) by 'cddr
+ when (let ((keyword (upcase (substring (symbol-name prop) 1))))
+ (or (string-match "^ATTR_" keyword)
+ (and
+ (member keyword org-element-affiliated-keywords)
+ (not (assoc keyword
+ org-element-keyword-translation-alist)))))
+ collect prop)
+ "")))
+
+;; Because interpretation of the parse tree must return the same
+;; number of blank lines between elements and the same number of white
+;; space after objects, some special care must be given to white
+;; spaces.
+;;
+;; The first function, `org-element-normalize-string', ensures any
+;; string different from the empty string will end with a single
+;; newline character.
+;;
+;; The second function, `org-element-normalize-contents', removes
+;; global indentation from the contents of the current element.
+
+(defun org-element-normalize-string (s)
+ "Ensure string S ends with a single newline character.
+
+If S isn't a string return it unchanged. If S is the empty
+string, return it. Otherwise, return a new string with a single
+newline character at its end."
+ (cond
+ ((not (stringp s)) s)
+ ((string= "" s) "")
+ (t (and (string-match "\\(\n[ \t]*\\)*\\'" s)
+ (replace-match "\n" nil nil s)))))
+
+(defun org-element-normalize-contents (element &optional ignore-first)
+ "Normalize plain text in ELEMENT's contents.
+
+ELEMENT must only contain plain text and objects.
+
+If optional argument IGNORE-FIRST is non-nil, ignore first line's
+indentation to compute maximal common indentation.
+
+Return the normalized element that is element with global
+indentation removed from its contents. The function assumes that
+indentation is not done with TAB characters."
+ (let* (ind-list ; for byte-compiler
+ collect-inds ; for byte-compiler
+ (collect-inds
+ (function
+ ;; Return list of indentations within BLOB. This is done by
+ ;; walking recursively BLOB and updating IND-LIST along the
+ ;; way. FIRST-FLAG is non-nil when the first string hasn't
+ ;; been seen yet. It is required as this string is the only
+ ;; one whose indentation doesn't happen after a newline
+ ;; character.
+ (lambda (blob first-flag)
+ (mapc
+ (lambda (object)
+ (when (and first-flag (stringp object))
+ (setq first-flag nil)
+ (string-match "\\`\\( *\\)" object)
+ (let ((len (length (match-string 1 object))))
+ ;; An indentation of zero means no string will be
+ ;; modified. Quit the process.
+ (if (zerop len) (throw 'zero (setq ind-list nil))
+ (push len ind-list))))
+ (cond
+ ((stringp object)
+ (let ((start 0))
+ ;; Avoid matching blank or empty lines.
+ (while (and (string-match "\n\\( *\\)\\(.\\)" object start)
+ (not (equal (match-string 2 object) " ")))
+ (setq start (match-end 0))
+ (push (length (match-string 1 object)) ind-list))))
+ ((memq (org-element-type object) org-element-recursive-objects)
+ (funcall collect-inds object first-flag))))
+ (org-element-contents blob))))))
+ ;; Collect indentation list in ELEMENT. Possibly remove first
+ ;; value if IGNORE-FIRST is non-nil.
+ (catch 'zero (funcall collect-inds element (not ignore-first)))
+ (if (not ind-list) element
+ ;; Build ELEMENT back, replacing each string with the same
+ ;; string minus common indentation.
+ (let* (build ; For byte compiler.
+ (build
+ (function
+ (lambda (blob mci first-flag)
+ ;; Return BLOB with all its strings indentation
+ ;; shortened from MCI white spaces. FIRST-FLAG is
+ ;; non-nil when the first string hasn't been seen
+ ;; yet.
+ (setcdr (cdr blob)
+ (mapcar
+ (lambda (object)
+ (when (and first-flag (stringp object))
+ (setq first-flag nil)
+ (setq object
+ (replace-regexp-in-string
+ (format "\\` \\{%d\\}" mci) "" object)))
+ (cond
+ ((stringp object)
+ (replace-regexp-in-string
+ (format "\n \\{%d\\}" mci) "\n" object))
+ ((memq (org-element-type object)
+ org-element-recursive-objects)
+ (funcall build object mci first-flag))
+ (t object)))
+ (org-element-contents blob)))
+ blob))))
+ (funcall build element (apply 'min ind-list) (not ignore-first))))))
+
+
+
+;;; The Toolbox
+;;
+;; The first move is to implement a way to obtain the smallest element
+;; containing point. This is the job of `org-element-at-point'. It
+;; basically jumps back to the beginning of section containing point
+;; and moves, element after element, with
+;; `org-element--current-element' until the container is found. Note:
+;; When using `org-element-at-point', secondary values are never
+;; parsed since the function focuses on elements, not on objects.
+;;
+;; At a deeper level, `org-element-context' lists all elements and
+;; objects containing point.
+;;
+;; `org-element-nested-p' and `org-element-swap-A-B' may be used
+;; internally by navigation and manipulation tools.
+
+;;;###autoload
+(defun org-element-at-point (&optional keep-trail)
+ "Determine closest element around point.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+of the element and PROPS a plist of properties associated to the
+element.
+
+Possible types are defined in `org-element-all-elements'.
+Properties depend on element or object type, but always
+include :begin, :end, :parent and :post-blank properties.
+
+As a special case, if point is at the very beginning of a list or
+sub-list, returned element will be that list instead of the first
+item. In the same way, if point is at the beginning of the first
+row of a table, returned element will be the table instead of the
+first row.
+
+If optional argument KEEP-TRAIL is non-nil, the function returns
+a list of of elements leading to element at point. The list's
+CAR is always the element at point. Following positions contain
+element's siblings, then parents, siblings of parents, until the
+first element of current section."
+ (org-with-wide-buffer
+ ;; If at an headline, parse it. It is the sole element that
+ ;; doesn't require to know about context. Be sure to disallow
+ ;; secondary string parsing, though.
+ (if (org-with-limited-levels (org-at-heading-p))
+ (progn
+ (beginning-of-line)
+ (if (not keep-trail) (org-element-headline-parser (point-max) t)
+ (list (org-element-headline-parser (point-max) t))))
+ ;; Otherwise move at the beginning of the section containing
+ ;; point.
+ (let ((origin (point))
+ (end (save-excursion
+ (org-with-limited-levels (outline-next-heading)) (point)))
+ element type special-flag trail struct prevs parent)
+ (org-with-limited-levels
+ (if (org-with-limited-levels (org-before-first-heading-p))
+ (goto-char (point-min))
+ (org-back-to-heading)
+ (forward-line)))
+ (org-skip-whitespace)
+ (beginning-of-line)
+ ;; Parse successively each element, skipping those ending
+ ;; before original position.
+ (catch 'exit
+ (while t
+ (setq element
+ (org-element--current-element end 'element special-flag struct)
+ type (car element))
+ (org-element-put-property element :parent parent)
+ (when keep-trail (push element trail))
+ (cond
+ ;; 1. Skip any element ending before point. Also skip
+ ;; element ending at point when we're sure that another
+ ;; element has started.
+ ((let ((elem-end (org-element-property :end element)))
+ (when (or (< elem-end origin)
+ (and (= elem-end origin) (/= elem-end end)))
+ (goto-char elem-end))))
+ ;; 2. An element containing point is always the element at
+ ;; point.
+ ((not (memq type org-element-greater-elements))
+ (throw 'exit (if keep-trail trail element)))
+ ;; 3. At any other greater element type, if point is
+ ;; within contents, move into it.
+ (t
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
+ ;; Create an anchor for tables and plain lists:
+ ;; when point is at the very beginning of these
+ ;; elements, ignoring affiliated keywords,
+ ;; target them instead of their contents.
+ (and (= cbeg origin) (memq type '(plain-list table)))
+ ;; When point is at contents end, do not move
+ ;; into elements with an explicit ending, but
+ ;; return that element instead.
+ (and (= cend origin)
+ (memq type
+ '(center-block
+ drawer dynamic-block inlinetask item
+ plain-list quote-block special-block))))
+ (throw 'exit (if keep-trail trail element))
+ (setq parent element)
+ (case type
+ (plain-list
+ (setq special-flag 'item
+ struct (org-element-property :structure element)))
+ (table (setq special-flag 'table-row))
+ (otherwise (setq special-flag nil)))
+ (setq end cend)
+ (goto-char cbeg)))))))))))
+
+;;;###autoload
+(defun org-element-context ()
+ "Return closest element or object around point.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+of the element or object and PROPS a plist of properties
+associated to it.
+
+Possible types are defined in `org-element-all-elements' and
+`org-element-all-objects'. Properties depend on element or
+object type, but always include :begin, :end, :parent
+and :post-blank properties."
+ (org-with-wide-buffer
+ (let* ((origin (point))
+ (element (org-element-at-point))
+ (type (car element))
+ end)
+ ;; Check if point is inside an element containing objects or at
+ ;; a secondary string. In that case, move to beginning of the
+ ;; element or secondary string and set END to the other side.
+ (if (not (or (and (eq type 'item)
+ (let ((tag (org-element-property :tag element)))
+ (and tag
+ (progn
+ (beginning-of-line)
+ (search-forward tag (point-at-eol))
+ (goto-char (match-beginning 0))
+ (and (>= origin (point))
+ (<= origin
+ ;; `1+' is required so some
+ ;; successors can match
+ ;; properly their object.
+ (setq end (1+ (match-end 0)))))))))
+ (and (memq type '(headline inlinetask))
+ (progn (beginning-of-line)
+ (skip-chars-forward "* ")
+ (setq end (point-at-eol))))
+ (and (memq type '(paragraph table-cell verse-block))
+ (let ((cbeg (org-element-property
+ :contents-begin element))
+ (cend (org-element-property
+ :contents-end element)))
+ (and (>= origin cbeg)
+ (<= origin cend)
+ (progn (goto-char cbeg) (setq end cend)))))))
+ element
+ (let ((restriction (org-element-restriction element))
+ (parent element)
+ candidates)
+ (catch 'exit
+ (while (setq candidates (org-element--get-next-object-candidates
+ end restriction candidates))
+ (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
+ candidates)))
+ ;; If ORIGIN is before next object in element, there's
+ ;; no point in looking further.
+ (if (> (cdr closest-cand) origin) (throw 'exit element)
+ (let* ((object
+ (progn (goto-char (cdr closest-cand))
+ (funcall (intern (format "org-element-%s-parser"
+ (car closest-cand))))))
+ (cbeg (org-element-property :contents-begin object))
+ (cend (org-element-property :contents-end object)))
+ (cond
+ ;; ORIGIN is after OBJECT, so skip it.
+ ((< (org-element-property :end object) origin)
+ (goto-char (org-element-property :end object)))
+ ;; ORIGIN is within a non-recursive object or at an
+ ;; object boundaries: Return that object.
+ ((or (not cbeg) (> cbeg origin) (< cend origin))
+ (throw 'exit
+ (org-element-put-property object :parent parent)))
+ ;; Otherwise, move within current object and restrict
+ ;; search to the end of its contents.
+ (t (goto-char cbeg)
+ (org-element-put-property object :parent parent)
+ (setq parent object end cend)))))))
+ parent))))))
+
+(defsubst org-element-nested-p (elem-A elem-B)
+ "Non-nil when elements ELEM-A and ELEM-B are nested."
+ (let ((beg-A (org-element-property :begin elem-A))
+ (beg-B (org-element-property :begin elem-B))
+ (end-A (org-element-property :end elem-A))
+ (end-B (org-element-property :end elem-B)))
+ (or (and (>= beg-A beg-B) (<= end-A end-B))
+ (and (>= beg-B beg-A) (<= end-B end-A)))))
+
+(defun org-element-swap-A-B (elem-A elem-B)
+ "Swap elements ELEM-A and ELEM-B.
+Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
+end of ELEM-A."
+ (goto-char (org-element-property :begin elem-A))
+ ;; There are two special cases when an element doesn't start at bol:
+ ;; the first paragraph in an item or in a footnote definition.
+ (let ((specialp (not (bolp))))
+ ;; Only a paragraph without any affiliated keyword can be moved at
+ ;; ELEM-A position in such a situation. Note that the case of
+ ;; a footnote definition is impossible: it cannot contain two
+ ;; paragraphs in a row because it cannot contain a blank line.
+ (if (and specialp
+ (or (not (eq (org-element-type elem-B) 'paragraph))
+ (/= (org-element-property :begin elem-B)
+ (org-element-property :contents-begin elem-B))))
+ (error "Cannot swap elements"))
+ ;; In a special situation, ELEM-A will have no indentation. We'll
+ ;; give it ELEM-B's (which will in, in turn, have no indentation).
+ (let* ((ind-B (when specialp
+ (goto-char (org-element-property :begin elem-B))
+ (org-get-indentation)))
+ (beg-A (org-element-property :begin elem-A))
+ (end-A (save-excursion
+ (goto-char (org-element-property :end elem-A))
+ (skip-chars-backward " \r\t\n")
+ (point-at-eol)))
+ (beg-B (org-element-property :begin elem-B))
+ (end-B (save-excursion
+ (goto-char (org-element-property :end elem-B))
+ (skip-chars-backward " \r\t\n")
+ (point-at-eol)))
+ ;; Store overlays responsible for visibility status. We
+ ;; also need to store their boundaries as they will be
+ ;; removed from buffer.
+ (overlays
+ (cons
+ (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
+ (overlays-in beg-A end-A))
+ (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
+ (overlays-in beg-B end-B))))
+ ;; Get contents.
+ (body-A (buffer-substring beg-A end-A))
+ (body-B (delete-and-extract-region beg-B end-B)))
+ (goto-char beg-B)
+ (when specialp
+ (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
+ (org-indent-to-column ind-B))
+ (insert body-A)
+ ;; Restore ex ELEM-A overlays.
+ (let ((offset (- beg-B beg-A)))
+ (mapc (lambda (ov)
+ (move-overlay
+ (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset)))
+ (car overlays))
+ (goto-char beg-A)
+ (delete-region beg-A end-A)
+ (insert body-B)
+ ;; Restore ex ELEM-B overlays.
+ (mapc (lambda (ov)
+ (move-overlay
+ (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset)))
+ (cdr overlays)))
+ (goto-char (org-element-property :end elem-B)))))
+
+
+(provide 'org-element)
+;;; org-element.el ends here
diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el
index 8b5b3f312e4..bd675c376bb 100644
--- a/lisp/org/org-entities.el
+++ b/lisp/org/org-entities.el
@@ -252,7 +252,7 @@ loaded, add these packages to `org-export-latex-packages-alist'."
"* Other"
"** Misc. (often used)"
- ("circ" "\\circ" t "&circ;" "^" "^" "ˆ")
+ ("circ" "\\^{}" nil "&circ;" "^" "^" "ˆ")
("vert" "\\vert{}" t "&#124;" "|" "|" "|")
("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
@@ -260,6 +260,11 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("lt" "\\textless{}" nil "&lt;" "<" "<" "<")
("gt" "\\textgreater{}" nil "&gt;" ">" ">" ">")
("tilde" "\\~{}" nil "&tilde;" "~" "~" "~")
+ ("slash" "/" nil "/" "/" "/" "/")
+ ("plus" "+" nil "+" "+" "+" "+")
+ ("under" "\\_" nil "_" "_" "_" "_")
+ ("equal" "=" nil "=" "=" "=" "=")
+ ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
("dagger" "\\textdagger{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
("Dagger" "\\textdaggerdbl{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
@@ -492,34 +497,31 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org
(defun org-entities-create-table ()
- "Create an org-mode table with all entities."
+ "Create an Org mode table with all entities."
(interactive)
- (let ((ll org-entities)
- (pos (point))
- e latex mathp html latin utf8 name ascii)
+ (let ((pos (point)) e latex mathp html latin utf8 name ascii)
(insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n")
- (while ll
- (when (listp e)
- (setq e (pop ll))
- (setq name (car e)
- latex (nth 1 e)
- mathp (nth 2 e)
- html (nth 3 e)
- ascii (nth 4 e)
- latin (nth 5 e)
- utf8 (nth 6 e))
- (if (equal ascii "|") (setq ascii "\\vert"))
- (if (equal latin "|") (setq latin "\\vert"))
- (if (equal utf8 "|") (setq utf8 "\\vert"))
- (if (equal ascii "=>") (setq ascii "= >"))
- (if (equal latin "=>") (setq latin "= >"))
- (insert "|" name
- "|" (format "=%s=" latex)
- "|" (format (if mathp "$%s$" "$\\mbox{%s}$")
- latex)
- "|" (format "=%s=" html) "|" html
- "|" ascii "|" latin "|" utf8
- "|\n")))
+ (mapc (lambda (e) (when (listp e)
+ (setq name (car e)
+ latex (nth 1 e)
+ mathp (nth 2 e)
+ html (nth 3 e)
+ ascii (nth 4 e)
+ latin (nth 5 e)
+ utf8 (nth 6 e))
+ (if (equal ascii "|") (setq ascii "\\vert"))
+ (if (equal latin "|") (setq latin "\\vert"))
+ (if (equal utf8 "|") (setq utf8 "\\vert"))
+ (if (equal ascii "=>") (setq ascii "= >"))
+ (if (equal latin "=>") (setq latin "= >"))
+ (insert "|" name
+ "|" (format "=%s=" latex)
+ "|" (format (if mathp "$%s$" "$\\mbox{%s}$")
+ latex)
+ "|" (format "=%s=" html) "|" html
+ "|" ascii "|" latin "|" utf8
+ "|\n")))
+ org-entities)
(goto-char pos)
(org-table-align)))
diff --git a/lisp/org/org-eshell.el b/lisp/org/org-eshell.el
index f572095d818..4335fce578c 100644
--- a/lisp/org/org-eshell.el
+++ b/lisp/org/org-eshell.el
@@ -37,18 +37,18 @@
followed by a colon."
(let* ((buffer-and-command
(if (string-match "\\([A-Za-z0-9-+*]+\\):\\(.*\\)" link)
- (list (match-string 1 link)
- (match-string 2 link))
+ (list (match-string 1 link)
+ (match-string 2 link))
(list eshell-buffer-name link)))
(eshell-buffer-name (car buffer-and-command))
(command (cadr buffer-and-command)))
- (if (get-buffer eshell-buffer-name)
- (org-pop-to-buffer-same-window eshell-buffer-name)
- (eshell))
- (goto-char (point-max))
- (eshell-kill-input)
- (insert command)
- (eshell-send-input)))
+ (if (get-buffer eshell-buffer-name)
+ (org-pop-to-buffer-same-window eshell-buffer-name)
+ (eshell))
+ (goto-char (point-max))
+ (eshell-kill-input)
+ (insert command)
+ (eshell-send-input)))
(defun org-eshell-store-link ()
"Store a link that, when opened, switches back to the current eshell buffer
@@ -57,7 +57,7 @@
(let* ((command (concat "cd " dired-directory))
(link (concat (buffer-name) ":" command)))
(org-store-link-props
- :link (org-make-link "eshell:" link)
+ :link (concat "eshell:" link)
:description command))))
(provide 'org-eshell)
diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el
index fbac6592090..89a0e5e5503 100644
--- a/lisp/org/org-exp-blocks.el
+++ b/lisp/org/org-exp-blocks.el
@@ -72,8 +72,13 @@
(eval-when-compile
(require 'cl))
-(require 'org)
(require 'find-func)
+(require 'org-compat)
+
+(declare-function org-split-string "org" (string &optional separators))
+(declare-function org-remove-indentation "org" (code &optional n))
+
+(defvar org-protecting-blocks nil) ; From org.el
(defun org-export-blocks-set (var value)
"Set the value of `org-export-blocks' and install fontification."
@@ -142,7 +147,6 @@ export function should accept three arguments."
(defun org-export-blocks-html-quote (body &optional open close)
"Protect BODY from org html export.
The optional OPEN and CLOSE tags will be inserted around BODY."
-
(concat
"\n#+BEGIN_HTML\n"
(or open "")
@@ -160,6 +164,7 @@ The optional OPEN and CLOSE tags will be inserted around BODY."
(or close "")
"#+END_LaTeX\n"))
+(defvar org-src-preserve-indentation) ; From org-src.el
(defun org-export-blocks-preprocess ()
"Export all blocks according to the `org-export-blocks' block export alist.
Does not export block types specified in specified in BLOCKS
@@ -167,65 +172,70 @@ which defaults to the value of `org-export-blocks-witheld'."
(interactive)
(save-window-excursion
(let ((case-fold-search t)
- (types '())
- matched indentation type func
+ (interblock (lambda (start end)
+ (mapcar (lambda (pair) (funcall (second pair) start end))
+ org-export-interblocks)))
+ matched indentation type types func
start end body headers preserve-indent progress-marker)
- (flet ((interblock (start end)
- (mapcar (lambda (pair) (funcall (second pair) start end))
- org-export-interblocks)))
- (goto-char (point-min))
- (setq start (point))
- (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
- (while (re-search-forward beg-re nil t)
- (let* ((match-start (copy-marker (match-beginning 0)))
- (body-start (copy-marker (match-end 0)))
- (indentation (length (match-string 1)))
- (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
- (regexp-quote (downcase (match-string 2)))))
- (type (intern (downcase (match-string 2))))
- (headers (save-match-data
- (org-split-string (match-string 3) "[ \t]+")))
- (balanced 1)
- (preserve-indent (or org-src-preserve-indentation
- (member "-i" headers)))
- match-end)
- (while (and (not (zerop balanced))
- (re-search-forward inner-re nil t))
- (if (string= (downcase (match-string 1)) "end")
- (decf balanced)
- (incf balanced)))
- (when (not (zerop balanced))
- (error "unbalanced begin/end_%s blocks with %S"
- type (buffer-substring match-start (point))))
- (setq match-end (copy-marker (match-end 0)))
- (unless preserve-indent
- (setq body (save-match-data (org-remove-indentation
- (buffer-substring
- body-start (match-beginning 0))))))
- (unless (memq type types) (setq types (cons type types)))
- (save-match-data (interblock start match-start))
- (when (setq func (cadr (assoc type org-export-blocks)))
- (let ((replacement (save-match-data
- (if (memq type org-export-blocks-witheld) ""
- (apply func body headers)))))
- (when replacement
- (delete-region match-start match-end)
- (goto-char match-start) (insert replacement)
- (if preserve-indent
- ;; indent only the code block markers
- (save-excursion
- (indent-line-to indentation) ; indent end_block
- (goto-char match-start)
- (indent-line-to indentation)) ; indent begin_block
- ;; indent everything
- (indent-code-rigidly match-start (point) indentation)))))
- ;; cleanup markers
- (set-marker match-start nil)
- (set-marker body-start nil)
- (set-marker match-end nil))
- (setq start (point))))
- (interblock start (point-max))
- (run-hooks 'org-export-blocks-postblock-hook)))))
+ (goto-char (point-min))
+ (setq start (point))
+ (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
+ (while (re-search-forward beg-re nil t)
+ (let* ((match-start (copy-marker (match-beginning 0)))
+ (body-start (copy-marker (match-end 0)))
+ (indentation (length (match-string 1)))
+ (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
+ (regexp-quote (downcase (match-string 2)))))
+ (type (intern (downcase (match-string 2))))
+ (headers (save-match-data
+ (org-split-string (match-string 3) "[ \t]+")))
+ (balanced 1)
+ (preserve-indent (or org-src-preserve-indentation
+ (member "-i" headers)))
+ match-end)
+ (while (and (not (zerop balanced))
+ (re-search-forward inner-re nil t))
+ (if (string= (downcase (match-string 1)) "end")
+ (decf balanced)
+ (incf balanced)))
+ (when (not (zerop balanced))
+ (error "Unbalanced begin/end_%s blocks with %S"
+ type (buffer-substring match-start (point))))
+ (setq match-end (copy-marker (match-end 0)))
+ (unless preserve-indent
+ (setq body (save-match-data (org-remove-indentation
+ (buffer-substring
+ body-start (match-beginning 0))))))
+ (unless (memq type types) (setq types (cons type types)))
+ (save-match-data (funcall interblock start match-start))
+ (when (setq func (cadr (assoc type org-export-blocks)))
+ (let ((replacement (save-match-data
+ (if (memq type org-export-blocks-witheld) ""
+ (apply func body headers)))))
+ ;; ;; un-comment this code after the org-element merge
+ ;; (save-match-data
+ ;; (when (and replacement (string= replacement ""))
+ ;; (delete-region
+ ;; (car (org-element-collect-affiliated-keyword))
+ ;; match-start)))
+ (when replacement
+ (delete-region match-start match-end)
+ (goto-char match-start) (insert replacement)
+ (if preserve-indent
+ ;; indent only the code block markers
+ (save-excursion
+ (indent-line-to indentation) ; indent end_block
+ (goto-char match-start)
+ (indent-line-to indentation)) ; indent begin_block
+ ;; indent everything
+ (indent-code-rigidly match-start (point) indentation)))))
+ ;; cleanup markers
+ (set-marker match-start nil)
+ (set-marker body-start nil)
+ (set-marker match-end nil))
+ (setq start (point))))
+ (funcall interblock start (point-max))
+ (run-hooks 'org-export-blocks-postblock-hook))))
;;================================================================================
;; type specific functions
@@ -233,14 +243,14 @@ which defaults to the value of `org-export-blocks-witheld'."
;;--------------------------------------------------------------------------------
;; ditaa: create images from ASCII art using the ditaa utility
(defcustom org-ditaa-jar-path (expand-file-name
- "ditaa.jar"
- (file-name-as-directory
- (expand-file-name
- "scripts"
- (file-name-as-directory
- (expand-file-name
- "../contrib"
- (file-name-directory (find-library-name "org")))))))
+ "ditaa.jar"
+ (file-name-as-directory
+ (expand-file-name
+ "scripts"
+ (file-name-as-directory
+ (expand-file-name
+ "../contrib"
+ (file-name-directory (org-find-library-dir "org")))))))
"Path to the ditaa jar executable."
:group 'org-babel
:type 'string)
@@ -273,29 +283,29 @@ passed to the ditaa utility as command line arguments."
(org-split-string body "\n")
"\n")))
(prog1
- (cond
- ((member org-export-current-backend '(html latex docbook))
- (unless (file-exists-p out-file)
- (mapc ;; remove old hashed versions of this file
- (lambda (file)
- (when (and (string-match (concat (regexp-quote (car out-file-parts))
- "_\\([[:alnum:]]+\\)\\."
- (regexp-quote (cdr out-file-parts)))
- file)
- (= (length (match-string 1 out-file)) 40))
- (delete-file (expand-file-name file
- (file-name-directory out-file)))))
- (directory-files (or (file-name-directory out-file)
- default-directory)))
- (with-temp-file data-file (insert body))
- (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
- (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
- (format "\n[[file:%s]]\n" out-file))
- (t (concat
- "\n#+BEGIN_EXAMPLE\n"
- body (if (string-match "\n$" body) "" "\n")
- "#+END_EXAMPLE\n")))
- (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
+ (cond
+ ((member org-export-current-backend '(html latex docbook))
+ (unless (file-exists-p out-file)
+ (mapc ;; remove old hashed versions of this file
+ (lambda (file)
+ (when (and (string-match (concat (regexp-quote (car out-file-parts))
+ "_\\([[:alnum:]]+\\)\\."
+ (regexp-quote (cdr out-file-parts)))
+ file)
+ (= (length (match-string 1 out-file)) 40))
+ (delete-file (expand-file-name file
+ (file-name-directory out-file)))))
+ (directory-files (or (file-name-directory out-file)
+ default-directory)))
+ (with-temp-file data-file (insert body))
+ (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
+ (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
+ (format "\n[[file:%s]]\n" out-file))
+ (t (concat
+ "\n#+BEGIN_EXAMPLE\n"
+ body (if (string-match "\n$" body) "" "\n")
+ "#+END_EXAMPLE\n")))
+ (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
;;--------------------------------------------------------------------------------
;; dot: create graphs using the dot graphing language
@@ -332,29 +342,29 @@ digraph data_relationships {
(cons raw-out-file "png")))
(out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
(prog1
- (cond
- ((member org-export-current-backend '(html latex docbook))
- (unless (file-exists-p out-file)
- (mapc ;; remove old hashed versions of this file
- (lambda (file)
- (when (and (string-match (concat (regexp-quote (car out-file-parts))
- "_\\([[:alnum:]]+\\)\\."
- (regexp-quote (cdr out-file-parts)))
- file)
- (= (length (match-string 1 out-file)) 40))
- (delete-file (expand-file-name file
- (file-name-directory out-file)))))
- (directory-files (or (file-name-directory out-file)
- default-directory)))
- (with-temp-file data-file (insert body))
- (message (concat "dot " data-file " " args " -o " out-file))
- (shell-command (concat "dot " data-file " " args " -o " out-file)))
- (format "\n[[file:%s]]\n" out-file))
- (t (concat
- "\n#+BEGIN_EXAMPLE\n"
- body (if (string-match "\n$" body) "" "\n")
- "#+END_EXAMPLE\n")))
- (message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
+ (cond
+ ((member org-export-current-backend '(html latex docbook))
+ (unless (file-exists-p out-file)
+ (mapc ;; remove old hashed versions of this file
+ (lambda (file)
+ (when (and (string-match (concat (regexp-quote (car out-file-parts))
+ "_\\([[:alnum:]]+\\)\\."
+ (regexp-quote (cdr out-file-parts)))
+ file)
+ (= (length (match-string 1 out-file)) 40))
+ (delete-file (expand-file-name file
+ (file-name-directory out-file)))))
+ (directory-files (or (file-name-directory out-file)
+ default-directory)))
+ (with-temp-file data-file (insert body))
+ (message (concat "dot " data-file " " args " -o " out-file))
+ (shell-command (concat "dot " data-file " " args " -o " out-file)))
+ (format "\n[[file:%s]]\n" out-file))
+ (t (concat
+ "\n#+BEGIN_EXAMPLE\n"
+ body (if (string-match "\n$" body) "" "\n")
+ "#+END_EXAMPLE\n")))
+ (message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
;;--------------------------------------------------------------------------------
;; comment: export comments in author-specific css-stylable divs
diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el
index 174619a3b8f..6b506cd1275 100644
--- a/lisp/org/org-exp.el
+++ b/lisp/org/org-exp.el
@@ -1,4 +1,4 @@
-;;; org-exp.el --- ASCII, HTML, XOXO and iCalendar export for Org-mode
+;;; org-exp.el --- Export internals for Org-mode
;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
@@ -190,16 +190,31 @@ This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
("eo" "A&#365;toro" "Dato" "Enhavo" "Piednotoj")
("es" "Autor" "Fecha" "&Iacute;ndice" "Pies de p&aacute;gina")
("fi" "Tekij&auml;" "P&auml;iv&auml;m&auml;&auml;r&auml;" "Sis&auml;llysluettelo" "Alaviitteet")
- ("fr" "Auteur" "Date" "Table des mati&egrave;res" "Notes de bas de page")
+ ("fr" "Auteur" "Date" "Sommaire" "Notes de bas de page")
("hu" "Szerz&otilde;" "D&aacute;tum" "Tartalomjegyz&eacute;k" "L&aacute;bjegyzet")
("is" "H&ouml;fundur" "Dagsetning" "Efnisyfirlit" "Aftanm&aacute;lsgreinar")
("it" "Autore" "Data" "Indice" "Note a pi&egrave; di pagina")
+ ;; Use numeric character entities for proper rendering of non-UTF8 documents
+ ;; ("ja" "著者" "日付" "目次" "脚注")
+ ("ja" "&#33879;&#32773;" "&#26085;&#20184;" "&#30446;&#27425;" "&#33050;&#27880;")
("nl" "Auteur" "Datum" "Inhoudsopgave" "Voetnoten")
("no" "Forfatter" "Dato" "Innhold" "Fotnoter")
("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l)
("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk)
("pl" "Autor" "Data" "Spis tre&#x015b;ci" "Przypis")
- ("sv" "F&ouml;rfattare" "Datum" "Inneh&aring;ll" "Fotnoter"))
+ ;; Use numeric character entities for proper rendering of non-UTF8 documents
+ ;; ("ru" "Ðвтор" "Дата" "Содержание" "СноÑки")
+ ("ru" "&#1040;&#1074;&#1090;&#1086;&#1088;" "&#1044;&#1072;&#1090;&#1072;" "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;" "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;")
+ ("sv" "F&ouml;rfattare" "Datum" "Inneh&aring;ll" "Fotnoter")
+ ;; Use numeric character entities for proper rendering of non-UTF8 documents
+ ;; ("uk" "Ðвтор" "Дата" "ЗміÑÑ‚" "Примітки")
+ ("uk" "&#1040;&#1074;&#1090;&#1086;&#1088;" "&#1044;&#1072;&#1090;&#1072;" "&#1047;&#1084;&#1110;&#1089;&#1090;" "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;")
+ ;; Use numeric character entities for proper rendering of non-UTF8 documents
+ ;; ("zh-CN" "作者" "日期" "目录" "脚注")
+ ("zh-CN" "&#20316;&#32773;" "&#26085;&#26399;" "&#30446;&#24405;" "&#33050;&#27880;")
+ ;; Use numeric character entities for proper rendering of non-UTF8 documents
+ ;; ("zh-TW" "作者" "日期" "目錄" "腳註")
+ ("zh-TW" "&#20316;&#32773;" "&#26085;&#26399;" "&#30446;&#37636;" "&#33139;&#35387;"))
"Terms used in export text, translated to different languages.
Use the variable `org-export-default-language' to set the language,
or use the +OPTION lines for a per-file setting."
@@ -525,12 +540,14 @@ This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\".
Allowed values are:
-nil Don't do anything.
-verbatim Keep everything in verbatim
-dvipng Process the LaTeX fragments to images.
- This will also include processing of non-math environments.
-t Do MathJax preprocessing if there is at least on math snippet,
- and arrange for MathJax.js to be loaded.
+nil Don't do anything.
+verbatim Keep everything in verbatim
+dvipng Process the LaTeX fragments to images.
+ This will also include processing of non-math environments.
+imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
+ to convert pdf files to png files.
+t Do MathJax preprocessing if there is at least on math snippet,
+ and arrange for MathJax.js to be loaded.
The default is nil, because this option needs the `dvipng' program which
is not available on all systems."
@@ -540,6 +557,7 @@ is not available on all systems."
(const :tag "Do not process math in any way" nil)
(const :tag "Obsolete, use dvipng setting" t)
(const :tag "Use dvipng to make images" dvipng)
+ (const :tag "Use imagemagick to make images" imagemagick)
(const :tag "Use MathJax to display math" mathjax)
(const :tag "Leave math verbatim" verbatim)))
@@ -623,7 +641,7 @@ table.el tables."
(defvar org-export-current-backend nil
"During export, this will be bound to a symbol such as 'html,
'latex, 'docbook, 'ascii, etc, indicating which of the export
- backends is in use. Otherwise it has the value nil. Users
+ backends is in use. Otherwise it has the value nil. Users
should not attempt to change the value of this variable
directly, but it can be used in code to test whether export is
in progress, and if so, what the backend is.")
@@ -702,7 +720,7 @@ Each element is a list of 3 items:
2. The string that can be used in the OPTION lines to set this option,
or nil if this option cannot be changed in this way
3. The customization variable that sets the default for this option."
-)
+ )
(defun org-default-export-plist ()
"Return the property list with default settings for the export variables."
@@ -713,8 +731,7 @@ Each element is a list of 3 items:
(setq s (nth 2 e)
v (cond
((assq s letbind) (nth 1 (assq s letbind)))
- ((boundp s) (symbol-value s))
- (t nil))
+ ((boundp s) (symbol-value s)))
rtn (cons (car e) (cons v rtn))))
rtn))
@@ -957,6 +974,8 @@ Pressing `1' will switch between these two options."
(let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background))
(subtree-p (or (org-region-active-p)
(eq org-export-initial-scope 'subtree)))
+ (regb (and (org-region-active-p) (region-beginning)))
+ (rege (and (org-region-active-p) (region-end)))
(help "[t] insert the export option template
\[v] limit export to visible part of outline tree
\[1] switch buffer/subtree export
@@ -1037,6 +1056,10 @@ Pressing `1' will switch between these two options."
((not subtree-p)
(setq subtree-p t)
(setq bpos (point))
+ (org-mark-subtree)
+ (org-activate-mark)
+ (setq regb (and (org-region-active-p) (region-beginning)))
+ (setq rege (and (org-region-active-p) (region-end)))
(message "Export subtree: "))))
(when (eq r1 ?\ )
(let ((case-fold-search t)
@@ -1074,8 +1097,9 @@ Pressing `1' will switch between these two options."
"-f" (symbol-name (nth 1 ass)))))
(set-process-sentinel p 'org-export-process-sentinel)
(message "Background process \"%s\": started" p))
- ;; background processing not requested, or not possible
- (if subtree-p (progn (org-mark-subtree) (org-activate-mark)))
+ ;; set the mark correctly when exporting a subtree
+ (if subtree-p (let (deactivate-mark) (push-mark rege t t) (goto-char regb)))
+
(call-interactively (nth 1 ass))
(when (and bpos (get-buffer-window cbuf))
(let ((cw (selected-window)))
@@ -1184,7 +1208,7 @@ on this string to produce the exported version."
(when (plist-get parameters :footnotes)
(org-footnote-normalize nil parameters))
- ;; Change lists ending. Other parts of export may insert blank
+ ;; Change lists ending. Other parts of export may insert blank
;; lines and lists' structure could be altered.
(org-export-mark-list-end)
@@ -1300,11 +1324,8 @@ on this string to produce the exported version."
;; Remove or replace comments
(org-export-handle-comments (plist-get parameters :comments))
- ;; Remove #+TBLFM and #+TBLNAME lines
- (org-export-handle-table-metalines)
-
- ;; Remove #+results and #+name lines
- (org-export-res/src-name-cleanup)
+ ;; Remove #+TBLFM #+TBLNAME #+NAME #+RESULTS lines
+ (org-export-handle-metalines)
;; Run the final hook
(run-hooks 'org-export-preprocess-final-hook)
@@ -1406,53 +1427,53 @@ the current file."
(goto-char (point-min))
(while (re-search-forward org-bracket-link-regexp nil t)
(org-if-unprotected-at (1+ (match-beginning 0))
- (let* ((org-link-search-must-match-exact-headline t)
- (md (match-data))
- (desc (match-end 2))
- (link (org-link-unescape (match-string 1)))
- (slink (org-solidify-link-text link))
- found props pos cref
- (target
- (cond
- ((= (string-to-char link) ?#)
- ;; user wants exactly this link
- link)
- ((cdr (assoc slink target-alist))
- (or (cdr (assoc (assoc slink target-alist)
- org-export-preferred-target-alist))
- (cdr (assoc slink target-alist))))
- ((and (string-match "^id:" link)
- (cdr (assoc (substring link 3) target-alist))))
- ((string-match "^(\\(.*\\))$" link)
- (setq cref (match-string 1 link))
- (concat "coderef:" cref))
- ((string-match org-link-types-re link) nil)
- ((or (file-name-absolute-p link)
- (string-match "^\\." link))
- nil)
- (t
- (let ((org-link-search-inhibit-query t))
- (save-excursion
- (setq found (condition-case nil (org-link-search link)
- (error nil)))
- (when (and found
- (or (org-at-heading-p)
- (not (eq found 'dedicated))))
- (or (get-text-property (point) 'target)
- (get-text-property
- (max (point-min)
- (1- (or (previous-single-property-change
- (point) 'target) 0)))
- 'target)))))))))
- (when target
- (set-match-data md)
- (goto-char (match-beginning 1))
- (setq props (text-properties-at (point)))
- (delete-region (match-beginning 1) (match-end 1))
- (setq pos (point))
- (insert target)
- (unless desc (insert "][" link))
- (add-text-properties pos (point) props))))))
+ (let* ((org-link-search-must-match-exact-headline t)
+ (md (match-data))
+ (desc (match-end 2))
+ (link (org-link-unescape (match-string 1)))
+ (slink (org-solidify-link-text link))
+ found props pos cref
+ (target
+ (cond
+ ((= (string-to-char link) ?#)
+ ;; user wants exactly this link
+ link)
+ ((cdr (assoc slink target-alist))
+ (or (cdr (assoc (assoc slink target-alist)
+ org-export-preferred-target-alist))
+ (cdr (assoc slink target-alist))))
+ ((and (string-match "^id:" link)
+ (cdr (assoc (substring link 3) target-alist))))
+ ((string-match "^(\\(.*\\))$" link)
+ (setq cref (match-string 1 link))
+ (concat "coderef:" cref))
+ ((string-match org-link-types-re link) nil)
+ ((or (file-name-absolute-p link)
+ (string-match "^\\." link))
+ nil)
+ (t
+ (let ((org-link-search-inhibit-query t))
+ (save-excursion
+ (setq found (condition-case nil (org-link-search link)
+ (error nil)))
+ (when (and found
+ (or (org-at-heading-p)
+ (not (eq found 'dedicated))))
+ (or (get-text-property (point) 'target)
+ (get-text-property
+ (max (point-min)
+ (1- (or (previous-single-property-change
+ (point) 'target) 0)))
+ 'target)))))))))
+ (when target
+ (set-match-data md)
+ (goto-char (match-beginning 1))
+ (setq props (text-properties-at (point)))
+ (delete-region (match-beginning 1) (match-end 1))
+ (setq pos (point))
+ (insert target)
+ (unless desc (insert "][" link))
+ (add-text-properties pos (point) props))))))
(defun org-export-remember-html-container-classes ()
"Store the HTML_CONTAINER_CLASS properties in a text property."
@@ -1462,8 +1483,10 @@ the current file."
"^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t)
(setq class (match-string 1))
(save-excursion
- (org-back-to-heading t)
- (put-text-property (point-at-bol) (point-at-eol) 'html-container-class class)))))
+ (when (re-search-backward "^\\*" (point-min) t)
+ (org-back-to-heading t)
+ (put-text-property (point-at-bol) (point-at-eol)
+ 'html-container-class class))))))
(defvar org-export-format-drawer-function nil
"Function to be called to format the contents of a drawer.
@@ -1532,8 +1555,8 @@ removed as well."
select-tags "\\|")
"\\):"))
(re-excl (concat ":\\(" (mapconcat 'regexp-quote
- exclude-tags "\\|")
- "\\):"))
+ exclude-tags "\\|")
+ "\\):"))
beg end cont)
(goto-char (point-min))
(when (and select-tags
@@ -1594,8 +1617,8 @@ When it is a list of strings, keep only tasks with these TODO keywords."
org-todo-keywords-1))))
"\\|")
"\\)\\($\\|[ \t]\\)"))
- (case-fold-search nil)
- beg)
+ (case-fold-search nil)
+ beg)
(goto-char (point-min))
(while (re-search-forward re nil t)
(org-if-unprotected
@@ -1741,7 +1764,7 @@ from the buffer."
(add-text-properties
(point-at-bol) (min (1+ (point-at-eol)) (point-max))
`(org-protected t original-indentation ,ind org-native-text t)))))
- ;; Delete #+ATTR_BACKEND: stuff of another backend. Those
+ ;; Delete #+ATTR_BACKEND: stuff of another backend. Those
;; matching the current backend will be taken care of by
;; `org-export-attach-captions-and-attributes'
(goto-char (point-min))
@@ -1819,9 +1842,9 @@ These special cookies will later be interpreted by the backend."
(replace-match ""))
(unless (bolp) (insert "\n"))
;; As org-list-end is inserted at column 0, it would end
- ;; by indentation any list. It can be problematic when
+ ;; by indentation any list. It can be problematic when
;; there are lists within lists: the inner list end would
- ;; also become the outer list end. To avoid this, text
+ ;; also become the outer list end. To avoid this, text
;; property `original-indentation' is added, as
;; `org-list-struct' pays attention to it when reading a
;; list.
@@ -1838,7 +1861,7 @@ These special properties will later be interpreted by the backend."
;; Mark a list with 3 properties: `list-item' which is
;; position at beginning of line, `list-struct' which is
;; list structure, and `list-prevs' which is the alist of
- ;; item and its predecessor. Leave point at list ending.
+ ;; item and its predecessor. Leave point at list ending.
(lambda (ctxt)
(let* ((struct (org-list-struct))
(top (org-list-get-top-point struct))
@@ -1866,9 +1889,9 @@ These special properties will later be interpreted by the backend."
'list-struct struct
'list-prevs prevs)))
poi)
- ;; Take care of bottom point. As babel may have inserted
+ ;; Take care of bottom point. As babel may have inserted
;; a new list in buffer, list ending isn't always
- ;; marked. Now mark every list ending and add properties
+ ;; marked. Now mark every list ending and add properties
;; useful to line processing exporters.
(goto-char bottom)
(when (or (looking-at "^ORG-LIST-END-MARKER\n")
@@ -1878,8 +1901,8 @@ These special properties will later be interpreted by the backend."
(unless (bolp) (insert "\n"))
(insert
(org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom
- 'list-struct struct
- 'list-prevs prevs)))
+ 'list-struct struct
+ 'list-prevs prevs)))
;; Following property is used by LaTeX exporter.
(add-text-properties top (point) (list 'list-context ctxt)))))))
;; Mark lists except for backends not interpreting them.
@@ -1971,29 +1994,33 @@ table line. If it is a link, add it to the line containing the link."
"Remove comments, or convert to backend-specific format.
ORG-COMMENTSP can be a format string for publishing comments.
When it is nil, all comments will be removed."
- (let ((re "^\\(#\\|[ \t]*#\\+ \\)\\(.*\n?\\)")
- pos)
+ (let ((re "^[ \t]*#\\( \\|$\\)"))
(goto-char (point-min))
- (while (or (looking-at re)
- (re-search-forward re nil t))
- (setq pos (match-beginning 0))
- (if (get-text-property pos 'org-protected)
- (goto-char (1+ pos))
- (if (and org-commentsp
- (not (equal (char-before (match-end 1)) ?+)))
- (progn (add-text-properties
- (match-beginning 0) (match-end 0) '(org-protected t))
- (replace-match (org-add-props
- (format org-commentsp (match-string 2))
- nil 'org-protected t)
- t t))
- (goto-char (1+ pos))
- (replace-match "")
- (goto-char (max (point-min) (1- pos))))))))
+ (while (re-search-forward re nil t)
+ (let ((pos (match-beginning 0))
+ (end (progn (forward-line) (point))))
+ (if (get-text-property pos 'org-protected)
+ (forward-line)
+ (if (not org-commentsp) (delete-region pos end)
+ (add-text-properties pos end '(org-protected t))
+ (replace-match
+ (org-add-props
+ (format org-commentsp (buffer-substring (match-end 0) end))
+ nil 'org-protected t)
+ t t)))))
+ ;; Hack attack: previous implementation also removed keywords at
+ ;; column 0. Brainlessly do it again.
+ (goto-char (point-min))
+ (while (re-search-forward "^#\\+" nil t)
+ (unless (get-text-property (point-at-bol) 'org-protected)
+ (delete-region (point-at-bol) (progn (forward-line) (point)))))))
-(defun org-export-handle-table-metalines ()
- "Remove table specific metalines #+TBLNAME: and #+TBLFM:."
- (let ((re "^[ \t]*#\\+TBL\\(NAME\\|FM\\):\\(.*\n?\\)")
+(defun org-export-handle-metalines ()
+ "Remove tables and source blocks metalines.
+This function should only be called after all block processing
+has taken place."
+ (let ((re "^[ \t]*#\\+\\(tbl\\(?:name\\|fm\\)\\|results\\(?:\\[[a-z0-9]+\\]\\)?\\|name\\):\\(.*\n?\\)")
+ (case-fold-search t)
pos)
(goto-char (point-min))
(while (or (looking-at re)
@@ -2005,18 +2032,6 @@ When it is nil, all comments will be removed."
(replace-match "")
(goto-char (max (point-min) (1- pos)))))))
-(defun org-export-res/src-name-cleanup ()
- "Clean up #+results and #+name lines for export.
-This function should only be called after all block processing
-has taken place."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (let ((case-fold-search t))
- (while (org-re-search-forward-unprotected
- "#\\+\\(name\\|results\\(\\[[a-z0-9]+\\]\\)?\\):" nil t)
- (delete-region (match-beginning 0) (progn (forward-line) (point)))))))
-
(defun org-export-mark-radio-links ()
"Find all matches for radio targets and turn them into internal links."
(let ((re-radio (and org-target-link-regexp
@@ -2146,8 +2161,8 @@ can work correctly."
(goto-char (point-min))
(while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
(org-if-unprotected-at (match-beginning 1)
- (replace-match "\\1 \\3")
- (goto-char (match-beginning 0)))))
+ (replace-match "\\1 \\3")
+ (goto-char (match-beginning 0)))))
(defun org-export-concatenate-multiline-emphasis ()
"Find multi-line emphasis and put it all into a single line.
@@ -2372,7 +2387,7 @@ TYPE must be a string, any of:
(if (stringp val) val (format "%s" val))
"\n")
(concat "\n" ind-str)))))
- ;; Eventually do the replacement, if VAL isn't nil. Move
+ ;; Eventually do the replacement, if VAL isn't nil. Move
;; point at beginning of macro for recursive expansions.
(when val
(replace-match val t t)
@@ -2391,13 +2406,14 @@ TYPE must be a string, any of:
(defun org-export-handle-include-files ()
"Include the contents of include files, with proper formatting."
(let ((case-fold-search t)
- params file markup lang start end prefix prefix1 switches all minlevel lines)
+ params file markup lang start end prefix prefix1 switches all minlevel currentlevel addlevel lines)
(goto-char (point-min))
- (while (re-search-forward "^#\\+INCLUDE:?[ \t]+\\(.*\\)" nil t)
+ (while (re-search-forward "^#\\+include:[ \t]+\\(.*\\)" nil t)
(setq params (read (concat "(" (match-string 1) ")"))
prefix (org-get-and-remove-property 'params :prefix)
prefix1 (org-get-and-remove-property 'params :prefix1)
minlevel (org-get-and-remove-property 'params :minlevel)
+ addlevel (org-get-and-remove-property 'params :addlevel)
lines (org-get-and-remove-property 'params :lines)
file (org-symname-or-string (pop params))
markup (org-symname-or-string (pop params))
@@ -2406,6 +2422,7 @@ TYPE must be a string, any of:
switches (mapconcat #'(lambda (x) (format "%s" x)) params " ")
start nil end nil)
(delete-region (match-beginning 0) (match-end 0))
+ (setq currentlevel (or (org-current-level) 0))
(if (or (not file)
(not (file-exists-p file))
(not (file-readable-p file)))
@@ -2421,7 +2438,7 @@ TYPE must be a string, any of:
end (format "#+end_%s" markup))))
(insert (or start ""))
(insert (org-get-file-contents (expand-file-name file)
- prefix prefix1 markup minlevel lines))
+ prefix prefix1 markup currentlevel minlevel addlevel lines))
(or (bolp) (newline))
(insert (or end ""))))
all))
@@ -2438,13 +2455,15 @@ TYPE must be a string, any of:
(when intersection
(error "Recursive #+INCLUDE: %S" intersection))))))
-(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel lines)
+(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel parentlevel addlevel lines)
"Get the contents of FILE and return them as a string.
If PREFIX is a string, prepend it to each line. If PREFIX1
is a string, prepend it to the first line instead of PREFIX.
If MARKUP, don't protect org-like lines, the exporter will
-take care of the block they are in. If LINES is a string
-specifying a range of lines, include only those lines ."
+take care of the block they are in. If ADDLEVEL is a number,
+demote included file to current heading level+ADDLEVEL.
+If LINES is a string specifying a range of lines,
+include only those lines."
(if (stringp markup) (setq markup (downcase markup)))
(with-temp-buffer
(insert-file-contents file)
@@ -2477,6 +2496,14 @@ specifying a range of lines, include only those lines ."
(when minlevel
(dotimes (lvl minlevel)
(org-map-region 'org-demote (point-min) (point-max))))
+ (when addlevel
+ (let ((inclevel (or (if (org-before-first-heading-p)
+ (1- (and (outline-next-heading)
+ (org-current-level)))
+ (1- (org-current-level)))
+ 0)))
+ (dotimes (level (- (+ parentlevel addlevel) inclevel))
+ (org-map-region 'org-demote (point-min) (point-max)))))
(buffer-string)))
(defun org-get-and-remove-property (listvar prop)
@@ -2548,7 +2575,7 @@ in the list) and remove property and value from the list in LISTVAR."
(defvar org-export-latex-minted-options) ;; defined in org-latex.el
(defun org-remove-formatting-on-newlines-in-region (beg end)
- "Remove formatting on newline characters"
+ "Remove formatting on newline characters."
(interactive "r")
(save-excursion
(goto-char beg)
@@ -2562,10 +2589,10 @@ in the list) and remove property and value from the list in LISTVAR."
The CODE is marked up in `org-export-current-backend' format.
Check if a function by name
-\"org-<backend>-format-source-code-or-example\" is bound. If yes,
-use it as the custom formatter. Otherwise, use the default
-formatter. Default formatters are provided for docbook, html,
-latex and ascii backends. For example, use
+\"org-<backend>-format-source-code-or-example\" is bound. If yes,
+use it as the custom formatter. Otherwise, use the default
+formatter. Default formatters are provided for docbook, html,
+latex and ascii backends. For example, use
`org-html-format-source-code-or-example' to provide a custom
formatter for export to \"html\".
@@ -2703,65 +2730,64 @@ INDENT was the original indentation of the block."
(setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
(cond
((and lang org-export-latex-listings)
- (flet ((make-option-string
- (pair)
- (concat (first pair)
- (if (> (length (second pair)) 0)
- (concat "=" (second pair))))))
- (let* ((lang-sym (intern lang))
- (minted-p (eq org-export-latex-listings 'minted))
- (listings-p (not minted-p))
- (backend-lang
- (or (cadr
- (assq
- lang-sym
- (cond
- (minted-p org-export-latex-minted-langs)
- (listings-p org-export-latex-listings-langs))))
- lang))
- (custom-environment
- (cadr
- (assq
- lang-sym
- org-export-latex-custom-lang-environments))))
- (concat
- (when (and listings-p (not custom-environment))
- (format
- "\\lstset{%s}\n"
- (mapconcat
- #'make-option-string
- (append org-export-latex-listings-options
- `(("language" ,backend-lang))) ",")))
- (when (and caption org-export-latex-listings-w-names)
- (format
- "\n%s $\\equiv$ \n"
- (replace-regexp-in-string "_" "\\\\_" caption)))
- (cond
- (custom-environment
- (format "\\begin{%s}\n%s\\end{%s}\n"
- custom-environment rtn custom-environment))
- (listings-p
- (format "\\begin{%s}\n%s\\end{%s}"
- "lstlisting" rtn "lstlisting"))
- (minted-p
- (format
- "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
- (mapconcat #'make-option-string
- org-export-latex-minted-options ",")
- backend-lang rtn)))))))
+ (let* ((make-option-string
+ (lambda (pair)
+ (concat (first pair)
+ (if (> (length (second pair)) 0)
+ (concat "=" (second pair))))))
+ (lang-sym (intern lang))
+ (minted-p (eq org-export-latex-listings 'minted))
+ (listings-p (not minted-p))
+ (backend-lang
+ (or (cadr
+ (assq
+ lang-sym
+ (cond
+ (minted-p org-export-latex-minted-langs)
+ (listings-p org-export-latex-listings-langs))))
+ lang))
+ (custom-environment
+ (cadr
+ (assq
+ lang-sym
+ org-export-latex-custom-lang-environments))))
+ (concat
+ (when (and listings-p (not custom-environment))
+ (format
+ "\\lstset{%s}\n"
+ (mapconcat
+ make-option-string
+ (append org-export-latex-listings-options
+ `(("language" ,backend-lang))) ",")))
+ (when (and caption org-export-latex-listings-w-names)
+ (format
+ "\n%s $\\equiv$ \n"
+ (replace-regexp-in-string "_" "\\\\_" caption)))
+ (cond
+ (custom-environment
+ (format "\\begin{%s}\n%s\\end{%s}\n"
+ custom-environment rtn custom-environment))
+ (listings-p
+ (format "\\begin{%s}\n%s\\end{%s}"
+ "lstlisting" rtn "lstlisting"))
+ (minted-p
+ (format
+ "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
+ (mapconcat make-option-string
+ org-export-latex-minted-options ",")
+ backend-lang rtn))))))
(t (concat (car org-export-latex-verbatim-wrap)
rtn (cdr org-export-latex-verbatim-wrap)))))
- ((eq org-export-current-backend 'ascii)
- ;; This is not HTML or LaTeX, so just make it an example.
- (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
- (concat caption "\n"
+ ((eq org-export-current-backend 'ascii)
+ ;; This is not HTML or LaTeX, so just make it an example.
+ (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
+ (concat caption "\n"
(concat
(mapconcat
(lambda (l) (concat " " l))
(org-split-string rtn "\n")
"\n")
- "\n")
- ))
+ "\n")))
(t
(error "Don't know how to markup source or example block in %s"
(upcase backend-name)))))
@@ -2787,7 +2813,7 @@ backend-specific lines pre-pended or appended to the original
source block.
NUMBER is non-nil if the literal example specifies \"+n\" or
-\"-n\" switch. If NUMBER is non-nil add line numbers.
+\"-n\" switch. If NUMBER is non-nil add line numbers.
CONT is non-nil if the literal example specifies \"+n\" switch.
If CONT is nil, start numbering this block from 1. Otherwise
@@ -2837,7 +2863,7 @@ block numbering. When non-nil do the following:
(fm
(cond
((eq org-export-current-backend 'html) (format "<span class=\"linenr\">%s</span>"
- fmt))
+ fmt))
((eq org-export-current-backend 'ascii) fmt)
((eq org-export-current-backend 'latex) fmt)
((eq org-export-current-backend 'docbook) fmt)
@@ -2915,7 +2941,7 @@ block numbering. When non-nil do the following:
(setq lv (- (match-end 1) (match-beginning 1))
todo (and (match-beginning 2)
(not (member (match-string 2 line)
- org-done-keywords))))
+ org-done-keywords))))
; TODO, not DONE
(if (<= lv level) (throw 'exit nil))
(if todo (throw 'exit t))))))))
@@ -3202,8 +3228,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
(or org-tag-alist (org-get-buffer-tags)) " ") "")
(mapconcat 'identity org-file-tags " ")
org-archive-location
- "org file:~/org/%s.org"
- ))
+ "org file:~/org/%s.org"))
;;;###autoload
(defun org-insert-export-options-template ()
@@ -3244,8 +3269,7 @@ If yes remove the column and the special lines."
(mapcar (lambda (x)
(cond ((member x '("<" "&lt;")) :start)
((member x '(">" "&gt;")) :end)
- ((member x '("<>" "&lt;&gt;")) :startend)
- (t nil)))
+ ((member x '("<>" "&lt;&gt;")) :startend)))
(org-split-string x "[ \t]*|[ \t]*")))
nil)
((org-table-cookie-line-p x)
@@ -3266,8 +3290,7 @@ If yes remove the column and the special lines."
(mapcar (lambda (x)
(cond ((member x '("<" "&lt;")) :start)
((member x '(">" "&gt;")) :end)
- ((member x '("<>" "&lt;&gt;")) :startend)
- (t nil)))
+ ((member x '("<>" "&lt;&gt;")) :startend)))
(cdr (org-split-string x "[ \t]*|[ \t]*"))))
nil)
((org-table-cookie-line-p x)
@@ -3284,18 +3307,20 @@ If yes remove the column and the special lines."
(defun org-export-cleanup-toc-line (s)
"Remove tags and timestamps from lines going into the toc."
- (when (memq org-export-with-tags '(not-in-toc nil))
- (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s)
+ (if (not s)
+ "" ; Return a string when argument is nil
+ (when (memq org-export-with-tags '(not-in-toc nil))
+ (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s)
+ (setq s (replace-match "" t t s))))
+ (when org-export-remove-timestamps-from-toc
+ (while (string-match org-maybe-keyword-time-regexp s)
(setq s (replace-match "" t t s))))
- (when org-export-remove-timestamps-from-toc
- (while (string-match org-maybe-keyword-time-regexp s)
- (setq s (replace-match "" t t s))))
- (while (string-match org-bracket-link-regexp s)
- (setq s (replace-match (match-string (if (match-end 3) 3 1) s)
- t t s)))
- (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s)
- (setq s (replace-match "" t t s)))
- s)
+ (while (string-match org-bracket-link-regexp s)
+ (setq s (replace-match (match-string (if (match-end 3) 3 1) s)
+ t t s)))
+ (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s)
+ (setq s (replace-match "" t t s)))
+ s))
(defun org-get-text-property-any (pos prop &optional object)
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index 58f879dd51a..51aead1b8bb 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -287,12 +287,14 @@ column view defines special faces for each outline level. See the file
(defface org-date-selected
(org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold nil))
- (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold nil))
- (((class color) (min-colors 8) (background light)) (:foreground "red" :bold nil))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold nil))
+ '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t))
+ (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t))
(t (:inverse-video t))))
- "Face for highlighting the calendar day when using `org-read-date'."
+ "Face for highlighting the calendar day when using `org-read-date'.
+Using a bold face here might cause discrepancies while displaying the
+calendar."
:group 'org-faces)
(defface org-sexp-date
@@ -309,6 +311,11 @@ Note that the variable `org-tag-faces' can be used to overrule this face for
specific tags."
:group 'org-faces)
+(defface org-list-dt
+ '((t (:bold t)))
+ "Default face for definition terms in lists."
+ :group 'org-faces)
+
(defface org-todo ; font-lock-warning-face
(org-compatible-face nil
'((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
@@ -381,8 +388,8 @@ determines if it is a foreground or a background color."
(cons
(string :tag "Keyword")
(choice :tag "Face "
- (string :tag "Color")
- (sexp :tag "Face")))))
+ (string :tag "Color")
+ (sexp :tag "Face")))))
(defcustom org-priority-faces nil
"Faces for specific Priorities.
@@ -398,8 +405,8 @@ determines if it is a foreground or a background color."
(cons
(character :tag "Priority")
(choice :tag "Face "
- (string :tag "Color")
- (sexp :tag "Face")))))
+ (string :tag "Color")
+ (sexp :tag "Face")))))
(defvar org-tags-special-faces-re nil)
(defun org-set-tag-faces (var value)
@@ -412,7 +419,7 @@ determines if it is a foreground or a background color."
(defface org-checkbox
(org-compatible-face 'bold
'((t (:bold t))))
- "Face for checkboxes"
+ "Face for checkboxes."
:group 'org-faces)
@@ -439,8 +446,8 @@ changes."
(cons
(string :tag "Tag ")
(choice :tag "Face"
- (string :tag "Foreground color")
- (sexp :tag "Face")))))
+ (string :tag "Foreground color")
+ (sexp :tag "Face")))))
(defface org-table ;; originally copied from font-lock-function-name-face
(org-compatible-face nil
@@ -484,9 +491,9 @@ changes."
:version "22.1")
(defface org-document-title
- '((((class color) (background light)) (:foreground "midnight blue" :weight bold :height 1.44))
- (((class color) (background dark)) (:foreground "pale turquoise" :weight bold :height 1.44))
- (t (:weight bold :height 1.44)))
+ '((((class color) (background light)) (:foreground "midnight blue" :weight bold))
+ (((class color) (background dark)) (:foreground "pale turquoise" :weight bold))
+ (t (:weight bold)))
"Face for document title, i.e. that which follows the #+TITLE: keyword."
:group 'org-faces)
@@ -549,9 +556,9 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
:version "22.1")
(org-copy-face 'org-block 'org-quote
- "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.")
+ "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.")
(org-copy-face 'org-block 'org-verse
- "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.")
+ "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.")
(defcustom org-fontify-quote-and-verse-blocks nil
"Non-nil means, add a special face to #+begin_quote and #+begin_verse block.
@@ -574,8 +581,8 @@ content of these blocks will still be treated as Org syntax."
(((class color) (min-colors 8))
(:background "cyan" :foreground "black"))
(t (:inverse-video t))))
- "Basic face for displaying the secondary selection."
- :group 'org-faces)
+ "Basic face for displaying the secondary selection."
+ :group 'org-faces)
(defface org-agenda-structure ;; originally copied from font-lock-function-name-face
(org-compatible-face nil
@@ -602,7 +609,7 @@ content of these blocks will still be treated as Org syntax."
"Face used in agenda for weekend days.
See the variable `org-agenda-weekend-days' for a definition of which days
belong to the weekend."
- :weight 'bold)
+ :weight 'bold)
(defface org-scheduled
(org-compatible-face nil
@@ -727,8 +734,8 @@ month and 365.24 days for a year)."
(defconst org-level-faces
'(org-level-1 org-level-2 org-level-3 org-level-4
- org-level-5 org-level-6 org-level-7 org-level-8
- ))
+ org-level-5 org-level-6 org-level-7 org-level-8
+ ))
(defcustom org-n-level-faces (length org-level-faces)
"The number of different faces to be used for headlines.
@@ -738,14 +745,14 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
:group 'org-faces)
(defcustom org-cycle-level-faces t
- "Non-nil means level styles cycle after level `org-n-level-faces'.
+ "Non-nil means level styles cycle after level `org-n-level-faces'.
Then so level org-n-level-faces+1 is styled like level 1.
If nil, then all levels >=org-n-level-faces are styled like
level org-n-level-faces"
- :group 'org-appearance
- :group 'org-faces
- :version "24.1"
- :type 'boolean)
+ :group 'org-appearance
+ :group 'org-faces
+ :version "24.1"
+ :type 'boolean)
(defface org-latex-and-export-specials
(let ((font (cond ((assq :inherit custom-face-attributes)
diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el
index f5186aaacf3..91bf3347953 100644
--- a/lisp/org/org-feed.el
+++ b/lisp/org/org-feed.el
@@ -80,7 +80,7 @@
;; that received the input of the feed. You should add FEEDSTATUS
;; to your list of drawers in the files that receive feed input:
;;
-;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS
+;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS
;;
;; Acknowledgments
;; ---------------
@@ -100,6 +100,10 @@
(declare-function xml-get-attribute-or-nil "xml" (node attribute))
(declare-function xml-substitute-special "xml" (string))
+(declare-function org-capture-escaped-% "org-capture" ())
+(declare-function org-capture-inside-embedded-elisp-p "org-capture" ())
+(declare-function org-capture-expand-embedded-elisp "org-capture" ())
+
(defgroup org-feed nil
"Options concerning RSS feeds as inputs for Org files."
:tag "Org Feed"
@@ -179,34 +183,34 @@ Here are the keyword-value pair allows in `org-feed-alist'.
:group 'org-feed
:type '(repeat
(list :value ("" "http://" "" "")
- (string :tag "Name")
- (string :tag "Feed URL")
- (file :tag "File for inbox")
- (string :tag "Headline for inbox")
- (repeat :inline t
- (choice
- (list :inline t :tag "Filter"
- (const :filter)
- (symbol :tag "Filter Function"))
- (list :inline t :tag "Template"
- (const :template)
- (string :tag "Template"))
- (list :inline t :tag "Formatter"
- (const :formatter)
- (symbol :tag "Formatter Function"))
- (list :inline t :tag "New items handler"
- (const :new-handler)
- (symbol :tag "Handler Function"))
- (list :inline t :tag "Changed items"
- (const :changed-handler)
- (symbol :tag "Handler Function"))
- (list :inline t :tag "Parse Feed"
- (const :parse-feed)
- (symbol :tag "Parse Feed Function"))
- (list :inline t :tag "Parse Entry"
- (const :parse-entry)
- (symbol :tag "Parse Entry Function"))
- )))))
+ (string :tag "Name")
+ (string :tag "Feed URL")
+ (file :tag "File for inbox")
+ (string :tag "Headline for inbox")
+ (repeat :inline t
+ (choice
+ (list :inline t :tag "Filter"
+ (const :filter)
+ (symbol :tag "Filter Function"))
+ (list :inline t :tag "Template"
+ (const :template)
+ (string :tag "Template"))
+ (list :inline t :tag "Formatter"
+ (const :formatter)
+ (symbol :tag "Formatter Function"))
+ (list :inline t :tag "New items handler"
+ (const :new-handler)
+ (symbol :tag "Handler Function"))
+ (list :inline t :tag "Changed items"
+ (const :changed-handler)
+ (symbol :tag "Handler Function"))
+ (list :inline t :tag "Parse Feed"
+ (const :parse-feed)
+ (symbol :tag "Parse Feed Function"))
+ (list :inline t :tag "Parse Entry"
+ (const :parse-entry)
+ (symbol :tag "Parse Entry Function"))
+ )))))
(defcustom org-feed-drawer "FEEDSTATUS"
"The name of the drawer for feed status information.
@@ -225,12 +229,14 @@ Any fields from the feed item can be interpolated into the template with
%name, for example %title, %description, %pubDate etc. In addition, the
following special escapes are valid as well:
-%h the title, or the first line of the description
-%t the date as a stamp, either from <pubDate> (if present), or
- the current date.
-%T date and time
-%u,%U like %t,%T, but inactive time stamps
-%a A link, from <guid> if that is a permalink, else from <link>"
+%h The title, or the first line of the description
+%t The date as a stamp, either from <pubDate> (if present), or
+ the current date
+%T Date and time
+%u,%U Like %t,%T, but inactive time stamps
+%a A link, from <guid> if that is a permalink, else from <link>
+%(sexp) Evaluate elisp `(sexp)' and replace with the result, the simple
+ %-escapes above can be used as arguments, e.g. %(capitalize \\\"%h\\\")"
:group 'org-feed
:type '(string :tag "Template"))
@@ -251,7 +257,7 @@ of the file pointed to by the URL."
(const :tag "Externally with wget" wget)
(function :tag "Function")))
- (defcustom org-feed-before-adding-hook nil
+(defcustom org-feed-before-adding-hook nil
"Hook that is run before adding new feed items to a file.
You might want to commit the file in its current state to version control,
for example."
@@ -450,8 +456,8 @@ Switch to that buffer, and return the position of that headline."
nil t)
(goto-char (match-beginning 0))
(goto-char (point-max))
- (insert "\n\n* " heading "\n\n")
- (org-back-to-heading t))
+ (insert "\n\n* " heading "\n\n")
+ (org-back-to-heading t))
(point))
(defun org-feed-read-previous-status (pos drawer)
@@ -506,9 +512,10 @@ This will find DRAWER and extract the alist."
ENTRY is a property list. This function adds a `:formatted-for-org' property
and returns the full property list.
If that property is already present, nothing changes."
+ (require 'org-capture)
(if formatter
(funcall formatter entry)
- (let (dlines fmt tmp indent time name
+ (let (dlines time escape name tmp
v-h v-t v-T v-u v-U v-a)
(setq dlines (org-split-string (or (plist-get entry :description) "???")
"\n")
@@ -527,20 +534,35 @@ If that property is already present, nothing changes."
""))
(with-temp-buffer
(insert template)
+
+ ;; Simple %-escapes
+ ;; before embedded elisp to support simple %-escapes as
+ ;; arguments for embedded elisp
(goto-char (point-min))
(while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
- (setq name (match-string 1))
- (cond
- ((member name '("h" "t" "T" "u" "U" "a"))
- (replace-match (symbol-value (intern (concat "v-" name))) t t))
- ((setq tmp (plist-get entry (intern (concat ":" name))))
- (save-excursion
- (save-match-data
- (beginning-of-line 1)
- (when (looking-at (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
- (setq tmp (org-feed-make-indented-block
- tmp (org-get-indentation))))))
- (replace-match tmp t t))))
+ (unless (org-capture-escaped-%)
+ (setq name (match-string 1)
+ escape (org-capture-inside-embedded-elisp-p))
+ (cond
+ ((member name '("h" "t" "T" "u" "U" "a"))
+ (setq tmp (symbol-value (intern (concat "v-" name)))))
+ ((setq tmp (plist-get entry (intern (concat ":" name))))
+ (save-excursion
+ (save-match-data
+ (beginning-of-line 1)
+ (when (looking-at
+ (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
+ (setq tmp (org-feed-make-indented-block
+ tmp (org-get-indentation))))))))
+ (when tmp
+ ;; escape string delimiters `"' when inside %() embedded lisp
+ (when escape
+ (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp)))
+ (replace-match tmp t t))))
+
+ ;; %() embedded elisp
+ (org-capture-expand-embedded-elisp)
+
(decode-coding-string
(buffer-string) (detect-coding-region (point-min) (point-max) t))))))
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index a9ba8d7510b..3aaa44b7ac3 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -57,6 +57,7 @@
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-show-context "org" (&optional key))
(declare-function org-trim "org" (s))
+(declare-function org-skip-whitespace "org" ())
(declare-function outline-next-heading "outline")
(declare-function org-skip-whitespace "org" ())
@@ -277,9 +278,7 @@ otherwise."
(concat org-outline-regexp-bol "\\|"
org-footnote-definition-re "\\|"
"^[ \t]*$") bound 'move))
- (progn (goto-char (match-beginning 0))
- (org-skip-whitespace)
- (point-at-bol))
+ (match-beginning 0)
(point)))))
(list label beg end
(org-trim (buffer-substring-no-properties beg-def end)))))))))
@@ -362,7 +361,7 @@ Return a non-nil value when a definition has been found."
(looking-at (format "\\[%s\\]\\|\\[%s:" label label))
(goto-char (match-end 0))
(org-show-context 'link-search)
- (when (eq major-mode 'org-mode)
+ (when (derived-mode-p 'org-mode)
(message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))
t)))
@@ -451,7 +450,8 @@ or new, let the user edit the definition of the footnote."
(error "Cannot insert a footnote here"))
(let* ((lbls (and (not (equal org-footnote-auto-label 'random))
(org-footnote-all-labels)))
- (propose (org-footnote-unique-label lbls))
+ (propose (and (not (equal org-footnote-auto-label 'random))
+ (org-footnote-unique-label lbls)))
(label
(org-footnote-normalize-label
(cond
@@ -489,7 +489,7 @@ or new, let the user edit the definition of the footnote."
(let ((label (org-footnote-normalize-label label)))
(cond
;; In an Org file.
- ((eq major-mode 'org-mode)
+ ((derived-mode-p 'org-mode)
;; If `org-footnote-section' is defined, find it, or create it
;; at the end of the buffer.
(when org-footnote-section
@@ -553,7 +553,7 @@ or new, let the user edit the definition of the footnote."
(backward-char)
;; Only notify user about next possible action when in an Org
;; buffer, as the bindings may have different meanings otherwise.
- (when (eq major-mode 'org-mode)
+ (when (derived-mode-p 'org-mode)
(message
"Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
@@ -713,7 +713,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; 2. Find and remove the footnote section, if any. Also
;; determine where footnotes shall be inserted (INS-POINT).
(cond
- ((and org-footnote-section (eq major-mode 'org-mode))
+ ((and org-footnote-section (derived-mode-p 'org-mode))
(goto-char (point-min))
(if (re-search-forward
(concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
@@ -729,7 +729,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; of the section containing their first reference.
;; Nevertheless, in an export situation, set insertion point to
;; `point-max' by default.
- ((eq major-mode 'org-mode)
+ ((derived-mode-p 'org-mode)
(when export-props
(goto-char (point-max))
(skip-chars-backward " \r\t\n")
@@ -790,7 +790,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; No footnote: exit.
((not ref-table))
;; Cases when footnotes should be inserted in one place.
- ((or (not (eq major-mode 'org-mode))
+ ((or (not (derived-mode-p 'org-mode))
org-footnote-section
export-props)
;; Insert again the section title, if any. Ensure that title,
@@ -799,7 +799,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; separate section with a blank line, unless explicitly
;; stated in `org-blank-before-new-entry'.
(cond
- ((not (eq major-mode 'org-mode))
+ ((not (derived-mode-p 'org-mode))
(skip-chars-backward " \t\n\r")
(delete-region (point) ins-point)
(unless (bolp) (newline))
@@ -845,7 +845,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(beginning-of-line 0)
(while (and (not (bobp)) (= (char-after) ?#))
(beginning-of-line 0))
- (if (looking-at "[ \t]*#\\+TBLFM:") (beginning-of-line 2))
+ (if (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) (beginning-of-line 2))
(end-of-line 1)
(skip-chars-backward "\n\r\t ")
(forward-line))
@@ -872,7 +872,11 @@ Return the number of footnotes removed."
(while (re-search-forward def-re nil t)
(let ((full-def (org-footnote-at-definition-p)))
(when full-def
- (delete-region (nth 1 full-def) (nth 2 full-def))
+ ;; Remove the footnote, and all blank lines before it.
+ (goto-char (nth 1 full-def))
+ (skip-chars-backward " \r\t\n")
+ (unless (bolp) (forward-line))
+ (delete-region (point) (nth 2 full-def))
(incf ndef))))
ndef)))
@@ -888,7 +892,7 @@ If LABEL is non-nil, delete that footnote instead."
(label (cond
;; LABEL is provided as argument.
(label)
- ;; Footnote reference at point. If the footnote is
+ ;; Footnote reference at point. If the footnote is
;; anonymous, delete it and exit instead.
((setq x (org-footnote-at-reference-p))
(or (car x)
diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el
index 3b94d928945..a05cb554d4b 100644
--- a/lisp/org/org-freemind.el
+++ b/lisp/org/org-freemind.el
@@ -60,7 +60,7 @@
(require 'xml)
(require 'org)
-;(require 'rx)
+ ;(require 'rx)
(require 'org-exp)
(eval-when-compile (require 'cl))
@@ -139,7 +139,7 @@ NOT READY YET."
;;;###autoload
(defun org-export-as-freemind (&optional hidden ext-plist
- to-buffer body-only pub-dir)
+ to-buffer body-only pub-dir)
"Export the current buffer as a Freemind file.
If there is an active region, export only the region. HIDDEN is
obsolete and does nothing. EXT-PLIST is a property list with
@@ -258,22 +258,22 @@ The characters \"&<> will be escaped."
;;(org-freemind-unescape-str-to-org "&#x6d;A&#x224C;B&lt;C&#x3C;&#x3D;")
;;(org-freemind-unescape-str-to-org "&#x3C;&lt;")
(defun org-freemind-unescape-str-to-org (fm-str)
- "Do some html-unescaping of FM-STR and return the result.
+ "Do some html-unescaping of FM-STR and return the result.
This is the opposite of `org-freemind-escape-str-from-org' but it
will also unescape &#nn;."
- (let ((org-str fm-str))
- (setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
- (setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
- (setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
- (setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
- (setq org-str (replace-regexp-in-string
- "&#x\\([a-f0-9]\\{2,4\\}\\);"
- (lambda (m)
- (char-to-string
- (+ (string-to-number (match-string 1 m) 16)
- 0 ;?\x800 ;; What is this for? Encoding?
- )))
- org-str))))
+ (let ((org-str fm-str))
+ (setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
+ (setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
+ (setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
+ (setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
+ (setq org-str (replace-regexp-in-string
+ "&#x\\([a-f0-9]\\{2,4\\}\\);"
+ (lambda (m)
+ (char-to-string
+ (+ (string-to-number (match-string 1 m) 16)
+ 0 ;?\x800 ;; What is this for? Encoding?
+ )))
+ org-str))))
;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
;; (str2 (org-freemind-escape-str-from-org str1))
@@ -291,7 +291,7 @@ MATCHED is the link just matched."
(is-img (and (image-type-from-file-name link)
(let ((url-type (substring link 0 col-pos)))
(member url-type '("file" "http" "https")))))
- )
+ )
(if is-img
;; Fix-me: I can't find a way to get the border to "shrink
;; wrap" around the image using <div>.
@@ -334,7 +334,7 @@ MATCHED is the link just matched."
"\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]"
;;"<a href=\"\\1\">\\2</a>"
'org-freemind-convert-links-helper
- fm-str)))
+ fm-str t t)))
;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>")
(defun org-freemind-convert-links-to-org (fm-str)
@@ -380,7 +380,7 @@ MATCHED is the link just matched."
(dolist (cc (append matched nil))
(if (= 32 cc)
;;(setq res (concat res "&nbsp;"))
- ;; We need to use the numerical version. Otherwise Freemind
+ ;; We need to use the numerical version. Otherwise Freemind
;; ver 0.9.0 RC9 can not export to html/javascript.
(progn
(if (< 0 bi)
@@ -410,7 +410,7 @@ MATCHED is the link just matched."
(defcustom org-freemind-node-css-style
"p { margin-top: 3px; margin-bottom: 3px; }"
"CSS style for Freemind nodes."
- ;; Fix-me: I do not understand this. It worked to export from Freemind
+ ;; Fix-me: I do not understand this. It worked to export from Freemind
;; with this setting now, but not before??? Was this perhaps a java
;; bug or is it a windows xp bug (some resource gets exhausted if you
;; use sticky keys which I do).
@@ -455,8 +455,7 @@ DRAWERS-REGEXP are converted to freemind notes."
note-res
"</body>\n"
"</html>\n"
- "</richcontent>\n"))
- )
+ "</richcontent>\n")))
;; There is always an LF char:
(when (> (length text) 1)
@@ -467,10 +466,10 @@ DRAWERS-REGEXP are converted to freemind notes."
(if (= 0 (length org-freemind-node-css-style))
""
(concat
- "<style type=\"text/css\">\n"
- "<!--\n"
+ "<style type=\"text/css\">\n"
+ "<!--\n"
org-freemind-node-css-style
- "-->\n"
+ "-->\n"
"</style>\n"))
"</head>\n"
"<body>\n"))
@@ -520,14 +519,15 @@ DRAWERS-REGEXP are converted to freemind notes."
(list node-res note-res))))
(defun org-freemind-write-node (mm-buffer drawers-regexp
- num-left-nodes base-level
- current-level next-level this-m2
- this-node-end
- this-children-visible
- next-node-start
- next-has-some-visible-child)
+ num-left-nodes base-level
+ current-level next-level this-m2
+ this-node-end
+ this-children-visible
+ next-node-start
+ next-has-some-visible-child)
(let* (this-icons
this-bg-color
+ this-m2-link
this-m2-escaped
this-rich-node
this-rich-note
@@ -560,6 +560,10 @@ DRAWERS-REGEXP are converted to freemind notes."
(add-to-list 'this-icons "full-7"))
))))
(setq this-m2 (org-trim this-m2))
+ (when (string-match org-bracket-link-analytic-regexp this-m2)
+ (setq this-m2-link (concat "link=\"" (match-string 1 this-m2)
+ (match-string 3 this-m2) "\" ")
+ this-m2 (replace-match "\\5" nil nil this-m2 0)))
(setq this-m2-escaped (org-freemind-escape-str-from-org this-m2))
(let ((node-notes (org-freemind-org-text-to-freemind-subnode/note
this-m2-escaped
@@ -569,7 +573,8 @@ DRAWERS-REGEXP are converted to freemind notes."
(setq this-rich-node (nth 0 node-notes))
(setq this-rich-note (nth 1 node-notes)))
(with-current-buffer mm-buffer
- (insert "<node text=\"" this-m2-escaped "\"")
+ (insert "<node " (if this-m2-link this-m2-link "")
+ "text=\"" this-m2-escaped "\"")
(org-freemind-get-node-style this-m2)
(when (> next-level current-level)
(unless (or this-children-visible
@@ -784,15 +789,15 @@ Otherwise give an error say the file exists."
;;; (unless (if node-at-line-last
;;; (>= (point) node-at-line-last)
;;; nil)
- ;; Write last node:
- (setq this-m2 next-m2)
- (setq current-level next-level)
- (setq next-node-start (if node-at-line-last
- (1+ node-at-line-last)
- (point-max)))
- (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child))
- (with-current-buffer mm-buffer (insert "</node>\n"))
- ;)
+ ;; Write last node:
+ (setq this-m2 next-m2)
+ (setq current-level next-level)
+ (setq next-node-start (if node-at-line-last
+ (1+ node-at-line-last)
+ (point-max)))
+ (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child))
+ (with-current-buffer mm-buffer (insert "</node>\n"))
+ ;)
)
(with-current-buffer mm-buffer
(while (> current-level base-level)
@@ -1032,7 +1037,7 @@ PATH should be a list of steps, where each step has the form
(let* ((child-attr-list (cadr child))
(step-attr-copy (copy-sequence step-attr-list)))
(dolist (child-attr child-attr-list)
- ;; Compare attr names:
+ ;; Compare attr names:
(when (org-freemind-symbols= (caar step-attr-copy) (car child-attr))
;; Compare values:
(let ((step-val (cdar step-attr-copy))
@@ -1066,12 +1071,12 @@ PATH should be a list of steps, where each step has the form
(defun org-freemind-test-get-tree-text ()
(let ((node '(p nil "\n"
- (a
- ((href . "link"))
- "text")
- "\n"
- (b nil "hej")
- "\n")))
+ (a
+ ((href . "link"))
+ "text")
+ "\n"
+ (b nil "hej")
+ "\n")))
(org-freemind-get-tree-text node)))
;; (org-freemind-test-get-tree-text)
@@ -1085,11 +1090,9 @@ PATH should be a list of steps, where each step has the form
;;(a (setq is-link t) )
((h1 h2 h3 h4 h5 h6 p)
;;(setq ntxt (concat "\n" ntxt))
- (setq lf-after 2)
- )
+ (setq lf-after 2))
(br
- (setq lf-after 1)
- )
+ (setq lf-after 1))
(t
(cond
((stringp n)
@@ -1106,8 +1109,7 @@ PATH should be a list of steps, where each step has the form
(let ((att (car att-val))
(val (cdr att-val)))
(when (eq att 'href)
- (setq link val)))))
- )))))
+ (setq link val))))))))))
(if lf-after
(setq ntxt (concat ntxt (make-string lf-after ?\n)))
(setq ntxt (concat ntxt " ")))
@@ -1184,7 +1186,7 @@ PATH should be a list of steps, where each step has the form
(org-freemind-node-to-org child (1+ level) skip-levels)))))
;; Fix-me: put back special things, like drawers that are stored in
-;; the notes. Should maybe all notes contents be put in drawers?
+;; the notes. Should maybe all notes contents be put in drawers?
;;;###autoload
(defun org-freemind-to-org-mode (mm-file org-file)
"Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."
diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el
index 5b855c291f0..77f9c0b8a7f 100644
--- a/lisp/org/org-gnus.el
+++ b/lisp/org/org-gnus.el
@@ -32,6 +32,7 @@
;;; Code:
(require 'org)
+(require 'gnus-util)
(eval-when-compile (require 'gnus-sum))
;; Declare external functions and variables
@@ -100,11 +101,11 @@ If `org-store-link' was called with a prefix arg the meaning of
(if (and (string-match "^nntp" group) ;; Only for nntp groups
(org-xor current-prefix-arg
org-gnus-prefer-web-links))
- (org-make-link (if (string-match "gmane" unprefixed-group)
- "http://news.gmane.org/"
- "http://groups.google.com/group/")
- unprefixed-group)
- (org-make-link "gnus:" group))))
+ (concat (if (string-match "gmane" unprefixed-group)
+ "http://news.gmane.org/"
+ "http://groups.google.com/group/")
+ unprefixed-group)
+ (concat "gnus:" group))))
(defun org-gnus-article-link (group newsgroups message-id x-no-archive)
"Create a link to a Gnus article.
@@ -125,7 +126,7 @@ If `org-store-link' was called with a prefix arg the meaning of
"http://mid.gmane.org/%s"
"http://groups.google.com/groups/search?as_umsgid=%s")
(org-fixup-message-id-for-http message-id))
- (org-make-link "gnus:" group "#" message-id)))
+ (concat "gnus:" group "#" message-id)))
(defun org-gnus-store-link ()
"Store a link to a Gnus folder or message."
@@ -206,7 +207,7 @@ If `org-store-link' was called with a prefix arg the meaning of
desc link
newsgroup xarchive) ; those are always nil for gcc
(and (not gcc)
- (error "Can not create link: No Gcc header found."))
+ (error "Can not create link: No Gcc header found"))
(org-store-link-props :type "gnus" :from from :subject subject
:message-id id :group gcc :to to)
(setq desc (org-email-link-description)
@@ -233,9 +234,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(setq group (match-string 1 path)
article (match-string 3 path))
(when group
- (setq group (org-substring-no-properties group)))
+ (setq group (org-no-properties group)))
(when article
- (setq article (org-substring-no-properties article)))
+ (setq article (org-no-properties article)))
(org-gnus-follow-link group article)))
(defun org-gnus-follow-link (&optional group article)
@@ -244,9 +245,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(funcall (cdr (assq 'gnus org-link-frame-setup)))
(if gnus-other-frame-object (select-frame gnus-other-frame-object))
(when group
- (setq group (org-substring-no-properties group)))
+ (setq group (org-no-properties group)))
(when article
- (setq article (org-substring-no-properties article)))
+ (setq article (org-no-properties article)))
(cond ((and group article)
(gnus-activate-group group)
(condition-case nil
@@ -272,7 +273,7 @@ If `org-store-link' was called with a prefix arg the meaning of
;; stop on integer overflows
(> articles 0))
(setq group-opened (gnus-group-read-group
- articles nil group)
+ articles t group)
articles (if (< articles 16)
(1+ articles)
(* articles 2))))
diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index 6b4776662e2..5b68ac32265 100644
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -67,6 +67,12 @@ relative to the current effective date."
:group 'org-habit
:type 'boolean)
+(defcustom org-habit-show-all-today nil
+ "If non-nil, will show the consistency graph of all habits on
+today's agenda, even if they are not scheduled."
+ :group 'org-habit
+ :type 'boolean)
+
(defcustom org-habit-today-glyph ?!
"Glyph character used to identify today."
:group 'org-habit
diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el
index 5cecc44a2df..79b028638a1 100644
--- a/lisp/org/org-html.el
+++ b/lisp/org/org-html.el
@@ -98,8 +98,32 @@ not be modified."
:group 'org-export-html
:type 'boolean)
-(defconst org-export-html-scripts
-"<script type=\"text/javascript\">
+(defvar org-export-html-scripts
+ "<script type=\"text/javascript\">
+/*
+@licstart The following is the entire license notice for the
+JavaScript code in this tag.
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+
+The JavaScript code in this tag is free software: you can
+redistribute it and/or modify it under the terms of the GNU
+General Public License (GNU GPL) as published by the Free Software
+Foundation, either version 3 of the License, or (at your option)
+any later version. The code is distributed WITHOUT ANY WARRANTY;
+without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+
+As additional permission under GNU GPL version 3 section 7, you
+may distribute non-source (e.g., minimized or compacted) forms of
+that code without the copy of the GNU GPL normally required by
+section 4, provided you include this license notice and a URL
+through which recipients can access the Corresponding Source.
+
+
+@licend The above is the entire license notice
+for the JavaScript code in this tag.
+*/
<!--/*--><![CDATA[/*><!--*/
function CodeHighlightOn(elem, id)
{
@@ -121,10 +145,10 @@ not be modified."
}
/*]]>*///-->
</script>"
-"Basic JavaScript that is needed by HTML files produced by Org-mode.")
+ "Basic JavaScript that is needed by HTML files produced by Org-mode.")
(defconst org-export-html-style-default
-"<style type=\"text/css\">
+ "<style type=\"text/css\">
<!--/*--><![CDATA[/*><!--*/
html { font-family: Times, serif; font-size: 12pt; }
.title { text-align: center; }
@@ -255,16 +279,16 @@ You can also customize this for each buffer, using something like
:group 'org-export-html
:version "24.1"
:type '(list :greedy t
- (list :tag "path (the path from where to load MathJax.js)"
- (const :format " " path) (string))
- (list :tag "scale (scaling for the displayed math)"
- (const :format " " scale) (string))
- (list :tag "align (alignment of displayed equations)"
- (const :format " " align) (string))
- (list :tag "indent (indentation with left or right alignment)"
- (const :format " " indent) (string))
- (list :tag "mathml (should MathML display be used is possible)"
- (const :format " " mathml) (boolean))))
+ (list :tag "path (the path from where to load MathJax.js)"
+ (const :format " " path) (string))
+ (list :tag "scale (scaling for the displayed math)"
+ (const :format " " scale) (string))
+ (list :tag "align (alignment of displayed equations)"
+ (const :format " " align) (string))
+ (list :tag "indent (indentation with left or right alignment)"
+ (const :format " " indent) (string))
+ (list :tag "mathml (should MathML display be used is possible)"
+ (const :format " " mathml) (boolean))))
(defun org-export-html-mathjax-config (template options in-buffer)
"Insert the user setup into the matchjax template."
@@ -276,8 +300,9 @@ You can also customize this for each buffer, using something like
(setq val (car (read-from-string
(substring in-buffer (match-end 0))))))
(if (not (stringp val)) (setq val (format "%s" val)))
- (if (string-match (concat "%" (upcase (symbol-name name))) template)
- (setq template (replace-match val t t template))))
+ (setq template
+ (replace-regexp-in-string
+ (concat "%" (upcase (symbol-name name))) val template t t)))
options)
(setq val (nth 1 (assq 'mathml options)))
(if (string-match (concat "\\<mathml:") in-buffer)
@@ -295,6 +320,56 @@ You can also customize this for each buffer, using something like
(defcustom org-export-html-mathjax-template
"<script type=\"text/javascript\" src=\"%PATH\">
+/**
+ *
+ * @source: %PATH
+ *
+ * @licstart The following is the entire license notice for the
+ * JavaScript code in %PATH.
+ *
+ * Copyright (C) 2012 MathJax
+ *
+ * Licensed under the Apache License, Version 2.0 (the \"License\");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an \"AS IS\" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * @licend The above is the entire license notice
+ * for the JavaScript code in %PATH.
+ *
+ */
+
+/*
+@licstart The following is the entire license notice for the
+JavaScript code below.
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+
+The JavaScript code below is free software: you can
+redistribute it and/or modify it under the terms of the GNU
+General Public License (GNU GPL) as published by the Free Software
+Foundation, either version 3 of the License, or (at your option)
+any later version. The code is distributed WITHOUT ANY WARRANTY;
+without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+
+As additional permission under GNU GPL version 3 section 7, you
+may distribute non-source (e.g., minimized or compacted) forms of
+that code without the copy of the GNU GPL normally required by
+section 4, provided you include this license notice and a URL
+through which recipients can access the Corresponding Source.
+
+
+@licend The above is the entire license notice
+for the JavaScript code below.
+*/
<!--/*--><![CDATA[/*><!--*/
MathJax.Hub.Config({
// Only one of the two following lines, depending on user settings
@@ -382,11 +457,17 @@ precedence over this variable."
:group 'org-export-html
:type '(choice (const :tag "No preamble" nil)
(const :tag "Default preamble" t)
- (string :tag "Custom formatting string")
+ (string :tag "Custom format string")
(function :tag "Function (must return a string)")))
(defcustom org-export-html-preamble-format '(("en" ""))
- "The format for the HTML preamble.
+ "Alist of languages and format strings for the HTML preamble.
+
+The first element of each list is the language code, as used for
+the #+LANGUAGE keyword.
+
+The second element of each list is a format string to format the
+preamble itself. This format string can contain these elements:
%t stands for the title.
%a stands for the author's name.
@@ -402,7 +483,7 @@ like that: \"%%\"."
(defcustom org-export-html-postamble 'auto
"Non-nil means insert a postamble in HTML export.
-When `t', insert a string as defined by the formatting string in
+When `t', insert a string as defined by the format string in
`org-export-html-postamble-format'. When set to a string, this
string overrides `org-export-html-postamble-format'. When set to
'auto, discard `org-export-html-postamble-format' and honor
@@ -416,8 +497,8 @@ precedence over this variable."
:group 'org-export-html
:type '(choice (const :tag "No postamble" nil)
(const :tag "Auto preamble" 'auto)
- (const :tag "Default formatting string" t)
- (string :tag "Custom formatting string")
+ (const :tag "Default format string" t)
+ (string :tag "Custom format string")
(function :tag "Function (must return a string)")))
(defcustom org-export-html-postamble-format
@@ -426,7 +507,13 @@ precedence over this variable."
<p class=\"creator\">Generated by %c</p>
<p class=\"xhtml-validation\">%v</p>
"))
- "The format for the HTML postamble.
+ "Alist of languages and format strings for the HTML postamble.
+
+The first element of each list is the language code, as used for
+the #+LANGUAGE keyword.
+
+The second element of each list is a format string to format the
+postamble itself. This format string can contain these elements:
%a stands for the author's name.
%e stands for the author's email.
@@ -653,6 +740,14 @@ postamble DIV."
(string :tag " Div for the content:")
(string :tag "Div for the postamble:")))
+(defcustom org-export-html-date-format-string "%Y-%m-%dT%R%z"
+ "Format string to format the date and time.
+
+The default is an extended format of the ISO 8601 specification."
+ :group 'org-export-html
+ :version "24.1"
+ :type 'string)
+
;;; Hooks
(defvar org-export-html-after-blockquotes-hook nil
@@ -668,7 +763,7 @@ postamble DIV."
(when (and org-current-export-file
(plist-get parameters :LaTeX-fragments))
(org-format-latex
- (concat "ltxpng/" (file-name-sans-extension
+ (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
(file-name-nondirectory
org-current-export-file)))
org-current-export-dir nil "Creating LaTeX image %s"
@@ -677,8 +772,8 @@ postamble DIV."
((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim)
((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax)
((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax)
- ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng)
- (t nil))))
+ ((eq (plist-get parameters :LaTeX-fragments) 'imagemagick) 'imagemagick)
+ ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng))))
(goto-char (point-min))
(let (label l1)
(while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
@@ -730,7 +825,7 @@ command to convert it."
(interactive "r")
(let (reg html buf pop-up-frames)
(save-window-excursion
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(setq html (org-export-region-as-html
beg end t 'string))
(setq reg (buffer-substring beg end)
@@ -782,51 +877,51 @@ in a window. A non-interactive call will only return the buffer."
;;; org-html-cvt-link-fn
(defconst org-html-cvt-link-fn
- nil
- "Function to convert link URLs to exportable URLs.
+ nil
+ "Function to convert link URLs to exportable URLs.
Takes two arguments, TYPE and PATH.
Returns exportable url as (TYPE PATH), or nil to signal that it
didn't handle this case.
Intended to be locally bound around a call to `org-export-as-html'." )
(defun org-html-cvt-org-as-html (opt-plist type path)
- "Convert an org filename to an equivalent html filename.
+ "Convert an org filename to an equivalent html filename.
If TYPE is not file, just return `nil'.
See variable `org-export-html-link-org-files-as-html'"
- (save-match-data
- (and
- org-export-html-link-org-files-as-html
- (string= type "file")
- (string-match "\\.org$" path)
- (progn
- (list
- "file"
- (concat
- (substring path 0 (match-beginning 0))
- "."
- (plist-get opt-plist :html-extension)))))))
+ (save-match-data
+ (and
+ org-export-html-link-org-files-as-html
+ (string= type "file")
+ (string-match "\\.org$" path)
+ (progn
+ (list
+ "file"
+ (concat
+ (substring path 0 (match-beginning 0))
+ "."
+ (plist-get opt-plist :html-extension)))))))
;;; org-html-should-inline-p
(defun org-html-should-inline-p (filename descp)
- "Return non-nil if link FILENAME should be inlined.
+ "Return non-nil if link FILENAME should be inlined.
The decision to inline the FILENAME link is based on the current
settings. DESCP is the boolean of whether there was a link
description. See variables `org-export-html-inline-images' and
`org-export-html-inline-image-extensions'."
- (declare (special
- org-export-html-inline-images
- org-export-html-inline-image-extensions))
- (and (or (eq t org-export-html-inline-images)
- (and org-export-html-inline-images (not descp)))
- (org-file-image-p
- filename org-export-html-inline-image-extensions)))
+ (declare (special
+ org-export-html-inline-images
+ org-export-html-inline-image-extensions))
+ (and (or (eq t org-export-html-inline-images)
+ (and org-export-html-inline-images (not descp)))
+ (org-file-image-p
+ filename org-export-html-inline-image-extensions)))
;;; org-html-make-link
(defun org-html-make-link (opt-plist type path fragment desc attr
- may-inline-p)
- "Make an HTML link.
+ may-inline-p)
+ "Make an HTML link.
OPT-PLIST is an options list.
TYPE is the device-type of the link (THIS://foo.html).
PATH is the path of the link (http://THIS#location).
@@ -835,89 +930,89 @@ DESC is the link description, if any.
ATTR is a string of other attributes of the \"a\" element.
MAY-INLINE-P allows inlining it as an image."
- (declare (special org-par-open))
- (save-match-data
- (let* ((filename path)
- ;;First pass. Just sanity stuff.
- (components-1
- (cond
- ((string= type "file")
- (list
- type
- ;;Substitute just if original path was absolute.
- ;;(Otherwise path must remain relative)
- (if (file-name-absolute-p path)
- (concat "file://" (expand-file-name path))
- path)))
- ((string= type "")
- (list nil path))
- (t (list type path))))
-
- ;;Second pass. Components converted so they can refer
- ;;to a remote site.
- (components-2
- (or
- (and org-html-cvt-link-fn
- (apply org-html-cvt-link-fn
- opt-plist components-1))
- (apply #'org-html-cvt-org-as-html
- opt-plist components-1)
- components-1))
- (type (first components-2))
- (thefile (second components-2)))
-
-
- ;;Third pass. Build final link except for leading type
- ;;spec.
- (cond
- ((or
- (not type)
- (string= type "http")
- (string= type "https")
- (string= type "file")
- (string= type "coderef"))
- (if fragment
- (setq thefile (concat thefile "#" fragment))))
-
- (t))
-
- ;;Final URL-build, for all types.
- (setq thefile
+ (declare (special org-par-open))
+ (save-match-data
+ (let* ((filename path)
+ ;;First pass. Just sanity stuff.
+ (components-1
+ (cond
+ ((string= type "file")
+ (list
+ type
+ ;;Substitute just if original path was absolute.
+ ;;(Otherwise path must remain relative)
+ (if (file-name-absolute-p path)
+ (concat "file://" (expand-file-name path))
+ path)))
+ ((string= type "")
+ (list nil path))
+ (t (list type path))))
+
+ ;;Second pass. Components converted so they can refer
+ ;;to a remote site.
+ (components-2
+ (or
+ (and org-html-cvt-link-fn
+ (apply org-html-cvt-link-fn
+ opt-plist components-1))
+ (apply #'org-html-cvt-org-as-html
+ opt-plist components-1)
+ components-1))
+ (type (first components-2))
+ (thefile (second components-2)))
+
+
+ ;;Third pass. Build final link except for leading type
+ ;;spec.
+ (cond
+ ((or
+ (not type)
+ (string= type "http")
+ (string= type "https")
+ (string= type "file")
+ (string= type "coderef"))
+ (if fragment
+ (setq thefile (concat thefile "#" fragment))))
+
+ (t))
+
+ ;;Final URL-build, for all types.
+ (setq thefile
(let
- ((str (org-export-html-format-href thefile)))
+ ((str (org-export-html-format-href thefile)))
(if (and type (not (or (string= "file" type)
(string= "coderef" type))))
(concat type ":" str)
- str)))
+ str)))
- (if (and
- may-inline-p
- ;;Can't inline a URL with a fragment.
- (not fragment))
- (progn
- (message "image %s %s" thefile org-par-open)
- (org-export-html-format-image thefile org-par-open))
- (concat
- "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">"
- (org-export-html-format-desc desc)
- "</a>")))))
-
-(defun org-html-handle-links (line opt-plist)
- "Return LINE with markup of Org mode links.
+ (if (and
+ may-inline-p
+ ;;Can't inline a URL with a fragment.
+ (not fragment))
+ (progn
+ (message "image %s %s" thefile org-par-open)
+ (org-export-html-format-image thefile org-par-open))
+ (concat
+ "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">"
+ (org-export-html-format-desc desc)
+ "</a>")))))
+
+(defun org-html-handle-links (org-line opt-plist)
+ "Return ORG-LINE with markup of Org mode links.
OPT-PLIST is the export options list."
(let ((start 0)
(current-dir (if buffer-file-name
- (file-name-directory buffer-file-name)
- default-directory))
+ (file-name-directory buffer-file-name)
+ default-directory))
(link-validate (plist-get opt-plist :link-validation-function))
type id-file fnc
rpl path attr desc descp desc1 desc2 link)
- (while (string-match org-bracket-link-analytic-regexp++ line start)
+ (while (string-match org-bracket-link-analytic-regexp++ org-line start)
(setq start (match-beginning 0))
(setq path (save-match-data (org-link-unescape
- (match-string 3 line))))
+ (match-string 3 org-line))))
(setq type (cond
- ((match-end 2) (match-string 2 line))
+ ((match-end 2) (match-string 2 org-line))
((save-match-data
(or (file-name-absolute-p path)
(string-match "^\\.\\.?/" path)))
@@ -925,7 +1020,7 @@ OPT-PLIST is the export options list."
(t "internal")))
(setq path (org-extract-attributes path))
(setq attr (get-text-property 0 'org-attributes path))
- (setq desc1 (if (match-end 5) (match-string 5 line))
+ (setq desc1 (if (match-end 5) (match-string 5 org-line))
desc2 (if (match-end 2) (concat type ":" path) path)
descp (and desc1 (not (equal desc1 desc2)))
desc (or desc1 desc2))
@@ -1066,9 +1161,9 @@ OPT-PLIST is the export options list."
(setq rpl (concat "<i>&lt;" type ":"
(save-match-data (org-link-unescape path))
"&gt;</i>"))))
- (setq line (replace-match rpl t t line)
+ (setq org-line (replace-match rpl t t org-line)
start (+ start (length rpl))))
- line))
+ org-line))
;;; org-export-as-html
@@ -1150,7 +1245,7 @@ PUB-DIR is set, use this as the publishing directory."
(org-current-export-dir
(or pub-dir (org-export-directory :html opt-plist)))
(org-current-export-file buffer-file-name)
- (level 0) (line "") (origline "") txt todo
+ (level 0) (org-line "") (origline "") txt todo
(umax nil)
(umax-toc nil)
(filename (if to-buffer nil
@@ -1227,6 +1322,9 @@ PUB-DIR is set, use this as the publishing directory."
(org-export-have-math nil)
(org-export-footnotes-seen nil)
(org-export-footnotes-data (org-footnote-all-labels 'with-defs))
+ (custom-id (or (org-entry-get nil "CUSTOM_ID" t) ""))
+ (footnote-def-prefix (format "fn-%s" custom-id))
+ (footnote-ref-prefix (format "fnr-%s" custom-id))
(lines
(org-split-string
(org-export-preprocess-string
@@ -1267,8 +1365,7 @@ PUB-DIR is set, use this as the publishing directory."
rpl path attr desc descp desc1 desc2 link
snumber fnc
footnotes footref-seen
- href
- )
+ href)
(let ((inhibit-read-only t))
(org-unmodified
@@ -1285,7 +1382,7 @@ PUB-DIR is set, use this as the publishing directory."
((and date (string-match "%" date))
(setq date (format-time-string date)))
(date)
- (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
+ (t (setq date (format-time-string org-export-html-date-format-string))))
;; Get the language-dependent settings
(setq lang-words (or (assoc language org-export-language-setup)
@@ -1371,12 +1468,12 @@ PUB-DIR is set, use this as the publishing directory."
(insert "\n</div>\n"))
(t
(setq html-pre-real-contents
- (format-spec
- (or (cadr (assoc (nth 0 lang-words)
- org-export-html-preamble-format))
- (cadr (assoc "en" org-export-html-preamble-format)))
- `((?t . ,title) (?a . ,author)
- (?d . ,date) (?e . ,email))))))
+ (format-spec
+ (or (cadr (assoc (nth 0 lang-words)
+ org-export-html-preamble-format))
+ (cadr (assoc "en" org-export-html-preamble-format)))
+ `((?t . ,title) (?a . ,author)
+ (?d . ,date) (?e . ,email))))))
;; don't output an empty preamble DIV
(unless (and (functionp html-pre)
(equal html-pre-real-contents ""))
@@ -1394,7 +1491,7 @@ PUB-DIR is set, use this as the publishing directory."
"\n<h1 class=\"title\">" title "</h1>\n"))
;; insert body
- (if (and org-export-with-toc (not body-only))
+ (if org-export-with-toc
(progn
(push (format "<h%d>%s</h%d>\n"
org-export-html-toplevel-hlevel
@@ -1405,9 +1502,9 @@ PUB-DIR is set, use this as the publishing directory."
(push "<ul>\n<li>" thetoc)
(setq lines
(mapcar
- #'(lambda (line)
- (if (and (string-match org-todo-line-regexp line)
- (not (get-text-property 0 'org-protected line)))
+ #'(lambda (org-line)
+ (if (and (string-match org-todo-line-regexp org-line)
+ (not (get-text-property 0 'org-protected org-line)))
;; This is a headline
(progn
(setq have-headings t)
@@ -1417,17 +1514,17 @@ PUB-DIR is set, use this as the publishing directory."
txt (save-match-data
(org-html-expand
(org-export-cleanup-toc-line
- (match-string 3 line))))
+ (match-string 3 org-line))))
todo
(or (and org-export-mark-todo-in-toc
(match-beginning 2)
- (not (member (match-string 2 line)
+ (not (member (match-string 2 org-line)
org-done-keywords)))
; TODO, not DONE
(and org-export-mark-todo-in-toc
(= level umax-toc)
(org-search-todo-below
- line lines level))))
+ org-line lines level))))
(if (string-match
(org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
(setq txt (replace-match
@@ -1456,11 +1553,11 @@ PUB-DIR is set, use this as the publishing directory."
(push "</li>\n</ul>" thetoc))
(push "\n" thetoc)))
;; Check for targets
- (while (string-match org-any-target-regexp line)
- (setq line (replace-match
- (concat "@<span class=\"target\">"
- (match-string 1 line) "@</span> ")
- t t line)))
+ (while (string-match org-any-target-regexp org-line)
+ (setq org-line (replace-match
+ (concat "@<span class=\"target\">"
+ (match-string 1 org-line) "@</span> ")
+ t t org-line)))
(while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
(setq txt (replace-match "" t t txt)))
(setq href
@@ -1477,7 +1574,7 @@ PUB-DIR is set, use this as the publishing directory."
href txt) thetoc)
(setq org-last-level level)))))
- line)
+ org-line)
lines))
(while (> org-last-level (1- org-min-level))
(setq org-last-level (1- org-last-level))
@@ -1490,28 +1587,28 @@ PUB-DIR is set, use this as the publishing directory."
(org-open-par)
- (while (setq line (pop lines) origline line)
+ (while (setq org-line (pop lines) origline org-line)
(catch 'nextline
;; end of quote section?
- (when (and inquote (string-match org-outline-regexp-bol line))
+ (when (and inquote (string-match org-outline-regexp-bol org-line))
(insert "</pre>\n")
(org-open-par)
(setq inquote nil))
;; inside a quote section?
(when inquote
- (insert (org-html-protect line) "\n")
+ (insert (org-html-protect org-line) "\n")
(throw 'nextline nil))
;; Fixed-width, verbatim lines (examples)
(when (and org-export-with-fixed-width
- (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
+ (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" org-line))
(when (not infixed)
(setq infixed t)
(org-close-par-maybe)
(insert "<pre class=\"example\">\n"))
- (insert (org-html-protect (match-string 3 line)) "\n")
+ (insert (org-html-protect (match-string 3 org-line)) "\n")
(when (or (not lines)
(not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
(car lines))))
@@ -1521,17 +1618,17 @@ PUB-DIR is set, use this as the publishing directory."
(throw 'nextline nil))
;; Protected HTML
- (when (and (get-text-property 0 'org-protected line)
+ (when (and (get-text-property 0 'org-protected org-line)
;; Make sure it is the entire line that is protected
(not (< (or (next-single-property-change
- 0 'org-protected line) 10000)
- (length line))))
- (let (par (ind (get-text-property 0 'original-indentation line)))
+ 0 'org-protected org-line) 10000)
+ (length org-line))))
+ (let (par (ind (get-text-property 0 'original-indentation org-line)))
(when (re-search-backward
"\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
(setq par (match-string 1))
(replace-match "\\2\n"))
- (insert line "\n")
+ (insert org-line "\n")
(while (and lines
(or (= (length (car lines)) 0)
(not ind)
@@ -1543,144 +1640,144 @@ PUB-DIR is set, use this as the publishing directory."
(throw 'nextline nil))
;; Blockquotes, verse, and center
- (when (equal "ORG-BLOCKQUOTE-START" line)
+ (when (equal "ORG-BLOCKQUOTE-START" org-line)
(org-close-par-maybe)
(insert "<blockquote>\n")
(org-open-par)
(throw 'nextline nil))
- (when (equal "ORG-BLOCKQUOTE-END" line)
+ (when (equal "ORG-BLOCKQUOTE-END" org-line)
(org-close-par-maybe)
(insert "\n</blockquote>\n")
(org-open-par)
(throw 'nextline nil))
- (when (equal "ORG-VERSE-START" line)
+ (when (equal "ORG-VERSE-START" org-line)
(org-close-par-maybe)
(insert "\n<p class=\"verse\">\n")
(setq org-par-open t)
(setq inverse t)
(throw 'nextline nil))
- (when (equal "ORG-VERSE-END" line)
+ (when (equal "ORG-VERSE-END" org-line)
(insert "</p>\n")
(setq org-par-open nil)
(org-open-par)
(setq inverse nil)
(throw 'nextline nil))
- (when (equal "ORG-CENTER-START" line)
+ (when (equal "ORG-CENTER-START" org-line)
(org-close-par-maybe)
(insert "\n<div style=\"text-align: center\">")
(org-open-par)
(throw 'nextline nil))
- (when (equal "ORG-CENTER-END" line)
+ (when (equal "ORG-CENTER-END" org-line)
(org-close-par-maybe)
(insert "\n</div>")
(org-open-par)
(throw 'nextline nil))
(run-hooks 'org-export-html-after-blockquotes-hook)
(when inverse
- (let ((i (org-get-string-indentation line)))
+ (let ((i (org-get-string-indentation org-line)))
(if (> i 0)
- (setq line (concat (mapconcat 'identity
- (make-list (* 2 i) "\\nbsp") "")
- " " (org-trim line))))
- (unless (string-match "\\\\\\\\[ \t]*$" line)
- (setq line (concat line "\\\\")))))
+ (setq org-line (concat (mapconcat 'identity
+ (make-list (* 2 i) "\\nbsp") "")
+ " " (org-trim org-line))))
+ (unless (string-match "\\\\\\\\[ \t]*$" org-line)
+ (setq org-line (concat org-line "\\\\")))))
;; make targets to anchors
(setq start 0)
(while (string-match
- "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
+ "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" org-line start)
(cond
- ((get-text-property (match-beginning 1) 'org-protected line)
+ ((get-text-property (match-beginning 1) 'org-protected org-line)
(setq start (match-end 1)))
((match-end 2)
- (setq line (replace-match
- (format
- "@<a name=\"%s\" id=\"%s\">@</a>"
- (org-solidify-link-text (match-string 1 line))
- (org-solidify-link-text (match-string 1 line)))
- t t line)))
- ((and org-export-with-toc (equal (string-to-char line) ?*))
+ (setq org-line (replace-match
+ (format
+ "@<a name=\"%s\" id=\"%s\">@</a>"
+ (org-solidify-link-text (match-string 1 org-line))
+ (org-solidify-link-text (match-string 1 org-line)))
+ t t org-line)))
+ ((and org-export-with-toc (equal (string-to-char org-line) ?*))
;; FIXME: NOT DEPENDENT on TOC?????????????????????
- (setq line (replace-match
- (concat "@<span class=\"target\">"
- (match-string 1 line) "@</span> ")
- ;; (concat "@<i>" (match-string 1 line) "@</i> ")
- t t line)))
+ (setq org-line (replace-match
+ (concat "@<span class=\"target\">"
+ (match-string 1 org-line) "@</span> ")
+ ;; (concat "@<i>" (match-string 1 org-line) "@</i> ")
+ t t org-line)))
(t
- (setq line (replace-match
- (concat "@<a name=\""
- (org-solidify-link-text (match-string 1 line))
- "\" class=\"target\">" (match-string 1 line)
- "@</a> ")
- t t line)))))
+ (setq org-line (replace-match
+ (concat "@<a name=\""
+ (org-solidify-link-text (match-string 1 org-line))
+ "\" class=\"target\">" (match-string 1 org-line)
+ "@</a> ")
+ t t org-line)))))
- (setq line (org-html-handle-time-stamps line))
+ (setq org-line (org-html-handle-time-stamps org-line))
;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
;; Also handle sub_superscripts and checkboxes
- (or (string-match org-table-hline-regexp line)
- (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line)
- (setq line (org-html-expand line)))
+ (or (string-match org-table-hline-regexp org-line)
+ (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" org-line)
+ (setq org-line (org-html-expand org-line)))
;; Format the links
- (setq line (org-html-handle-links line opt-plist))
+ (setq org-line (org-html-handle-links org-line opt-plist))
;; TODO items
(if (and org-todo-line-regexp
- (string-match org-todo-line-regexp line)
+ (string-match org-todo-line-regexp org-line)
(match-beginning 2))
- (setq line
- (concat (substring line 0 (match-beginning 2))
+ (setq org-line
+ (concat (substring org-line 0 (match-beginning 2))
"<span class=\""
- (if (member (match-string 2 line)
+ (if (member (match-string 2 org-line)
org-done-keywords)
"done" "todo")
" " (org-export-html-get-todo-kwd-class-name
- (match-string 2 line))
- "\">" (match-string 2 line)
- "</span>" (substring line (match-end 2)))))
+ (match-string 2 org-line))
+ "\">" (match-string 2 org-line)
+ "</span>" (substring org-line (match-end 2)))))
;; Does this contain a reference to a footnote?
(when org-export-with-footnotes
(setq start 0)
- (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
+ (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" org-line start)
;; Discard protected matches not clearly identified as
;; footnote markers.
- (if (or (get-text-property (match-beginning 2) 'org-protected line)
- (not (get-text-property (match-beginning 2) 'org-footnote line)))
+ (if (or (get-text-property (match-beginning 2) 'org-protected org-line)
+ (not (get-text-property (match-beginning 2) 'org-footnote org-line)))
(setq start (match-end 2))
- (let ((n (match-string 2 line)) extra a)
+ (let ((n (match-string 2 org-line)) extra a)
(if (setq a (assoc n footref-seen))
(progn
(setcdr a (1+ (cdr a)))
(setq extra (format ".%d" (cdr a))))
(setq extra "")
(push (cons n 1) footref-seen))
- (setq line
+ (setq org-line
(replace-match
(concat
(format
(concat "%s"
(format org-export-html-footnote-format
- (concat "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>")))
- (or (match-string 1 line) "") n extra n n)
+ (concat "<a class=\"footref\" name=\"" footnote-ref-prefix ".%s%s\" href=\"#" footnote-def-prefix ".%s\">%s</a>")))
+ (or (match-string 1 org-line) "") n extra n n)
;; If another footnote is following the
;; current one, add a separator.
(if (save-match-data
(string-match "\\`\\[[0-9]+\\]"
- (substring line (match-end 0))))
+ (substring org-line (match-end 0))))
org-export-html-footnote-separator
""))
- t t line))))))
+ t t org-line))))))
(cond
- ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
+ ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" org-line)
;; This is a headline
(setq level (org-tr-level (- (match-end 1) (match-beginning 1)
level-offset))
- txt (match-string 2 line))
+ txt (or (match-string 2 org-line) ""))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(if (<= level (max umax umax-toc))
@@ -1691,19 +1788,19 @@ PUB-DIR is set, use this as the publishing directory."
head-count opt-plist)
;; QUOTES
- (when (string-match quote-re line)
+ (when (string-match quote-re org-line)
(org-close-par-maybe)
(insert "<pre>")
(setq inquote t)))
((and org-export-with-tables
- (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
+ (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" org-line))
(when (not table-open)
;; New table starts
(setq table-open t table-buffer nil table-orig-buffer nil))
;; Accumulate lines
- (setq table-buffer (cons line table-buffer)
+ (setq table-buffer (cons org-line table-buffer)
table-orig-buffer (cons origline table-orig-buffer))
(when (or (not lines)
(not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
@@ -1718,15 +1815,15 @@ PUB-DIR is set, use this as the publishing directory."
(t
;; This line either is list item or end a list.
- (when (get-text-property 0 'list-item line)
- (setq line (org-html-export-list-line
- line
- (get-text-property 0 'list-item line)
- (get-text-property 0 'list-struct line)
- (get-text-property 0 'list-prevs line))))
+ (when (get-text-property 0 'list-item org-line)
+ (setq org-line (org-html-export-list-line
+ org-line
+ (get-text-property 0 'list-item org-line)
+ (get-text-property 0 'list-struct org-line)
+ (get-text-property 0 'list-prevs org-line))))
;; Horizontal line
- (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
+ (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line)
(if org-par-open
(insert "\n</p>\n<hr/>\n<p>\n")
(insert "\n<hr/>\n"))
@@ -1735,44 +1832,45 @@ PUB-DIR is set, use this as the publishing directory."
;; Empty lines start a new paragraph. If hand-formatted lists
;; are not fully interpreted, lines starting with "-", "+", "*"
;; also start a new paragraph.
- (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
+ (if (string-match "^ [-+*]-\\|^[ \t]*$" org-line) (org-open-par))
;; Is this the start of a footnote?
(when org-export-with-footnotes
(when (and (boundp 'footnote-section-tag-regexp)
(string-match (concat "^" footnote-section-tag-regexp)
- line))
+ org-line))
;; ignore this line
(throw 'nextline nil))
- (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
+ (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" org-line)
(org-close-par-maybe)
- (let ((n (match-string 1 line)))
+ (let ((n (match-string 1 org-line)))
(setq org-par-open t
- line (replace-match
- (format
- (concat "<p class=\"footnote\">"
- (format org-export-html-footnote-format
- "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>"))
- n n n) t t line)))))
+ org-line (replace-match
+ (format
+ (concat "<p class=\"footnote\">"
+ (format org-export-html-footnote-format
+ (concat
+ "<a class=\"footnum\" name=\"" footnote-def-prefix ".%s\" href=\"#" footnote-ref-prefix ".%s\">%s</a>")))
+ n n n) t t org-line)))))
;; Check if the line break needs to be conserved
(cond
- ((string-match "\\\\\\\\[ \t]*$" line)
- (setq line (replace-match "<br/>" t t line)))
+ ((string-match "\\\\\\\\[ \t]*$" org-line)
+ (setq org-line (replace-match "<br/>" t t org-line)))
(org-export-preserve-breaks
- (setq line (concat line "<br/>"))))
+ (setq org-line (concat org-line "<br/>"))))
;; Check if a paragraph should be started
(let ((start 0))
(while (and org-par-open
- (string-match "\\\\par\\>" line start))
+ (string-match "\\\\par\\>" org-line start))
;; Leave a space in the </p> so that the footnote matcher
;; does not see this.
(if (not (get-text-property (match-beginning 0)
- 'org-protected line))
- (setq line (replace-match "</p ><p >" t t line)))
+ 'org-protected org-line))
+ (setq org-line (replace-match "</p ><p >" t t org-line)))
(setq start (match-end 0))))
- (insert line "\n")))))
+ (insert org-line "\n")))))
;; Properly close all local lists and other lists
(when inquote
@@ -1814,7 +1912,8 @@ PUB-DIR is set, use this as the publishing directory."
(split-string email ",+ *")
", "))
(creator-info
- (concat "Org version " org-version " with Emacs version "
+ (concat "<a href=\"http://orgmode.org\">Org</a> version "
+ (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version "
(number-to-string emacs-major-version))))
(when (plist-get opt-plist :html-postamble)
@@ -1831,12 +1930,13 @@ PUB-DIR is set, use this as the publishing directory."
(when (plist-get opt-plist :time-stamp-file)
(insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n"))
(when (and (plist-get opt-plist :author-info) author)
- (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n"))
+ (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n"))
(when (and (plist-get opt-plist :email-info) email)
(insert "<p class=\"email\">" email "</p>\n"))
(when (plist-get opt-plist :creator-info)
(insert "<p class=\"creator\">"
- (concat "Org version " org-version " with Emacs version "
+ (concat "<a href=\"http://orgmode.org\">Org</a> version "
+ (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version "
(number-to-string emacs-major-version) "</p>\n")))
(insert html-validation-link "\n"))
(t
@@ -1931,7 +2031,7 @@ PUB-DIR is set, use this as the publishing directory."
(defun org-export-html-format-image (src par-open)
"Create image tag with source and attributes."
(save-match-data
- (if (string-match "^ltxpng/" src)
+ (if (string-match (regexp-quote org-latex-preview-ltxpng-directory) src)
(format "<img src=\"%s\" alt=\"%s\"/>"
src (org-find-text-property-in-string 'org-latex-src src))
(let* ((caption (org-find-text-property-in-string 'org-caption src))
@@ -1939,21 +2039,21 @@ PUB-DIR is set, use this as the publishing directory."
(label (org-find-text-property-in-string 'org-label src)))
(setq caption (and caption (org-html-do-expand caption)))
(concat
- (if caption
- (format "%s<div %sclass=\"figure\">
+ (if caption
+ (format "%s<div %sclass=\"figure\">
<p>"
- (if org-par-open "</p>\n" "")
- (if label (format "id=\"%s\" " (org-solidify-link-text label)) "")))
- (format "<img src=\"%s\"%s />"
- src
- (if (string-match "\\<alt=" (or attr ""))
- (concat " " attr )
- (concat " " attr " alt=\"" src "\"")))
- (if caption
- (format "</p>%s
+ (if org-par-open "</p>\n" "")
+ (if label (format "id=\"%s\" " (org-solidify-link-text label)) "")))
+ (format "<img src=\"%s\"%s />"
+ src
+ (if (string-match "\\<alt=" (or attr ""))
+ (concat " " attr )
+ (concat " " attr " alt=\"" src "\"")))
+ (if caption
+ (format "</p>%s
</div>%s"
- (concat "\n<p>" caption "</p>")
- (if org-par-open "\n<p>" ""))))))))
+ (concat "\n<p>" caption "</p>")
+ (if org-par-open "\n<p>" ""))))))))
(defun org-export-html-get-bibliography ()
"Find bibliography, cut it out and return it."
@@ -1969,7 +2069,7 @@ PUB-DIR is set, use this as the publishing directory."
(and (looking-at ">") (forward-char 1))
(setq bib (buffer-substring beg (point)))
(delete-region beg (point))
- (throw 'exit bib))))
+ (throw 'exit bib))))
nil))))
(defvar org-table-number-regexp) ; defined in org-table.el
@@ -2020,7 +2120,7 @@ for formatting. This is required for the DocBook exporter."
(lambda (x) (string-match "^[ \t]*|-" x))
(cdr lines)))))
(nline 0) fnum nfields i (cnt 0)
- tbopen line fields html gr colgropen rowstart rowend
+ tbopen org-line fields html gr colgropen rowstart rowend
ali align aligns n)
(setq caption (and caption (org-html-do-expand caption)))
(when (and col-cookies org-table-clean-did-remove-column)
@@ -2029,9 +2129,9 @@ for formatting. This is required for the DocBook exporter."
(if splice (setq head nil))
(unless splice (push (if head "<thead>" "<tbody>") html))
(setq tbopen t)
- (while (setq line (pop lines))
+ (while (setq org-line (pop lines))
(catch 'next-line
- (if (string-match "^[ \t]*|-" line)
+ (if (string-match "^[ \t]*|-" org-line)
(progn
(unless splice
(push (if head "</thead>" "</tbody>") html)
@@ -2040,7 +2140,7 @@ for formatting. This is required for the DocBook exporter."
;; ignore this line
(throw 'next-line t)))
;; Break the line into fields
- (setq fields (org-split-string line "[ \t]*|[ \t]*"))
+ (setq fields (org-split-string org-line "[ \t]*|[ \t]*"))
(unless fnum (setq fnum (make-vector (length fields) 0)
nfields (length fnum)))
(setq nline (1+ nline) i -1
@@ -2114,11 +2214,12 @@ for formatting. This is required for the DocBook exporter."
(if colgropen (setq html (cons (car html)
(cons "</colgroup>" (cdr html)))))
;; Since the output of HTML table formatter can also be used in
- ;; DocBook document, we want to always include the caption to make
- ;; DocBook XML file valid.
- (push (format "<caption>%s</caption>" (or caption "")) html)
+ ;; DocBook document, include empty captions for the DocBook
+ ;; export only so that it produces valid XML.
+ (when (or caption (eq org-export-current-backend 'docbook))
+ (push (format "<caption>%s</caption>" (or caption "")) html))
(when label
- (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label)))))
+ (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label)))))
(push html-table-tag html))
(setq html (mapcar
(lambda (x)
@@ -2155,14 +2256,14 @@ for formatting. This is required for the DocBook exporter."
This conversion does *not* use `table-generate-source' from table.el.
This has the advantage that Org-mode's HTML conversions can be used.
But it has the disadvantage, that no cell- or row-spanning is allowed."
- (let (line field-buffer
- (head org-export-highlight-first-table-line)
- fields html empty i)
+ (let (org-line field-buffer
+ (head org-export-highlight-first-table-line)
+ fields html empty i)
(setq html (concat html-table-tag "\n"))
- (while (setq line (pop lines))
+ (while (setq org-line (pop lines))
(setq empty "&nbsp;")
(catch 'next-line
- (if (string-match "^[ \t]*\\+-" line)
+ (if (string-match "^[ \t]*\\+-" org-line)
(progn
(if field-buffer
(progn
@@ -2188,7 +2289,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
;; Ignore this line
(throw 'next-line t)))
;; Break the line into fields and store the fields
- (setq fields (org-split-string line "[ \t]*|[ \t]*"))
+ (setq fields (org-split-string org-line "[ \t]*|[ \t]*"))
(if field-buffer
(setq field-buffer (mapcar
(lambda (x)
@@ -2338,7 +2439,7 @@ is nil, return nil."
l (match-string 0 string)
string (substring string (match-end 0)))
(push (org-html-do-expand s) res)
- (push l res))
+ (push l res))
(push (org-html-do-expand string) res)
(apply 'concat (nreverse res)))))
@@ -2469,22 +2570,22 @@ When TITLE is nil, just close all open levels."
(when title
;; If title is nil, this means this function is called to close
;; all levels, so the rest is done only if title is given
- (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
- (setq title (replace-match
- (if org-export-with-tags
- (save-match-data
- (concat
- "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
- (mapconcat
- (lambda (x)
- (format "<span class=\"%s\">%s</span>"
- (org-export-html-get-tag-class-name x)
- x))
- (org-split-string (match-string 1 title) ":")
- "&nbsp;")
- "</span>"))
- "")
- t t title)))
+ (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
+ (setq title (replace-match
+ (if org-export-with-tags
+ (save-match-data
+ (concat
+ "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
+ (mapconcat
+ (lambda (x)
+ (format "<span class=\"%s\">%s</span>"
+ (org-export-html-get-tag-class-name x)
+ x))
+ (org-split-string (match-string 1 title) ":")
+ "&nbsp;")
+ "</span>"))
+ "")
+ t t title)))
(if (> level umax)
(progn
(if (aref org-levels-open (1- level))
@@ -2553,11 +2654,11 @@ Replaces invalid characters with \"_\" and then prepends a prefix."
(org-close-li)
(insert "</ul>\n")))
-(defun org-html-export-list-line (line pos struct prevs)
- "Insert list syntax in export buffer. Return LINE, maybe modified.
+(defun org-html-export-list-line (org-line pos struct prevs)
+ "Insert list syntax in export buffer. Return ORG-LINE, maybe modified.
-POS is the item position or line position the line had before
-modifications to buffer. STRUCT is the list structure. PREVS is
+POS is the item position or org-line position the org-line had before
+modifications to buffer. STRUCT is the list structure. PREVS is
the alist of previous items."
(let* ((get-type
(function
@@ -2605,10 +2706,10 @@ the alist of previous items."
"\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
"\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
"\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
- "\\(.*\\)") line)
- (let* ((checkbox (match-string 3 line))
- (desc-tag (or (match-string 4 line) "???"))
- (body (or (match-string 5 line) ""))
+ "\\(.*\\)") org-line)
+ (let* ((checkbox (match-string 3 org-line))
+ (desc-tag (or (match-string 4 org-line) "???"))
+ (body (or (match-string 5 org-line) ""))
(list-beg (org-list-get-list-begin pos struct prevs))
(firstp (= list-beg pos))
;; Always refer to first item to determine list type, in
@@ -2642,9 +2743,9 @@ the alist of previous items."
;; Return modified line
body))
;; At a list ender: go to next line (side-effects only).
- ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil))
+ ((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil))
;; Not at an item: return line unchanged (side-effects only).
- (t line))))
+ (t org-line))))
(provide 'org-html)
diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el
index d73a6195b32..8523b442583 100644
--- a/lisp/org/org-icalendar.el
+++ b/lisp/org/org-icalendar.el
@@ -28,8 +28,7 @@
(require 'org-exp)
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl))
(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
@@ -194,7 +193,7 @@ or if they are only using it locally."
(defcustom org-icalendar-timezone (getenv "TZ")
"The time zone string for iCalendar export.
-When nil of the empty string, use the abbreviation retrieved from Emacs."
+When nil or the empty string, use output from \(current-time-zone\)."
:group 'org-export-icalendar
:type '(choice
(const :tag "Unspecified" nil)
@@ -257,7 +256,7 @@ The file is stored under the name `org-combined-agenda-icalendar-file'."
If COMBINE is non-nil, combine all calendar entries into a single large
file and store it under the name `org-combined-agenda-icalendar-file'."
(save-excursion
- (org-prepare-agenda-buffers files)
+ (org-agenda-prepare-buffers files)
(let* ((dir (org-export-directory
:ical (list :publishing-directory
org-export-publishing-directory)))
@@ -288,20 +287,19 @@ file and store it under the name `org-combined-agenda-icalendar-file'."
(let ((standard-output ical-buffer))
(if combine
(and (not started) (setq started t)
- (org-start-icalendar-file org-icalendar-combined-name))
- (org-start-icalendar-file category))
- (org-print-icalendar-entries combine)
+ (org-icalendar-start-file org-icalendar-combined-name))
+ (org-icalendar-start-file category))
+ (org-icalendar-print-entries combine)
(when (or (and combine (not files)) (not combine))
(when (and combine org-icalendar-include-bbdb-anniversaries)
(require 'org-bbdb)
(org-bbdb-anniv-export-ical))
- (org-finish-icalendar-file)
+ (org-icalendar-finish-file)
(set-buffer ical-buffer)
(run-hooks 'org-before-save-iCalendar-file-hook)
(save-buffer)
(run-hooks 'org-after-save-iCalendar-file-hook)
- (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
- ))))
+ (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))))))
(org-release-buffers org-agenda-new-buffers))))
(defvar org-before-save-iCalendar-file-hook nil
@@ -315,18 +313,18 @@ A good way to use this is to tell a desktop calendar application to re-read
the iCalendar file.")
(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
-(defun org-print-icalendar-entries (&optional combine)
+(defun org-icalendar-print-entries (&optional combine)
"Print iCalendar entries for the current Org-mode file to `standard-output'.
When COMBINE is non nil, add the category to each line."
(require 'org-agenda)
(let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
(re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
- (dts (org-ical-ts-to-string
+ (dts (org-icalendar-ts-to-string
(format-time-string (cdr org-time-stamp-formats) (current-time))
"DTSTART"))
hd ts ts2 state status (inc t) pos b sexp rrule
scheduledp deadlinep todo prefix due start tags
- tmp pri categories location summary desc uid alarm
+ tmp pri categories location summary desc uid alarm alarm-time
(sexp-buffer (get-buffer-create "*ical-tmp*")))
(org-refresh-category-properties)
(save-excursion
@@ -359,26 +357,25 @@ When COMBINE is non nil, add the category to each line."
(org-id-get-create)
(or (org-id-get) (org-id-new)))
categories (org-export-get-categories)
+ alarm-time (org-entry-get nil "APPT_WARNTIME")
+ alarm-time (if alarm-time (string-to-number alarm-time) 0)
alarm ""
deadlinep nil scheduledp nil)
+ (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos)
+ deadlinep (string-match org-deadline-regexp tmp)
+ scheduledp (string-match org-scheduled-regexp tmp)
+ todo (org-get-todo-state))
+ ;; donep (org-entry-is-done-p)
(if (looking-at re2)
(progn
(goto-char (match-end 0))
(setq ts2 (match-string 1)
inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
- (setq tmp (buffer-substring (max (point-min)
- (- pos org-ds-keyword-length))
- pos)
- ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
+ (setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
(progn
(setq inc nil)
(replace-match "\\1" t nil ts))
- ts)
- deadlinep (string-match org-deadline-regexp tmp)
- scheduledp (string-match org-scheduled-regexp tmp)
- todo (org-get-todo-state)
- ;; donep (org-entry-is-done-p)
- ))
+ ts)))
(when (and (not org-icalendar-use-plain-timestamp)
(not deadlinep) (not scheduledp))
(throw :skip t))
@@ -403,12 +400,12 @@ When COMBINE is non nil, add the category to each line."
(if (or (string-match org-tr-regexp hd)
(string-match org-ts-regexp hd))
(setq hd (replace-match "" t t hd)))
- (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
+ (if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts)
(setq rrule
(concat "\nRRULE:FREQ="
(cdr (assoc
(match-string 2 ts)
- '(("d" . "DAILY")("w" . "WEEKLY")
+ '(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY")
("m" . "MONTHLY")("y" . "YEARLY"))))
";INTERVAL=" (match-string 1 ts)))
(setq rrule ""))
@@ -419,11 +416,11 @@ When COMBINE is non nil, add the category to each line."
;; (c) only a DISPLAY action is defined.
;; [ESF]
(let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault))))
- (if (and (> org-icalendar-alarm-time 0)
+ (if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0))
(car t1) (nth 1 t1) (nth 2 t1))
- (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time))
- (setq alarm ""))
- )
+ (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM"
+ summary (or alarm-time org-icalendar-alarm-time)))
+ (setq alarm "")))
(if (string-match org-bracket-link-regexp summary)
(setq summary
(replace-match (if (match-end 3)
@@ -446,8 +443,8 @@ SUMMARY:%s%s%s
CATEGORIES:%s%s
END:VEVENT\n"
(concat prefix uid)
- (org-ical-ts-to-string ts "DTSTART")
- (org-ical-ts-to-string ts2 "DTEND" inc)
+ (org-icalendar-ts-to-string ts "DTSTART")
+ (org-icalendar-ts-to-string ts2 "DTEND" inc)
rrule summary
(if (and desc (string-match "\\S-" desc))
(concat "\nDESCRIPTION: " desc) "")
@@ -525,13 +522,13 @@ END:VEVENT\n"
due (and (member 'todo-due org-icalendar-use-deadline)
(org-entry-get nil "DEADLINE"))
start (and (member 'todo-start org-icalendar-use-scheduled)
- (org-entry-get nil "SCHEDULED"))
+ (org-entry-get nil "SCHEDULED"))
categories (org-export-get-categories)
uid (if org-icalendar-store-UID
(org-id-get-create)
(or (org-id-get) (org-id-new))))
- (and due (setq due (org-ical-ts-to-string due "DUE")))
- (and start (setq start (org-ical-ts-to-string start "DTSTART")))
+ (and due (setq due (org-icalendar-ts-to-string due "DUE")))
+ (and start (setq start (org-icalendar-ts-to-string start "DTSTART")))
(if (string-match org-bracket-link-regexp hd)
(setq hd (replace-match (if (match-end 3) (match-string 3 hd)
@@ -588,10 +585,10 @@ characters."
(if (not s)
nil
(if is-body
- (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
- (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
- (while (string-match re s) (setq s (replace-match "" t t s)))
- (while (string-match re2 s) (setq s (replace-match "" t t s))))
+ (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
+ (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
+ (while (string-match re s) (setq s (replace-match "" t t s)))
+ (while (string-match re2 s) (setq s (replace-match "" t t s))))
(setq s (replace-regexp-in-string "[[:space:]]+" " " s)))
(let ((start 0))
(while (string-match "\\([,;]\\)" s start)
@@ -634,7 +631,7 @@ not used right now."
(when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
s))
-(defun org-start-icalendar-file (name)
+(defun org-icalendar-start-file (name)
"Start an iCalendar file by inserting the header."
(let ((user user-full-name)
(name (or name "unknown"))
@@ -651,11 +648,11 @@ X-WR-TIMEZONE:%s
X-WR-CALDESC:%s
CALSCALE:GREGORIAN\n" name user timezone description))))
-(defun org-finish-icalendar-file ()
+(defun org-icalendar-finish-file ()
"Finish an iCalendar file by inserting the END statement."
(princ "END:VCALENDAR\n"))
-(defun org-ical-ts-to-string (s keyword &optional inc)
+(defun org-icalendar-ts-to-string (s keyword &optional inc)
"Take a time string S and convert it to iCalendar format.
KEYWORD is added in front, to make a complete line like DTSTART....
When INC is non-nil, increase the hour by two (if time string contains
@@ -680,7 +677,7 @@ a time), or the day by one (if it does not contain a time)."
(replace-regexp-in-string "%Z"
org-icalendar-timezone
org-icalendar-date-time-format)
- ";VALUE=DATE:%Y%m%d"))
+ ";VALUE=DATE:%Y%m%d"))
(concat keyword (format-time-string fmt time
(and (org-icalendar-use-UTC-date-timep)
have-time))))))
diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el
index a93f804946f..c156e240dbf 100644
--- a/lisp/org/org-id.el
+++ b/lisp/org/org-id.el
@@ -83,6 +83,47 @@
:tag "Org ID"
:group 'org)
+(define-obsolete-variable-alias
+ 'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3")
+(defcustom org-id-link-to-org-use-id nil
+ "Non-nil means storing a link to an Org file will use entry IDs.
+
+The variable can have the following values:
+
+t Create an ID if needed to make a link to the current entry.
+
+create-if-interactive
+ If `org-store-link' is called directly (interactively, as a user
+ command), do create an ID to support the link. But when doing the
+ job for capture, only use the ID if it already exists. The
+ purpose of this setting is to avoid proliferation of unwanted
+ IDs, just because you happen to be in an Org file when you
+ call `org-capture' that automatically and preemptively creates a
+ link. If you do want to get an ID link in a capture template to
+ an entry not having an ID, create it first by explicitly creating
+ a link to it, using `C-c C-l' first.
+
+create-if-interactive-and-no-custom-id
+ Like create-if-interactive, but do not create an ID if there is
+ a CUSTOM_ID property defined in the entry.
+
+use-existing
+ Use existing ID, do not create one.
+
+nil Never use an ID to make a link, instead link using a text search for
+ the headline text."
+ :group 'org-link-store
+ :group 'org-id
+ :version "24.3"
+ :type '(choice
+ (const :tag "Create ID to make link" t)
+ (const :tag "Create if storing link interactively"
+ create-if-interactive)
+ (const :tag "Create if storing link interactively and no CUSTOM_ID is present"
+ create-if-interactive-and-no-custom-id)
+ (const :tag "Only use existing" use-existing)
+ (const :tag "Do not use ID to create link" nil)))
+
(defcustom org-id-uuid-program "uuidgen"
"The uuidgen program."
:group 'org-id
@@ -216,8 +257,7 @@ In any case, the ID of the entry is returned."
(setq id (org-id-new prefix))
(org-entry-put pom "ID" id)
(org-id-add-location id (buffer-file-name (buffer-base-buffer)))
- id)
- (t nil)))))
+ id)))))
;;;###autoload
(defun org-id-get-with-outline-path-completion (&optional targets)
@@ -273,7 +313,7 @@ With optional argument MARKERP, return the position as a new marker."
(when file
(setq where (org-id-find-id-in-file id file markerp)))
(unless where
- (org-id-update-id-locations)
+ (org-id-update-id-locations nil t)
(setq file (org-id-find-id-file id))
(when file
(setq where (org-id-find-id-in-file id file markerp))))
@@ -403,7 +443,7 @@ and time is the usual three-integer representation of time."
;; Storing ID locations (files)
-(defun org-id-update-id-locations (&optional files)
+(defun org-id-update-id-locations (&optional files silent)
"Scan relevant files for IDs.
Store the relation between files and corresponding IDs.
This will scan all agenda files, all associated archives, and all
@@ -427,11 +467,11 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(if (symbolp org-id-extra-files)
(symbol-value org-id-extra-files)
org-id-extra-files)
- ;; Files associated with live org-mode buffers
+ ;; Files associated with live org-mode buffers
(delq nil
(mapcar (lambda (b)
(with-current-buffer b
- (and (eq major-mode 'org-mode) (buffer-file-name))))
+ (and (derived-mode-p 'org-mode) (buffer-file-name))))
(buffer-list)))
;; All files known to have IDs
org-id-files)))
@@ -441,8 +481,9 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(setq files (delq 'agenda-archives (copy-sequence files))))
(setq nfiles (length files))
(while (setq file (pop files))
- (message "Finding ID locations (%d/%d files): %s"
- (- nfiles (length files)) nfiles file)
+ (unless silent
+ (message "Finding ID locations (%d/%d files): %s"
+ (- nfiles (length files)) nfiles file))
(setq tfile (file-truename file))
(when (and (file-exists-p file) (not (member tfile seen)))
(push tfile seen)
@@ -505,7 +546,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(goto-char (point-min))
(setq org-id-locations (read (current-buffer))))
(error
- (message "Could not read org-id-values from %s. Setting it to nil."
+ (message "Could not read org-id-values from %s. Setting it to nil."
org-id-locations-file))))
(setq org-id-files (mapcar 'car org-id-locations))
(setq org-id-locations (org-id-alist-to-hash org-id-locations))))
@@ -600,8 +641,8 @@ optional argument MARKERP, return the position as a new marker."
(defun org-id-store-link ()
"Store a link to the current entry, using its ID."
(interactive)
- (when (and (buffer-file-name (buffer-base-buffer)) (eq major-mode 'org-mode))
- (let* ((link (org-make-link "id:" (org-id-get-create)))
+ (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+ (let* ((link (concat "id:" (org-id-get-create)))
(case-fold-search nil)
(desc (save-excursion
(org-back-to-heading t)
diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el
index 99a75841dee..d006df86747 100644
--- a/lisp/org/org-indent.el
+++ b/lisp/org/org-indent.el
@@ -45,6 +45,7 @@
(declare-function org-inlinetask-get-task-level "org-inlinetask" ())
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
(declare-function org-list-item-body-column "org-list" (item))
+(defvar org-inlinetask-show-first-star)
(defgroup org-indent nil
"Options concerning dynamic virtual outline indentation."
@@ -159,72 +160,75 @@ properties, after each buffer modification, on the modified zone.
The process is synchronous. Though, initial indentation of
buffer, which can take a few seconds on large buffers, is done
during idle time." nil " Ind" nil
- (cond
- ((org-bound-and-true-p org-inhibit-startup)
- (setq org-indent-mode nil))
- ((and org-indent-mode (featurep 'xemacs))
- (message "org-indent-mode does not work in XEmacs - refusing to turn it on")
- (setq org-indent-mode nil))
- ((and org-indent-mode
- (not (org-version-check "23.1.50" "Org Indent mode" :predicate)))
- (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!")
- (ding)
- (sit-for 1)
- (setq org-indent-mode nil))
- (org-indent-mode
- ;; mode was turned on.
- (org-set-local 'indent-tabs-mode nil)
- (or org-indent-strings (org-indent-initialize))
- (org-set-local 'org-indent-initial-marker (copy-marker 1))
- (when org-indent-mode-turns-off-org-adapt-indentation
- (org-set-local 'org-adapt-indentation nil))
- (when org-indent-mode-turns-on-hiding-stars
- (org-set-local 'org-hide-leading-stars-before-indent-mode
- org-hide-leading-stars)
- (org-set-local 'org-hide-leading-stars t))
- (make-local-variable 'buffer-substring-filters)
- (add-to-list 'buffer-substring-filters
- 'org-indent-remove-properties-from-string)
- (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
- (org-add-hook 'before-change-functions
- 'org-indent-notify-modified-headline nil 'local)
- (and font-lock-mode (org-restart-font-lock))
- (org-indent-remove-properties (point-min) (point-max))
- ;; Submit current buffer to initialize agent. If it's the first
- ;; buffer submitted, also start the agent. Current buffer is
- ;; pushed in both cases to avoid a race condition.
- (if org-indent-agentized-buffers
- (push (current-buffer) org-indent-agentized-buffers)
+(cond
+ ((org-bound-and-true-p org-inhibit-startup)
+ (setq org-indent-mode nil))
+ ((and org-indent-mode (featurep 'xemacs))
+ (message "org-indent-mode does not work in XEmacs - refusing to turn it on")
+ (setq org-indent-mode nil))
+ ((and org-indent-mode
+ (not (org-version-check "23.1.50" "Org Indent mode" :predicate)))
+ (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!")
+ (ding)
+ (sit-for 1)
+ (setq org-indent-mode nil))
+ (org-indent-mode
+ ;; mode was turned on.
+ (org-set-local 'indent-tabs-mode nil)
+ (or org-indent-strings (org-indent-initialize))
+ (org-set-local 'org-indent-initial-marker (copy-marker 1))
+ (when org-indent-mode-turns-off-org-adapt-indentation
+ (org-set-local 'org-adapt-indentation nil))
+ (when org-indent-mode-turns-on-hiding-stars
+ (org-set-local 'org-hide-leading-stars-before-indent-mode
+ org-hide-leading-stars)
+ (org-set-local 'org-hide-leading-stars t))
+ (make-local-variable 'filter-buffer-substring-functions)
+ (add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (org-indent-remove-properties-from-string
+ (funcall fun start end delete))))
+ (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
+ (org-add-hook 'before-change-functions
+ 'org-indent-notify-modified-headline nil 'local)
+ (and font-lock-mode (org-restart-font-lock))
+ (org-indent-remove-properties (point-min) (point-max))
+ ;; Submit current buffer to initialize agent. If it's the first
+ ;; buffer submitted, also start the agent. Current buffer is
+ ;; pushed in both cases to avoid a race condition.
+ (if org-indent-agentized-buffers
(push (current-buffer) org-indent-agentized-buffers)
- (setq org-indent-agent-timer
- (run-with-idle-timer 0.2 t #'org-indent-initialize-agent))))
- (t
- ;; mode was turned off (or we refused to turn it on)
- (kill-local-variable 'org-adapt-indentation)
- (setq org-indent-agentized-buffers
- (delq (current-buffer) org-indent-agentized-buffers))
- (when (markerp org-indent-initial-marker)
- (set-marker org-indent-initial-marker nil))
- (when (boundp 'org-hide-leading-stars-before-indent-mode)
- (org-set-local 'org-hide-leading-stars
- org-hide-leading-stars-before-indent-mode))
- (setq buffer-substring-filters
- (delq 'org-indent-remove-properties-from-string
- buffer-substring-filters))
- (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local)
- (remove-hook 'before-change-functions
- 'org-indent-notify-modified-headline 'local)
- (org-with-wide-buffer
- (org-indent-remove-properties (point-min) (point-max)))
- (and font-lock-mode (org-restart-font-lock))
- (redraw-display))))
+ (push (current-buffer) org-indent-agentized-buffers)
+ (setq org-indent-agent-timer
+ (run-with-idle-timer 0.2 t #'org-indent-initialize-agent))))
+ (t
+ ;; mode was turned off (or we refused to turn it on)
+ (kill-local-variable 'org-adapt-indentation)
+ (setq org-indent-agentized-buffers
+ (delq (current-buffer) org-indent-agentized-buffers))
+ (when (markerp org-indent-initial-marker)
+ (set-marker org-indent-initial-marker nil))
+ (when (boundp 'org-hide-leading-stars-before-indent-mode)
+ (org-set-local 'org-hide-leading-stars
+ org-hide-leading-stars-before-indent-mode))
+ (remove-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (org-indent-remove-properties-from-string
+ (funcall fun start end delete))))
+ (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local)
+ (remove-hook 'before-change-functions
+ 'org-indent-notify-modified-headline 'local)
+ (org-with-wide-buffer
+ (org-indent-remove-properties (point-min) (point-max)))
+ (and font-lock-mode (org-restart-font-lock))
+ (redraw-display))))
(defun org-indent-indent-buffer ()
"Add indentation properties to the accessible part of the buffer."
(interactive)
- (if (not (eq major-mode 'org-mode))
+ (if (not (derived-mode-p 'org-mode))
(error "Not in Org mode")
- (message "Setting buffer indentation. It may take a few seconds...")
+ (message "Setting buffer indentation. It may take a few seconds...")
(org-indent-remove-properties (point-min) (point-max))
(org-indent-add-properties (point-min) (point-max))
(message "Indentation of buffer set.")))
@@ -293,8 +297,10 @@ Assume point is at beginning of line."
(let ((stars (aref org-indent-stars
(min l org-indent-max-levels))))
(and stars
- (concat org-indent-inlinetask-first-star
- (substring stars 1)))))
+ (if (org-bound-and-true-p org-inlinetask-show-first-star)
+ (concat org-indent-inlinetask-first-star
+ (substring stars 1))
+ stars))))
(h (aref org-indent-stars
(min l org-indent-max-levels)))
(t (aref org-indent-strings
@@ -414,12 +420,12 @@ This function is meant to be called by `after-change-functions'."
(goto-char beg)
(beginning-of-line)
(re-search-forward org-outline-regexp-bol end t)))
- (let ((end (save-excursion
- (goto-char end)
- (org-with-limited-levels (outline-next-heading))
- (point))))
- (setq org-indent-modified-headline-flag nil)
- (org-indent-add-properties beg end))
+ (let ((end (save-excursion
+ (goto-char end)
+ (org-with-limited-levels (outline-next-heading))
+ (point))))
+ (setq org-indent-modified-headline-flag nil)
+ (org-indent-add-properties beg end))
;; Otherwise, only set properties on modified area.
(org-indent-add-properties beg end)))))
diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el
index b4e5c2244d5..31981ae1b29 100644
--- a/lisp/org/org-info.el
+++ b/lisp/org/org-info.el
@@ -48,9 +48,9 @@
"Store a link to an Info file and node."
(when (eq major-mode 'Info-mode)
(let (link desc)
- (setq link (org-make-link "info:"
- (file-name-nondirectory Info-current-file)
- "#" Info-current-node))
+ (setq link (concat "info:"
+ (file-name-nondirectory Info-current-file)
+ "#" Info-current-node))
(setq desc (concat (file-name-nondirectory Info-current-file)
"#" Info-current-node))
(org-store-link-props :type "info" :file Info-current-file
diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el
index 5cd190050b4..01f861e611a 100644
--- a/lisp/org/org-inlinetask.el
+++ b/lisp/org/org-inlinetask.el
@@ -90,6 +90,9 @@
(defcustom org-inlinetask-min-level 15
"Minimum level a headline must have before it is treated as an inline task.
+Don't set it to something higher than `29' or clocking will break since this
+is the hardcoded maximum number of stars `org-clock-sum' will work with.
+
It is strongly recommended that you set `org-cycle-max-level' not at all,
or to a number smaller than this one. In fact, when `org-cycle-max-level' is
not set, it will be assumed to be one less than the value of smaller than
@@ -99,6 +102,12 @@ the value of this variable."
(const :tag "Off" nil)
(integer)))
+(defcustom org-inlinetask-show-first-star nil
+ "Non-nil means display the first star of an inline task as additional marker.
+When nil, the first star is not shown."
+ :tag "Org Inline Tasks"
+ :group 'org-structure)
+
(defcustom org-inlinetask-export t
"Non-nil means export inline tasks.
When nil, they will not be exported."
@@ -329,75 +338,75 @@ Either remove headline and meta data, or do special formatting."
(end (copy-marker (save-excursion
(org-inlinetask-goto-end) (point))))
content)
- ;; Delete SCHEDULED, DEADLINE...
- (while (re-search-forward keywords-re end t)
- (delete-region (point-at-bol) (1+ (point-at-eol))))
- (goto-char beg)
- ;; Delete drawers
- (while (re-search-forward org-drawer-regexp end t)
- (when (save-excursion (re-search-forward org-property-end-re nil t))
- (delete-region beg (1+ (match-end 0)))))
- ;; Get CONTENT, if any.
- (goto-char beg)
- (forward-line 1)
- (unless (= (point) end)
- (setq content (buffer-substring (point)
- (save-excursion (goto-char end)
- (forward-line -1)
- (point)))))
- ;; Remove the task.
- (goto-char beg)
- (delete-region beg end)
- (when (and org-inlinetask-export
- (assq org-export-current-backend
- org-inlinetask-export-templates))
- ;; Format CONTENT, if appropriate.
- (setq content
- (if (not (and content (string-match "\\S-" content)))
- ""
- ;; Ensure CONTENT has minimal indentation, a single
- ;; newline character at its boundaries, and isn't
- ;; protected.
- (when (string-match "\\`\\([ \t]*\n\\)+" content)
- (setq content (substring content (match-end 0))))
- (when (string-match "[ \t\n]+\\'" content)
- (setq content (substring content 0 (match-beginning 0))))
- (org-add-props
- (concat "\n\n" (org-remove-indentation content) "\n\n")
- '(org-protected nil org-native-text nil))))
-
- (when (string-match org-complex-heading-regexp headline)
- (let* ((nil-to-str
- (function
- ;; Change nil arguments into empty strings.
- (lambda (el) (or (eval el) ""))))
- ;; Set up keywords provided to templates.
- (todo (or (match-string 2 headline) ""))
- (class (or (and (eq "" todo) "")
- (if (member todo org-done-keywords) "done" "todo")))
- (priority (or (match-string 3 headline) ""))
- (heading (or (match-string 4 headline) ""))
- (tags (or (match-string 5 headline) ""))
- ;; Read `org-inlinetask-export-templates'.
- (backend-spec (assq org-export-current-backend
- org-inlinetask-export-templates))
- (format-str (org-add-props (nth 1 backend-spec)
- '(org-protected t org-native-text t)))
- (tokens (cadr (nth 2 backend-spec)))
- ;; Build export string. Ensure it won't break
- ;; surrounding lists by giving it arbitrary high
- ;; indentation.
- (export-str (org-add-props
- (eval (append '(format format-str)
- (mapcar nil-to-str tokens)))
- '(original-indentation 1000))))
- ;; Ensure task starts a new paragraph.
- (unless (or (bobp)
- (save-excursion (forward-line -1)
- (looking-at "[ \t]*$")))
- (insert "\n"))
- (insert export-str)
- (unless (bolp) (insert "\n")))))))))
+ ;; Delete SCHEDULED, DEADLINE...
+ (while (re-search-forward keywords-re end t)
+ (delete-region (point-at-bol) (1+ (point-at-eol))))
+ (goto-char beg)
+ ;; Delete drawers
+ (while (re-search-forward org-drawer-regexp end t)
+ (when (save-excursion (re-search-forward org-property-end-re nil t))
+ (delete-region beg (1+ (match-end 0)))))
+ ;; Get CONTENT, if any.
+ (goto-char beg)
+ (forward-line 1)
+ (unless (= (point) end)
+ (setq content (buffer-substring (point)
+ (save-excursion (goto-char end)
+ (forward-line -1)
+ (point)))))
+ ;; Remove the task.
+ (goto-char beg)
+ (delete-region beg end)
+ (when (and org-inlinetask-export
+ (assq org-export-current-backend
+ org-inlinetask-export-templates))
+ ;; Format CONTENT, if appropriate.
+ (setq content
+ (if (not (and content (string-match "\\S-" content)))
+ ""
+ ;; Ensure CONTENT has minimal indentation, a single
+ ;; newline character at its boundaries, and isn't
+ ;; protected.
+ (when (string-match "\\`\\([ \t]*\n\\)+" content)
+ (setq content (substring content (match-end 0))))
+ (when (string-match "[ \t\n]+\\'" content)
+ (setq content (substring content 0 (match-beginning 0))))
+ (org-add-props
+ (concat "\n\n" (org-remove-indentation content) "\n\n")
+ '(org-protected nil org-native-text nil))))
+
+ (when (string-match org-complex-heading-regexp headline)
+ (let* ((nil-to-str
+ (function
+ ;; Change nil arguments into empty strings.
+ (lambda (el) (or (eval el) ""))))
+ ;; Set up keywords provided to templates.
+ (todo (or (match-string 2 headline) ""))
+ (class (or (and (eq "" todo) "")
+ (if (member todo org-done-keywords) "done" "todo")))
+ (priority (or (match-string 3 headline) ""))
+ (heading (or (match-string 4 headline) ""))
+ (tags (or (match-string 5 headline) ""))
+ ;; Read `org-inlinetask-export-templates'.
+ (backend-spec (assq org-export-current-backend
+ org-inlinetask-export-templates))
+ (format-str (org-add-props (nth 1 backend-spec)
+ '(org-protected t org-native-text t)))
+ (tokens (cadr (nth 2 backend-spec)))
+ ;; Build export string. Ensure it won't break
+ ;; surrounding lists by giving it arbitrary high
+ ;; indentation.
+ (export-str (org-add-props
+ (eval (append '(format format-str)
+ (mapcar nil-to-str tokens)))
+ '(original-indentation 1000))))
+ ;; Ensure task starts a new paragraph.
+ (unless (or (bobp)
+ (save-excursion (forward-line -1)
+ (looking-at "[ \t]*$")))
+ (insert "\n"))
+ (insert export-str)
+ (unless (bolp) (insert "\n")))))))))
(defun org-inlinetask-get-current-indentation ()
"Get the indentation of the last non-while line above this one."
@@ -423,18 +432,21 @@ Either remove headline and meta data, or do special formatting."
(1- (* 2 (or org-inlinetask-min-level 200)))
(or org-inlinetask-min-level 200)))
(re (concat "^\\(\\*\\)\\(\\*\\{"
- (format "%d" (- nstars 3))
- ",\\}\\)\\(\\*\\* .*\\)"))
+ (format "%d" (- nstars 3))
+ ",\\}\\)\\(\\*\\* .*\\)"))
;; Virtual indentation will add the warning face on the first
- ;; star. Thus, in that case, only hide it.
+ ;; star. Thus, in that case, only hide it.
(start-face (if (and (org-bound-and-true-p org-indent-mode)
(> org-indent-indentation-per-level 1))
'org-hide
'org-warning)))
(while (re-search-forward re limit t)
- (add-text-properties (match-beginning 1) (match-end 1)
- `(face ,start-face font-lock-fontified t))
- (add-text-properties (match-beginning 2) (match-end 2)
+ (if org-inlinetask-show-first-star
+ (add-text-properties (match-beginning 1) (match-end 1)
+ `(face ,start-face font-lock-fontified t)))
+ (add-text-properties (match-beginning
+ (if org-inlinetask-show-first-star 2 1))
+ (match-end 2)
'(face org-hide font-lock-fontified t))
(add-text-properties (match-beginning 3) (match-end 3)
'(face org-inlinetask font-lock-fontified t)))))
@@ -452,7 +464,7 @@ Either remove headline and meta data, or do special formatting."
((= end start))
;; Inlinetask was folded: expand it.
((get-char-property (1+ start) 'invisible)
- (outline-flag-region start end nil))
+ (org-show-entry))
(t (outline-flag-region start end t)))))
(defun org-inlinetask-remove-END-maybe ()
diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el
index 107428366dc..787eed7950f 100644
--- a/lisp/org/org-irc.el
+++ b/lisp/org/org-irc.el
@@ -81,10 +81,10 @@
"Parse LINK and dispatch to the correct function based on the client found."
(let ((link (org-irc-parse-link link)))
(cond
- ((eq org-irc-client 'erc)
- (org-irc-visit-erc link))
- (t
- (error "erc only known client")))))
+ ((eq org-irc-client 'erc)
+ (org-irc-visit-erc link))
+ (t
+ (error "ERC only known client")))))
(defun org-irc-parse-link (link)
"Parse an IRC LINK and return the attributes found.
@@ -102,8 +102,8 @@ attributes that are found."
(defun org-irc-store-link ()
"Dispatch to the appropriate function to store a link to an IRC session."
(cond
- ((eq major-mode 'erc-mode)
- (org-irc-erc-store-link))))
+ ((eq major-mode 'erc-mode)
+ (org-irc-erc-store-link))))
(defun org-irc-elipsify-description (string &optional after)
"Remove unnecessary white space from STRING and add ellipses if necessary.
@@ -140,9 +140,9 @@ result is a cons of the filename and search string."
(when (search-backward-regexp "^[^ ]" nil t)
(buffer-substring-no-properties (point-at-bol)
(point-at-eol))))
- (when (search-backward erc-line nil t)
- (buffer-substring-no-properties (point-at-bol)
- (point-at-eol)))))))
+ (when (search-backward erc-line nil t)
+ (buffer-substring-no-properties (point-at-bol)
+ (point-at-eol)))))))
(defun org-irc-erc-store-link ()
"Store a link to the IRC log file or the session itself.
@@ -164,27 +164,27 @@ the session itself."
:link (concat "file:" (car parsed-line) "::"
(cadr parsed-line)))
t)
- (error "This ERC session is not being logged")))
- (let* ((link-text (org-irc-get-erc-link))
- (link (org-irc-parse-link link-text)))
- (if link-text
- (progn
- (org-store-link-props
- :type "irc"
- :link (org-make-link "irc:/" link-text)
- :description (concat "irc session '" link-text "'")
- :server (car (car link))
- :port (or (string-to-number (cadr (pop link))) erc-default-port)
- :nick (pop link))
- t)
- (error "Failed to create ('irc:/' style) ERC link")))))
+ (error "This ERC session is not being logged")))
+ (let* ((link-text (org-irc-get-erc-link))
+ (link (org-irc-parse-link link-text)))
+ (if link-text
+ (progn
+ (org-store-link-props
+ :type "irc"
+ :link (concat "irc:/" link-text)
+ :description (concat "irc session '" link-text "'")
+ :server (car (car link))
+ :port (or (string-to-number (cadr (pop link))) erc-default-port)
+ :nick (pop link))
+ t)
+ (error "Failed to create ('irc:/' style) ERC link")))))
(defun org-irc-get-erc-link ()
"Return an org compatible irc:/ link from an ERC buffer."
(let* ((session-port (if (numberp erc-session-port)
(number-to-string erc-session-port)
- erc-session-port))
- (link (concat erc-session-server ":" session-port)))
+ erc-session-port))
+ (link (concat erc-session-server ":" session-port)))
(concat link "/"
(if (and (erc-default-target)
(erc-channel-p (erc-default-target))
@@ -192,19 +192,19 @@ the session itself."
;; we can get a nick
(let ((nick (car (get-text-property (point) 'erc-data))))
(concat (erc-default-target) "/" nick))
- (erc-default-target)))))
+ (erc-default-target)))))
(defun org-irc-get-current-erc-port ()
"Return the current port as a number.
Return the current port number or, if none is set, return the ERC
default."
(cond
- ((stringp erc-session-port)
- (string-to-number erc-session-port))
- ((numberp erc-session-port)
- erc-session-port)
- (t
- erc-default-port)))
+ ((stringp erc-session-port)
+ (string-to-number erc-session-port))
+ ((numberp erc-session-port)
+ erc-session-port)
+ (t
+ erc-default-port)))
(defun org-irc-visit-erc (link)
"Visit an ERC buffer based on criteria found in LINK."
@@ -242,13 +242,13 @@ default."
(progn
(goto-char (point-max))
(insert (concat nick ": ")))
- (error "%s not found in %s" nick chan-name)))))
- (progn
- (org-pop-to-buffer-same-window server-buffer)
- (erc-cmd-JOIN chan-name))))
- (org-pop-to-buffer-same-window server-buffer)))
- ;; no server match, make new connection
- (erc-select :server server :port port))))
+ (error "%s not found in %s" nick chan-name)))))
+ (progn
+ (org-pop-to-buffer-same-window server-buffer)
+ (erc-cmd-JOIN chan-name))))
+ (org-pop-to-buffer-same-window server-buffer)))
+ ;; no server match, make new connection
+ (erc-select :server server :port port))))
(provide 'org-irc)
diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el
index f4075d02981..35d43dec8da 100644
--- a/lisp/org/org-jsinfo.el
+++ b/lisp/org/org-jsinfo.el
@@ -99,13 +99,69 @@ means to use the maximum value consistent with other options."
(lambda (x)
(list 'cons (list 'const (car x))
'(choice
- (symbol :tag "Publishing/Export property")
- (string :tag "Value"))))
+ (symbol :tag "Publishing/Export property")
+ (string :tag "Value"))))
org-infojs-opts-table)))
(defcustom org-infojs-template
- "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\"></script>
-<script type=\"text/javascript\" >
+ "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\">
+/**
+ *
+ * @source: %SCRIPT_PATH
+ *
+ * @licstart The following is the entire license notice for the
+ * JavaScript code in %SCRIPT_PATH.
+ *
+ * Copyright (C) 2012 Sebastian Rose
+ *
+ *
+ * The JavaScript code in this tag is free software: you can
+ * redistribute it and/or modify it under the terms of the GNU
+ * General Public License (GNU GPL) as published by the Free Software
+ * Foundation, either version 3 of the License, or (at your option)
+ * any later version. The code is distributed WITHOUT ANY WARRANTY;
+ * without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+ *
+ * As additional permission under GNU GPL version 3 section 7, you
+ * may distribute non-source (e.g., minimized or compacted) forms of
+ * that code without the copy of the GNU GPL normally required by
+ * section 4, provided you include this license notice and a URL
+ * through which recipients can access the Corresponding Source.
+ *
+ * @licend The above is the entire license notice
+ * for the JavaScript code in %SCRIPT_PATH.
+ *
+ */
+</script>
+
+<script type=\"text/javascript\">
+
+/*
+@licstart The following is the entire license notice for the
+JavaScript code in this tag.
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+
+The JavaScript code in this tag is free software: you can
+redistribute it and/or modify it under the terms of the GNU
+General Public License (GNU GPL) as published by the Free Software
+Foundation, either version 3 of the License, or (at your option)
+any later version. The code is distributed WITHOUT ANY WARRANTY;
+without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+
+As additional permission under GNU GPL version 3 section 7, you
+may distribute non-source (e.g., minimized or compacted) forms of
+that code without the copy of the GNU GPL normally required by
+section 4, provided you include this license notice and a URL
+through which recipients can access the Corresponding Source.
+
+
+@licend The above is the entire license notice
+for the JavaScript code in this tag.
+*/
+
<!--/*--><![CDATA[/*><!--*/
%MANAGER_OPTIONS
org_html_manager.setup(); // activate after the parameters are set
@@ -127,67 +183,67 @@ Option settings will replace the %MANAGER-OPTIONS cookie."
exp-plist
;; We do want to use the script, set it up
(let ((template org-infojs-template)
- (ptoc (plist-get exp-plist :table-of-contents))
- (hlevels (plist-get exp-plist :headline-levels))
- tdepth sdepth s v e opt var val table default)
- (setq sdepth hlevels
- tdepth hlevels)
- (if (integerp ptoc) (setq tdepth (min ptoc tdepth)))
- (setq v (plist-get exp-plist :infojs-opt)
- table org-infojs-opts-table)
- (while (setq e (pop table))
- (setq opt (car e) var (nth 1 e)
- default (cdr (assoc opt org-infojs-options)))
- (and (symbolp default) (not (memq default '(t nil)))
- (setq default (plist-get exp-plist default)))
- (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v))
- (setq val (match-string 1 v))
- (setq val default))
- (cond
- ((eq opt 'path)
- (and (string-match "%SCRIPT_PATH" template)
- (setq template (replace-match val t t template))))
- ((eq opt 'sdepth)
- (if (integerp (read val))
- (setq sdepth (min (read val) hlevels))))
- ((eq opt 'tdepth)
- (if (integerp (read val))
- (setq tdepth (min (read val) hlevels))))
- (t
- (setq val
- (cond
- ((or (eq val t) (equal val "t")) "1")
- ((or (eq val nil) (equal val "nil")) "0")
- ((stringp val) val)
- (t (format "%s" val))))
- (push (cons var val) s))))
-
- ;; Now we set the depth of the *generated* TOC to SDEPTH, because the
- ;; toc will actually determine the splitting. How much of the toc will
- ;; actually be displayed is governed by the TDEPTH option.
- (setq exp-plist (plist-put exp-plist :table-of-contents sdepth))
-
- ;; The table of contents should not show more sections then we generate
- (setq tdepth (min tdepth sdepth))
- (push (cons "TOC_DEPTH" tdepth) s)
-
- (setq s (mapconcat
- (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
- (car x) (cdr x)))
- s "\n"))
- (when (and s (> (length s) 0))
- (and (string-match "%MANAGER_OPTIONS" template)
- (setq s (replace-match s t t template))
- (setq exp-plist
- (plist-put
- exp-plist :style-extra
- (concat (or (plist-get exp-plist :style-extra) "") "\n" s)))))
- ;; This script absolutely needs the table of contents, to we change that
- ;; setting
- (if (not (plist-get exp-plist :table-of-contents))
- (setq exp-plist (plist-put exp-plist :table-of-contents t)))
- ;; Return the modified property list
- exp-plist)))
+ (ptoc (plist-get exp-plist :table-of-contents))
+ (hlevels (plist-get exp-plist :headline-levels))
+ tdepth sdepth s v e opt var val table default)
+ (setq sdepth hlevels
+ tdepth hlevels)
+ (if (integerp ptoc) (setq tdepth (min ptoc tdepth)))
+ (setq v (plist-get exp-plist :infojs-opt)
+ table org-infojs-opts-table)
+ (while (setq e (pop table))
+ (setq opt (car e) var (nth 1 e)
+ default (cdr (assoc opt org-infojs-options)))
+ (and (symbolp default) (not (memq default '(t nil)))
+ (setq default (plist-get exp-plist default)))
+ (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v))
+ (setq val (match-string 1 v))
+ (setq val default))
+ (cond
+ ((eq opt 'path)
+ (setq template
+ (replace-regexp-in-string "%SCRIPT_PATH" val template t t)))
+ ((eq opt 'sdepth)
+ (if (integerp (read val))
+ (setq sdepth (min (read val) hlevels))))
+ ((eq opt 'tdepth)
+ (if (integerp (read val))
+ (setq tdepth (min (read val) hlevels))))
+ (t
+ (setq val
+ (cond
+ ((or (eq val t) (equal val "t")) "1")
+ ((or (eq val nil) (equal val "nil")) "0")
+ ((stringp val) val)
+ (t (format "%s" val))))
+ (push (cons var val) s))))
+
+ ;; Now we set the depth of the *generated* TOC to SDEPTH, because the
+ ;; toc will actually determine the splitting. How much of the toc will
+ ;; actually be displayed is governed by the TDEPTH option.
+ (setq exp-plist (plist-put exp-plist :table-of-contents sdepth))
+
+ ;; The table of contents should not show more sections then we generate
+ (setq tdepth (min tdepth sdepth))
+ (push (cons "TOC_DEPTH" tdepth) s)
+
+ (setq s (mapconcat
+ (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
+ (car x) (cdr x)))
+ s "\n"))
+ (when (and s (> (length s) 0))
+ (and (string-match "%MANAGER_OPTIONS" template)
+ (setq s (replace-match s t t template))
+ (setq exp-plist
+ (plist-put
+ exp-plist :style-extra
+ (concat (or (plist-get exp-plist :style-extra) "") "\n" s)))))
+ ;; This script absolutely needs the table of contents, to we change that
+ ;; setting
+ (if (not (plist-get exp-plist :table-of-contents))
+ (setq exp-plist (plist-put exp-plist :table-of-contents t)))
+ ;; Return the modified property list
+ exp-plist)))
(defun org-infojs-options-inbuffer-template ()
(format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s"
diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el
index 4418dee73e8..933fa56b8dd 100644
--- a/lisp/org/org-latex.el
+++ b/lisp/org/org-latex.el
@@ -235,7 +235,7 @@ are written as utf8 files."
"Alist of LaTeX expressions to convert emphasis fontifiers.
Each element of the list is a list of three elements.
The first element is the character used as a marker for fontification.
-The second element is a formatting string to wrap fontified text with.
+The second element is a format string to wrap fontified text with.
If it is \"\\verb\", Org will automatically select a delimiter
character that is not in the string. \"\\protectedtexttt\" will use \\texttt
to typeset and try to protect special characters.
@@ -247,7 +247,7 @@ conversions."
(defcustom org-export-latex-title-command "\\maketitle"
"The command used to insert the title just after \\begin{document}.
If this string contains the formatting specification \"%s\" then
-it will be used as a formatting string, passing the title as an
+it will be used as a format string, passing the title as an
argument."
:group 'org-export-latex
:type 'string)
@@ -321,6 +321,18 @@ will be filled with the link, the second with its description."
:version "24.1"
:type 'string)
+(defcustom org-export-latex-hyperref-options-format
+ "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={Emacs Org-mode version %s}}\n"
+ "A format string for hyperref options.
+When non-nil, it must contain three %s format specifications
+which will respectively be replaced by the document's keywords,
+its description and the Org's version number, as a string. Set
+this option to the empty string if you don't want to include
+hyperref options altogether."
+ :type 'string
+ :version "24.3"
+ :group 'org-export-latex)
+
(defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\,"
"Text used to separate footnotes."
:group 'org-export-latex
@@ -377,6 +389,33 @@ When nil, grouping causes only separation lines between groups."
:group 'org-export-latex
:type 'boolean)
+(defcustom org-export-latex-tables-tstart nil
+ "LaTeX command for top rule for tables."
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "Nothing" nil)
+ (string :tag "String")
+ (const :tag "Booktabs default: \\toprule" "\\toprule")))
+
+(defcustom org-export-latex-tables-hline "\\hline"
+ "LaTeX command to use for a rule somewhere in the middle of a table."
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(choice
+ (string :tag "String")
+ (const :tag "Standard: \\hline" "\\hline")
+ (const :tag "Booktabs default: \\midrule" "\\midrule")))
+
+(defcustom org-export-latex-tables-tend nil
+ "LaTeX command for bottom rule for tables."
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "Nothing" nil)
+ (string :tag "String")
+ (const :tag "Booktabs default: \\bottomrule" "\\bottomrule")))
+
(defcustom org-export-latex-low-levels 'itemize
"How to convert sections below the current level of sectioning.
This is specified by the `org-export-headline-levels' option or the
@@ -518,9 +557,9 @@ pygmentize -L lexers
"Association list of options for the latex listings package.
These options are supplied as a comma-separated list to the
-\\lstset command. Each element of the association list should be
+\\lstset command. Each element of the association list should be
a list containing two strings: the name of the option, and the
-value. For example,
+value. For example,
(setq org-export-latex-listings-options
'((\"basicstyle\" \"\\small\")
@@ -542,9 +581,9 @@ languages."
"Association list of options for the latex minted package.
These options are supplied within square brackets in
-\\begin{minted} environments. Each element of the alist should be
+\\begin{minted} environments. Each element of the alist should be
a list containing two strings: the name of the option, and the
-value. For example,
+value. For example,
(setq org-export-latex-minted-options
'((\"bgcolor\" \"bg\") (\"frame\" \"lines\")))
@@ -553,7 +592,7 @@ will result in src blocks being exported with
\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
-as the start of the minted environment. Note that the same
+as the start of the minted environment. Note that the same
options will be applied to blocks of all languages."
:group 'org-export-latex
:version "24.1"
@@ -565,7 +604,7 @@ options will be applied to blocks of all languages."
(defvar org-export-latex-custom-lang-environments nil
"Association list mapping languages to language-specific latex
environments used during export of src blocks by the listings
- and minted latex packages. For example,
+ and minted latex packages. For example,
(setq org-export-latex-custom-lang-environments
'((python \"pythoncode\")))
@@ -607,6 +646,12 @@ and `org-export-with-tags' instead."
:version "24.1"
:type 'string)
+(defcustom org-export-latex-link-with-unknown-path-format "\\texttt{%s}"
+ "Format string for links with unknown path type."
+ :group 'org-export-latex
+ :version "24.3"
+ :type 'string)
+
(defcustom org-export-latex-inline-image-extensions
'("pdf" "jpeg" "jpg" "png" "ps" "eps")
"Extensions of image files that can be inlined into LaTeX.
@@ -632,11 +677,24 @@ allowed. The default we use here encompasses both."
'("pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f"
"pdflatex -interaction nonstopmode -output-directory %o %f")
- "Commands to process a LaTeX file to a PDF file.
-This is a list of strings, each of them will be given to the shell
-as a command. %f in the command will be replaced by the full file name, %b
-by the file base name (i.e. without extension) and %o by the base directory
-of the file.
+ "Commands to process a LaTeX file to a PDF file and process latex
+fragments to pdf files.By default,this is a list of strings,and each of
+strings will be given to the shell as a command. %f in the command will
+be replaced by the full file name, %b by the file base name (i.e. without
+extension) and %o by the base directory of the file.
+
+If you set `org-create-formula-image-program'
+`org-export-with-LaTeX-fragments' to 'imagemagick, you can add a
+sublist which contains your own command(s) for LaTeX fragments
+previewing, like this:
+
+ '(\"xelatex -interaction nonstopmode -output-directory %o %f\"
+ \"xelatex -interaction nonstopmode -output-directory %o %f\"
+ ;; use below command(s) to convert latex fragments
+ (\"xelatex %f\"))
+
+With no such sublist, the default command used to convert LaTeX
+fragments will be the first string in the list.
The reason why this is a list is that it usually takes several runs of
`pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever
@@ -661,28 +719,28 @@ This function should accept the file name as its single argument."
(string :tag "Shell command"))
(const :tag "2 runs of pdflatex"
("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "3 runs of pdflatex"
("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "pdflatex,bibtex,pdflatex,pdflatex"
("pdflatex -interaction nonstopmode -output-directory %o %f"
- "bibtex %b"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ "bibtex %b"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "2 runs of xelatex"
("xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
+ "xelatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "3 runs of xelatex"
("xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
+ "xelatex -interaction nonstopmode -output-directory %o %f"
+ "xelatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "xelatex,bibtex,xelatex,xelatex"
("xelatex -interaction nonstopmode -output-directory %o %f"
- "bibtex %b"
- "xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
+ "bibtex %b"
+ "xelatex -interaction nonstopmode -output-directory %o %f"
+ "xelatex -interaction nonstopmode -output-directory %o %f"))
(const :tag "texi2dvi"
("texi2dvi -p -b -c -V %f"))
(const :tag "rubber"
@@ -750,7 +808,7 @@ then use this command to convert it."
(interactive "r")
(let (reg latex buf)
(save-window-excursion
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(setq latex (org-export-region-as-latex
beg end t 'string))
(setq reg (buffer-substring beg end)
@@ -985,7 +1043,7 @@ when PUB-DIR is set, use this as the publishing directory."
(when (and text (not (eq to-buffer 'string)))
(insert (org-export-latex-content
text '(lists tables fixed-width keywords))
- "\n\n"))
+ "\n\n"))
;; insert lines before the first headline
(unless (or skip (string-match "^\\*" first-lines))
@@ -1034,6 +1092,11 @@ when PUB-DIR is set, use this as the publishing directory."
(if (looking-at "[\n \t]+")
(replace-match "\n")))
+ ;; Ensure we have a final newline
+ (goto-char (point-max))
+ (or (eq (char-before) ?\n)
+ (insert ?\n))
+
(run-hooks 'org-export-latex-final-hook)
(if to-buffer
(unless (eq major-mode 'latex-mode) (latex-mode))
@@ -1084,22 +1147,24 @@ when PUB-DIR is set, use this as the publishing directory."
(funcall cmds (shell-quote-argument file))
(while cmds
(setq cmd (pop cmds))
- (while (string-match "%b" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument base))
- t t cmd)))
- (while (string-match "%f" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument file))
- t t cmd)))
- (while (string-match "%o" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument output-dir))
- t t cmd)))
- (shell-command cmd outbuf)))))
+ (cond
+ ((not (listp cmd))
+ (while (string-match "%b" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument base))
+ t t cmd)))
+ (while (string-match "%f" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument file))
+ t t cmd)))
+ (while (string-match "%o" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument output-dir))
+ t t cmd)))
+ (shell-command cmd outbuf)))))))
(message (concat "Processing LaTeX file " file "...done"))
(setq errors (org-export-latex-get-error outbuf))
(if (not (file-exists-p pdffile))
@@ -1471,11 +1536,10 @@ OPT-PLIST is the options plist for current buffer."
(or (plist-get opt-plist :date)
org-export-latex-date-format)))
;; add some hyperref options
- ;; FIXME: let's have a defcustom for this?
- (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
- (org-export-latex-fontify-headline keywords)
- (org-export-latex-fontify-headline description)
- (concat "Emacs Org-mode version " org-version))
+ (format org-export-latex-hyperref-options-format
+ (org-export-latex-fontify-headline keywords)
+ (org-export-latex-fontify-headline description)
+ (org-version))
;; beginning of the document
"\n\\begin{document}\n\n"
;; insert the title command
@@ -1569,7 +1633,7 @@ links, keywords, lists, tables, fixed-width"
(unless (memq 'fixed-width exclude-list)
(org-export-latex-fixed-width
(plist-get org-export-latex-options-plist :fixed-width)))
- ;; return string
+ ;; return string
(buffer-substring (point-min) (point-max))))
(defun org-export-latex-protect-string (s)
@@ -1691,13 +1755,13 @@ links, keywords, lists, tables, fixed-width"
(let ((org-display-custom-times org-export-latex-display-custom-times))
(while (re-search-forward org-ts-regexp-both nil t)
(org-if-unprotected-at (1- (point))
- (replace-match
- (org-export-latex-protect-string
- (format (if (string= "<" (substring (match-string 0) 0 1))
- org-export-latex-timestamp-markup
- org-export-latex-timestamp-inactive-markup)
- (substring (org-translate-time (match-string 0)) 1 -1)))
- t t)))))
+ (replace-match
+ (org-export-latex-protect-string
+ (format (if (string= "<" (substring (match-string 0) 0 1))
+ org-export-latex-timestamp-markup
+ org-export-latex-timestamp-inactive-markup)
+ (substring (org-translate-time (match-string 0)) 1 -1)))
+ t t)))))
(defun org-export-latex-quotation-marks ()
"Export quotation marks depending on language conventions."
@@ -1723,8 +1787,7 @@ See the `org-export-latex.el' code for a complete conversion table."
(goto-char (point-min))
(while (re-search-forward c nil t)
;; Put the point where to check for org-protected
- (unless (or (get-text-property (match-beginning 2) 'org-protected)
- (save-match-data (org-at-table.el-p)))
+ (unless (get-text-property (match-beginning 2) 'org-protected)
(cond ((member (match-string 2) '("\\$" "$"))
(if (equal (match-string 2) "\\$")
nil
@@ -1752,7 +1815,7 @@ See the `org-export-latex.el' code for a complete conversion table."
(replace-match (match-string 2) t t)
(replace-match (concat (match-string 1) "\\"
(match-string 2)) t t)))))
- (unless (save-match-data (org-inside-latex-math-p))
+ (unless (save-match-data (or (org-inside-latex-math-p) (org-at-table-p)))
(cond ((equal (match-string 2) "\\")
(replace-match (or (save-match-data
(org-export-latex-treat-backslash-char
@@ -1877,19 +1940,19 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t)
(unless (get-text-property (point) 'org-example)
- (if opt
- (progn (goto-char (match-beginning 0))
- (insert "\\begin{verbatim}\n")
- (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
- (replace-match (concat (match-string 1)
- (match-string 2)) t t)
- (forward-line))
- (insert "\\end{verbatim}\n"))
- (progn (goto-char (match-beginning 0))
- (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
- (replace-match (concat "%" (match-string 1)
- (match-string 2)) t t)
- (forward-line)))))))
+ (if opt
+ (progn (goto-char (match-beginning 0))
+ (insert "\\begin{verbatim}\n")
+ (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
+ (replace-match (concat (match-string 1)
+ (match-string 2)) t t)
+ (forward-line))
+ (insert "\\end{verbatim}\n"))
+ (progn (goto-char (match-beginning 0))
+ (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
+ (replace-match (concat "%" (match-string 1)
+ (match-string 2)) t t)
+ (forward-line)))))))
(defvar org-table-last-alignment) ; defined in org-table.el
(defvar org-table-last-column-widths) ; defined in org-table.el
@@ -1915,7 +1978,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(org-table-last-column-widths (copy-sequence
org-table-last-column-widths))
fnum fields line lines olines gr colgropen line-fmt align
- caption width shortn label attr floatp placement
+ caption width shortn label attr hfmt floatp placement
longtblp tblenv tabular-env)
(if org-export-latex-tables-verbatim
(let* ((tbl (concat "\\begin{verbatim}\n" raw-table
@@ -1952,6 +2015,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
align (and attr (stringp attr)
(string-match "\\<align=\\([^ \t\n\r]+\\)" attr)
(match-string 1 attr))
+ hfmt (and attr (stringp attr)
+ (string-match "\\<hfmt=\\(\\S-+\\)" attr)
+ (match-string 1 attr))
floatp (or caption label (string= "table*" tblenv))
placement (if (and attr
(stringp attr)
@@ -1967,7 +2033,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(when org-table-clean-did-remove-column
(pop org-table-last-alignment)
(pop org-table-last-column-widths))
- ;; make a formatting string to reflect alignment
+ ;; make a format string to reflect alignment
(setq olines lines)
(while (and (not line-fmt) (setq line (pop olines)))
(unless (string-match "^[ \t]*|-" line)
@@ -2034,14 +2100,21 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
align))
(orgtbl-to-latex
lines
- `(:tstart nil :tend nil
+ `(:tstart ,org-export-latex-tables-tstart
+ :tend ,org-export-latex-tables-tend
+ :hline ,org-export-latex-tables-hline
+ :skipheadrule ,longtblp
+ :hfmt ,hfmt
:hlend ,(if longtblp
(format "\\\\
-\\hline
+%s
\\endhead
-\\hline\\multicolumn{%d}{r}{Continued on next page}\\
+%s\\multicolumn{%d}{r}{Continued on next page}\\
\\endfoot
-\\endlastfoot" (length org-table-last-alignment))
+\\endlastfoot"
+ org-export-latex-tables-hline
+ org-export-latex-tables-hline
+ (length org-table-last-alignment))
nil)))
(if (not longtblp) (format "\n\\end{%s}" tabular-env))
(if longtblp "\n" (if org-export-latex-tables-centered
@@ -2272,8 +2345,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(insert
(save-match-data
(funcall fnc (org-link-unescape raw-path) desc 'latex))))
-
- (t (insert "\\texttt{" desc "}")))))))
+ ;; Unrecognized path type
+ (t (insert (format org-export-latex-link-with-unknown-path-format desc))))))))
(defun org-export-latex-format-image (path caption label attr &optional shortn)
@@ -2382,7 +2455,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
;; Compute string to insert (FNOTE), and protect the outside
;; macro from further transformation. When footnote at
;; point is referring to a previously defined footnote, use
- ;; \footnotemark. Otherwise, use \footnote.
+ ;; \footnotemark. Otherwise, use \footnote.
(let ((fnote (if (member lbl org-export-latex-footmark-seen)
(org-export-latex-protect-string
(format "\\footnotemark[%s]" lbl))
@@ -2607,7 +2680,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(defun org-export-latex-lists ()
"Convert plain text lists in current buffer into LaTeX lists."
;; `org-list-end-re' output has changed since preprocess from
- ;; org-exp.el. Make sure it is taken into account.
+ ;; org-exp.el. Make sure it is taken into account.
(let ((org-list-end-re "^ORG-LIST-END-MARKER\n"))
(mapc
(lambda (e)
@@ -2638,181 +2711,181 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(append org-list-export-context '(nil)))))
(defconst org-latex-entities
- '("\\!"
- "\\'"
- "\\+"
- "\\,"
- "\\-"
- "\\:"
- "\\;"
- "\\<"
- "\\="
- "\\>"
- "\\Huge"
- "\\LARGE"
- "\\Large"
- "\\Styles"
- "\\\\"
- "\\`"
- "\\\""
- "\\addcontentsline"
- "\\address"
- "\\addtocontents"
- "\\addtocounter"
- "\\addtolength"
- "\\addvspace"
- "\\alph"
- "\\appendix"
- "\\arabic"
- "\\author"
- "\\begin{array}"
- "\\begin{center}"
- "\\begin{description}"
- "\\begin{enumerate}"
- "\\begin{eqnarray}"
- "\\begin{equation}"
- "\\begin{figure}"
- "\\begin{flushleft}"
- "\\begin{flushright}"
- "\\begin{itemize}"
- "\\begin{list}"
- "\\begin{minipage}"
- "\\begin{picture}"
- "\\begin{quotation}"
- "\\begin{quote}"
- "\\begin{tabbing}"
- "\\begin{table}"
- "\\begin{tabular}"
- "\\begin{thebibliography}"
- "\\begin{theorem}"
- "\\begin{titlepage}"
- "\\begin{verbatim}"
- "\\begin{verse}"
- "\\bf"
- "\\bf"
- "\\bibitem"
- "\\bigskip"
- "\\cdots"
- "\\centering"
- "\\circle"
- "\\cite"
- "\\cleardoublepage"
- "\\clearpage"
- "\\cline"
- "\\closing"
- "\\dashbox"
- "\\date"
- "\\ddots"
- "\\dotfill"
- "\\em"
- "\\fbox"
- "\\flushbottom"
- "\\fnsymbol"
- "\\footnote"
- "\\footnotemark"
- "\\footnotesize"
- "\\footnotetext"
- "\\frac"
- "\\frame"
- "\\framebox"
- "\\hfill"
- "\\hline"
- "\\hrulespace"
- "\\hspace"
- "\\huge"
- "\\hyphenation"
- "\\include"
- "\\includeonly"
- "\\indent"
- "\\input"
- "\\it"
- "\\kill"
- "\\label"
- "\\large"
- "\\ldots"
- "\\line"
- "\\linebreak"
- "\\linethickness"
- "\\listoffigures"
- "\\listoftables"
- "\\location"
- "\\makebox"
- "\\maketitle"
- "\\mark"
- "\\mbox"
- "\\medskip"
- "\\multicolumn"
- "\\multiput"
- "\\newcommand"
- "\\newcounter"
- "\\newenvironment"
- "\\newfont"
- "\\newlength"
- "\\newline"
- "\\newpage"
- "\\newsavebox"
- "\\newtheorem"
- "\\nocite"
- "\\nofiles"
- "\\noindent"
- "\\nolinebreak"
- "\\nopagebreak"
- "\\normalsize"
- "\\onecolumn"
- "\\opening"
- "\\oval"
- "\\overbrace"
- "\\overline"
- "\\pagebreak"
- "\\pagenumbering"
- "\\pageref"
- "\\pagestyle"
- "\\par"
- "\\parbox"
- "\\put"
- "\\raggedbottom"
- "\\raggedleft"
- "\\raggedright"
- "\\raisebox"
- "\\ref"
- "\\rm"
- "\\roman"
- "\\rule"
- "\\savebox"
- "\\sc"
- "\\scriptsize"
- "\\setcounter"
- "\\setlength"
- "\\settowidth"
- "\\sf"
- "\\shortstack"
- "\\signature"
- "\\sl"
- "\\small"
- "\\smallskip"
- "\\sqrt"
- "\\tableofcontents"
- "\\telephone"
- "\\thanks"
- "\\thispagestyle"
- "\\tiny"
- "\\title"
- "\\tt"
- "\\twocolumn"
- "\\typein"
- "\\typeout"
- "\\underbrace"
- "\\underline"
- "\\usebox"
- "\\usecounter"
- "\\value"
- "\\vdots"
- "\\vector"
- "\\verb"
- "\\vfill"
- "\\vline"
- "\\vspace")
- "A list of LaTeX commands to be protected when performing conversion.")
+ '("\\!"
+ "\\'"
+ "\\+"
+ "\\,"
+ "\\-"
+ "\\:"
+ "\\;"
+ "\\<"
+ "\\="
+ "\\>"
+ "\\Huge"
+ "\\LARGE"
+ "\\Large"
+ "\\Styles"
+ "\\\\"
+ "\\`"
+ "\\\""
+ "\\addcontentsline"
+ "\\address"
+ "\\addtocontents"
+ "\\addtocounter"
+ "\\addtolength"
+ "\\addvspace"
+ "\\alph"
+ "\\appendix"
+ "\\arabic"
+ "\\author"
+ "\\begin{array}"
+ "\\begin{center}"
+ "\\begin{description}"
+ "\\begin{enumerate}"
+ "\\begin{eqnarray}"
+ "\\begin{equation}"
+ "\\begin{figure}"
+ "\\begin{flushleft}"
+ "\\begin{flushright}"
+ "\\begin{itemize}"
+ "\\begin{list}"
+ "\\begin{minipage}"
+ "\\begin{picture}"
+ "\\begin{quotation}"
+ "\\begin{quote}"
+ "\\begin{tabbing}"
+ "\\begin{table}"
+ "\\begin{tabular}"
+ "\\begin{thebibliography}"
+ "\\begin{theorem}"
+ "\\begin{titlepage}"
+ "\\begin{verbatim}"
+ "\\begin{verse}"
+ "\\bf"
+ "\\bf"
+ "\\bibitem"
+ "\\bigskip"
+ "\\cdots"
+ "\\centering"
+ "\\circle"
+ "\\cite"
+ "\\cleardoublepage"
+ "\\clearpage"
+ "\\cline"
+ "\\closing"
+ "\\dashbox"
+ "\\date"
+ "\\ddots"
+ "\\dotfill"
+ "\\em"
+ "\\fbox"
+ "\\flushbottom"
+ "\\fnsymbol"
+ "\\footnote"
+ "\\footnotemark"
+ "\\footnotesize"
+ "\\footnotetext"
+ "\\frac"
+ "\\frame"
+ "\\framebox"
+ "\\hfill"
+ "\\hline"
+ "\\hrulespace"
+ "\\hspace"
+ "\\huge"
+ "\\hyphenation"
+ "\\include"
+ "\\includeonly"
+ "\\indent"
+ "\\input"
+ "\\it"
+ "\\kill"
+ "\\label"
+ "\\large"
+ "\\ldots"
+ "\\line"
+ "\\linebreak"
+ "\\linethickness"
+ "\\listoffigures"
+ "\\listoftables"
+ "\\location"
+ "\\makebox"
+ "\\maketitle"
+ "\\mark"
+ "\\mbox"
+ "\\medskip"
+ "\\multicolumn"
+ "\\multiput"
+ "\\newcommand"
+ "\\newcounter"
+ "\\newenvironment"
+ "\\newfont"
+ "\\newlength"
+ "\\newline"
+ "\\newpage"
+ "\\newsavebox"
+ "\\newtheorem"
+ "\\nocite"
+ "\\nofiles"
+ "\\noindent"
+ "\\nolinebreak"
+ "\\nopagebreak"
+ "\\normalsize"
+ "\\onecolumn"
+ "\\opening"
+ "\\oval"
+ "\\overbrace"
+ "\\overline"
+ "\\pagebreak"
+ "\\pagenumbering"
+ "\\pageref"
+ "\\pagestyle"
+ "\\par"
+ "\\parbox"
+ "\\put"
+ "\\raggedbottom"
+ "\\raggedleft"
+ "\\raggedright"
+ "\\raisebox"
+ "\\ref"
+ "\\rm"
+ "\\roman"
+ "\\rule"
+ "\\savebox"
+ "\\sc"
+ "\\scriptsize"
+ "\\setcounter"
+ "\\setlength"
+ "\\settowidth"
+ "\\sf"
+ "\\shortstack"
+ "\\signature"
+ "\\sl"
+ "\\small"
+ "\\smallskip"
+ "\\sqrt"
+ "\\tableofcontents"
+ "\\telephone"
+ "\\thanks"
+ "\\thispagestyle"
+ "\\tiny"
+ "\\title"
+ "\\tt"
+ "\\twocolumn"
+ "\\typein"
+ "\\typeout"
+ "\\underbrace"
+ "\\underline"
+ "\\usebox"
+ "\\usecounter"
+ "\\value"
+ "\\vdots"
+ "\\vector"
+ "\\verb"
+ "\\vfill"
+ "\\vline"
+ "\\vspace")
+ "A list of LaTeX commands to be protected when performing conversion.")
(defconst org-latex-entities-regexp
(let (names rest)
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index 8d3948698fc..10f5e6ec6a9 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -236,8 +236,7 @@ Otherwise, two of them will be necessary."
:group 'org-plain-lists
:type 'boolean)
-(defcustom org-list-automatic-rules '((bullet . t)
- (checkbox . t)
+(defcustom org-list-automatic-rules '((checkbox . t)
(indent . t))
"Non-nil means apply set of rules when acting on lists.
By default, automatic actions are taken when using
@@ -247,27 +246,21 @@ By default, automatic actions are taken when using
\\[org-insert-todo-heading]. You can disable individually these
rules by setting them to nil. Valid rules are:
-bullet when non-nil, cycling bullet do not allow lists at
- column 0 to have * as a bullet and descriptions lists
- to be numbered.
checkbox when non-nil, checkbox statistics is updated each time
you either insert a new checkbox or toggle a checkbox.
- It also prevents from inserting a checkbox in a
- description item.
indent when non-nil, indenting or outdenting list top-item
with its subtree will move the whole list and
outdenting a list whose bullet is * to column 0 will
change that bullet to \"-\"."
- :group 'org-plain-lists
- :version "24.1"
- :type '(alist :tag "Sets of rules"
- :key-type
- (choice
- (const :tag "Bullet" bullet)
- (const :tag "Checkbox" checkbox)
- (const :tag "Indent" indent))
- :value-type
- (boolean :tag "Activate" :value t)))
+ :group 'org-plain-lists
+ :version "24.1"
+ :type '(alist :tag "Sets of rules"
+ :key-type
+ (choice
+ (const :tag "Checkbox" checkbox)
+ (const :tag "Indent" indent))
+ :value-type
+ (boolean :tag "Activate" :value t)))
(defcustom org-list-use-circular-motion nil
"Non-nil means commands implying motion in lists should be cyclic.
@@ -491,7 +484,7 @@ group 4: description tag")
(defun org-at-item-description-p ()
"Is point at a description list item?"
- (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+"))
+ (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::\\([ \t]+\\|$\\)"))
(defun org-at-item-checkbox-p ()
"Is point at a line starting a plain-list item with a checklet?"
@@ -628,12 +621,15 @@ Assume point is at an item."
;; Return association at point.
(lambda (ind)
(looking-at org-list-full-item-re)
- (list (point)
- ind
- (match-string-no-properties 1) ; bullet
- (match-string-no-properties 2) ; counter
- (match-string-no-properties 3) ; checkbox
- (match-string-no-properties 4))))) ; description tag
+ (let ((bullet (match-string-no-properties 1)))
+ (list (point)
+ ind
+ bullet
+ (match-string-no-properties 2) ; counter
+ (match-string-no-properties 3) ; checkbox
+ ;; Description tag.
+ (and (save-match-data (string-match "[-+*]" bullet))
+ (match-string-no-properties 4)))))))
(end-before-blank
(function
;; Ensure list ends at the first blank line.
@@ -694,7 +690,7 @@ Assume point is at an item."
(forward-line -1))
((looking-at "^[ \t]*$")
(forward-line -1))
- ;; From there, point is not at an item. Interpret
+ ;; From there, point is not at an item. Interpret
;; line's indentation:
;; - text at column 0 is necessarily out of any list.
;; Dismiss data recorded above BEG-CELL. Jump to
@@ -1015,10 +1011,45 @@ Possible types are `descriptive', `ordered' and `unordered'. The
type is determined by the first item of the list."
(let ((first (org-list-get-list-begin item struct prevs)))
(cond
- ((org-list-get-tag first struct) 'descriptive)
((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered)
+ ((org-list-get-tag first struct) 'descriptive)
(t 'unordered))))
+(defun org-list-get-item-number (item struct prevs parents)
+ "Return ITEM's sequence number.
+
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'. PARENTS is the
+alist of ancestors, as returned by `org-list-parents-alist'.
+
+Return value is a list of integers. Counters have an impact on
+that value."
+ (let ((get-relative-number
+ (function
+ (lambda (item struct prevs)
+ ;; Return relative sequence number of ITEM in the sub-list
+ ;; it belongs. STRUCT is the list structure. PREVS is
+ ;; the alist of previous items.
+ (let ((seq 0) (pos item) counter)
+ (while (and (not (setq counter (org-list-get-counter pos struct)))
+ (setq pos (org-list-get-prev-item pos struct prevs)))
+ (incf seq))
+ (if (not counter) (1+ seq)
+ (cond
+ ((string-match "[A-Za-z]" counter)
+ (+ (- (string-to-char (upcase (match-string 0 counter))) 64)
+ seq))
+ ((string-match "[0-9]+" counter)
+ (+ (string-to-number (match-string 0 counter)) seq))
+ (t (1+ seq)))))))))
+ ;; Cons each parent relative number into return value (OUT).
+ (let ((out (list (funcall get-relative-number item struct prevs)))
+ (parent item))
+ (while (setq parent (org-list-get-parent parent struct parents))
+ (push (funcall get-relative-number parent struct prevs) out))
+ ;; Return value.
+ out)))
+
;;; Searching
@@ -1225,8 +1256,15 @@ This function modifies STRUCT."
(let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin))))
(item-end (org-list-get-item-end item struct))
(item-end-no-blank (org-list-get-item-end-before-blank item struct))
- (beforep (and (looking-at org-list-full-item-re)
- (<= pos (match-end 0))))
+ (beforep
+ (progn
+ (looking-at org-list-full-item-re)
+ ;; Do not count tag in a non-descriptive list.
+ (<= pos (if (and (match-beginning 4)
+ (save-match-data
+ (string-match "[.)]" (match-string 1))))
+ (match-beginning 4)
+ (match-end 0)))))
(split-line-p (org-get-alist-option org-M-RET-may-split-line 'item))
(blank-nb (org-list-separating-blank-lines-number
pos struct prevs))
@@ -1270,9 +1308,8 @@ This function modifies STRUCT."
(insert body item-sep)
;; 5. Add new item to STRUCT.
(mapc (lambda (e)
- (let ((p (car e))
- (end (nth 6 e)))
- (cond
+ (let ((p (car e)) (end (nth 6 e)))
+ (cond
;; Before inserted item, positions don't change but
;; an item ending after insertion has its end shifted
;; by SIZE-OFFSET.
@@ -1591,7 +1628,7 @@ as returned by `org-list-prevs-alist'."
(if (> ascii 90)
(throw 'exit nil)
(setq item (org-list-get-next-item item struct prevs)))))
- ;; All items checked. All good.
+ ;; All items checked. All good.
t))))
(defun org-list-inc-bullet-maybe (bullet)
@@ -1808,7 +1845,6 @@ Initial position of cursor is restored after the changes."
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(item-re (org-item-re))
- (box-rule-p (cdr (assq 'checkbox org-list-automatic-rules)))
(shift-body-ind
(function
;; Shift the indentation between END and BEG by DELTA.
@@ -1842,14 +1878,11 @@ Initial position of cursor is restored after the changes."
(old-bul (org-list-get-bullet item old-struct))
(new-box (org-list-get-checkbox item struct)))
(looking-at org-list-full-item-re)
- ;; a. Replace bullet
+ ;; a. Replace bullet
(unless (equal old-bul new-bul)
(replace-match new-bul nil nil nil 1))
- ;; b. Replace checkbox.
+ ;; b. Replace checkbox.
(cond
- ((and new-box box-rule-p
- (save-match-data (org-at-item-description-p)))
- (message "Cannot add a checkbox to a description list item"))
((equal (match-string 3) new-box))
((and (match-string 3) new-box)
(replace-match new-box nil nil nil 3))
@@ -1859,7 +1892,7 @@ Initial position of cursor is restored after the changes."
(t (let ((counterp (match-end 2)))
(goto-char (if counterp (1+ counterp) (match-end 1)))
(insert (concat new-box (unless counterp " "))))))
- ;; c. Indent item to appropriate column.
+ ;; c. Indent item to appropriate column.
(unless (= new-ind old-ind)
(delete-region (goto-char (point-at-bol))
(progn (skip-chars-forward " \t") (point)))
@@ -2007,7 +2040,7 @@ Possible values are: `folded', `children' or `subtree'. See
(let (bpos bcol tpos tcol)
(save-excursion
(goto-char item)
- (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?[ \t]+")
+ (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)")
(setq bpos (match-beginning 1) tpos (match-end 0)
bcol (progn (goto-char bpos) (current-column))
tcol (progn (goto-char tpos) (current-column)))
@@ -2164,20 +2197,19 @@ item is invisible."
(org-list-struct)))
(prevs (org-list-prevs-alist struct))
;; If we're in a description list, ask for the new term.
- (desc (when (org-list-get-tag itemp struct)
- (concat (read-string "Term: ") " :: ")))
- ;; Don't insert a checkbox if checkbox rule is applied
- ;; and it is a description item.
- (checkp (and checkbox
- (or (not desc)
- (not (cdr (assq 'checkbox
- org-list-automatic-rules)))))))
+ (desc (when (eq (org-list-get-list-type itemp struct prevs)
+ 'descriptive)
+ (concat (read-string "Term: ") " :: "))))
(setq struct
- (org-list-insert-item pos struct prevs checkp desc))
+ (org-list-insert-item pos struct prevs checkbox desc))
(org-list-write-struct struct (org-list-parents-alist struct))
- (when checkp (org-update-checkbox-count-maybe))
+ (when checkbox (org-update-checkbox-count-maybe))
(looking-at org-list-full-item-re)
- (goto-char (match-end 0))
+ (goto-char (if (and (match-beginning 4)
+ (save-match-data
+ (string-match "[.)]" (match-string 1))))
+ (match-beginning 4)
+ (match-end 0)))
t)))))
(defun org-list-repair ()
@@ -2206,7 +2238,6 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
(prevs (org-list-prevs-alist struct))
(list-beg (org-list-get-first-item (point) struct prevs))
(bullet (org-list-get-bullet list-beg struct))
- (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
(alpha-p (org-list-use-alpha-bul-p list-beg struct prevs))
(case-fold-search nil)
(current (cond
@@ -2221,22 +2252,21 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
(bullet-list
(append '("-" "+" )
;; *-bullets are not allowed at column 0.
- (unless (and bullet-rule-p
- (looking-at "\\S-")) '("*"))
+ (unless (looking-at "\\S-") '("*"))
;; Description items cannot be numbered.
(unless (or (eq org-plain-list-ordered-item-terminator ?\))
- (and bullet-rule-p (org-at-item-description-p)))
+ (org-at-item-description-p))
'("1."))
(unless (or (eq org-plain-list-ordered-item-terminator ?.)
- (and bullet-rule-p (org-at-item-description-p)))
+ (org-at-item-description-p))
'("1)"))
(unless (or (not alpha-p)
(eq org-plain-list-ordered-item-terminator ?\))
- (and bullet-rule-p (org-at-item-description-p)))
+ (org-at-item-description-p))
'("a." "A."))
(unless (or (not alpha-p)
(eq org-plain-list-ordered-item-terminator ?.)
- (and bullet-rule-p (org-at-item-description-p)))
+ (org-at-item-description-p))
'("a)" "A)"))))
(len (length bullet-list))
(item-index (- len (length (member current bullet-list))))
@@ -2339,13 +2369,13 @@ in subtree, ignoring drawers."
(lambda (e) (or (< e lim-up) (> e lim-down)))
(mapcar 'car struct))))
(mapc (lambda (e) (org-list-set-checkbox
- e struct
- ;; If there is no box at item, leave as-is
- ;; unless function was called with C-u prefix.
- (let ((cur-box (org-list-get-checkbox e struct)))
- (if (or cur-box (equal toggle-presence '(4)))
- ref-checkbox
- cur-box))))
+ e struct
+ ;; If there is no box at item, leave as-is
+ ;; unless function was called with C-u prefix.
+ (let ((cur-box (org-list-get-checkbox e struct)))
+ (if (or cur-box (equal toggle-presence '(4)))
+ ref-checkbox
+ cur-box))))
items-to-toggle)
(setq block-item (org-list-struct-fix-box
struct parents prevs orderedp))
@@ -2792,11 +2822,10 @@ COMPARE-FUNC to compare entries."
(sort-func (cond
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
- ((= dcst ?t) '<)
- (t nil)))
+ ((= dcst ?t) '<)))
(next-record (lambda ()
- (skip-chars-forward " \r\t\n")
- (beginning-of-line)))
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)))
(end-record (lambda ()
(goto-char (org-list-get-item-end-before-blank
(point) struct))))
@@ -2910,7 +2939,7 @@ Point is left at list end."
(goto-char e)
(looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*")
(match-end 0)))
- ;; Get counter number. For alphabetic counter, get
+ ;; Get counter number. For alphabetic counter, get
;; its position in the alphabet.
(counter (let ((c (org-list-get-counter e struct)))
(cond
@@ -3116,7 +3145,7 @@ items."
((and counter (eq type 'ordered))
(concat (eval icount) "%s"))
(t (concat (eval istart) "%s")))
- (eval iend)))
+ (eval iend)))
(first (car item)))
;; Replace checkbox if any is found.
(cond
@@ -3173,21 +3202,21 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}"
- :ustart "\\begin{itemize}\n" :uend "\\end{itemize}"
- :dstart "\\begin{description}\n" :dend "\\end{description}"
- :dtstart "[" :dtend "] "
- :istart "\\item " :iend "\n"
- :icount (let ((enum (nth depth '("i" "ii" "iii" "iv"))))
- (if enum
- ;; LaTeX increments counter just before
- ;; using it, so set it to the desired
- ;; value, minus one.
- (format "\\setcounter{enum%s}{%s}\n\\item "
- enum (1- counter))
- "\\item "))
- :csep "\n"
- :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}"
- :cbtrans "\\texttt{[-]}")
+ :ustart "\\begin{itemize}\n" :uend "\\end{itemize}"
+ :dstart "\\begin{description}\n" :dend "\\end{description}"
+ :dtstart "[" :dtend "] "
+ :istart "\\item " :iend "\n"
+ :icount (let ((enum (nth depth '("i" "ii" "iii" "iv"))))
+ (if enum
+ ;; LaTeX increments counter just before
+ ;; using it, so set it to the desired
+ ;; value, minus one.
+ (format "\\setcounter{enum%s}{%s}\n\\item "
+ enum (1- counter))
+ "\\item "))
+ :csep "\n"
+ :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}"
+ :cbtrans "\\texttt{[-]}")
params)))
(defun org-list-to-html (list &optional params)
@@ -3198,15 +3227,15 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice nil :ostart "<ol>\n" :oend "\n</ol>"
- :ustart "<ul>\n" :uend "\n</ul>"
- :dstart "<dl>\n" :dend "\n</dl>"
- :dtstart "<dt>" :dtend "</dt>\n"
- :ddstart "<dd>" :ddend "</dd>"
- :istart "<li>" :iend "</li>"
- :icount (format "<li value=\"%s\">" counter)
- :isep "\n" :lsep "\n" :csep "\n"
- :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>"
- :cbtrans "<code>[-]</code>")
+ :ustart "<ul>\n" :uend "\n</ul>"
+ :dstart "<dl>\n" :dend "\n</dl>"
+ :dtstart "<dt>" :dtend "</dt>\n"
+ :ddstart "<dd>" :ddend "</dd>"
+ :istart "<li>" :iend "</li>"
+ :icount (format "<li value=\"%s\">" counter)
+ :isep "\n" :lsep "\n" :csep "\n"
+ :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>"
+ :cbtrans "<code>[-]</code>")
params)))
(defun org-list-to-texinfo (list &optional params)
@@ -3217,14 +3246,14 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize"
- :ustart "@enumerate\n" :uend "@end enumerate"
- :dstart "@table @asis\n" :dend "@end table"
- :dtstart " " :dtend "\n"
- :istart "@item\n" :iend "\n"
- :icount "@item\n"
- :csep "\n"
- :cbon "@code{[X]}" :cboff "@code{[ ]}"
- :cbtrans "@code{[-]}")
+ :ustart "@enumerate\n" :uend "@end enumerate"
+ :dstart "@table @asis\n" :dend "@end table"
+ :dtstart " " :dtend "\n"
+ :istart "@item\n" :iend "\n"
+ :icount "@item\n"
+ :csep "\n"
+ :cbon "@code{[X]}" :cboff "@code{[ ]}"
+ :cbtrans "@code{[-]}")
params)))
(defun org-list-to-subtree (list &optional params)
diff --git a/lisp/org/org-lparse.el b/lisp/org/org-lparse.el
index 9c3cd5b4811..7024912050a 100644
--- a/lisp/org/org-lparse.el
+++ b/lisp/org/org-lparse.el
@@ -67,7 +67,7 @@ lists."
((file-exists-p file-or-buf) file-or-buf)
(t (error "org-lparse-and-open: This shouldn't happen"))))
(message "Opening file %s" f)
- (org-open-file f)
+ (org-open-file f 'system)
(when org-export-kill-product-buffer-when-displayed
(kill-buffer (current-buffer))))))
@@ -89,9 +89,9 @@ emacs --batch
No file is created. The prefix ARG is passed through to
`org-lparse'."
(let ((tempbuf (format "*Org %s Export*" (upcase backend))))
- (org-lparse backend backend arg nil nil tempbuf)
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window tempbuf))))
+ (org-lparse backend backend arg nil nil tempbuf)
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window tempbuf))))
;;;###autoload
(defun org-replace-region-by (backend beg end)
@@ -101,7 +101,7 @@ itemized list in org-mode syntax in an HTML buffer and then use
this command to convert it."
(let (reg backend-string buf pop-up-frames)
(save-window-excursion
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(setq backend-string (org-lparse-region backend beg end t 'string))
(setq reg (buffer-substring beg end)
buf (get-buffer-create "*Org tmp*"))
@@ -145,16 +145,16 @@ in a window. A non-interactive call will only return the buffer."
(defvar org-lparse-par-open nil)
(defun org-lparse-should-inline-p (filename descp)
- "Return non-nil if link FILENAME should be inlined.
+ "Return non-nil if link FILENAME should be inlined.
The decision to inline the FILENAME link is based on the current
settings. DESCP is the boolean of whether there was a link
description. See variables `org-export-html-inline-images' and
`org-export-html-inline-image-extensions'."
- (let ((inline-images (org-lparse-get 'INLINE-IMAGES))
- (inline-image-extensions
- (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
- (and (or (eq t inline-images) (and inline-images (not descp)))
- (org-file-image-p filename inline-image-extensions))))
+ (let ((inline-images (org-lparse-get 'INLINE-IMAGES))
+ (inline-image-extensions
+ (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
+ (and (or (eq t inline-images) (and inline-images (not descp)))
+ (org-file-image-p filename inline-image-extensions))))
(defun org-lparse-format-org-link (line opt-plist)
"Return LINE with markup of Org mode links.
@@ -435,6 +435,10 @@ PUB-DIR specifies the publishing directory."
(let* ((org-lparse-backend (intern native-backend))
(org-lparse-other-backend (and target-backend
(intern target-backend))))
+ (add-hook 'org-export-preprocess-hook
+ 'org-lparse-strip-experimental-blocks-maybe)
+ (add-hook 'org-export-preprocess-after-blockquote-hook
+ 'org-lparse-preprocess-after-blockquote)
(unless (org-lparse-backend-is-native-p native-backend)
(error "Don't know how to export natively to backend %s" native-backend))
@@ -443,7 +447,11 @@ PUB-DIR specifies the publishing directory."
(error "Don't know how to export to backend %s %s" target-backend
(format "via %s" native-backend)))
(run-hooks 'org-export-first-hook)
- (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)))
+ (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)
+ (remove-hook 'org-export-preprocess-hook
+ 'org-lparse-strip-experimental-blocks-maybe)
+ (remove-hook 'org-export-preprocess-after-blockquote-hook
+ 'org-lparse-preprocess-after-blockquote)))
(defcustom org-lparse-use-flashy-warning nil
"Control flashing of messages logged with `org-lparse-warn'.
@@ -509,7 +517,7 @@ This is a helper routine for interactive use."
(message "Exported to %s" out-file)
(when prefix-arg
(message "Opening %s..." out-file)
- (org-open-file out-file))
+ (org-open-file out-file 'system))
out-file)
(t
(message "Export to %s failed" out-file)
@@ -565,7 +573,7 @@ and then converted to \"doc\" then org-lparse-backend is set to
(defun org-do-lparse (arg &optional hidden ext-plist
to-buffer body-only pub-dir)
"Export the outline to various formats.
-See `org-lparse' for more information. This function is a
+See `org-lparse' for more information. This function is a
html-agnostic version of the `org-export-as-html' function in 7.5
version."
;; Make sure we have a file name when we need it.
@@ -771,7 +779,7 @@ version."
;; collection
org-lparse-collect-buffer
(org-lparse-collect-count 0) ; things will get haywire if
- ; collections are chained. Use
+ ; collections are chained. Use
; this variable to assert this
; pre-requisite
org-lparse-toc
@@ -901,7 +909,6 @@ version."
(funcall f style env-options-plist)
(throw 'nextline nil))))
- (run-hooks 'org-export-html-after-blockquotes-hook)
(when (org-lparse-current-environment-p 'verse)
(let ((i (org-get-string-indentation line)))
(if (> i 0)
@@ -1158,7 +1165,7 @@ version."
(defun org-lparse-table-get-colalign-info (lines)
(let ((col-cookies (org-find-text-property-in-string
- 'org-col-cookies (car lines))))
+ 'org-col-cookies (car lines))))
(when (and col-cookies org-table-clean-did-remove-column)
(setq col-cookies
(mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies)))
@@ -1218,7 +1225,11 @@ for formatting. This is required for the DocBook exporter."
;; column and the special lines
(setq lines (org-table-clean-before-export lines)))
(let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
+ (short-caption (or (org-find-text-property-in-string
+ 'org-caption-shortn (car lines)) caption))
(caption (and caption (org-xml-encode-org-text caption)))
+ (short-caption (and short-caption
+ (org-xml-encode-plain-text short-caption)))
(label (org-find-text-property-in-string 'org-label (car lines)))
(org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines))
(attributes (org-find-text-property-in-string 'org-attributes
@@ -1229,11 +1240,13 @@ for formatting. This is required for the DocBook exporter."
(cdr lines))))))
(setq lines (org-lparse-org-table-to-list-table lines splice))
(org-lparse-insert-list-table
- lines splice caption label attributes head org-lparse-table-colalign-info)))
+ lines splice caption label attributes head org-lparse-table-colalign-info
+ short-caption)))
(defun org-lparse-insert-list-table (lines &optional splice
- caption label attributes head
- org-lparse-table-colalign-info)
+ caption label attributes head
+ org-lparse-table-colalign-info
+ short-caption)
(or (featurep 'org-table) ; required for
(require 'org-table)) ; `org-table-number-regexp'
(let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0)
@@ -1253,7 +1266,7 @@ for formatting. This is required for the DocBook exporter."
(insert (org-lparse-format-table-row line) "\n")))
(t
(setq org-lparse-table-is-styled t)
- (org-lparse-begin 'TABLE caption label attributes)
+ (org-lparse-begin 'TABLE caption label attributes short-caption)
(setq org-lparse-table-begin-marker (point))
(org-lparse-begin-table-rowgroup head)
(while (setq line (pop lines))
@@ -1284,13 +1297,14 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
(org-lparse-table-cur-rowgrp-is-hdr
org-export-highlight-first-table-line)
(caption nil)
+ (short-caption nil)
(attributes nil)
(label nil)
(org-lparse-table-style 'table-table)
(org-lparse-table-is-styled nil)
fields org-lparse-table-ncols i (org-lparse-table-rownum -1)
(empty (org-lparse-format 'SPACES 1)))
- (org-lparse-begin 'TABLE caption label attributes)
+ (org-lparse-begin 'TABLE caption label attributes short-caption)
(while (setq line (pop lines))
(cond
((string-match "^[ \t]*\\+-" line)
@@ -1320,9 +1334,9 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
(defvar table-source-languages) ; defined in table.el
(defun org-lparse-format-table-table-using-table-generate-source (backend
- lines
- &optional
- spanned-only)
+ lines
+ &optional
+ spanned-only)
"Format a table into BACKEND, using `table-generate-source' from table.el.
Use SPANNED-ONLY to suppress exporting of simple table.el tables.
@@ -1353,9 +1367,9 @@ for further information."
(set-buffer " org-tmp2 ")
(buffer-substring (point-min) (point-max)))
(t
- ;; table.el doesn't support the given backend. Currently this
+ ;; table.el doesn't support the given backend. Currently this
;; happens in case of odt export. Strip the table from the
- ;; generated document. A better alternative would be to embed
+ ;; generated document. A better alternative would be to embed
;; the table as ascii text in the output document.
(org-lparse-warn
(concat
@@ -1706,7 +1720,12 @@ information."
(org-lparse-end-paragraph)
(org-lparse-end-list-item (or type "u")))
-(defun org-lparse-preprocess-after-blockquote-hook ()
+(define-obsolete-function-alias
+ 'org-lparse-preprocess-after-blockquote-hook
+ 'org-lparse-preprocess-after-blockquote
+ "24.3")
+
+(defun org-lparse-preprocess-after-blockquote ()
"Treat `org-lparse-special-blocks' specially."
(goto-char (point-min))
(while (re-search-forward
@@ -1719,10 +1738,12 @@ information."
(format "ORG-%s-END %s" (upcase (match-string 2))
(match-string 3))) t t))))
-(add-hook 'org-export-preprocess-after-blockquote-hook
- 'org-lparse-preprocess-after-blockquote-hook)
+(define-obsolete-function-alias
+ 'org-lparse-strip-experimental-blocks-maybe-hook
+ 'org-lparse-strip-experimental-blocks-maybe
+ "24.3")
-(defun org-lparse-strip-experimental-blocks-maybe-hook ()
+(defun org-lparse-strip-experimental-blocks-maybe ()
"Strip \"list-table\" and \"annotation\" blocks.
Stripping happens only when the exported backend is not one of
\"odt\" or \"xhtml\"."
@@ -1737,9 +1758,6 @@ Stripping happens only when the exported backend is not one of
(when (member (match-string 1) org-lparse-special-blocks)
(replace-match "" t t))))))
-(add-hook 'org-export-preprocess-hook
- 'org-lparse-strip-experimental-blocks-maybe-hook)
-
(defvar org-lparse-list-table-p nil
"Non-nil if `org-do-lparse' is within a list-table.")
@@ -1871,7 +1889,7 @@ See `org-xhtml-entity-format-callbacks-alist' for more information."
(replace-match
(let ((org-lparse-encode-pending t))
(org-lparse-format 'FONTIFY
- (match-string 1 line) "target"))
+ (match-string 1 line) "target"))
t t line)))
(when (string-match
(org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
@@ -1923,8 +1941,7 @@ See `org-xhtml-entity-format-callbacks-alist' for more information."
(cond
((string= align "l") "left")
((string= align "r") "right")
- ((string= align "c") "center")
- (t nil))))))))
+ ((string= align "c") "center"))))))))
(incf org-lparse-table-rownum)
(let ((i -1))
(org-lparse-format
@@ -2036,8 +2053,8 @@ When TITLE is nil, just close all open levels."
(defvar org-lparse-outline-text-open)
(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags
- target extra-targets
- extra-class)
+ target extra-targets
+ extra-class)
(org-lparse-begin
'OUTLINE level1 snumber title tags target extra-targets extra-class)
(org-lparse-begin-outline-text level1 snumber extra-class))
@@ -2087,7 +2104,7 @@ When TITLE is nil, just close all open levels."
;; Note that org-tables are NOT multi-line and each line is mapped to
;; a unique row in the exported document. So if an exported table
;; needs to contain a single paragraph (with copious text) it needs to
-;; be typed up in a single line. Editing such long lines using the
+;; be typed up in a single line. Editing such long lines using the
;; table editor will be a cumbersome task. Furthermore inclusion of
;; multi-paragraph text in a table cell is well-nigh impossible.
;;
@@ -2232,11 +2249,11 @@ Replaces invalid characters with \"_\"."
(defun org-lparse-format-extra-targets (extra-targets)
(if (not extra-targets) ""
- (mapconcat (lambda (x)
- (setq x (org-solidify-link-text
- (if (org-uuidgen-p x) (concat "ID-" x) x)))
- (org-lparse-format 'ANCHOR "" x))
- extra-targets "")))
+ (mapconcat (lambda (x)
+ (setq x (org-solidify-link-text
+ (if (org-uuidgen-p x) (concat "ID-" x) x)))
+ (org-lparse-format 'ANCHOR "" x))
+ extra-targets "")))
(defun org-lparse-format-org-tags (tags)
(if (not tags) ""
diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el
index 2223c63f154..91866b46c0a 100644
--- a/lisp/org/org-mac-message.el
+++ b/lisp/org/org-mac-message.el
@@ -47,7 +47,7 @@
(require 'org)
(defgroup org-mac-flagged-mail nil
- "Options concerning linking to flagged Mail.app messages"
+ "Options concerning linking to flagged Mail.app messages."
:tag "Org Mail.app"
:group 'org-link)
@@ -84,15 +84,15 @@ This will use the command `open' with the message URL."
(do-applescript
(concat
"tell application \"Mail\"\n"
- "set theLinkList to {}\n"
- "set theSelection to selection\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
- "end repeat\n"
- "return theLinkList as string\n"
+ "set theLinkList to {}\n"
+ "set theSelection to selection\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to message id of theMessage\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
"end tell")))
(defun as-get-flagged-mail ()
@@ -101,47 +101,47 @@ This will use the command `open' with the message URL."
(concat
;; Is Growl installed?
"tell application \"System Events\"\n"
- "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
- "if (count of growlHelpers) > 0 then\n"
- "set growlHelperApp to item 1 of growlHelpers\n"
- "else\n"
- "set growlHelperApp to \"\"\n"
- "end if\n"
+ "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
+ "if (count of growlHelpers) > 0 then\n"
+ "set growlHelperApp to item 1 of growlHelpers\n"
+ "else\n"
+ "set growlHelperApp to \"\"\n"
+ "end if\n"
"end tell\n"
;; Get links
"tell application \"Mail\"\n"
- "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
- "set theLinkList to {}\n"
- "repeat with aMailbox in theMailboxes\n"
- "set theSelection to (every message in aMailbox whose flagged status = true)\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
-
- ;; Report progress through Growl
- ;; This "double tell" idiom is described in detail at
- ;; http://macscripter.net/viewtopic.php?id=24570 The
- ;; script compiler needs static knowledge of the
- ;; growlHelperApp. Hmm, since we're compiling
- ;; on-the-fly here, this is likely to be way less
- ;; portable than I'd hoped. It'll work when the name
- ;; is still "GrowlHelperApp", though.
- "if growlHelperApp is not \"\" then\n"
- "tell application \"GrowlHelperApp\"\n"
- "tell application growlHelperApp\n"
- "set the allNotificationsList to {\"FlaggedMail\"}\n"
- "set the enabledNotificationsList to allNotificationsList\n"
- "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
- "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
- "end tell\n"
- "end tell\n"
- "end if\n"
- "end repeat\n"
- "end repeat\n"
- "return theLinkList as string\n"
+ "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
+ "set theLinkList to {}\n"
+ "repeat with aMailbox in theMailboxes\n"
+ "set theSelection to (every message in aMailbox whose flagged status = true)\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to message id of theMessage\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+
+ ;; Report progress through Growl
+ ;; This "double tell" idiom is described in detail at
+ ;; http://macscripter.net/viewtopic.php?id=24570 The
+ ;; script compiler needs static knowledge of the
+ ;; growlHelperApp. Hmm, since we're compiling
+ ;; on-the-fly here, this is likely to be way less
+ ;; portable than I'd hoped. It'll work when the name
+ ;; is still "GrowlHelperApp", though.
+ "if growlHelperApp is not \"\" then\n"
+ "tell application \"GrowlHelperApp\"\n"
+ "tell application growlHelperApp\n"
+ "set the allNotificationsList to {\"FlaggedMail\"}\n"
+ "set the enabledNotificationsList to allNotificationsList\n"
+ "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
+ "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
+ "end tell\n"
+ "end tell\n"
+ "end if\n"
+ "end repeat\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
"end tell")))
(defun org-mac-message-get-links (&optional select-or-flag)
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index daeea715789..e99991702fe 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -54,21 +54,22 @@
(defmacro org-called-interactively-p (&optional kind)
(if (featurep 'xemacs)
- `(interactive-p)
- (if (or (> emacs-major-version 23)
- (and (>= emacs-major-version 23)
- (>= emacs-minor-version 2)))
- `(with-no-warnings (called-interactively-p ,kind)) ;; defined with no argument in <=23.1
- `(interactive-p))))
+ `(interactive-p)
+ (if (or (> emacs-major-version 23)
+ (and (>= emacs-major-version 23)
+ (>= emacs-minor-version 2)))
+ ;; defined with no argument in <=23.1
+ `(with-no-warnings (called-interactively-p ,kind))
+ `(interactive-p))))
(def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp)))
(when (and (not (fboundp 'with-silent-modifications))
- (or (< emacs-major-version 23)
- (and (= emacs-major-version 23)
- (< emacs-minor-version 2))))
- (defmacro with-silent-modifications (&rest body)
- `(org-unmodified ,@body))
- (def-edebug-spec with-silent-modifications (body)))
+ (or (< emacs-major-version 23)
+ (and (= emacs-major-version 23)
+ (< emacs-minor-version 2))))
+ (defmacro with-silent-modifications (&rest body)
+ `(org-unmodified ,@body))
+ (def-edebug-spec with-silent-modifications (body)))
(defmacro org-bound-and-true-p (var)
"Return the value of symbol VAR if it is bound, else nil."
@@ -129,15 +130,15 @@ Also, do not record undo information."
`(if (and (boundp 'partial-completion-mode)
partial-completion-mode
(fboundp 'partial-completion-mode))
- (unwind-protect
- (progn
- (partial-completion-mode -1)
- ,@body)
- (partial-completion-mode 1))
+ (unwind-protect
+ (progn
+ (partial-completion-mode -1)
+ ,@body)
+ (partial-completion-mode 1))
,@body))
(def-edebug-spec org-without-partial-completion (body))
-;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22
+;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22
(defmacro org-maybe-intangible (props)
"Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22.
In Emacs 21, invisible text is not avoided by the command loop, so the
@@ -238,10 +239,15 @@ We use a macro so that the test can happen at compilation time."
s)
(match-string-no-properties num string)))
-(defsubst org-no-properties (s)
+(defsubst org-no-properties (s &optional restricted)
+ "Remove all text properties from string S.
+When RESTRICTED is non-nil, only remove the properties listed
+in `org-rm-props'."
(if (fboundp 'set-text-properties)
(set-text-properties 0 (length s) nil s)
- (remove-text-properties 0 (length s) org-rm-props s))
+ (if restricted
+ (remove-text-properties 0 (length s) org-rm-props s)
+ (set-text-properties 0 (length s) nil s)))
s)
(defsubst org-get-alist-option (option key)
@@ -363,18 +369,19 @@ point nowhere."
(def-edebug-spec org-save-outline-visibility (form body))
(defmacro org-with-wide-buffer (&rest body)
- "Execute body while temporarily widening the buffer."
- `(save-excursion
- (save-restriction
+ "Execute body while temporarily widening the buffer."
+ `(save-excursion
+ (save-restriction
(widen)
,@body)))
(def-edebug-spec org-with-wide-buffer (body))
(defmacro org-with-limited-levels (&rest body)
"Execute BODY with limited number of outline levels."
- `(let* ((org-outline-regexp (org-get-limited-outline-regexp))
+ `(let* ((org-called-with-limited-levels t)
+ (org-outline-regexp (org-get-limited-outline-regexp))
(outline-regexp org-outline-regexp)
- (org-outline-regexp-at-bol (concat "^" org-outline-regexp)))
+ (org-outline-regexp-bol (concat "^" org-outline-regexp)))
,@body))
(def-edebug-spec org-with-limited-levels (body))
@@ -384,14 +391,14 @@ point nowhere."
(defun org-get-limited-outline-regexp ()
"Return outline-regexp with limited number of levels.
The number of levels is controlled by `org-inlinetask-min-level'"
- (if (or (not (eq major-mode 'org-mode)) (not (featurep 'org-inlinetask)))
+ (if (or (not (derived-mode-p 'org-mode)) (not (featurep 'org-inlinetask)))
org-outline-regexp
(let* ((limit-level (1- org-inlinetask-min-level))
(nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
(format "\\*\\{1,%d\\} " nstars))))
(defun org-format-seconds (string seconds)
- "Compatibility function replacing format-seconds"
+ "Compatibility function replacing format-seconds."
(if (fboundp 'format-seconds)
(format-seconds string seconds)
(format-time-string string (seconds-to-time seconds))))
@@ -403,12 +410,12 @@ The number of levels is controlled by `org-inlinetask-min-level'"
(defun org-make-parameter-alist (flat)
"Return alist based on FLAT.
-FLAT is a list with alternating symbol names and values. The
+FLAT is a list with alternating symbol names and values. The
returned alist is a list of lists with the symbol name in car and
the value in cdr."
(when flat
(cons (list (car flat) (cadr flat))
- (org-make-parameter-alist (cddr flat)))))
+ (org-make-parameter-alist (cddr flat)))))
(provide 'org-macs)
diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el
index 9cc767eaec4..74ace5a529f 100644
--- a/lisp/org/org-mew.el
+++ b/lisp/org/org-mew.el
@@ -103,8 +103,7 @@
:date-timestamp-inactive date-ts-ia))
(setq message-id (org-remove-angle-brackets message-id))
(setq desc (org-email-link-description))
- (setq link (org-make-link "mew:" folder-name
- "#" message-id))
+ (setq link (concat "mew:" folder-name "#" message-id))
(org-add-link-props :link link :description desc)
link)))
diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el
index 0c59d500735..7c8b0b23905 100644
--- a/lisp/org/org-mhe.el
+++ b/lisp/org/org-mhe.el
@@ -99,8 +99,8 @@ supported by MH-E."
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
(setq desc (org-email-link-description))
- (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
- (org-remove-angle-brackets message-id)))
+ (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#"
+ (org-remove-angle-brackets message-id)))
(org-add-link-props :link link :description desc)
link))))
@@ -179,17 +179,17 @@ you have a better idea of how to do this then please let us know."
(num (org-mhe-get-message-num))
(buffer (get-buffer-create (concat "show-" folder)))
(header-field))
- (with-current-buffer buffer
- (mh-display-msg num folder)
- (if (equal major-mode 'mh-folder-mode)
- (mh-header-display)
- (mh-show-header-display))
- (set-buffer buffer)
- (setq header-field (mh-get-header-field header))
- (if (equal major-mode 'mh-folder-mode)
- (mh-show)
- (mh-show-show))
- (org-trim header-field))))
+ (with-current-buffer buffer
+ (mh-display-msg num folder)
+ (if (equal major-mode 'mh-folder-mode)
+ (mh-header-display)
+ (mh-show-header-display))
+ (set-buffer buffer)
+ (setq header-field (mh-get-header-field header))
+ (if (equal major-mode 'mh-folder-mode)
+ (mh-show)
+ (mh-show-show))
+ (org-trim header-field))))
(defun org-mhe-follow-link (folder article)
"Follow an MH-E link to FOLDER and ARTICLE.
diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el
index 3bd9a7c0bbd..d2c9c17367f 100644
--- a/lisp/org/org-mobile.el
+++ b/lisp/org/org-mobile.el
@@ -236,7 +236,7 @@ by the mobile device, this hook should be used to copy the capture file
directory `org-mobile-directory'.")
(defvar org-mobile-post-pull-hook nil
- "Hook run after running `org-mobile-pull'.
+ "Hook run after running `org-mobile-pull', only if new items were found.
If Emacs does not have direct write access to the WebDAV directory used
by the mobile device, this hook should be used to copy the emptied
capture file `mobileorg.org' back to the WebDAV directory, for example
@@ -300,6 +300,8 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
(push (cons file link-name) rtn)))
(nreverse rtn)))
+(defvar org-agenda-filter)
+
;;;###autoload
(defun org-mobile-push ()
"Push the current state of Org affairs to the WebDAV directory.
@@ -316,7 +318,9 @@ create all custom agenda views, for upload to the mobile phone."
(org-mobile-check-setup)
(org-mobile-prepare-file-lists)
(message "Creating agendas...")
- (let ((inhibit-redisplay t)) (org-mobile-create-sumo-agenda))
+ (let ((inhibit-redisplay t)
+ (org-agenda-files (mapcar 'car org-mobile-files-alist)))
+ (org-mobile-create-sumo-agenda))
(message "Creating agendas...done")
(org-save-all-org-buffers) ; to save any IDs created by this process
(message "Copying files...")
@@ -402,7 +406,7 @@ agenda view showing the flagged items."
(error "Cannot write to encryption tempfile %s"
org-mobile-encryption-tempfile))
(unless (executable-find "openssl")
- (error "openssl is needed to encrypt files"))))
+ (error "OpenSSL is needed to encrypt files"))))
(defun org-mobile-create-index-file ()
"Write the index file in the WebDAV directory."
@@ -414,21 +418,14 @@ agenda view showing the flagged items."
org-mobile-directory))
file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds)
- (org-prepare-agenda-buffers (mapcar 'car files-alist))
+ (org-agenda-prepare-buffers (mapcar 'car files-alist))
(setq done-kwds (org-uniquify org-done-keywords-for-agenda))
(setq todo-kwds (org-delete-all
done-kwds
(org-uniquify org-todo-keywords-for-agenda)))
(setq drawers (org-uniquify org-drawers-for-agenda))
- (setq tags (org-uniquify
- (delq nil
- (mapcar
- (lambda (e)
- (cond ((stringp e) e)
- ((listp e)
- (if (stringp (car e)) (car e) nil))
- (t nil)))
- org-tag-alist-for-agenda))))
+ (setq tags (mapcar 'car (org-global-tags-completion-table
+ (mapcar 'car files-alist))))
(with-temp-file
(if org-mobile-use-encryption
org-mobile-encryption-tempfile
@@ -454,8 +451,7 @@ agenda view showing the flagged items."
((eq (car x) :startgroup) "{")
((eq (car x) :endgroup) "}")
((eq (car x) :newline) nil)
- ((listp x) (car x))
- (t nil)))
+ ((listp x) (car x))))
def-tags))
(setq def-tags (delq nil def-tags))
(setq tags (org-delete-all def-tags tags))
@@ -579,7 +575,7 @@ The table of checksums is written to the file mobile-checksums."
(concat "<after>KEYS=" key " TITLE: "
(if (and (stringp desc) (> (length desc) 0))
desc (symbol-name type))
- " " match "</after>"))
+ "</after>"))
settings))
(push (list type match settings) new))
((or (functionp (nth 2 e)) (symbolp (nth 2 e)))
@@ -596,7 +592,7 @@ The table of checksums is written to the file mobile-checksums."
(setq settings
(cons (list 'org-agenda-title-append
(concat "<after>KEYS=" gkey "#" (number-to-string
- (setq cnt (1+ cnt)))
+ (setq cnt (1+ cnt)))
" TITLE: " gdesc " " match "</after>"))
settings))
(push (list type match settings) new)))))
@@ -827,107 +823,95 @@ If BEG and END are given, only do this in that region."
(not (equal (downcase (substring (match-string 1) 0 2)) "f("))
(incf cnt-new)))
+ ;; Find and apply the edits
(goto-char beg)
(while (re-search-forward
"^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[\\(\\(id\\|olp\\):\\([^]\n]+\\)\\)" end t)
- (setq id-pos (condition-case msg
- (org-mobile-locate-entry (match-string 4))
- (error (nth 1 msg))))
- (when (and (markerp id-pos)
- (not (member (marker-buffer id-pos) buf-list)))
- (org-mobile-timestamp-buffer (marker-buffer id-pos))
- (push (marker-buffer id-pos) buf-list))
-
- (if (or (not id-pos) (stringp id-pos))
- (progn
- (goto-char (+ 2 (point-at-bol)))
- (insert id-pos " ")
- (incf cnt-error))
- (add-text-properties (point-at-bol) (point-at-eol)
- (list 'org-mobile-marker
- (or id-pos "Linked entry not found")))))
-
- ;; OK, now go back and start applying
- (goto-char beg)
- (while (re-search-forward "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)" end t)
(catch 'next
- (setq id-pos (get-text-property (point-at-bol) 'org-mobile-marker))
- (if (not (markerp id-pos))
- (progn
- (incf cnt-error)
- (insert "UNKNOWN PROBLEM"))
- (let* ((action (match-string 1))
- (data (and (match-end 3) (match-string 3)))
- (bos (point-at-bol))
- (eos (save-excursion (org-end-of-subtree t t)))
- (cmd (if (equal action "")
- '(progn
- (incf cnt-flag)
- (org-toggle-tag "FLAGGED" 'on)
- (and note
- (org-entry-put nil "THEFLAGGINGNOTE" note)))
- (incf cnt-edit)
- (cdr (assoc action org-mobile-action-alist))))
- (note (and (equal action "")
- (buffer-substring (1+ (point-at-eol)) eos)))
- (org-inhibit-logging 'note) ;; Do not take notes interactively
- old new)
- (goto-char bos)
- (move-marker bos-marker (point))
- (if (re-search-forward "^** Old value[ \t]*$" eos t)
- (setq old (buffer-substring
- (1+ (match-end 0))
- (progn (outline-next-heading) (point)))))
- (if (re-search-forward "^** New value[ \t]*$" eos t)
- (setq new (buffer-substring
- (1+ (match-end 0))
- (progn (outline-next-heading)
- (if (eobp) (org-back-over-empty-lines))
- (point)))))
- (setq old (and old (if (string-match "\\S-" old) old nil)))
- (setq new (and new (if (string-match "\\S-" new) new nil)))
- (if (and note (> (length note) 0))
- ;; Make Note into a single line, to fit into a property
- (setq note (mapconcat 'identity
- (org-split-string (org-trim note) "\n")
- "\\n")))
- (unless (equal data "body")
- (setq new (and new (org-trim new))
- old (and old (org-trim old))))
- (goto-char (+ 2 bos-marker))
- (unless (markerp id-pos)
- (insert "BAD REFERENCE ")
- (incf cnt-error)
- (throw 'next t))
- (unless cmd
- (insert "BAD FLAG ")
- (incf cnt-error)
- (throw 'next t))
- ;; Remember this place so that we can return
- (move-marker marker (point))
- (setq org-mobile-error nil)
- (save-excursion
- (condition-case msg
- (org-with-point-at id-pos
- (progn
- (eval cmd)
- (if (member "FLAGGED" (org-get-tags))
- (add-to-list 'org-mobile-last-flagged-files
- (buffer-file-name (current-buffer))))))
- (error (setq org-mobile-error msg))))
- (when org-mobile-error
- (org-pop-to-buffer-same-window (marker-buffer marker))
- (goto-char marker)
- (incf cnt-error)
- (insert (if (stringp (nth 1 org-mobile-error))
- (nth 1 org-mobile-error)
- "EXECUTION FAILED")
- " ")
- (throw 'next t))
- ;; If we get here, the action has been applied successfully
- ;; So remove the entry
- (goto-char bos-marker)
- (delete-region (point) (org-end-of-subtree t t))))))
+ (let* ((action (match-string 1))
+ (data (and (match-end 3) (match-string 3)))
+ (id-pos (condition-case msg
+ (org-mobile-locate-entry (match-string 4))
+ (error (nth 1 msg))))
+ (bos (point-at-bol))
+ (eos (save-excursion (org-end-of-subtree t t)))
+ (cmd (if (equal action "")
+ '(progn
+ (incf cnt-flag)
+ (org-toggle-tag "FLAGGED" 'on)
+ (and note
+ (org-entry-put nil "THEFLAGGINGNOTE" note)))
+ (incf cnt-edit)
+ (cdr (assoc action org-mobile-action-alist))))
+ (note (and (equal action "")
+ (buffer-substring (1+ (point-at-eol)) eos)))
+ (org-inhibit-logging 'note) ;; Do not take notes interactively
+ old new)
+
+ (goto-char bos)
+ (when (and (markerp id-pos)
+ (not (member (marker-buffer id-pos) buf-list)))
+ (org-mobile-timestamp-buffer (marker-buffer id-pos))
+ (push (marker-buffer id-pos) buf-list))
+ (unless (markerp id-pos)
+ (goto-char (+ 2 (point-at-bol)))
+ (if (stringp id-pos)
+ (insert id-pos " ")
+ (insert "BAD REFERENCE "))
+ (incf cnt-error)
+ (throw 'next t))
+ (unless cmd
+ (insert "BAD FLAG ")
+ (incf cnt-error)
+ (throw 'next t))
+ (move-marker bos-marker (point))
+ (if (re-search-forward "^** Old value[ \t]*$" eos t)
+ (setq old (buffer-substring
+ (1+ (match-end 0))
+ (progn (outline-next-heading) (point)))))
+ (if (re-search-forward "^** New value[ \t]*$" eos t)
+ (setq new (buffer-substring
+ (1+ (match-end 0))
+ (progn (outline-next-heading)
+ (if (eobp) (org-back-over-empty-lines))
+ (point)))))
+ (setq old (and old (if (string-match "\\S-" old) old nil)))
+ (setq new (and new (if (string-match "\\S-" new) new nil)))
+ (if (and note (> (length note) 0))
+ ;; Make Note into a single line, to fit into a property
+ (setq note (mapconcat 'identity
+ (org-split-string (org-trim note) "\n")
+ "\\n")))
+ (unless (equal data "body")
+ (setq new (and new (org-trim new))
+ old (and old (org-trim old))))
+ (goto-char (+ 2 bos-marker))
+ ;; Remember this place so that we can return
+ (move-marker marker (point))
+ (setq org-mobile-error nil)
+ (save-excursion
+ (condition-case msg
+ (org-with-point-at id-pos
+ (progn
+ (eval cmd)
+ (unless (member data (list "delete" "archive" "archive-sibling" "addheading"))
+ (if (member "FLAGGED" (org-get-tags))
+ (add-to-list 'org-mobile-last-flagged-files
+ (buffer-file-name (current-buffer)))))))
+ (error (setq org-mobile-error msg))))
+ (when org-mobile-error
+ (org-pop-to-buffer-same-window (marker-buffer marker))
+ (goto-char marker)
+ (incf cnt-error)
+ (insert (if (stringp (nth 1 org-mobile-error))
+ (nth 1 org-mobile-error)
+ "EXECUTION FAILED")
+ " ")
+ (throw 'next t))
+ ;; If we get here, the action has been applied successfully
+ ;; So remove the entry
+ (goto-char bos-marker)
+ (delete-region (point) (org-end-of-subtree t t)))))
(save-buffer)
(move-marker marker nil)
(move-marker end nil)
@@ -988,7 +972,19 @@ is currently a noop.")
(if (string-match "\\`id:\\(.*\\)$" link)
(org-id-find (match-string 1 link) 'marker)
(if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link))
- nil
+ ; not found with path, but maybe it is to be inserted
+ ; in top level of the file?
+ (if (not (string-match "\\`olp:\\(.*?\\)$" link))
+ nil
+ (let ((file (match-string 1 link)))
+ (setq file (org-link-unescape file))
+ (setq file (expand-file-name file org-directory))
+ (save-excursion
+ (find-file file)
+ (goto-char (point-max))
+ (newline)
+ (goto-char (point-max))
+ (move-marker (make-marker) (point)))))
(let ((file (match-string 1 link))
(path (match-string 2 link)))
(setq file (org-link-unescape file))
@@ -1004,7 +1000,7 @@ The edit only takes place if the current value is equal (except for
white space) the OLD. If this is so, OLD will be replace by NEW
and the command will return t. If something goes wrong, a string will
be returned that indicates what went wrong."
- (let (current old1 new1)
+ (let (current old1 new1 level)
(if (stringp what) (setq what (intern what)))
(cond
@@ -1062,6 +1058,36 @@ be returned that indicates what went wrong."
(org-set-tags nil 'align))
(t (error "Heading changed in MobileOrg and on the computer")))))
+ ((eq what 'addheading)
+ (if (org-on-heading-p) ; if false we are in top-level of file
+ (progn
+ (end-of-line 1)
+ (org-insert-heading-respect-content)
+ (org-demote))
+ (beginning-of-line)
+ (insert "* "))
+ (insert new))
+
+ ((eq what 'refile)
+ (org-copy-subtree)
+ (org-with-point-at (org-mobile-locate-entry new)
+ (if (org-on-heading-p) ; if false we are in top-level of file
+ (progn
+ (setq level (org-get-valid-level (funcall outline-level) 1))
+ (org-end-of-subtree t t)
+ (org-paste-subtree level))
+ (org-paste-subtree 1)))
+ (org-cut-subtree))
+
+ ((eq what 'delete)
+ (org-cut-subtree))
+
+ ((eq what 'archive)
+ (org-archive-subtree))
+
+ ((eq what 'archive-sibling)
+ (org-archive-to-archive-sibling))
+
((eq what 'body)
(setq current (buffer-substring (min (1+ (point-at-eol)) (point-max))
(save-excursion (outline-next-heading)
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index b467064b888..b5a6dad733a 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -260,7 +260,7 @@ after the current heading."
(interactive)
(case (org-mouse-line-position)
(:beginning (beginning-of-line)
- (org-insert-heading))
+ (org-insert-heading))
(t (org-mouse-next-heading)
(org-insert-heading))))
@@ -269,10 +269,8 @@ after the current heading."
For the acceptable UNITS, see `org-timestamp-change'."
(interactive)
- (flet ((org-read-date (&rest rest) (current-time)))
- (org-time-stamp nil))
- (when shift
- (org-timestamp-change shift units)))
+ (org-time-stamp nil)
+ (when shift (org-timestamp-change shift units)))
(defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
"A helper function.
@@ -295,19 +293,19 @@ string to (format ITEMFORMAT keyword). If it is neither a string
nor a function, elements of KEYWORDS are used directly."
(mapcar
`(lambda (keyword)
- (vector (cond
- ((functionp ,itemformat) (funcall ,itemformat keyword))
- ((stringp ,itemformat) (format ,itemformat keyword))
- (t keyword))
- (list 'funcall ,function keyword)
- :style (cond
- ((null ,selected) t)
- ((functionp ,selected) 'toggle)
- (t 'radio))
- :selected (if (functionp ,selected)
- (and (funcall ,selected keyword) t)
- (equal ,selected keyword))))
- keywords))
+ (vector (cond
+ ((functionp ,itemformat) (funcall ,itemformat keyword))
+ ((stringp ,itemformat) (format ,itemformat keyword))
+ (t keyword))
+ (list 'funcall ,function keyword)
+ :style (cond
+ ((null ,selected) t)
+ ((functionp ,selected) 'toggle)
+ (t 'radio))
+ :selected (if (functionp ,selected)
+ (and (funcall ,selected keyword) t)
+ (equal ,selected keyword))))
+ keywords))
(defun org-mouse-remove-match-and-spaces ()
"Remove the match, make just one space around the point."
@@ -375,8 +373,7 @@ nor a function, elements of KEYWORDS are used directly."
(defun org-mouse-set-priority (priority)
"Set the priority of the current headline to PRIORITY."
- (flet ((read-char-exclusive () priority))
- (org-priority)))
+ (org-priority priority))
(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
"Regular expression matching the priority indicator.
@@ -410,8 +407,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(> (match-end 0) point))))))
(defun org-mouse-priority-list ()
- (loop for priority from ?A to org-lowest-priority
- collect (char-to-string priority)))
+ (loop for priority from ?A to org-lowest-priority
+ collect (char-to-string priority)))
(defun org-mouse-todo-menu (state)
"Create the menu with TODO keywords."
@@ -464,12 +461,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(defun org-mouse-agenda-type (type)
(case type
- ('tags "Tags: ")
- ('todo "TODO: ")
- ('tags-tree "Tags tree: ")
- ('todo-tree "TODO tree: ")
- ('occur-tree "Occur tree: ")
- (t "Agenda command ???")))
+ ('tags "Tags: ")
+ ('todo "TODO: ")
+ ('tags-tree "Tags tree: ")
+ ('todo-tree "TODO tree: ")
+ ('occur-tree "Occur tree: ")
+ (t "Agenda command ???")))
(defun org-mouse-list-options-menu (alloptions &optional function)
(let ((options (save-match-data
@@ -488,8 +485,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
" ")
nil nil nil 1)
(when (functionp ',function) (funcall ',function)))
- :style 'toggle
- :selected (and (member name options) t)))))
+ :style 'toggle
+ :selected (and (member name options) t)))))
(defun org-mouse-clip-text (text maxlength)
(if (> (length text) maxlength)
@@ -532,19 +529,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
,@(org-mouse-keyword-menu
(mapcar 'car org-agenda-custom-commands)
#'(lambda (key)
- (eval `(flet ((read-char-exclusive () (string-to-char ,key)))
- (org-agenda nil))))
+ (eval `(org-agenda nil (string-to-char ,key))))
nil
#'(lambda (key)
- (let ((entry (assoc key org-agenda-custom-commands)))
- (org-mouse-clip-text
- (cond
- ((stringp (nth 1 entry)) (nth 1 entry))
- ((stringp (nth 2 entry))
- (concat (org-mouse-agenda-type (nth 1 entry))
- (nth 2 entry)))
- (t "Agenda Command '%s'"))
- 30))))
+ (let ((entry (assoc key org-agenda-custom-commands)))
+ (org-mouse-clip-text
+ (cond
+ ((stringp (nth 1 entry)) (nth 1 entry))
+ ((stringp (nth 2 entry))
+ (concat (org-mouse-agenda-type (nth 1 entry))
+ (nth 2 entry)))
+ (t "Agenda Command '%s'"))
+ 30))))
"--"
["Delete Blank Lines" delete-blank-lines
:visible (org-mouse-empty-line)]
@@ -597,21 +593,21 @@ This means, between the beginning of line and the point."
(beginning-of-line))
(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(org-mouse-insert-item text)
ad-do-it))
(defadvice dnd-open-file (around org-mouse-dnd-open-file activate)
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(org-mouse-insert-item uri)
ad-do-it))
(defun org-mouse-match-closure (function)
(let ((match (match-data t)))
`(lambda (&rest rest)
- (save-match-data
- (set-match-data ',match)
- (apply ',function rest)))))
+ (save-match-data
+ (set-match-data ',match)
+ (apply ',function rest)))))
(defun org-mouse-yank-link (click)
(interactive "e")
@@ -623,234 +619,234 @@ This means, between the beginning of line and the point."
(insert-for-yank (concat " [[" (current-kill 0) "]] ")))
(defun org-mouse-context-menu (&optional event)
- (let ((stamp-prefixes (list org-deadline-string org-scheduled-string))
- (contextlist (org-context)))
- (flet ((get-context (context) (org-mouse-get-context contextlist context)))
- (cond
- ((org-mouse-mark-active)
- (let ((region-string (buffer-substring (region-beginning) (region-end))))
+ (let* ((stamp-prefixes (list org-deadline-string org-scheduled-string))
+ (contextlist (org-context))
+ (get-context (lambda (context) (org-mouse-get-context contextlist context))))
+ (cond
+ ((org-mouse-mark-active)
+ (let ((region-string (buffer-substring (region-beginning) (region-end))))
+ (popup-menu
+ `(nil
+ ["Sparse Tree" (org-occur ',region-string)]
+ ["Find in Buffer" (occur ',region-string)]
+ ["Grep in Current Dir"
+ (grep (format "grep -rnH -e '%s' *" ',region-string))]
+ ["Grep in Parent Dir"
+ (grep (format "grep -rnH -e '%s' ../*" ',region-string))]
+ "--"
+ ["Convert to Link"
+ (progn (save-excursion (goto-char (region-beginning)) (insert "[["))
+ (save-excursion (goto-char (region-end)) (insert "]]")))]
+ ["Insert Link Here" (org-mouse-yank-link ',event)]))))
+ ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
(popup-menu
`(nil
- ["Sparse Tree" (org-occur ',region-string)]
- ["Find in Buffer" (occur ',region-string)]
- ["Grep in Current Dir"
- (grep (format "grep -rnH -e '%s' *" ',region-string))]
- ["Grep in Parent Dir"
- (grep (format "grep -rnH -e '%s' ../*" ',region-string))]
- "--"
- ["Convert to Link"
- (progn (save-excursion (goto-char (region-beginning)) (insert "[["))
- (save-excursion (goto-char (region-end)) (insert "]]")))]
- ["Insert Link Here" (org-mouse-yank-link ',event)]))))
- ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
- (popup-menu
- `(nil
- ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
- 'org-mode-restart))))
- ((or (eolp)
- (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
- (org-looking-back " \\|\t")))
- (org-mouse-popup-global-menu))
- ((get-context :checkbox)
- (popup-menu
- '(nil
- ["Toggle" org-toggle-checkbox t]
- ["Remove" org-mouse-remove-match-and-spaces t]
- ""
- ["All Clear" (org-mouse-for-each-item
- (lambda ()
- (when (save-excursion (org-at-item-checkbox-p))
- (replace-match "[ ]"))))]
- ["All Set" (org-mouse-for-each-item
+ ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
+ 'org-mode-restart))))
+ ((or (eolp)
+ (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
+ (org-looking-back " \\|\t")))
+ (org-mouse-popup-global-menu))
+ ((funcall get-context :checkbox)
+ (popup-menu
+ '(nil
+ ["Toggle" org-toggle-checkbox t]
+ ["Remove" org-mouse-remove-match-and-spaces t]
+ ""
+ ["All Clear" (org-mouse-for-each-item
+ (lambda ()
+ (when (save-excursion (org-at-item-checkbox-p))
+ (replace-match "[ ]"))))]
+ ["All Set" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
(replace-match "[X]"))))]
- ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
- ["All Remove" (org-mouse-for-each-item
- (lambda ()
- (when (save-excursion (org-at-item-checkbox-p))
- (org-mouse-remove-match-and-spaces))))]
- )))
- ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
- (member (match-string 0) org-todo-keywords-1))
- (popup-menu
- `(nil
- ,@(org-mouse-todo-menu (match-string 0))
- "--"
- ["Check TODOs" org-show-todo-tree t]
- ["List all TODO keywords" org-todo-list t]
- [,(format "List only %s" (match-string 0))
- (org-todo-list (match-string 0)) t]
- )))
- ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
- (member (match-string 0) stamp-prefixes))
- (popup-menu
- `(nil
- ,@(org-mouse-keyword-replace-menu stamp-prefixes)
- "--"
- ["Check Deadlines" org-check-deadlines t]
- )))
- ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
- (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
- (org-mouse-priority-list) 1 "Priority %s" t))))
- ((get-context :link)
- (popup-menu
- '(nil
- ["Open" org-open-at-point t]
- ["Open in Emacs" (org-open-at-point t) t]
- "--"
- ["Copy link" (org-kill-new (match-string 0))]
- ["Cut link"
- (progn
- (kill-region (match-beginning 0) (match-end 0))
- (just-one-space))]
- "--"
- ["Grep for TODOs"
- (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
-; ["Paste file link" ((insert "file:") (yank))]
- )))
- ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
- (popup-menu
- `(nil
- [,(format "Display '%s'" (match-string 1))
- (org-tags-view nil ,(match-string 1))]
- [,(format "Sparse Tree '%s'" (match-string 1))
- (org-tags-sparse-tree nil ,(match-string 1))]
- "--"
- ,@(org-mouse-tag-menu))))
- ((org-at-timestamp-p)
- (popup-menu
- '(nil
- ["Show Day" org-open-at-point t]
- ["Change Timestamp" org-time-stamp t]
- ["Delete Timestamp" (org-mouse-delete-timestamp) t]
- ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
- "--"
- ["Set for Today" org-mouse-timestamp-today]
- ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
- ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
- ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
- ["Set in a Month" (org-mouse-timestamp-today 1 'month)]
- "--"
- ["+ 1 Day" (org-timestamp-change 1 'day)]
- ["+ 1 Week" (org-timestamp-change 7 'day)]
- ["+ 1 Month" (org-timestamp-change 1 'month)]
- "--"
- ["- 1 Day" (org-timestamp-change -1 'day)]
- ["- 1 Week" (org-timestamp-change -7 'day)]
- ["- 1 Month" (org-timestamp-change -1 'month)])))
- ((get-context :table-special)
- (let ((mdata (match-data)))
- (incf (car mdata) 2)
- (store-match-data mdata))
- (message "match: %S" (match-string 0))
- (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
- '(" " "!" "^" "_" "$" "#" "*" "'") 0
- (lambda (mark)
- (case (string-to-char mark)
- (? "( ) Nothing Special")
- (?! "(!) Column Names")
- (?^ "(^) Field Names Above")
- (?_ "(^) Field Names Below")
- (?$ "($) Formula Parameters")
- (?# "(#) Recalculation: Auto")
- (?* "(*) Recalculation: Manual")
- (?' "(') Recalculation: None"))) t))))
- ((assq :table contextlist)
- (popup-menu
- '(nil
- ["Align Table" org-ctrl-c-ctrl-c]
- ["Blank Field" org-table-blank-field]
- ["Edit Field" org-table-edit-field]
- "--"
- ("Column"
- ["Move Column Left" org-metaleft]
- ["Move Column Right" org-metaright]
- ["Delete Column" org-shiftmetaleft]
- ["Insert Column" org-shiftmetaright]
+ ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
+ ["All Remove" (org-mouse-for-each-item
+ (lambda ()
+ (when (save-excursion (org-at-item-checkbox-p))
+ (org-mouse-remove-match-and-spaces))))]
+ )))
+ ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
+ (member (match-string 0) org-todo-keywords-1))
+ (popup-menu
+ `(nil
+ ,@(org-mouse-todo-menu (match-string 0))
"--"
- ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
- ("Row"
- ["Move Row Up" org-metaup]
- ["Move Row Down" org-metadown]
- ["Delete Row" org-shiftmetaup]
- ["Insert Row" org-shiftmetadown]
- ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
+ ["Check TODOs" org-show-todo-tree t]
+ ["List all TODO keywords" org-todo-list t]
+ [,(format "List only %s" (match-string 0))
+ (org-todo-list (match-string 0)) t]
+ )))
+ ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
+ (member (match-string 0) stamp-prefixes))
+ (popup-menu
+ `(nil
+ ,@(org-mouse-keyword-replace-menu stamp-prefixes)
"--"
- ["Insert Hline" org-table-insert-hline])
- ("Rectangle"
- ["Copy Rectangle" org-copy-special]
- ["Cut Rectangle" org-cut-special]
- ["Paste Rectangle" org-paste-special]
- ["Fill Rectangle" org-table-wrap-region])
- "--"
- ["Set Column Formula" org-table-eval-formula]
- ["Set Field Formula" (org-table-eval-formula '(4))]
- ["Edit Formulas" org-table-edit-formulas]
- "--"
- ["Recalculate Line" org-table-recalculate]
- ["Recalculate All" (org-table-recalculate '(4))]
- ["Iterate All" (org-table-recalculate '(16))]
- "--"
- ["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
- ["Sum Column/Rectangle" org-table-sum
- :active (or (org-at-table-p) (org-region-active-p))]
- ["Field Info" org-table-field-info]
- ["Debug Formulas"
- (setq org-table-formula-debug (not org-table-formula-debug))
- :style toggle :selected org-table-formula-debug]
- )))
- ((and (assq :headline contextlist) (not (eolp)))
- (let ((priority (org-mouse-get-priority t)))
+ ["Check Deadlines" org-check-deadlines t]
+ )))
+ ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
+ (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
+ (org-mouse-priority-list) 1 "Priority %s" t))))
+ ((funcall get-context :link)
(popup-menu
- `("Headline Menu"
- ("Tags and Priorities"
- ,@(org-mouse-keyword-menu
- (org-mouse-priority-list)
- #'(lambda (keyword)
- (org-mouse-set-priority (string-to-char keyword)))
- priority "Priority %s")
- "--"
- ,@(org-mouse-tag-menu))
- ("TODO Status"
- ,@(org-mouse-todo-menu (org-get-todo-state)))
- ["Show Tags"
- (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
- :visible (not org-mouse-direct)]
- ["Show Priority"
- (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
- :visible (not org-mouse-direct)]
- ,@(if org-mouse-direct '("--") nil)
- ["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
- ["Set Deadline"
- (progn (org-mouse-end-headline) (insert " ") (org-deadline))
- :active (not (save-excursion
- (org-mouse-re-search-line org-deadline-regexp)))]
- ["Schedule Task"
- (progn (org-mouse-end-headline) (insert " ") (org-schedule))
- :active (not (save-excursion
- (org-mouse-re-search-line org-scheduled-regexp)))]
- ["Insert Timestamp"
- (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
-; ["Timestamp (inactive)" org-time-stamp-inactive t]
+ '(nil
+ ["Open" org-open-at-point t]
+ ["Open in Emacs" (org-open-at-point t) t]
+ "--"
+ ["Copy link" (org-kill-new (match-string 0))]
+ ["Cut link"
+ (progn
+ (kill-region (match-beginning 0) (match-end 0))
+ (just-one-space))]
"--"
- ["Archive Subtree" org-archive-subtree]
- ["Cut Subtree" org-cut-special]
- ["Copy Subtree" org-copy-special]
- ["Paste Subtree" org-paste-special :visible org-mouse-direct]
- ("Sort Children"
- ["Alphabetically" (org-sort-entries nil ?a)]
- ["Numerically" (org-sort-entries nil ?n)]
- ["By Time/Date" (org-sort-entries nil ?t)]
+ ["Grep for TODOs"
+ (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
+ ; ["Paste file link" ((insert "file:") (yank))]
+ )))
+ ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
+ (popup-menu
+ `(nil
+ [,(format "Display '%s'" (match-string 1))
+ (org-tags-view nil ,(match-string 1))]
+ [,(format "Sparse Tree '%s'" (match-string 1))
+ (org-tags-sparse-tree nil ,(match-string 1))]
+ "--"
+ ,@(org-mouse-tag-menu))))
+ ((org-at-timestamp-p)
+ (popup-menu
+ '(nil
+ ["Show Day" org-open-at-point t]
+ ["Change Timestamp" org-time-stamp t]
+ ["Delete Timestamp" (org-mouse-delete-timestamp) t]
+ ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
+ "--"
+ ["Set for Today" org-mouse-timestamp-today]
+ ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
+ ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
+ ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
+ ["Set in a Month" (org-mouse-timestamp-today 1 'month)]
+ "--"
+ ["+ 1 Day" (org-timestamp-change 1 'day)]
+ ["+ 1 Week" (org-timestamp-change 7 'day)]
+ ["+ 1 Month" (org-timestamp-change 1 'month)]
+ "--"
+ ["- 1 Day" (org-timestamp-change -1 'day)]
+ ["- 1 Week" (org-timestamp-change -7 'day)]
+ ["- 1 Month" (org-timestamp-change -1 'month)])))
+ ((funcall get-context :table-special)
+ (let ((mdata (match-data)))
+ (incf (car mdata) 2)
+ (store-match-data mdata))
+ (message "match: %S" (match-string 0))
+ (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
+ '(" " "!" "^" "_" "$" "#" "*" "'") 0
+ (lambda (mark)
+ (case (string-to-char mark)
+ (? "( ) Nothing Special")
+ (?! "(!) Column Names")
+ (?^ "(^) Field Names Above")
+ (?_ "(^) Field Names Below")
+ (?$ "($) Formula Parameters")
+ (?# "(#) Recalculation: Auto")
+ (?* "(*) Recalculation: Manual")
+ (?' "(') Recalculation: None"))) t))))
+ ((assq :table contextlist)
+ (popup-menu
+ '(nil
+ ["Align Table" org-ctrl-c-ctrl-c]
+ ["Blank Field" org-table-blank-field]
+ ["Edit Field" org-table-edit-field]
+ "--"
+ ("Column"
+ ["Move Column Left" org-metaleft]
+ ["Move Column Right" org-metaright]
+ ["Delete Column" org-shiftmetaleft]
+ ["Insert Column" org-shiftmetaright]
+ "--"
+ ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
+ ("Row"
+ ["Move Row Up" org-metaup]
+ ["Move Row Down" org-metadown]
+ ["Delete Row" org-shiftmetaup]
+ ["Insert Row" org-shiftmetadown]
+ ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
"--"
- ["Reverse Alphabetically" (org-sort-entries nil ?A)]
- ["Reverse Numerically" (org-sort-entries nil ?N)]
- ["Reverse By Time/Date" (org-sort-entries nil ?T)])
+ ["Insert Hline" org-table-insert-hline])
+ ("Rectangle"
+ ["Copy Rectangle" org-copy-special]
+ ["Cut Rectangle" org-cut-special]
+ ["Paste Rectangle" org-paste-special]
+ ["Fill Rectangle" org-table-wrap-region])
"--"
- ["Move Trees" org-mouse-move-tree :active nil]
- ))))
- (t
- (org-mouse-popup-global-menu))))))
+ ["Set Column Formula" org-table-eval-formula]
+ ["Set Field Formula" (org-table-eval-formula '(4))]
+ ["Edit Formulas" org-table-edit-formulas]
+ "--"
+ ["Recalculate Line" org-table-recalculate]
+ ["Recalculate All" (org-table-recalculate '(4))]
+ ["Iterate All" (org-table-recalculate '(16))]
+ "--"
+ ["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
+ ["Sum Column/Rectangle" org-table-sum
+ :active (or (org-at-table-p) (org-region-active-p))]
+ ["Field Info" org-table-field-info]
+ ["Debug Formulas"
+ (setq org-table-formula-debug (not org-table-formula-debug))
+ :style toggle :selected org-table-formula-debug]
+ )))
+ ((and (assq :headline contextlist) (not (eolp)))
+ (let ((priority (org-mouse-get-priority t)))
+ (popup-menu
+ `("Headline Menu"
+ ("Tags and Priorities"
+ ,@(org-mouse-keyword-menu
+ (org-mouse-priority-list)
+ #'(lambda (keyword)
+ (org-mouse-set-priority (string-to-char keyword)))
+ priority "Priority %s")
+ "--"
+ ,@(org-mouse-tag-menu))
+ ("TODO Status"
+ ,@(org-mouse-todo-menu (org-get-todo-state)))
+ ["Show Tags"
+ (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
+ :visible (not org-mouse-direct)]
+ ["Show Priority"
+ (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
+ :visible (not org-mouse-direct)]
+ ,@(if org-mouse-direct '("--") nil)
+ ["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
+ ["Set Deadline"
+ (progn (org-mouse-end-headline) (insert " ") (org-deadline))
+ :active (not (save-excursion
+ (org-mouse-re-search-line org-deadline-regexp)))]
+ ["Schedule Task"
+ (progn (org-mouse-end-headline) (insert " ") (org-schedule))
+ :active (not (save-excursion
+ (org-mouse-re-search-line org-scheduled-regexp)))]
+ ["Insert Timestamp"
+ (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
+ ; ["Timestamp (inactive)" org-time-stamp-inactive t]
+ "--"
+ ["Archive Subtree" org-archive-subtree]
+ ["Cut Subtree" org-cut-special]
+ ["Copy Subtree" org-copy-special]
+ ["Paste Subtree" org-paste-special :visible org-mouse-direct]
+ ("Sort Children"
+ ["Alphabetically" (org-sort-entries nil ?a)]
+ ["Numerically" (org-sort-entries nil ?n)]
+ ["By Time/Date" (org-sort-entries nil ?t)]
+ "--"
+ ["Reverse Alphabetically" (org-sort-entries nil ?A)]
+ ["Reverse Numerically" (org-sort-entries nil ?N)]
+ ["Reverse By Time/Date" (org-sort-entries nil ?T)])
+ "--"
+ ["Move Trees" org-mouse-move-tree :active nil]
+ ))))
+ (t
+ (org-mouse-popup-global-menu)))))
(defun org-mouse-mark-active ()
(and mark-active transient-mark-mode))
@@ -868,55 +864,55 @@ This means, between the beginning of line and the point."
(mouse-drag-region event)))
(add-hook 'org-mode-hook
- #'(lambda ()
- (setq org-mouse-context-menu-function 'org-mouse-context-menu)
-
- (when (memq 'context-menu org-mouse-features)
- (org-defkey org-mouse-map [mouse-3] nil)
- (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu))
- (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
- (when (memq 'context-menu org-mouse-features)
- (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
- (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start))
- (when (memq 'yank-link org-mouse-features)
- (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link)
- (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link))
- (when (memq 'move-tree org-mouse-features)
- (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
- (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start))
-
- (when (memq 'activate-stars org-mouse-features)
- (font-lock-add-keywords
- nil
- `((,org-outline-regexp
- 0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
- 'prepend))
- t))
-
- (when (memq 'activate-bullets org-mouse-features)
- (font-lock-add-keywords
- nil
- `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
- (1 `(face org-link keymap ,org-mouse-map mouse-face highlight)
- 'prepend)))
- t))
-
- (when (memq 'activate-checkboxes org-mouse-features)
- (font-lock-add-keywords
- nil
- `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
- (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
- t))
-
- (defadvice org-open-at-point (around org-mouse-open-at-point activate)
- (let ((context (org-context)))
- (cond
- ((assq :headline-stars context) (org-cycle))
- ((assq :checkbox context) (org-toggle-checkbox))
- ((assq :item-bullet context)
- (let ((org-cycle-include-plain-lists t)) (org-cycle)))
- ((org-footnote-at-reference-p) nil)
- (t ad-do-it))))))
+ #'(lambda ()
+ (setq org-mouse-context-menu-function 'org-mouse-context-menu)
+
+ (when (memq 'context-menu org-mouse-features)
+ (org-defkey org-mouse-map [mouse-3] nil)
+ (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu))
+ (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
+ (when (memq 'context-menu org-mouse-features)
+ (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
+ (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start))
+ (when (memq 'yank-link org-mouse-features)
+ (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link)
+ (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link))
+ (when (memq 'move-tree org-mouse-features)
+ (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
+ (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start))
+
+ (when (memq 'activate-stars org-mouse-features)
+ (font-lock-add-keywords
+ nil
+ `((,org-outline-regexp
+ 0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
+ 'prepend))
+ t))
+
+ (when (memq 'activate-bullets org-mouse-features)
+ (font-lock-add-keywords
+ nil
+ `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
+ (1 `(face org-link keymap ,org-mouse-map mouse-face highlight)
+ 'prepend)))
+ t))
+
+ (when (memq 'activate-checkboxes org-mouse-features)
+ (font-lock-add-keywords
+ nil
+ `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
+ (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
+ t))
+
+ (defadvice org-open-at-point (around org-mouse-open-at-point activate)
+ (let ((context (org-context)))
+ (cond
+ ((assq :headline-stars context) (org-cycle))
+ ((assq :checkbox context) (org-toggle-checkbox))
+ ((assq :item-bullet context)
+ (let ((org-cycle-include-plain-lists t)) (org-cycle)))
+ ((org-footnote-at-reference-p) nil)
+ (t ad-do-it))))))
(defun org-mouse-move-tree-start (event)
(interactive "e")
@@ -936,42 +932,42 @@ This means, between the beginning of line and the point."
(sbuf (marker-buffer start))
(ebuf (marker-buffer end)))
- (when (and sbuf ebuf)
- (set-buffer sbuf)
- (goto-char start)
- (org-back-to-heading)
- (if (and (eq sbuf ebuf)
- (equal
- (point)
- (save-excursion (goto-char end) (org-back-to-heading) (point))))
- ;; if the same line then promote/demote
- (if (>= end start) (org-demote-subtree) (org-promote-subtree))
- ;; if different lines then move
- (org-cut-subtree)
-
- (set-buffer ebuf)
- (goto-char end)
- (org-back-to-heading)
- (when (and (eq sbuf ebuf)
- (equal
- (point)
- (save-excursion (goto-char start)
- (org-back-to-heading) (point))))
- (outline-end-of-subtree)
- (end-of-line)
- (if (eobp) (newline) (forward-char)))
-
- (when (looking-at org-outline-regexp)
- (let ((level (- (match-end 0) (match-beginning 0))))
- (when (> end (match-end 0))
+ (when (and sbuf ebuf)
+ (set-buffer sbuf)
+ (goto-char start)
+ (org-back-to-heading)
+ (if (and (eq sbuf ebuf)
+ (equal
+ (point)
+ (save-excursion (goto-char end) (org-back-to-heading) (point))))
+ ;; if the same line then promote/demote
+ (if (>= end start) (org-demote-subtree) (org-promote-subtree))
+ ;; if different lines then move
+ (org-cut-subtree)
+
+ (set-buffer ebuf)
+ (goto-char end)
+ (org-back-to-heading)
+ (when (and (eq sbuf ebuf)
+ (equal
+ (point)
+ (save-excursion (goto-char start)
+ (org-back-to-heading) (point))))
(outline-end-of-subtree)
(end-of-line)
- (if (eobp) (newline) (forward-char))
- (setq level (1+ level)))
- (org-paste-subtree level)
- (save-excursion
- (outline-end-of-subtree)
- (when (bolp) (delete-char -1))))))))))
+ (if (eobp) (newline) (forward-char)))
+
+ (when (looking-at org-outline-regexp)
+ (let ((level (- (match-end 0) (match-beginning 0))))
+ (when (> end (match-end 0))
+ (outline-end-of-subtree)
+ (end-of-line)
+ (if (eobp) (newline) (forward-char))
+ (setq level (1+ level)))
+ (org-paste-subtree level)
+ (save-excursion
+ (outline-end-of-subtree)
+ (when (bolp) (delete-char -1))))))))))
(defun org-mouse-transform-to-outline ()
@@ -994,7 +990,7 @@ This means, between the beginning of line and the point."
(defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'.
(defun org-mouse-do-remotely (command)
-; (org-agenda-check-no-diary)
+ ; (org-agenda-check-no-diary)
(when (get-text-property (point) 'org-marker)
(let* ((anticol (- (point-at-eol) (point)))
(marker (get-text-property (point) 'org-marker))
@@ -1091,20 +1087,20 @@ This means, between the beginning of line and the point."
(if (< (car startxy) (car endxy)) :right :left)))
-; (setq org-agenda-mode-hook nil)
+ ; (setq org-agenda-mode-hook nil)
(defvar org-agenda-mode-map)
(add-hook 'org-agenda-mode-hook
- #'(lambda ()
- (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
- (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
- (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
- (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
- (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
- (org-defkey org-agenda-mode-map [drag-mouse-3]
- #'(lambda (event) (interactive "e")
- (case (org-mouse-get-gesture event)
- (:left (org-agenda-earlier 1))
- (:right (org-agenda-later 1)))))))
+ #'(lambda ()
+ (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
+ (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
+ (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
+ (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
+ (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
+ (org-defkey org-agenda-mode-map [drag-mouse-3]
+ #'(lambda (event) (interactive "e")
+ (case (org-mouse-get-gesture event)
+ (:left (org-agenda-earlier 1))
+ (:right (org-agenda-later 1)))))))
(provide 'org-mouse)
diff --git a/lisp/org/org-odt.el b/lisp/org/org-odt.el
index ca43d05bdbd..7de4b5de853 100644
--- a/lisp/org/org-odt.el
+++ b/lisp/org/org-odt.el
@@ -100,9 +100,7 @@ Use this to infer values of `org-odt-styles-dir' and
(expand-file-name "./schema/" org-odt-data-dir)) ; bail out
(eval-when-compile
(and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
- (expand-file-name "./schema/" org-odt-data-dir)))
- (expand-file-name "../contrib/odt/etc/schema/" org-odt-lib-dir) ; git
- )
+ (expand-file-name "./schema/" org-odt-data-dir))))
"List of directories to search for OpenDocument schema files.
Use this list to set the default value of
`org-export-odt-schema-dir'. The entries in this list are
@@ -213,7 +211,7 @@ heuristically based on the values of `org-odt-lib-dir' and
org-odt-styles-dir-list)
nil)))
(unless styles-dir
- (error "Error (org-odt): Cannot find factory styles files. Aborting."))
+ (error "Error (org-odt): Cannot find factory styles files, aborting"))
styles-dir)
"Directory that holds auxiliary XML files used by the ODT exporter.
@@ -245,9 +243,6 @@ standard Emacs.")
(mapc
(lambda (desc)
- ;; Let Org open all OpenDocument files using system-registered app
- (add-to-list 'org-file-apps
- (cons (concat "\\." (car desc) "\\'") 'system))
;; Let Emacs open all OpenDocument files in archive mode
(add-to-list 'auto-mode-alist
(cons (concat "\\." (car desc) "\\'") 'archive-mode)))
@@ -285,7 +280,7 @@ Valid values are one of:
4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2
...))
-In case of option 1, an in-built styles.xml is used. See
+In case of option 1, an in-built styles.xml is used. See
`org-odt-styles-dir' for more information.
In case of option 3, the specified file is unzipped and the
@@ -326,6 +321,8 @@ a per-file basis. For example,
(defconst org-export-odt-tmpdir-prefix "%s-")
(defconst org-export-odt-bookmark-prefix "OrgXref.")
+(defvar org-odt-zip-dir nil
+ "Temporary directory that holds XML files during export.")
(defvar org-export-odt-embed-images t
"Should the images be copied in to the odt file or just linked?")
@@ -382,7 +379,8 @@ This variable is effective only if
(table . "Table")
(definition-term . "Text_20_body_20_bold")
(horizontal-line . "Horizontal_20_Line")))
- (character . ((bold . "Bold")
+ (character . ((default . "Default")
+ (bold . "Bold")
(emphasis . "Emphasis")
(code . "OrgCode")
(verbatim . "OrgCode")
@@ -413,7 +411,10 @@ Interactive commands `org-export-as-odt' and
then use `org-export-odt-convert-process' to convert the
resulting document to this format. During customization of this
variable, the list of valid values are populated based on
-`org-export-odt-convert-capabilities'."
+`org-export-odt-convert-capabilities'.
+
+You can set this option on per-file basis using file local
+values. See Info node `(emacs) File Variables'."
:group 'org-export-odt
:version "24.1"
:type '(choice :convert-widget
@@ -424,6 +425,35 @@ variable, the list of valid values are populated based on
,@(mapcar (lambda (c)
`(const :tag ,c ,c))
(org-lparse-reachable-formats "odt")))))
+;;;###autoload
+(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp)
+
+(defmacro org-odt-cleanup-xml-buffers (&rest body)
+ `(let ((org-odt-zip-dir
+ (make-temp-file
+ (format org-export-odt-tmpdir-prefix "odf") t))
+ (--cleanup-xml-buffers
+ (function
+ (lambda nil
+ (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
+ "meta.xml" "styles.xml")))
+ ;; kill all xml buffers
+ (mapc (lambda (file)
+ (let ((buf (find-file-noselect
+ (expand-file-name file org-odt-zip-dir) t)))
+ (when (buffer-name buf)
+ (set-buffer-modified-p nil)
+ (kill-buffer buf))))
+ xml-files))
+ ;; delete temporary directory.
+ (delete-directory org-odt-zip-dir t)))))
+ (org-condition-case-unless-debug err
+ (prog1 (progn ,@body)
+ (funcall --cleanup-xml-buffers))
+ ((quit error)
+ (funcall --cleanup-xml-buffers)
+ (message "OpenDocument export failed: %s"
+ (error-message-string err))))))
;;;###autoload
(defun org-export-as-odt-and-open (arg)
@@ -432,8 +462,9 @@ If there is an active region, export only the region.
The prefix ARG specifies how many levels of the outline should become
headlines. The default is 3. Lower levels will become bulleted lists."
(interactive "P")
- (org-lparse-and-open
- (or org-export-odt-preferred-output-format "odt") "odt" arg))
+ (org-odt-cleanup-xml-buffers
+ (org-lparse-and-open
+ (or org-export-odt-preferred-output-format "odt") "odt" arg)))
;;;###autoload
(defun org-export-as-odt-batch ()
@@ -464,8 +495,9 @@ the file header and footer, simply return the content of
<body>...</body>, without even the body tags themselves. When
PUB-DIR is set, use this as the publishing directory."
(interactive "P")
- (org-lparse (or org-export-odt-preferred-output-format "odt")
- "odt" arg hidden ext-plist to-buffer body-only pub-dir))
+ (org-odt-cleanup-xml-buffers
+ (org-lparse (or org-export-odt-preferred-output-format "odt")
+ "odt" arg hidden ext-plist to-buffer body-only pub-dir)))
(defvar org-odt-entity-control-callbacks-alist
`((EXPORT
@@ -539,7 +571,7 @@ PUB-DIR is set, use this as the publishing directory."
(delete-region (match-beginning 0) (point-max)))
;; Following variable is let bound when `org-do-lparse' is in
-;; progress. See org-html.el.
+;; progress. See org-html.el.
(defvar org-lparse-toc)
(defun org-odt-format-toc ()
(if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n")))
@@ -810,7 +842,7 @@ PUB-DIR is set, use this as the publishing directory."
(org-lparse-begin-list-item list-type)))
;; Following variables are let bound when table emission is in
-;; progress. See org-lparse.el.
+;; progress. See org-lparse.el.
(defvar org-lparse-table-begin-marker)
(defvar org-lparse-table-ncols)
(defvar org-lparse-table-rowgrp-open)
@@ -944,7 +976,7 @@ Use `org-odt-add-automatic-style' to add update this variable.'")
(defvar org-odt-object-counters nil
"Running counters for various OBJECT-TYPEs.
-Use this to generate automatic names and style-names. See
+Use this to generate automatic names and style-names. See
`org-odt-add-automatic-style'.")
(defun org-odt-write-automatic-styles ()
@@ -987,7 +1019,7 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
(cons object-name style-name)))
(defvar org-odt-table-indentedp nil)
-(defun org-odt-begin-table (caption label attributes)
+(defun org-odt-begin-table (caption label attributes short-caption)
(setq org-odt-table-indentedp (not (null org-lparse-list-stack)))
(when org-odt-table-indentedp
;; Within the Org file, the table is appearing within a list item.
@@ -1006,11 +1038,12 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
(insert
(org-odt-format-stylized-paragraph
'table (org-odt-format-entity-caption label caption "__Table__"))))
- (let ((name-and-style (org-odt-add-automatic-style "Table" attributes)))
+ (let ((automatic-name (org-odt-add-automatic-style "Table" attributes)))
(org-lparse-insert-tag
"<table:table table:name=\"%s\" table:style-name=\"%s\">"
- (car name-and-style) (or (nth 1 org-odt-table-style-spec)
- (cdr name-and-style) "OrgTable")))
+ (or short-caption (car automatic-name))
+ (or (nth 1 org-odt-table-style-spec)
+ (cdr automatic-name) "OrgTable")))
(setq org-lparse-table-begin-marker (point)))
(defvar org-lparse-table-colalign-info)
@@ -1097,7 +1130,7 @@ styles congruent with the ODF-1.2 specification."
;; Additional Note: LibreOffice's AutoFormat facility for tables -
;; which recognizes as many as 16 different cell types - is much
- ;; richer. Unfortunately it is NOT amenable to easy configuration
+ ;; richer. Unfortunately it is NOT amenable to easy configuration
;; by hand.
(let* ((template-name (nth 1 style-spec))
@@ -1247,7 +1280,7 @@ styles congruent with the ODF-1.2 specification."
(+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))))
(insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n")))
-;; Following variable is let bound during 'ORG-LINK callback. See
+;; Following variable is let bound during 'ORG-LINK callback. See
;; org-html.el
(defvar org-lparse-link-description-is-image nil)
(defun org-odt-format-link (desc href &optional attr)
@@ -1443,7 +1476,7 @@ is turned on."
(" " "<text:s/>")
(" " "<text:tab/>")))
(hfy-face-to-css 'org-odt-hfy-face-to-css)
- (hfy-optimisations-1 (copy-seq hfy-optimisations))
+ (hfy-optimisations-1 (copy-sequence hfy-optimisations))
(hfy-optimisations (add-to-list 'hfy-optimisations-1
'body-text-only))
(hfy-begin-span-handler
@@ -1552,7 +1585,12 @@ See `org-odt-add-label-definition' and
(defun org-export-odt-format-formula (src href)
(save-match-data
(let* ((caption (org-find-text-property-in-string 'org-caption src))
+ (short-caption
+ (or (org-find-text-property-in-string 'org-caption-shortn src)
+ caption))
(caption (and caption (org-xml-format-desc caption)))
+ (short-caption (and short-caption
+ (org-xml-encode-plain-text short-caption)))
(label (org-find-text-property-in-string 'org-label src))
(latex-frag (org-find-text-property-in-string 'org-latex-src src))
(embed-as (or (and latex-frag
@@ -1572,7 +1610,8 @@ See `org-odt-add-label-definition' and
`((,(org-odt-format-entity
(if (not (or caption label)) "DisplayFormula"
"CaptionedDisplayFormula")
- href width height :caption caption :label label)
+ href width height :caption caption :label label
+ :short-caption short-caption)
,(if (not (or caption label)) ""
(let* ((label-props (car org-odt-entity-labels-alist)))
(setcar (last label-props) "math-label")
@@ -1732,7 +1771,7 @@ ATTR is a string of other attributes of the a element."
(concat
(org-lparse-format 'EXTRA-TARGETS extra-targets)
- ;; No need to generate section numbers. They are auto-generated by
+ ;; No need to generate section numbers. They are auto-generated by
;; the application
;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ")
@@ -1799,7 +1838,12 @@ ATTR is a string of other attributes of the a element."
"Create image tag with source and attributes."
(save-match-data
(let* ((caption (org-find-text-property-in-string 'org-caption src))
+ (short-caption
+ (or (org-find-text-property-in-string 'org-caption-shortn src)
+ caption))
(caption (and caption (org-xml-format-desc caption)))
+ (short-caption (and short-caption
+ (org-xml-encode-plain-text short-caption)))
(attr (org-find-text-property-in-string 'org-attributes src))
(label (org-find-text-property-in-string 'org-label src))
(latex-frag (org-find-text-property-in-string
@@ -1837,6 +1881,7 @@ ATTR is a string of other attributes of the a element."
(org-odt-format-entity
frame-style-handle href width height
:caption caption :label label :category category
+ :short-caption short-caption
:user-frame-params user-frame-params)))))
(defun org-odt-format-object-description (title description)
@@ -1915,7 +1960,7 @@ ATTR is a string of other attributes of the a element."
(defun* org-odt-format-entity (entity href width height
&key caption label category
- user-frame-params)
+ user-frame-params short-caption)
(let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t))
default-frame-params frame-params)
(cond
@@ -1933,7 +1978,16 @@ ATTR is a string of other attributes of the a element."
'illustration
(concat
(apply 'org-odt-format-frame href width height
- (nth 2 entity-style))
+ (let ((entity-style-1 (copy-sequence
+ (nth 2 entity-style))))
+ (setcar (cdr entity-style-1)
+ (concat
+ (cadr entity-style-1)
+ (and short-caption
+ (format " draw:name=\"%s\" "
+ short-caption))))
+
+ entity-style-1))
(org-odt-format-entity-caption
label caption (or category (nth 1 entity-style)))))
width height frame-params)))))
@@ -1973,37 +2027,43 @@ ATTR is a string of other attributes of the a element."
methods.")
;; A4 page size is 21.0 by 29.7 cms
-;; The default page settings has 2cm margin on each of the sides. So
+;; The default page settings has 2cm margin on each of the sides. So
;; the effective text area is 17.0 by 25.7 cm
(defvar org-export-odt-max-image-size '(17.0 . 20.0)
"Limiting dimensions for an embedded image.")
(defun org-odt-do-image-size (probe-method file &optional dpi anchor-type)
- (setq dpi (or dpi org-export-odt-pixels-per-inch))
- (setq anchor-type (or anchor-type "paragraph"))
- (flet ((size-in-cms (size-in-pixels)
- (flet ((pixels-to-cms (pixels)
- (let* ((cms-per-inch 2.54)
- (inches (/ pixels dpi)))
- (* cms-per-inch inches))))
- (and size-in-pixels
- (cons (pixels-to-cms (car size-in-pixels))
- (pixels-to-cms (cdr size-in-pixels)))))))
+ (let* ((dpi (or dpi org-export-odt-pixels-per-inch))
+ (anchor-type (or anchor-type "paragraph"))
+ (--pixels-to-cms
+ (function
+ (lambda (pixels dpi)
+ (let* ((cms-per-inch 2.54)
+ (inches (/ pixels dpi)))
+ (* cms-per-inch inches)))))
+ (--size-in-cms
+ (function
+ (lambda (size-in-pixels dpi)
+ (and size-in-pixels
+ (cons (funcall --pixels-to-cms (car size-in-pixels) dpi)
+ (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))))
(case probe-method
(emacs
- (size-in-cms (ignore-errors ; Emacs could be in batch mode
- (clear-image-cache)
- (image-size (create-image file) 'pixels))))
+ (let ((size-in-pixels
+ (ignore-errors ; Emacs could be in batch mode
+ (clear-image-cache)
+ (image-size (create-image file) 'pixels))))
+ (funcall --size-in-cms size-in-pixels dpi)))
(imagemagick
- (size-in-cms
- (let ((dim (shell-command-to-string
- (format "identify -format \"%%w:%%h\" \"%s\"" file))))
- (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim)
- (cons (string-to-number (match-string 1 dim))
- (string-to-number (match-string 2 dim)))))))
- (t
- (cdr (assoc-string anchor-type
- org-export-odt-default-image-sizes-alist))))))
+ (let ((size-in-pixels
+ (let ((dim (shell-command-to-string
+ (format "identify -format \"%%w:%%h\" \"%s\"" file))))
+ (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim)
+ (cons (string-to-number (match-string 1 dim))
+ (string-to-number (match-string 2 dim)))))))
+ (funcall --size-in-cms size-in-pixels dpi)))
+ (t (cdr (assoc-string anchor-type
+ org-export-odt-default-image-sizes-alist))))))
(defun org-odt-image-size-from-file (file &optional user-width
user-height scale dpi embed-as)
@@ -2016,7 +2076,7 @@ ATTR is a string of other attributes of the a element."
until size
do (setq size (org-odt-do-image-size
probe-method file dpi embed-as)))
- (or size (error "Cannot determine Image size. Aborting ..."))
+ (or size (error "Cannot determine image size, aborting"))
(setq width (car size) height (cdr size)))
(cond
(scale
@@ -2206,10 +2266,7 @@ captions on export.")
;; Not at all OSes ship with zip by default
(error "Executable \"zip\" needed for creating OpenDocument files"))
- (let* ((outdir (make-temp-file
- (format org-export-odt-tmpdir-prefix org-lparse-backend) t))
- (content-file (expand-file-name "content.xml" outdir)))
-
+ (let* ((content-file (expand-file-name "content.xml" org-odt-zip-dir)))
;; init conten.xml
(require 'nxml-mode)
(let ((nxml-auto-insert-xml-declaration-flag nil))
@@ -2259,11 +2316,9 @@ visually."
(org-odt-write-manifest-file)
(let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
- "meta.xml"))
- (zipdir default-directory))
+ "meta.xml")))
(when (equal org-lparse-backend 'odt)
(push "styles.xml" xml-files))
- (message "Switching to directory %s" (expand-file-name zipdir))
;; save all xml files
(mapc (lambda (file)
@@ -2299,15 +2354,8 @@ visually."
cmds))
;; move the file from outdir to target-dir
- (rename-file target-name target-dir)
-
- ;; kill all xml buffers
- (mapc (lambda (file)
- (kill-buffer
- (find-file-noselect (expand-file-name file zipdir) t)))
- xml-files)
+ (rename-file target-name target-dir)))
- (delete-directory zipdir)))
(message "Created %s" target)
(set-buffer (find-file-noselect target t)))
@@ -2366,7 +2414,8 @@ visually."
(org-odt-format-tags '("\n<meta:generator>" . "</meta:generator>")
(when org-export-creator-info
(format "Org-%s/Emacs-%s"
- org-version emacs-version)))
+ (org-version)
+ emacs-version)))
(org-odt-format-tags '("\n<meta:keyword>" . "</meta:keyword>") keywords)
(org-odt-format-tags '("\n<dc:subject>" . "</dc:subject>") description)
(org-odt-format-tags '("\n<dc:title>" . "</dc:title>") title)
@@ -2386,12 +2435,12 @@ visually."
;; Update styles.xml - take care of outline numbering
(with-current-buffer
(find-file-noselect (expand-file-name "styles.xml") t)
- ;; Don't make automatic backup of styles.xml file. This setting
+ ;; Don't make automatic backup of styles.xml file. This setting
;; prevents the backed-up styles.xml file from being zipped in to
- ;; odt file. This is more of a hackish fix. Better alternative
+ ;; odt file. This is more of a hackish fix. Better alternative
;; would be to fix the zip command so that the output odt file
;; includes only the needed files and excludes any auto-generated
- ;; extra files like backups and auto-saves etc etc. Note that
+ ;; extra files like backups and auto-saves etc etc. Note that
;; currently the zip command zips up the entire temp directory so
;; that any auto-generated files created under the hood ends up in
;; the resulting odt file.
@@ -2609,7 +2658,7 @@ using `org-open-file'."
cache-dir display-msg)
(cond
((eq latex-frag-opt 'dvipng)
- (setq cache-dir "ltxpng/")
+ (setq cache-dir org-latex-preview-ltxpng-directory)
(setq display-msg "Creating LaTeX image %s"))
((member latex-frag-opt '(mathjax t))
(setq latex-frag-opt 'mathml)
@@ -2657,7 +2706,7 @@ Do this when translation to MathML fails."
"" (org-add-props label '(org-protected t)))) t t)))))
;; process latex fragments as part of
-;; `org-export-preprocess-after-blockquote-hook'. Note that this hook
+;; `org-export-preprocess-after-blockquote-hook'. Note that this hook
;; is the one that is closest and well before the call to
;; `org-export-attach-captions-and-attributes' in
;; `org-export-preprocess-string'. The above arrangement permits
@@ -2692,7 +2741,7 @@ Do this when translation to MathML fails."
members))
(defun org-odt-copy-styles-file (&optional styles-file)
- ;; Non-availability of styles.xml is not a critical error. For now
+ ;; Non-availability of styles.xml is not a critical error. For now
;; throw an error purely for aesthetic reasons.
(setq styles-file (or styles-file
org-export-odt-styles-file
@@ -2749,7 +2798,7 @@ MathML source to kill ring, if `org-export-copy-to-kill-ring' is
non-nil."
(interactive
`(,(let (frag)
- (setq frag (and (setq frag (and (region-active-p)
+ (setq frag (and (setq frag (and (org-region-active-p)
(buffer-substring (region-beginning)
(region-end))))
(loop for e in org-latex-regexps
@@ -2764,27 +2813,28 @@ non-nil."
(file-name-directory buffer-file-name))))
(read-file-name "ODF filename: " nil odf-filename nil
(file-name-nondirectory odf-filename)))))
- (let* ((org-lparse-backend 'odf)
- org-lparse-opt-plist
- (filename (or odf-file
- (expand-file-name
- (concat
- (file-name-sans-extension
- (or (file-name-nondirectory buffer-file-name)))
- "." "odf")
- (file-name-directory buffer-file-name))))
- (buffer (find-file-noselect (org-odt-init-outfile filename)))
- (coding-system-for-write 'utf-8)
- (save-buffer-coding-system 'utf-8))
- (set-buffer buffer)
- (set-buffer-file-coding-system coding-system-for-write)
- (let ((mathml (org-create-math-formula latex-frag)))
- (unless mathml (error "No Math formula created"))
- (insert mathml)
- (or (org-export-push-to-kill-ring
- (upcase (symbol-name org-lparse-backend)))
- (message "Exporting... done")))
- (org-odt-save-as-outfile filename nil)))
+ (org-odt-cleanup-xml-buffers
+ (let* ((org-lparse-backend 'odf)
+ org-lparse-opt-plist
+ (filename (or odf-file
+ (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (file-name-nondirectory buffer-file-name)))
+ "." "odf")
+ (file-name-directory buffer-file-name))))
+ (buffer (find-file-noselect (org-odt-init-outfile filename)))
+ (coding-system-for-write 'utf-8)
+ (save-buffer-coding-system 'utf-8))
+ (set-buffer buffer)
+ (set-buffer-file-coding-system coding-system-for-write)
+ (let ((mathml (org-create-math-formula latex-frag)))
+ (unless mathml (error "No Math formula created"))
+ (insert mathml)
+ (or (org-export-push-to-kill-ring
+ (upcase (symbol-name org-lparse-backend)))
+ (message "Exporting... done")))
+ (org-odt-save-as-outfile filename nil))))
;;;###autoload
(defun org-export-as-odf-and-open ()
diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el
index 5950d8e26da..64678409920 100644
--- a/lisp/org/org-pcomplete.el
+++ b/lisp/org/org-pcomplete.el
@@ -31,6 +31,7 @@
(require 'cl))
(require 'org-macs)
+(require 'org-compat)
(require 'pcomplete)
(declare-function org-split-string "org" (string &optional separators))
@@ -50,14 +51,17 @@
:tag "Org"
:group 'org)
+(defvar org-drawer-regexp)
+(defvar org-property-re)
+
(defun org-thing-at-point ()
"Examine the thing at point and let the caller know what it is.
The return value is a string naming the thing at point."
(let ((beg1 (save-excursion
- (skip-chars-backward (org-re "[:alnum:]_@"))
+ (skip-chars-backward (org-re "[:alnum:]-_@"))
(point)))
(beg (save-excursion
- (skip-chars-backward "a-zA-Z0-9_:$")
+ (skip-chars-backward "a-zA-Z0-9-_:$")
(point)))
(line-to-here (buffer-substring (point-at-bol) (point))))
(cond
@@ -84,8 +88,18 @@ The return value is a string naming the thing at point."
(equal (char-after (point-at-bol)) ?*))
(cons "tag" nil))
((and (equal (char-before beg1) ?:)
- (not (equal (char-after (point-at-bol)) ?*)))
+ (not (equal (char-after (point-at-bol)) ?*))
+ (save-excursion
+ (move-beginning-of-line 1)
+ (skip-chars-backward "[ \t\n]")
+ ;; org-drawer-regexp matches a whole line but while
+ ;; looking-back, we just ignore trailing whitespaces
+ (or (org-looking-back (substring org-drawer-regexp 0 -1))
+ (org-looking-back org-property-re))))
(cons "prop" nil))
+ ((and (equal (char-before beg1) ?:)
+ (not (equal (char-after (point-at-bol)) ?*)))
+ (cons "drawer" nil))
(t nil))))
(defun org-command-at-point ()
@@ -119,7 +133,6 @@ When completing for #+STARTUP, for example, this function returns
args)))
(cons (reverse args) (reverse begins))))))
-
(defun org-pcomplete-initial ()
"Calls the right completion function for first argument completions."
(ignore
@@ -127,7 +140,8 @@ When completing for #+STARTUP, for example, this function returns
(car (org-thing-at-point)))
pcomplete-default-completion-function))))
-(defvar org-additional-option-like-keywords)
+(defvar org-options-keywords) ; From org.el
+(defvar org-additional-option-like-keywords) ; From org.el
(defun pcomplete/org-mode/file-option ()
"Complete against all valid file options."
(require 'org-exp)
@@ -137,14 +151,8 @@ When completing for #+STARTUP, for example, this function returns
(if (= ?: (aref x (1- (length x))))
(concat x " ")
x))
- (delq nil
- (pcomplete-uniqify-list
- (append
- (mapcar (lambda (x)
- (if (string-match "^#\\+\\([A-Z_]+:?\\)" x)
- (match-string 1 x)))
- (org-split-string (org-get-current-options) "\n"))
- (copy-sequence org-additional-option-like-keywords))))))
+ (append org-options-keywords
+ org-additional-option-like-keywords)))
(substring pcomplete-stub 2)))
(defvar org-startup-options)
@@ -161,8 +169,40 @@ When completing for #+STARTUP, for example, this function returns
(setq opts (delete "showstars" opts)))))
opts))))
+(defmacro pcomplete/org-mode/file-option/x (option)
+ "Complete arguments for OPTION."
+ `(while
+ (pcomplete-here
+ (pcomplete-uniqify-list
+ (delq nil
+ (mapcar (lambda(o)
+ (when (string-match (concat "^[ \t]*#\\+"
+ ,option ":[ \t]+\\(.*\\)[ \t]*$") o)
+ (match-string 1 o)))
+ (split-string (org-get-current-options) "\n")))))))
+
+(defun pcomplete/org-mode/file-option/options ()
+ "Complete arguments for the #+OPTIONS file option."
+ (pcomplete/org-mode/file-option/x "OPTIONS"))
+
+(defun pcomplete/org-mode/file-option/title ()
+ "Complete arguments for the #+TITLE file option."
+ (pcomplete/org-mode/file-option/x "TITLE"))
+
+(defun pcomplete/org-mode/file-option/author ()
+ "Complete arguments for the #+AUTHOR file option."
+ (pcomplete/org-mode/file-option/x "AUTHOR"))
+
+(defun pcomplete/org-mode/file-option/email ()
+ "Complete arguments for the #+EMAIL file option."
+ (pcomplete/org-mode/file-option/x "EMAIL"))
+
+(defun pcomplete/org-mode/file-option/date ()
+ "Complete arguments for the #+DATE file option."
+ (pcomplete/org-mode/file-option/x "DATE"))
+
(defun pcomplete/org-mode/file-option/bind ()
- "Complete arguments for the #+BIND file option, which are variable names"
+ "Complete arguments for the #+BIND file option, which are variable names."
(let (vars)
(mapatoms
(lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars)))))
@@ -196,16 +236,16 @@ When completing for #+STARTUP, for example, this function returns
"Complete against all headings.
This needs more work, to handle headings with lots of spaces in them."
(while
- (pcomplete-here
- (save-excursion
- (goto-char (point-min))
- (let (tbl)
- (while (re-search-forward org-todo-line-regexp nil t)
- (push (org-make-org-heading-search-string
- (match-string-no-properties 3) t)
- tbl))
- (pcomplete-uniqify-list tbl)))
- (substring pcomplete-stub 1))))
+ (pcomplete-here
+ (save-excursion
+ (goto-char (point-min))
+ (let (tbl)
+ (while (re-search-forward org-todo-line-regexp nil t)
+ (push (org-make-org-heading-search-string
+ (match-string-no-properties 3) t)
+ tbl))
+ (pcomplete-uniqify-list tbl)))
+ (substring pcomplete-stub 1))))
(defvar org-tag-alist)
(defun pcomplete/org-mode/tag ()
@@ -239,6 +279,25 @@ This needs more work, to handle headings with lots of spaces in them."
lst))
(substring pcomplete-stub 1)))
+(defvar org-drawers)
+
+(defun pcomplete/org-mode/drawer ()
+ "Complete a drawer name."
+ (let ((spc (save-excursion
+ (move-beginning-of-line 1)
+ (looking-at "^\\([ \t]*\\):")
+ (match-string 1)))
+ (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
+ (pcomplete-here cpllist
+ (substring pcomplete-stub 1)
+ (unless (or (not (delete
+ nil
+ (mapcar (lambda(x)
+ (string-match (substring pcomplete-stub 1) x))
+ cpllist)))
+ (looking-at "[ \t]*\n.*:END:"))
+ (save-excursion (insert "\n" spc ":END:"))))))
+
(defun pcomplete/org-mode/block-option/src ()
"Complete the arguments of a begin_src block.
Complete a language in the first field, the header arguments and switches."
@@ -256,7 +315,7 @@ Complete a language in the first field, the header arguments and switches."
":session" ":shebang" ":tangle" ":var"))))
(defun pcomplete/org-mode/block-option/clocktable ()
- "Complete keywords in a clocktable line"
+ "Complete keywords in a clocktable line."
(while (pcomplete-here '(":maxlevel" ":scope"
":tstart" ":tend" ":block" ":step"
":stepskip0" ":fileskip0"
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el
index f44694fa781..48d72ac2810 100644
--- a/lisp/org/org-plot.el
+++ b/lisp/org/org-plot.el
@@ -144,7 +144,8 @@ and dependant variables."
(dotimes (col (length (first table)))
(setf collector (cons col collector)))
collector)))
- row-vals (counter 0))
+ (counter 0)
+ row-vals)
(when (>= ind 0) ;; collect values of ind col
(setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
(cons counter (nth ind row))) table)))
@@ -159,26 +160,26 @@ and dependant variables."
;; write table to gnuplot grid datafile format
(with-temp-file data-file
(let ((num-rows (length table)) (num-cols (length (first table)))
+ (gnuplot-row (lambda (col row value)
+ (setf col (+ 1 col)) (setf row (+ 1 row))
+ (format "%f %f %f\n%f %f %f\n"
+ col (- row 0.5) value ;; lower edge
+ col (+ row 0.5) value))) ;; upper edge
front-edge back-edge)
- (flet ((gnuplot-row (col row value)
- (setf col (+ 1 col)) (setf row (+ 1 row))
- (format "%f %f %f\n%f %f %f\n"
- col (- row 0.5) value ;; lower edge
- col (+ row 0.5) value))) ;; upper edge
- (dotimes (col num-cols)
- (dotimes (row num-rows)
- (setf back-edge
- (concat back-edge
- (gnuplot-row (- col 1) row (string-to-number
- (nth col (nth row table))))))
- (setf front-edge
- (concat front-edge
- (gnuplot-row col row (string-to-number
- (nth col (nth row table)))))))
- ;; only insert once per row
- (insert back-edge) (insert "\n") ;; back edge
- (insert front-edge) (insert "\n") ;; front edge
- (setf back-edge "") (setf front-edge "")))))
+ (dotimes (col num-cols)
+ (dotimes (row num-rows)
+ (setf back-edge
+ (concat back-edge
+ (funcall gnuplot-row (- col 1) row
+ (string-to-number (nth col (nth row table))))))
+ (setf front-edge
+ (concat front-edge
+ (funcall gnuplot-row col row
+ (string-to-number (nth col (nth row table)))))))
+ ;; only insert once per row
+ (insert back-edge) (insert "\n") ;; back edge
+ (insert front-edge) (insert "\n") ;; front edge
+ (setf back-edge "") (setf front-edge ""))))
row-vals))
(defun org-plot/gnuplot-script (data-file num-cols params &optional preface)
@@ -208,40 +209,41 @@ manner suitable for prepending to a user-specified script."
('2d "plot")
('3d "splot")
('grid "splot")))
- (script "reset") plot-lines)
- (flet ((add-to-script (line) (setf script (format "%s\n%s" script line))))
- (when file ;; output file
- (add-to-script (format "set term %s" (file-name-extension file)))
- (add-to-script (format "set output '%s'" file)))
- (case type ;; type
- ('2d ())
- ('3d (if map (add-to-script "set map")))
- ('grid (if map
- (add-to-script "set pm3d map")
- (add-to-script "set pm3d"))))
- (when title (add-to-script (format "set title '%s'" title))) ;; title
- (when lines (mapc (lambda (el) (add-to-script el)) lines)) ;; line
- (when sets ;; set
- (mapc (lambda (el) (add-to-script (format "set %s" el))) sets))
- (when x-labels ;; x labels (xtics)
- (add-to-script
- (format "set xtics (%s)"
- (mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
- x-labels ", "))))
- (when y-labels ;; y labels (ytics)
- (add-to-script
- (format "set ytics (%s)"
- (mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
- y-labels ", "))))
- (when time-ind ;; timestamp index
- (add-to-script "set xdata time")
- (add-to-script (concat "set timefmt \""
- (or timefmt ;; timefmt passed to gnuplot
- "%Y-%m-%d-%H:%M:%S") "\"")))
- (unless preface
- (case type ;; plot command
+ (script "reset")
+ ; ats = add-to-script
+ (ats (lambda (line) (setf script (format "%s\n%s" script line))))
+ plot-lines)
+ (when file ;; output file
+ (funcall ats (format "set term %s" (file-name-extension file)))
+ (funcall ats (format "set output '%s'" file)))
+ (case type ;; type
+ ('2d ())
+ ('3d (if map (funcall ats "set map")))
+ ('grid (if map (funcall ats "set pm3d map")
+ (funcall ats "set pm3d"))))
+ (when title (funcall ats (format "set title '%s'" title))) ;; title
+ (when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line
+ (when sets ;; set
+ (mapc (lambda (el) (funcall ats (format "set %s" el))) sets))
+ (when x-labels ;; x labels (xtics)
+ (funcall ats
+ (format "set xtics (%s)"
+ (mapconcat (lambda (pair)
+ (format "\"%s\" %d" (cdr pair) (car pair)))
+ x-labels ", "))))
+ (when y-labels ;; y labels (ytics)
+ (funcall ats
+ (format "set ytics (%s)"
+ (mapconcat (lambda (pair)
+ (format "\"%s\" %d" (cdr pair) (car pair)))
+ y-labels ", "))))
+ (when time-ind ;; timestamp index
+ (funcall ats "set xdata time")
+ (funcall ats (concat "set timefmt \""
+ (or timefmt ;; timefmt passed to gnuplot
+ "%Y-%m-%d-%H:%M:%S") "\"")))
+ (unless preface
+ (case type ;; plot command
('2d (dotimes (col num-cols)
(unless (and (equal type '2d)
(or (and ind (equal (+ 1 col) ind))
@@ -263,9 +265,9 @@ manner suitable for prepending to a user-specified script."
('grid
(setq plot-lines (list (format "'%s' with %s title ''"
data-file with)))))
- (add-to-script
- (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n "))))
- script)))
+ (funcall ats
+ (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n "))))
+ script))
;;-----------------------------------------------------------------------------
;; facade functions
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 74fc35f2db1..31f6fb26711 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -187,7 +187,7 @@ Each element of this list must be of the form:
(module-name :property value property: value ...)
-where module-name is an arbitrary name. All the values are strings.
+where module-name is an arbitrary name. All the values are strings.
Possible properties are:
@@ -195,7 +195,7 @@ Possible properties are:
:working-suffix - the replacement for online-suffix
:base-url - the base URL, e.g. http://www.example.com/project/
Last slash required.
- :working-directory - the local working directory. This is, what base-url will
+ :working-directory - the local working directory. This is, what base-url will
be replaced with.
:redirects - A list of cons cells, each of which maps a regular
expression to match to a path relative to :working-directory.
@@ -236,21 +236,21 @@ protocol - protocol to detect in a filename without trailing colon and slashes.
If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol'
will search filenames for \"org-protocol:/my-protocol:/\"
and trigger your action for every match. `org-protocol' is defined in
- `org-protocol-the-protocol'. Double and triple slashes are compressed
+ `org-protocol-the-protocol'. Double and triple slashes are compressed
to one by emacsclient.
function - function that handles requests with protocol and takes exactly one
- argument: the filename with all protocols stripped. If the function
- returns nil, emacsclient and -server do nothing. Any non-nil return
+ argument: the filename with all protocols stripped. If the function
+ returns nil, emacsclient and -server do nothing. Any non-nil return
value is considered a valid filename and thus passed to the server.
`org-protocol.el provides some support for handling those filenames,
if you stay with the conventions used for the standard handlers in
- `org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
+ `org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
kill-client - If t, kill the client immediately, once the sub-protocol is
- detected. This is necessary for actions that can be interrupted by
- `C-g' to avoid dangling emacsclients. Note, that all other command
+ detected. This is necessary for actions that can be interrupted by
+ `C-g' to avoid dangling emacsclients. Note, that all other command
line arguments but the this one will be discarded, greedy handlers
still receive the whole list of arguments though.
@@ -273,6 +273,12 @@ string with two characters."
:group 'org-protocol
:type 'string)
+(defcustom org-protocol-data-separator "/+"
+ "The default data separator to use.
+ This should be a single regexp string."
+ :group 'org-protocol
+ :type 'string)
+
;;; Helper functions:
(defun org-protocol-sanitize-uri (uri)
@@ -316,32 +322,32 @@ Everything up to the end of the protocols is stripped.
Note, that this function will always behave as if
`org-protocol-reverse-list-of-files' was set to t and the returned list will
-reflect that. I.e. emacsclients first parameter will be the first one in the
+reflect that. I.e. emacsclients first parameter will be the first one in the
returned list."
-(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
- param-list
- (reverse param-list))))
- (trigger (car l))
- (len 0)
- dir
- ret)
- (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger)
- (setq dir (match-string 1 trigger))
- (setq len (length dir))
- (setcar l (concat dir (match-string 3 trigger))))
- (if strip-path
- (progn
- (dolist (e l ret)
- (setq ret
- (append ret
- (list
- (if (stringp e)
- (if (stringp replacement)
- (setq e (concat replacement (substring e len)))
- (setq e (substring e len)))
- e)))))
- ret)
- l)))
+ (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
+ param-list
+ (reverse param-list))))
+ (trigger (car l))
+ (len 0)
+ dir
+ ret)
+ (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger)
+ (setq dir (match-string 1 trigger))
+ (setq len (length dir))
+ (setcar l (concat dir (match-string 3 trigger))))
+ (if strip-path
+ (progn
+ (dolist (e l ret)
+ (setq ret
+ (append ret
+ (list
+ (if (stringp e)
+ (if (stringp replacement)
+ (setq e (concat replacement (substring e len)))
+ (setq e (substring e len)))
+ e)))))
+ ret)
+ l)))
(defun org-protocol-flatten (l)
"Greedy handlers might receive a list like this from emacsclient:
@@ -350,7 +356,7 @@ where \"/dir/\" is the absolute path to emacsclients working directory.
This function transforms it into a flat list."
(if (null l) ()
(if (listp l)
- (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
+ (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
(list l))))
@@ -358,7 +364,7 @@ This function transforms it into a flat list."
(defun org-protocol-store-link (fname)
"Process an org-protocol://store-link:// style url.
-Additionally store a browser URL as an org link. Also pushes the
+Additionally store a browser URL as an org link. Also pushes the
link's URL to the `kill-ring'.
The location for a browser's bookmark has to look like this:
@@ -367,17 +373,17 @@ The location for a browser's bookmark has to look like this:
encodeURIComponent(location.href)
encodeURIComponent(document.title)+'/'+ \\
-Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
+Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
could contain slashes and the location definitely will.
The sub-protocol used to reach this function is set in
`org-protocol-protocol-alist'."
- (let* ((splitparts (org-protocol-split-data fname t))
+ (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator))
(uri (org-protocol-sanitize-uri (car splitparts)))
(title (cadr splitparts))
orglink)
(if (boundp 'org-stored-links)
- (setq org-stored-links (cons (list uri title) org-stored-links)))
+ (setq org-stored-links (cons (list uri title) org-stored-links)))
(kill-new uri)
(message "`%s' to insert new org-link, `%s' to insert `%s'"
(substitute-command-keys"\\[org-insert-link]")
@@ -433,7 +439,7 @@ Now template ?b will be used."
(defun org-protocol-do-capture (info capture-func)
"Support `org-capture' and `org-remember' alike.
CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
- (let* ((parts (org-protocol-split-data info t))
+ (let* ((parts (org-protocol-split-data info t org-protocol-data-separator))
(template (or (and (>= 2 (length (car parts))) (pop parts))
org-protocol-default-template-key))
(url (org-protocol-sanitize-uri (car parts)))
@@ -529,7 +535,7 @@ This is, how the matching is done:
protocol and sub-protocol are regexp-quoted.
If a matching protocol is found, the protocol is stripped from fname and the
-result is passed to the protocols function as the only parameter. If the
+result is passed to the protocols function as the only parameter. If the
function returns nil, the filename is removed from the list of filenames
passed from emacsclient to the server.
If the function returns a non nil value, that value is passed to the server
@@ -548,7 +554,7 @@ as filename."
(split (split-string fname proto))
(result (if greedy restoffiles (cadr split))))
(when (plist-get (cdr prolist) :kill-client)
- (message "Greedy org-protocol handler. Killing client.")
+ (message "Greedy org-protocol handler. Killing client.")
(server-edit))
(when (fboundp func)
(unless greedy
@@ -566,7 +572,7 @@ as filename."
(client (ad-get-arg 1)))
(catch 'greedy
(dolist (var flist)
- ;; `\' to `/' on windows. FIXME: could this be done any better?
+ ;; `\' to `/' on windows. FIXME: could this be done any better?
(let ((fname (expand-file-name (car var))))
(setq fname (org-protocol-check-filename-for-protocol
fname (member var flist) client))
@@ -589,14 +595,14 @@ most of the work."
(require 'org-publish)
(let ((all (or (org-publish-get-project-from-filename buffer-file-name))))
(if all (org-protocol-create (cdr all))
- (message "Not in an org-project. Did mean %s?"
+ (message "Not in an org-project. Did mean %s?"
(substitute-command-keys"\\[org-protocol-create]")))))
(defun org-protocol-create (&optional project-plist)
"Create a new org-protocol project interactively.
An org-protocol project is an entry in `org-protocol-project-alist'
which is used by `org-protocol-open-source'.
-Optionally use project-plist to initialize the defaults for this project. If
+Optionally use project-plist to initialize the defaults for this project. If
project-plist is the CDR of an element in `org-publish-project-alist', reuse
:base-directory, :html-extension and :base-extension."
(interactive)
@@ -625,19 +631,19 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse
(setq strip-suffix
(read-string
(concat "Extension to strip from published URLs (" strip-suffix "): ")
- strip-suffix nil strip-suffix t))
+ strip-suffix nil strip-suffix t))
(setq working-suffix
(read-string
(concat "Extension of editable files (" working-suffix "): ")
- working-suffix nil working-suffix t))
+ working-suffix nil working-suffix t))
(when (yes-or-no-p "Save the new org-protocol-project to your init file? ")
(setq org-protocol-project-alist
(cons `(,base-url . (:base-url ,base-url
- :working-directory ,working-dir
- :online-suffix ,strip-suffix
- :working-suffix ,working-suffix))
+ :working-directory ,working-dir
+ :online-suffix ,strip-suffix
+ :working-suffix ,working-suffix))
org-protocol-project-alist))
(customize-save-variable 'org-protocol-project-alist org-protocol-project-alist))))
diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el
index 74cab14716c..947d52b9200 100644
--- a/lisp/org/org-publish.el
+++ b/lisp/org/org-publish.el
@@ -105,7 +105,7 @@ being published. Its value may be a string or regexp matching
file names you don't want to be published.
The :include property may be used to include extra files. Its
-value may be a list of filenames to include. The filenames are
+value may be a list of filenames to include. The filenames are
considered relative to the base directory.
When both :include and :exclude properties are given values, the
@@ -315,7 +315,7 @@ You could use brackets to delimit on what part the link will be.
(format "%s" (or pub-func ""))))
(concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
-(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir)
+(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir)
"Return t if FILENAME should be published in PUB-DIR using PUB-FUNC.
TRUE-PUB-DIR is where the file will truly end up. Currently we are not using
this - maybe it can eventually be used to check if the file is present at
@@ -325,7 +325,7 @@ function can still decide about that independently."
(let ((rtn
(if org-publish-use-timestamps-flag
(org-publish-cache-file-needs-publishing
- filename pub-dir pub-func)
+ filename pub-dir pub-func base-dir)
;; don't use timestamps, always return t
t)))
(if rtn
@@ -334,7 +334,7 @@ function can still decide about that independently."
(message "Skipping unmodified file %s" filename)))
rtn))
-(defun org-publish-update-timestamp (filename &optional pub-dir pub-func)
+(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir)
"Update publishing timestamp for file FILENAME.
If there is no timestamp, create one."
(let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
@@ -418,22 +418,22 @@ This splices all the components into the list."
(setq retval (if org-sitemap-ignore-case
(not (string-lessp (upcase B) (upcase A)))
(not (string-lessp B A))))))
- ((or (equal org-sitemap-sort-files 'chronologically)
- (equal org-sitemap-sort-files 'anti-chronologically))
- (let* ((adate (org-publish-find-date a))
- (bdate (org-publish-find-date b))
- (A (+ (lsh (car adate) 16) (cadr adate)))
- (B (+ (lsh (car bdate) 16) (cadr bdate))))
- (setq retval (if (equal org-sitemap-sort-files 'chronologically)
- (<= A B)
- (>= A B)))))))
+ ((or (equal org-sitemap-sort-files 'chronologically)
+ (equal org-sitemap-sort-files 'anti-chronologically))
+ (let* ((adate (org-publish-find-date a))
+ (bdate (org-publish-find-date b))
+ (A (+ (lsh (car adate) 16) (cadr adate)))
+ (B (+ (lsh (car bdate) 16) (cadr bdate))))
+ (setq retval (if (equal org-sitemap-sort-files 'chronologically)
+ (<= A B)
+ (>= A B)))))))
;; Directory-wise wins:
(when org-sitemap-sort-folders
;; a is directory, b not:
(cond
((and (file-directory-p a) (not (file-directory-p b)))
(setq retval (equal org-sitemap-sort-folders 'first)))
- ;; a is not a directory, but b is:
+ ;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b))
(setq retval (equal org-sitemap-sort-folders 'last))))))
retval))
@@ -506,7 +506,7 @@ matching filenames."
(setq org-publish-temp-files nil)
(if org-sitemap-requested
(pushnew (expand-file-name (concat base-dir sitemap-filename))
- org-publish-temp-files))
+ org-publish-temp-files))
(org-publish-get-base-files-1 base-dir recurse match
;; FIXME distinguish exclude regexp
;; for skip-file and skip-dir?
@@ -536,14 +536,14 @@ matching filenames."
(xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
(when
(or
- (and
+ (and
i (member filename
(mapcar
(lambda (file) (expand-file-name file b))
i)))
- (and
- (not (and e (string-match e filename)))
- (string-match xm filename)))
+ (and
+ (not (and e (string-match e filename)))
+ (string-match xm filename)))
(setq project-name (car prj))
(throw 'p-found project-name))))))
(when up
@@ -600,10 +600,10 @@ PUB-DIR is the publishing directory."
(defmacro org-publish-with-aux-preprocess-maybe (&rest body)
"Execute BODY with a modified hook to preprocess for index."
`(let ((org-export-preprocess-after-headline-targets-hook
- (if (plist-get project-plist :makeindex)
- (cons 'org-publish-aux-preprocess
- org-export-preprocess-after-headline-targets-hook)
- org-export-preprocess-after-headline-targets-hook)))
+ (if (plist-get project-plist :makeindex)
+ (cons 'org-publish-aux-preprocess
+ org-export-preprocess-after-headline-targets-hook)
+ org-export-preprocess-after-headline-targets-hook)))
,@body))
(def-edebug-spec org-publish-with-aux-preprocess-maybe (body))
@@ -624,7 +624,7 @@ See `org-publish-org-to' to the list of arguments."
"Publish an org file to HTML.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
- (org-publish-org-to "html" plist filename pub-dir)))
+ (org-publish-org-to "html" plist filename pub-dir)))
(defun org-publish-org-to-org (plist filename pub-dir)
"Publish an org file to HTML.
@@ -635,19 +635,19 @@ See `org-publish-org-to' to the list of arguments."
"Publish an org file to ASCII.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
- (org-publish-org-to "ascii" plist filename pub-dir)))
+ (org-publish-org-to "ascii" plist filename pub-dir)))
(defun org-publish-org-to-latin1 (plist filename pub-dir)
"Publish an org file to Latin-1.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
- (org-publish-org-to "latin1" plist filename pub-dir)))
+ (org-publish-org-to "latin1" plist filename pub-dir)))
(defun org-publish-org-to-utf8 (plist filename pub-dir)
"Publish an org file to UTF-8.
See `org-publish-org-to' to the list of arguments."
(org-publish-with-aux-preprocess-maybe
- (org-publish-org-to "utf8" plist filename pub-dir)))
+ (org-publish-org-to "utf8" plist filename pub-dir)))
(defun org-publish-attachment (plist filename pub-dir)
"Publish a file with no transformation of any kind.
@@ -705,15 +705,14 @@ See `org-publish-projects'."
(if (listp publishing-function)
;; allow chain of publishing functions
(mapc (lambda (f)
- (when (org-publish-needed-p filename pub-dir f tmp-pub-dir)
+ (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
(funcall f project-plist filename tmp-pub-dir)
- (org-publish-update-timestamp filename pub-dir f)))
+ (org-publish-update-timestamp filename pub-dir f base-dir)))
publishing-function)
- (when (org-publish-needed-p filename pub-dir publishing-function
- tmp-pub-dir)
+ (when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir)
(funcall publishing-function project-plist filename tmp-pub-dir)
(org-publish-update-timestamp
- filename pub-dir publishing-function)))
+ filename pub-dir publishing-function base-dir)))
(unless no-cache (org-publish-write-cache-file))))
(defun org-publish-projects (projects)
@@ -733,9 +732,9 @@ If :makeindex is set, also produce a file theindex.org."
(sitemap-function (or (plist-get project-plist :sitemap-function)
'org-publish-org-sitemap))
(org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
- org-publish-sitemap-date-format))
+ org-publish-sitemap-date-format))
(org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
- org-publish-sitemap-file-entry-format))
+ org-publish-sitemap-file-entry-format))
(preparation-function (plist-get project-plist :preparation-function))
(completion-function (plist-get project-plist :completion-function))
(files (org-publish-get-base-files project exclude-regexp)) file)
@@ -751,7 +750,7 @@ If :makeindex is set, also produce a file theindex.org."
(plist-get project-plist :base-directory))
project t))
(when completion-function (run-hooks 'completion-function))
- (org-publish-write-cache-file)))
+ (org-publish-write-cache-file)))
(org-publish-expand-projects projects)))
(defun org-publish-org-sitemap (project &optional sitemap-filename)
@@ -767,9 +766,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(files (nreverse (org-publish-get-base-files project exclude-regexp)))
(sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
(sitemap-title (or (plist-get project-plist :sitemap-title)
- (concat "Sitemap for project " (car project))))
+ (concat "Sitemap for project " (car project))))
(sitemap-style (or (plist-get project-plist :sitemap-style)
- 'tree))
+ 'tree))
(sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension))
(visiting (find-buffer-visiting sitemap-filename))
(ifn (file-name-nondirectory sitemap-filename))
@@ -833,10 +832,10 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(defun org-publish-format-file-entry (fmt file project-plist)
(format-spec fmt
- `((?t . ,(org-publish-find-title file t))
- (?d . ,(format-time-string org-sitemap-date-format
- (org-publish-find-date file)))
- (?a . ,(or (plist-get project-plist :author) user-full-name)))))
+ `((?t . ,(org-publish-find-title file t))
+ (?d . ,(format-time-string org-sitemap-date-format
+ (org-publish-find-date file)))
+ (?a . ,(or (plist-get project-plist :author) user-full-name)))))
(defun org-publish-find-title (file &optional reset)
"Find the title of FILE in project."
@@ -902,7 +901,7 @@ It returns time in `current-time' format."
;; If this function is called in batch mode,
;; project is still a string here.
(list (assoc project org-publish-project-alist))
- (list project))))))
+ (list project))))))
;;;###autoload
(defun org-publish-all (&optional force)
@@ -1033,25 +1032,24 @@ the project."
;; Create theindex.org if it doesn't exist already
(let ((index-file (expand-file-name "theindex.org" directory)))
(unless (file-exists-p index-file)
- (setq ibuffer (find-file-noselect index-file))
- (with-current-buffer ibuffer
- (erase-buffer)
- (insert "\n\n#+include: \"theindex.inc\"\n\n")
- (save-buffer))
- (kill-buffer ibuffer)))))
+ (setq ibuffer (find-file-noselect index-file))
+ (with-current-buffer ibuffer
+ (erase-buffer)
+ (insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n")
+ (save-buffer))
+ (kill-buffer ibuffer)))))
;; Caching functions:
(defun org-publish-write-cache-file (&optional free-cache)
"Write `org-publish-cache' to file.
If FREE-CACHE, empty the cache."
- (unless org-publish-cache
- (error "%s" "`org-publish-write-cache-file' called, but no cache present"))
+ (or org-publish-cache
+ (error "`org-publish-write-cache-file' called, but no cache present"))
(let ((cache-file (org-publish-cache-get ":cache-file:")))
- (unless cache-file
- (error
- "%s" "Cannot find cache-file name in `org-publish-write-cache-file'"))
+ (or cache-file
+ (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
(with-temp-file cache-file
(let ((print-level nil)
(print-length nil))
@@ -1068,9 +1066,8 @@ If FREE-CACHE, empty the cache."
(defun org-publish-initialize-cache (project-name)
"Initialize the projects cache if not initialized yet and return it."
- (unless project-name
- (error "%s%s" "Cannot initialize `org-publish-cache' without projects name"
- " in `org-publish-initialize-cache'"))
+ (or project-name
+ (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
(unless (file-exists-p org-publish-timestamp-directory)
(make-directory org-publish-timestamp-directory t))
@@ -1105,23 +1102,24 @@ If FREE-CACHE, empty the cache."
(clrhash org-publish-cache))
(setq org-publish-cache nil))
-(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func)
+(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir)
"Check the timestamp of the last publishing of FILENAME.
Return `t', if the file needs publishing. The function also
checks if any included files have been more recently published,
so that the file including them will be republished as well."
- (unless org-publish-cache
- (error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present"))
+ (or org-publish-cache
+ (error "`org-publish-cache-file-needs-publishing' called, but no cache present"))
(let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
(pstamp (org-publish-cache-get key))
(visiting (find-buffer-visiting filename))
+ (case-fold-search t)
included-files-ctime buf)
(when (equal (file-name-extension filename) "org")
(setq buf (find-file (expand-file-name filename)))
(with-current-buffer buf
(goto-char (point-min))
- (while (re-search-forward "^#\\+INCLUDE:[ \t]+\"?\\([^ \t\n\r\"]*\\)\"?[ \t]*.*$" nil t)
+ (while (re-search-forward "^#\\+include:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t)
(let* ((included-file (expand-file-name (match-string 1))))
(add-to-list 'included-files-ctime
(org-publish-cache-ctime-of-src included-file) t))))
@@ -1173,28 +1171,24 @@ If the entry will be created, unless NO-CREATE is not nil."
"Return the value stored in `org-publish-cache' for key KEY.
Returns nil, if no value or nil is found, or the cache does not
exist."
- (unless org-publish-cache
- (error "%s" "`org-publish-cache-get' called, but no cache present"))
+ (or org-publish-cache
+ (error "`org-publish-cache-get' called, but no cache present"))
(gethash key org-publish-cache))
(defun org-publish-cache-set (key value)
"Store KEY VALUE pair in `org-publish-cache'.
Returns value on success, else nil."
- (unless org-publish-cache
- (error "%s" "`org-publish-cache-set' called, but no cache present"))
+ (or org-publish-cache
+ (error "`org-publish-cache-set' called, but no cache present"))
(puthash key value org-publish-cache))
-(defun org-publish-cache-ctime-of-src (filename)
- "Get the FILENAME ctime as an integer."
- (let* ((symlink-maybe (or (file-symlink-p filename) filename))
- (src-attr (file-attributes (if (file-name-absolute-p symlink-maybe)
- symlink-maybe
- (expand-file-name
- symlink-maybe
- (file-name-directory filename))))))
- (+
- (lsh (car (nth 5 src-attr)) 16)
- (cadr (nth 5 src-attr)))))
+(defun org-publish-cache-ctime-of-src (file)
+ "Get the ctime of filename F as an integer."
+ (let ((attr (file-attributes
+ (expand-file-name (or (file-symlink-p file) file)
+ (file-name-directory file)))))
+ (+ (lsh (car (nth 5 attr)) 16)
+ (cadr (nth 5 attr)))))
(provide 'org-publish)
diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el
index d1d863c2845..dd493749295 100644
--- a/lisp/org/org-remember.el
+++ b/lisp/org/org-remember.el
@@ -189,22 +189,22 @@ calendar | %:type %:date"
(character :tag "Selection Key")
(string :tag "Template")
(choice :tag "Destination file"
- (file :tag "Specify")
- (function :tag "Function")
- (const :tag "Use `org-default-notes-file'" nil))
+ (file :tag "Specify")
+ (function :tag "Function")
+ (const :tag "Use `org-default-notes-file'" nil))
(choice :tag "Destin. headline"
- (string :tag "Specify")
- (function :tag "Function")
- (const :tag "Use `org-remember-default-headline'" nil)
- (const :tag "At beginning of file" top)
- (const :tag "At end of file" bottom)
- (const :tag "In a date tree" date-tree))
+ (string :tag "Specify")
+ (function :tag "Function")
+ (const :tag "Use `org-remember-default-headline'" nil)
+ (const :tag "At beginning of file" top)
+ (const :tag "At end of file" bottom)
+ (const :tag "In a date tree" date-tree))
(choice :tag "Context"
- (const :tag "Use in all contexts" nil)
- (const :tag "Use in all contexts" t)
- (repeat :tag "Use only if in major mode"
- (symbol :tag "Major mode"))
- (function :tag "Perform a check against function")))))
+ (const :tag "Use in all contexts" nil)
+ (const :tag "Use in all contexts" t)
+ (repeat :tag "Use only if in major mode"
+ (symbol :tag "Major mode"))
+ (function :tag "Perform a check against function")))))
(defcustom org-remember-delete-empty-lines-at-end t
"Non-nil means clean up final empty lines in remember buffer."
@@ -277,9 +277,6 @@ opposite case, the default, t, is more useful."
:group 'org-remember
:type 'boolean)
-(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
-(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
-
;;;###autoload
(defun org-remember-insinuate ()
"Setup remember.el for use with Org-mode."
@@ -297,7 +294,7 @@ conventions in Org-mode. This function returns such a link."
(org-store-link nil))
(defconst org-remember-help
-"Select a destination location for the note.
+ "Select a destination location for the note.
UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store
RET on headline -> Store as sublevel entry to current headline
RET at beg-of-buf -> Append to file as level 2 headline
@@ -401,8 +398,7 @@ RET at beg-of-buf -> Append to file as level 2 headline
This function should be placed into `remember-mode-hook' and in fact requires
to be run from that hook to function properly."
(when (and (boundp 'initial) (stringp initial))
- (setq initial (org-no-properties initial))
- (remove-text-properties 0 (length initial) '(read-only t) initial))
+ (setq initial (org-no-properties initial)))
(if org-remember-templates
(let* ((entry (org-select-remember-template use-char))
(ct (or org-overriding-default-time (org-current-time)))
@@ -431,10 +427,10 @@ to be run from that hook to function properly."
;; `initial' and `annotation' are bound in `remember'.
;; But if the property list has them, we prefer those values
(v-i (or (plist-get org-store-link-plist :initial)
- (and (boundp 'initial) initial)
+ (and (boundp 'initial) (symbol-value 'initial))
""))
(v-a (or (plist-get org-store-link-plist :annotation)
- (and (boundp 'annotation) annotation)
+ (and (boundp 'annotation) (symbol-value 'annotation))
""))
;; Is the link empty? Then we do not want it...
(v-a (if (equal v-a "[[]]") "" v-a))
@@ -449,7 +445,7 @@ to be run from that hook to function properly."
v-a))
(v-n user-full-name)
(v-k (if (marker-buffer org-clock-marker)
- (org-substring-no-properties org-clock-heading)))
+ (org-no-properties org-clock-heading)))
(v-K (if (marker-buffer org-clock-marker)
(org-make-link-string
(buffer-file-name (marker-buffer org-clock-marker))
@@ -476,7 +472,7 @@ to be run from that hook to function properly."
(erase-buffer)
(insert (substitute-command-keys
(format
-"## %s \"%s\" -> \"* %s\"
+ "## %s \"%s\" -> \"* %s\"
## C-u C-c C-c like C-c C-c, and immediately visit note at target location
## C-0 C-c C-c \"%s\" -> \"* %s\"
## %s to select file and header location interactively.
@@ -505,18 +501,20 @@ to be run from that hook to function properly."
filename error)))))))
;; Simple %-escapes
(goto-char (point-min))
- (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
- (unless (org-remember-escaped-%)
- (when (and initial (equal (match-string 0) "%i"))
- (save-match-data
- (let* ((lead (buffer-substring
- (point-at-bol) (match-beginning 0))))
- (setq v-i (mapconcat 'identity
- (org-split-string initial "\n")
- (concat "\n" lead))))))
- (replace-match
- (or (eval (intern (concat "v-" (match-string 1)))) "")
- t t)))
+ (let ((init (and (boundp 'initial)
+ (symbol-value 'initial))))
+ (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
+ (unless (org-remember-escaped-%)
+ (when (and init (equal (match-string 0) "%i"))
+ (save-match-data
+ (let* ((lead (buffer-substring
+ (point-at-bol) (match-beginning 0))))
+ (setq v-i (mapconcat 'identity
+ (org-split-string init "\n")
+ (concat "\n" lead))))))
+ (replace-match
+ (or (eval (intern (concat "v-" (match-string 1)))) "")
+ t t))))
;; %() embedded elisp
(goto-char (point-min))
@@ -536,10 +534,10 @@ to be run from that hook to function properly."
(when plist-p
(goto-char (point-min))
(while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
- (unless (org-remember-escaped-%)
- (and (setq x (or (plist-get org-store-link-plist
- (intern (match-string 1))) ""))
- (replace-match x t t)))))
+ (unless (org-remember-escaped-%)
+ (and (setq x (or (plist-get org-store-link-plist
+ (intern (match-string 1))) ""))
+ (replace-match x t t)))))
;; Turn on org-mode in the remember buffer, set local variables
(let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1))
@@ -599,7 +597,7 @@ to be run from that hook to function properly."
(car clipboards))))))
((equal char "p")
(let*
- ((prop (org-substring-no-properties prompt))
+ ((prop (org-no-properties prompt))
(pall (concat prop "_ALL"))
(allowed
(with-current-buffer
@@ -943,7 +941,7 @@ See also the variable `org-reverse-note-order'."
(throw 'quit t))
;; Find the file
(with-current-buffer (or visiting (find-file-noselect file))
- (unless (or (eq major-mode 'org-mode) (member heading '(top bottom)))
+ (unless (or (derived-mode-p 'org-mode) (member heading '(top bottom)))
(error "Target files for notes must be in Org-mode if not filing to top/bottom"))
(save-excursion
(save-restriction
@@ -953,7 +951,7 @@ See also the variable `org-reverse-note-order'."
;; Find the default location
(when heading
(cond
- ((not (eq major-mode 'org-mode))
+ ((not (derived-mode-p 'org-mode))
(if (eq heading 'top)
(goto-char (point-min))
(goto-char (point-max))
@@ -995,7 +993,7 @@ See also the variable `org-reverse-note-order'."
(cond
((and fastp (memq heading '(top bottom)))
(setq spos org-goto-start-pos
- exitcmd (if (eq heading 'top) 'left nil)))
+ exitcmd (if (eq heading 'top) 'left nil)))
(fastp (setq spos org-goto-start-pos
exitcmd 'return))
((eq org-remember-interactive-interface 'outline)
diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el
index 3146ff32758..4be7bcbb5f6 100644
--- a/lisp/org/org-rmail.el
+++ b/lisp/org/org-rmail.el
@@ -33,9 +33,12 @@
(require 'org)
;; Declare external functions and variables
-(declare-function rmail-show-message "rmail" (&optional n no-summary))
-(declare-function rmail-what-message "rmail" ())
-(defvar rmail-current-message)
+(declare-function rmail-show-message "rmail" (&optional n no-summary))
+(declare-function rmail-what-message "rmail" (&optional pos))
+(declare-function rmail-toggle-header "rmail" (&optional arg))
+(declare-function rmail-widen "rmail" ())
+(defvar rmail-current-message) ; From rmail.el
+(defvar rmail-header-style) ; From rmail.el
;; Install the link type
(org-add-link-type "rmail" 'org-rmail-open)
@@ -52,6 +55,8 @@
(rmail-show-message rmail-current-message))
(when (fboundp 'rmail-narrow-to-non-pruned-header)
(rmail-narrow-to-non-pruned-header))
+ (when (eq rmail-header-style 'normal)
+ (rmail-toggle-header -1))
(let* ((folder buffer-file-name)
(message-id (mail-fetch-field "message-id"))
(from (mail-fetch-field "from"))
@@ -73,7 +78,7 @@
:date-timestamp-inactive date-ts-ia))
(setq message-id (org-remove-angle-brackets message-id))
(setq desc (org-email-link-description))
- (setq link (org-make-link "rmail:" folder "#" message-id))
+ (setq link (concat "rmail:" folder "#" message-id))
(org-add-link-props :link link :description desc)
(rmail-show-message rmail-current-message)
link)))))
@@ -97,7 +102,7 @@
(rmail (if (string= folder "RMAIL") rmail-file-name folder))
(setq message-number
(save-restriction
- (widen)
+ (rmail-widen)
(goto-char (point-max))
(if (re-search-backward
(concat "^Message-ID:\\s-+" (regexp-quote
diff --git a/lisp/org/org-special-blocks.el b/lisp/org/org-special-blocks.el
index 43b37c64016..ddd612074b4 100644
--- a/lisp/org/org-special-blocks.el
+++ b/lisp/org/org-special-blocks.el
@@ -80,17 +80,17 @@ seen. This is run after a few special cases are taken care of."
(add-hook 'org-export-latex-after-blockquotes-hook
'org-special-blocks-convert-latex-special-cookies)
-(defvar line)
+(defvar org-line)
(defun org-special-blocks-convert-html-special-cookies ()
"Converts the special cookies into div blocks."
- ;; Uses the dynamically-bound variable `line'.
- (when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" line)
+ ;; Uses the dynamically-bound variable `org-line'.
+ (when (and org-line (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line))
(message "%s" (match-string 1))
- (when (equal (match-string 2 line) "START")
+ (when (equal (match-string 2 org-line) "START")
(org-close-par-maybe)
- (insert "\n<div class=\"" (match-string 1 line) "\">")
+ (insert "\n<div class=\"" (match-string 1 org-line) "\">")
(org-open-par))
- (when (equal (match-string 2 line) "END")
+ (when (equal (match-string 2 org-line) "END")
(org-close-par-maybe)
(insert "\n</div>")
(org-open-par))
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index 496dafe5e77..9d6bc1aa2c8 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -41,6 +41,7 @@
(declare-function org-at-table.el-p "org" ())
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-switch-to-buffer-other-window "org" (&rest args))
+(declare-function org-strip-protective-commas "org" (beg end))
(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
(declare-function org-strip-protective-commas "org" (beg end))
@@ -112,8 +113,7 @@ editing it with \\[org-edit-src-code]. Has no effect if
:type 'integer)
(defvar org-src-strip-leading-and-trailing-blank-lines nil
- "If non-nil, blank lines are removed when exiting the code edit
-buffer.")
+ "If non-nil, blank lines are removed when exiting the code edit buffer.")
(defcustom org-edit-src-persistent-message t
"Non-nil means show persistent exit help message while editing src examples.
@@ -130,7 +130,7 @@ current-window Show edit buffer in the current window, keeping all other
windows.
other-window Use `switch-to-buffer-other-window' to display edit buffer.
reorganize-frame Show only two windows on the current frame, the current
- window and the edit buffer. When exiting the edit buffer,
+ window and the edit buffer. When exiting the edit buffer,
return to one window.
other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
Also, when exiting the edit buffer, kill that frame."
@@ -174,6 +174,7 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(defvar org-src-mode-map (make-sparse-keymap))
(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
+(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save)
(defvar org-edit-src-force-single-line nil)
(defvar org-edit-src-from-org-mode nil)
@@ -187,9 +188,9 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(defvar org-src-ask-before-returning-to-edit-buffer t
"If nil, when org-edit-src code is used on a block that already
- has an active edit buffer, it will switch to that edit buffer
- immediately; otherwise it will ask whether you want to return
- to the existing edit buffer.")
+has an active edit buffer, it will switch to that edit buffer
+immediately; otherwise it will ask whether you want to return to
+the existing edit buffer.")
(defvar org-src-babel-info nil)
@@ -202,13 +203,13 @@ There is a mode hook, and keybindings for `org-edit-src-exit' and
`org-edit-src-save'")
(defun org-edit-src-code (&optional context code edit-buffer-name)
- "Edit the source code example at point.
+ "Edit the source CODE example at point.
The example is copied to a separate buffer, and that buffer is
switched to the correct language mode. When done, exit with
\\[org-edit-src-exit]. This will remove the original code in the
-Org buffer, and replace it with the edited version. Optional
+Org buffer, and replace it with the edited version. An optional
argument CONTEXT is used by \\[org-edit-src-save] when calling
-this function. See \\[org-src-window-setup] to configure the
+this function. See `org-src-window-setup' to configure the
display of windows containing the Org buffer and the code
buffer."
(interactive)
@@ -271,8 +272,9 @@ buffer."
(setq line (org-current-line)
col (current-column)))
(if (and (setq buffer (org-edit-src-find-buffer beg end))
- (if org-src-ask-before-returning-to-edit-buffer
- (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ") t))
+ (or (eq context 'save)
+ (if org-src-ask-before-returning-to-edit-buffer
+ (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ") t)))
(org-src-switch-to-buffer buffer 'return)
(when buffer
(with-current-buffer buffer
@@ -309,7 +311,7 @@ buffer."
(error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
(dolist (pair transmitted-variables)
(org-set-local (car pair) (cadr pair)))
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(progn
(goto-char (point-min))
(while (re-search-forward "^," nil t)
@@ -328,6 +330,7 @@ buffer."
(if org-src-preserve-indentation col (max 0 (- col total-nindent))))
(org-src-mode)
(set-buffer-modified-p nil)
+ (setq buffer-file-name nil)
(and org-edit-src-persistent-message
(org-set-local 'header-line-format msg))
(let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
@@ -336,6 +339,7 @@ buffer."
t)))
(defun org-edit-src-continue (e)
+ "Continue editing source blocks." ;; Fixme: be more accurate
(interactive "e")
(mouse-set-point e)
(let ((buf (get-char-property (point) 'edit-buffer)))
@@ -412,7 +416,7 @@ the fragment in the Org-mode buffer."
(case-fold-search t)
(msg (substitute-command-keys
"Edit, then exit with C-c ' (C-c and single quote)"))
- (org-mode-p (eq major-mode 'org-mode))
+ (org-mode-p (derived-mode-p 'org-mode))
(beg (make-marker))
(end (make-marker))
(preserve-indentation org-src-preserve-indentation)
@@ -436,7 +440,7 @@ the fragment in the Org-mode buffer."
code (buffer-substring-no-properties beg end)
begline (save-excursion (goto-char beg) (org-current-line)))
(if (and (setq buffer (org-edit-src-find-buffer beg end))
- (y-or-n-p "Return to existing edit buffer? [n] will revert changes: "))
+ (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? "))
(org-pop-to-buffer-same-window buffer)
(when buffer
(with-current-buffer buffer
@@ -452,10 +456,10 @@ the fragment in the Org-mode buffer."
(overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
(overlay-put ovl 'face 'secondary-selection)
(overlay-put ovl
- 'keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'org-edit-src-continue)
- map))
+ 'keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'org-edit-src-continue)
+ map))
(overlay-put ovl :read-only "Leave me alone")
(org-pop-to-buffer-same-window buffer)
(insert code)
@@ -586,6 +590,21 @@ the language, a switch telling if the content should be in a single line."
(goto-char pos)
(org-get-indentation)))
+(defun org-add-protective-commas (beg end &optional line)
+ "Add protective commas in region.
+Return the delta in size of the region."
+ (interactive "r")
+ (let ((org-re "^\\(.\\)")
+ (other-re "^\\([*]\\|[ \t]*#\\+\\)")
+ (delta 0))
+ (save-excursion
+ (goto-char beg)
+ (while (re-search-forward (if (derived-mode-p 'org-mode) org-re other-re)
+ end t)
+ (if (and line (eq (org-current-line) line)) (setq delta (1+ delta)))
+ (replace-match ",\\1")))
+ delta))
+
(defun org-edit-src-exit (&optional context)
"Exit special edit and protect problematic lines."
(interactive)
@@ -595,6 +614,7 @@ the language, a switch telling if the content should be in a single line."
(let* ((beg org-edit-src-beg-marker)
(end org-edit-src-end-marker)
(ovl org-edit-src-overlay)
+ (bufstr (buffer-string))
(buffer (current-buffer))
(single (org-bound-and-true-p org-edit-src-force-single-line))
(macro (eq single 'macro-definition))
@@ -629,11 +649,8 @@ the language, a switch telling if the content should be in a single line."
(goto-char (point-min))
(if (looking-at "\\s-*") (replace-match " ")))
(when (org-bound-and-true-p org-edit-src-from-org-mode)
- (goto-char (point-min))
- (while (re-search-forward
- (if (eq major-mode 'org-mode) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t)
- (if (eq (org-current-line) line) (setq delta (1+ delta)))
- (replace-match ",\\1")))
+ (setq delta (+ delta (org-add-protective-commas
+ (point-min) (point-max) line))))
(when (org-bound-and-true-p org-edit-src-picture)
(setq preserve-indentation nil)
(untabify (point-min) (point-max))
@@ -648,13 +665,18 @@ the language, a switch telling if the content should be in a single line."
(if (org-bound-and-true-p org-edit-src-picture)
(setq total-nindent (+ total-nindent 2)))
(setq code (buffer-string))
+ (when (eq context 'save)
+ (erase-buffer)
+ (insert bufstr))
(set-buffer-modified-p nil))
(org-src-switch-to-buffer (marker-buffer beg) (or context 'exit))
- (kill-buffer buffer)
+ (if (eq context 'save) (save-buffer)
+ (kill-buffer buffer))
(goto-char beg)
(when allow-write-back-p
- (delete-region beg end)
+ (delete-region beg (1- end))
(insert code)
+ (delete-char 1)
(goto-char beg)
(if single (just-one-space)))
(if (memq t (mapcar (lambda (overlay)
@@ -666,28 +688,41 @@ the language, a switch telling if the content should be in a single line."
;; Block is visible, put point where it was in the code buffer
(org-goto-line (1- (+ (org-current-line) line)))
(org-move-to-column (if preserve-indentation col (+ col total-nindent delta))))
- (move-marker beg nil)
- (move-marker end nil))
+ (unless (eq context 'save)
+ (move-marker beg nil)
+ (move-marker end nil)))
(unless (eq context 'save)
(when org-edit-src-saved-temp-window-config
(set-window-configuration org-edit-src-saved-temp-window-config)
(setq org-edit-src-saved-temp-window-config nil))))
+(defmacro org-src-in-org-buffer (&rest body)
+ `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg)
+ (save-window-excursion
+ (org-edit-src-exit 'save)
+ ,@body
+ (setq msg (current-message))
+ (if (eq org-src-window-setup 'other-frame)
+ (let ((org-src-window-setup 'current-window))
+ (org-edit-src-code 'save))
+ (org-edit-src-code 'save)))
+ (setq buffer-undo-list ul)
+ (push-mark m 'nomessage)
+ (goto-char (min p (point-max)))
+ (message (or msg ""))))
+(def-edebug-spec org-src-in-org-buffer (body))
+
(defun org-edit-src-save ()
"Save parent buffer with current state source-code buffer."
(interactive)
- (let ((p (point)) (m (mark)) msg)
- (save-window-excursion
- (org-edit-src-exit 'save)
- (save-buffer)
- (setq msg (current-message))
- (if (eq org-src-window-setup 'other-frame)
- (let ((org-src-window-setup 'current-window))
- (org-edit-src-code 'save))
- (org-edit-src-code 'save)))
- (push-mark m 'nomessage)
- (goto-char (min p (point-max)))
- (message (or msg ""))))
+ (org-src-in-org-buffer (save-buffer)))
+
+(declare-function org-babel-tangle "ob-tangle" (&optional only-this-block target-file lang))
+
+(defun org-src-tangle (arg)
+ "Tangle the parent buffer."
+ (interactive)
+ (org-src-in-org-buffer (org-babel-tangle arg)))
(defun org-src-mode-configure-edit-buffer ()
(when (org-bound-and-true-p org-edit-src-from-org-mode)
@@ -739,7 +774,7 @@ remotely with point temporarily at the start of the code block in
the Org buffer.
This command is not bound to a key by default, to avoid conflicts
-with language major mode bindings. To bind it to C-c @ in all
+with language major mode bindings. To bind it to C-c @ in all
language major modes, you could use
(add-hook 'org-src-mode-hook
@@ -777,7 +812,7 @@ mode."
(defun org-src-font-lock-fontify-block (lang start end)
"Fontify code block.
This function is called by emacs automatic fontification, as long
-as `org-src-fontify-natively' is non-nil. For manual
+as `org-src-fontify-natively' is non-nil. For manual
fontification of code blocks see `org-src-fontify-block' and
`org-src-fontify-buffer'"
(let ((lang-mode (org-src-get-lang-mode lang)))
@@ -790,13 +825,13 @@ fontification of code blocks see `org-src-fontify-block' and
(get-buffer-create
(concat " org-src-fontification:" (symbol-name lang-mode)))
(delete-region (point-min) (point-max))
- (insert (concat string " ")) ;; so there's a final property change
+ (insert string " ") ;; so there's a final property change
(unless (eq major-mode lang-mode) (funcall lang-mode))
(font-lock-fontify-buffer)
(setq pos (point-min))
(while (setq next (next-single-property-change pos 'face))
(put-text-property
- (+ start (1- pos)) (+ start next) 'face
+ (+ start (1- pos)) (1- (+ start next)) 'face
(get-text-property pos 'face) org-buffer)
(setq pos next)))
(add-text-properties
@@ -813,7 +848,7 @@ fontification of code blocks see `org-src-fontify-block' and
(font-lock-fontify-region (nth 0 info) (nth 1 info)))))
(defun org-src-fontify-buffer ()
- "Fontify all code blocks in the current buffer"
+ "Fontify all code blocks in the current buffer."
(interactive)
(org-babel-map-src-blocks nil
(org-src-fontify-block)))
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index e02062a2b93..3eb63b6e53c 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -41,6 +41,7 @@
(declare-function org-table-clean-before-export "org-exp"
(lines &optional maybe-quoted))
(declare-function org-format-org-table-html "org-html" (lines &optional splice))
+(declare-function aa2u "ext:ascii-art-to-unicode" ())
(defvar orgtbl-mode) ; defined below
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
(defvar org-export-html-table-tag) ; defined in org-exp.el
@@ -85,7 +86,13 @@ this variable requires a restart of Emacs to become effective."
<!--
#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
| | |
--->\n"))
+-->\n")
+ (org-mode "#+ BEGIN RECEIVE ORGTBL %n
+#+ END RECEIVE ORGTBL %n
+
+#+ORGTBL: SEND %n orgtbl-to-orgtbl :splice nil :skip 0
+| | |
+"))
"Templates for radio tables in different major modes.
All occurrences of %n in a template will be replaced with the name of the
table, obtained by prompting the user."
@@ -102,7 +109,7 @@ table, obtained by prompting the user."
(defcustom org-table-default-size "5x2"
"The default size for newly created tables, Columns x Rows."
:group 'org-table-settings
- :type 'string)
+ :type 'string)
(defcustom org-table-number-regexp
"^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$"
@@ -131,6 +138,8 @@ Other options offered by the customize interface are more restrictive."
"^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$")
(const :tag "Very General Number-Like, including hex"
"^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$")
+ (const :tag "Very General Number-Like, including hex, allows comma as decimal mark"
+ "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$")
(string :tag "Regexp:")))
(defcustom org-table-number-fraction 0.5
@@ -217,13 +226,13 @@ t accept as input and present for editing"
(defcustom org-calc-default-modes
'(calc-internal-prec 12
- calc-float-format (float 8)
- calc-angle-mode deg
- calc-prefer-frac nil
- calc-symbolic-mode nil
- calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm))
- calc-display-working-message t
- )
+ calc-float-format (float 8)
+ calc-angle-mode deg
+ calc-prefer-frac nil
+ calc-symbolic-mode nil
+ calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm))
+ calc-display-working-message t
+ )
"List with Calc mode settings for use in `calc-eval' for table formulas.
The list must contain alternating symbols (Calc modes variables and values).
Don't remove any of the default settings, just change the values. Org-mode
@@ -368,8 +377,8 @@ available parameters."
"Vector of hline line numbers in the current table.")
(defconst org-table-range-regexp
- "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?"
- ;; 1 2 3 4 5
+ "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?"
+ ;; 1 2 3 4 5
"Regular expression for matching ranges in formulas.")
(defconst org-table-range-regexp2
@@ -551,15 +560,18 @@ are found, lines will be split on whitespace into fields."
(defvar org-table-last-column-widths)
(defun org-table-export (&optional file format)
"Export table to a file, with configurable format.
-Such a file can be imported into a spreadsheet program like Excel.
-FILE can be the output file name. If not given, it will be taken from
-a TABLE_EXPORT_FILE property in the current entry or higher up in the
-hierarchy, or the user will be prompted for a file name.
-FORMAT can be an export format, of the same kind as it used when
-`orgtbl-mode' sends a table in a different format. The default format can
-be found in the variable `org-table-export-default-format', but the function
-first checks if there is an export format specified in a TABLE_EXPORT_FORMAT
-property, locally or anywhere up in the hierarchy."
+Such a file can be imported into usual spreadsheet programs.
+
+FILE can be the output file name. If not given, it will be taken
+from a TABLE_EXPORT_FILE property in the current entry or higher
+up in the hierarchy, or the user will be prompted for a file
+name. FORMAT can be an export format, of the same kind as it
+used when `orgtbl-mode' sends a table in a different format.
+
+The command suggests a format depending on TABLE_EXPORT_FORMAT,
+whether it is set locally or up in the hierarchy, then on the
+extension of the given file name, and finally on the variable
+`org-table-export-default-format'."
(interactive)
(unless (org-at-table-p)
(error "No table at point"))
@@ -569,9 +581,13 @@ property, locally or anywhere up in the hierarchy."
(end (org-table-end))
(txt (buffer-substring-no-properties beg end))
(file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t)))
+ (formats '("orgtbl-to-tsv" "orgtbl-to-csv"
+ "orgtbl-to-latex" "orgtbl-to-html"
+ "orgtbl-to-generic" "orgtbl-to-texinfo"
+ "orgtbl-to-orgtbl"))
(format (or format
(org-entry-get beg "TABLE_EXPORT_FORMAT" t)))
- buf deffmt-readable)
+ buf deffmt-readable fileext)
(unless file
(setq file (read-file-name "Export table to: "))
(unless (or (not (file-exists-p file))
@@ -583,19 +599,16 @@ property, locally or anywhere up in the hierarchy."
(equal (file-truename file)
(file-truename (buffer-file-name))))
(error "Please specify a file name that is different from current"))
+ (setq fileext (concat (file-name-extension file) "$"))
(unless format
- (setq deffmt-readable org-table-export-default-format)
+ (setq deffmt-readable
+ (or (car (delq nil (mapcar (lambda(f) (if (string-match fileext f) f)) formats)))
+ org-table-export-default-format))
(while (string-match "\t" deffmt-readable)
(setq deffmt-readable (replace-match "\\t" t t deffmt-readable)))
(while (string-match "\n" deffmt-readable)
(setq deffmt-readable (replace-match "\\n" t t deffmt-readable)))
- (setq format (org-completing-read
- "Format: "
- '("orgtbl-to-tsv" "orgtbl-to-csv"
- "orgtbl-to-latex" "orgtbl-to-html"
- "orgtbl-to-generic" "orgtbl-to-texinfo"
- "orgtbl-to-orgtbl") nil nil
- deffmt-readable)))
+ (setq format (org-completing-read "Format: " formats nil nil deffmt-readable)))
(if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format)
(let* ((transform (intern (match-string 1 format)))
(params (if (match-end 2)
@@ -695,7 +708,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(re-search-forward org-emph-re end t)))
(goto-char beg)
(setq raise (and org-use-sub-superscripts
- (re-search-forward org-match-substring-regexp end t)))
+ (re-search-forward org-match-substring-regexp end t)))
(goto-char beg)
(setq dates (and org-display-custom-times
(re-search-forward org-ts-regexp-both end t)))
@@ -732,7 +745,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
;; Get the data fields by splitting the lines.
(setq fields (mapcar
(lambda (l)
- (org-split-string l " *| *"))
+ (org-split-string l " *| *"))
(delq nil (copy-sequence lines))))
;; How many fields in the longest line?
(condition-case nil
@@ -764,7 +777,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(> (org-string-width xx) fmax))
(org-add-props xx nil
'help-echo
- (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx))))
+ (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx))))
(setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
(unless (> f1 1)
(error "Cannot narrow field starting with wide link \"%s\""
@@ -833,7 +846,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(delete-region (point) end)
(move-marker end nil)
(move-marker org-table-aligned-end-marker (point))
- (when (and orgtbl-mode (not (eq major-mode 'org-mode)))
+ (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
(goto-char org-table-aligned-begin-marker)
(while (org-hide-wide-columns org-table-aligned-end-marker)))
;; Try to move to the old location
@@ -1319,8 +1332,8 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(while (< i ll)
(if (>= (aref org-table-dlines i) line)
(throw 'exit i))
- (setq i (1+ i)))))
- nil))
+ (setq i (1+ i)))))
+ nil))
(defun org-table-delete-column ()
"Delete a column from the table."
@@ -1627,8 +1640,8 @@ with `org-table-paste-rectangle'."
(if (org-region-active-p) (region-end) (point))
current-prefix-arg))
(let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
- region cols
- (rpl (if cut " " nil)))
+ region cols
+ (rpl (if cut " " nil)))
(goto-char beg)
(org-table-check-inside-data-field)
(setq l01 (org-current-line)
@@ -2088,22 +2101,23 @@ When NAMED is non-nil, look for a named equation."
(defun org-table-store-formulas (alist)
"Store the list of formulas below the current table."
(setq alist (sort alist 'org-table-formula-less-p))
- (save-excursion
- (goto-char (org-table-end))
- (if (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM:\\(.*\n?\\)")
- (progn
- ;; don't overwrite TBLFM, we might use text properties to store stuff
- (goto-char (match-beginning 2))
- (delete-region (match-beginning 2) (match-end 0)))
- (org-indent-line-function)
- (insert "#+TBLFM:"))
- (insert " "
- (mapconcat (lambda (x)
- (concat
- (if (equal (string-to-char (car x)) ?@) "" "$")
- (car x) "=" (cdr x)))
- alist "::")
- "\n")))
+ (let ((case-fold-search t))
+ (save-excursion
+ (goto-char (org-table-end))
+ (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)")
+ (progn
+ ;; don't overwrite TBLFM, we might use text properties to store stuff
+ (goto-char (match-beginning 3))
+ (delete-region (match-beginning 3) (match-end 0)))
+ (org-indent-line)
+ (insert (or (match-string 2) "#+TBLFM:")))
+ (insert " "
+ (mapconcat (lambda (x)
+ (concat
+ (if (equal (string-to-char (car x)) ?@) "" "$")
+ (car x) "=" (cdr x)))
+ alist "::")
+ "\n"))))
(defsubst org-table-formula-make-cmp-string (a)
(when (string-match "\\`$[<>]" a)
@@ -2133,10 +2147,10 @@ When NAMED is non-nil, look for a named equation."
(defun org-table-get-stored-formulas (&optional noerror)
"Return an alist with the stored formulas directly after current table."
(interactive)
- (let (scol eq eq-alist strings string seen)
+ (let ((case-fold-search t) scol eq eq-alist strings string seen)
(save-excursion
(goto-char (org-table-end))
- (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
+ (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)")
(setq strings (org-split-string (org-match-string-no-properties 2)
" *:: *"))
(while (setq string (pop strings))
@@ -2164,8 +2178,9 @@ KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace.
For all numbers larger than LIMIT, shift them by DELTA."
(save-excursion
(goto-char (org-table-end))
- (when (looking-at "[ \t]*#\\+TBLFM:")
- (let ((re (concat key "\\([0-9]+\\)"))
+ (when (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:"))
+ (let ((msg "The formulas in #+TBLFM have been updated")
+ (re (concat key "\\([0-9]+\\)"))
(re2
(when remove
(if (or (equal key "$") (equal key "$LR"))
@@ -2177,7 +2192,7 @@ For all numbers larger than LIMIT, shift them by DELTA."
(while (re-search-forward re2 (point-at-eol) t)
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
(if (equal (char-before (match-beginning 0)) ?.)
- (error "Change makes TBLFM term %s invalid. Use undo to recover."
+ (error "Change makes TBLFM term %s invalid, use undo to recover"
(match-string 0))
(replace-match "")))))
(while (re-search-forward re (point-at-eol) t)
@@ -2185,10 +2200,11 @@ For all numbers larger than LIMIT, shift them by DELTA."
(setq s (match-string 1) n (string-to-number s))
(cond
((setq a (assoc s replace))
- (replace-match (concat key (cdr a)) t t))
+ (replace-match (concat key (cdr a)) t t)
+ (message msg))
((and limit (> n limit))
- (replace-match (concat key (int-to-string (+ n delta)))
- t t)))))))))
+ (replace-match (concat key (int-to-string (+ n delta))) t t)
+ (message msg)))))))))
(defun org-table-get-specials ()
"Get the column names and local parameters for this table."
@@ -2234,8 +2250,8 @@ For all numbers larger than LIMIT, shift them by DELTA."
(setq v (pop fields1) col (1+ col))
(when (and (stringp field) (stringp v)
(string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field))
- (push (cons field v) org-table-local-parameters)
- (push (list field line col) org-table-named-field-locations))))
+ (push (cons field v) org-table-local-parameters)
+ (push (list field line col) org-table-named-field-locations))))
;; Analyse the line types
(goto-char beg)
(setq org-table-current-begin-line (org-current-line)
@@ -2275,7 +2291,7 @@ If yes, store the formula and apply it."
(when org-table-formula-evaluate-inline
(let* ((field (org-trim (or (org-table-get-field) "")))
named eq)
- (when (string-match "^:?=\\(.*\\)" field)
+ (when (string-match "^:?=\\(.*[^=]\\)$" field)
(setq named (equal (string-to-char field) ?:)
eq (match-string 1 field))
(if (or (fboundp 'calc-eval)
@@ -2292,8 +2308,8 @@ Will be filled automatically during use.")
'((" " . "Unmarked: no special line, no automatic recalculation")
("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line")
("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'")
- ("!" . "Column name definition line. Reference in formula as $name.")
- ("$" . "Parameter definition line name=value. Reference in formula as $name.")
+ ("!" . "Column name definition line. Reference in formula as $name.")
+ ("$" . "Parameter definition line name=value. Reference in formula as $name.")
("_" . "Names for values in row below this one.")
("^" . "Names for values in row above this one.")))
@@ -2489,8 +2505,7 @@ not overwrite the stored one."
(setq orig (or (get-text-property 1 :orig-formula formula) "?"))
(while (> ndown 0)
(setq fields (org-split-string
- (org-no-properties
- (buffer-substring (point-at-bol) (point-at-eol)))
+ (buffer-substring-no-properties (point-at-bol) (point-at-eol))
" *| *"))
;; replace fields with duration values if relevant
(if duration
@@ -2589,10 +2604,17 @@ not overwrite the stored one."
duration-output-format) ev))
(or (fboundp 'calc-eval)
(error "Calc does not seem to be installed, and is needed to evaluate the formula"))
- (setq ev (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num))
+ ;; "Inactivate" time-stamps so that Calc can handle them
+ (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form))
+ (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form))
+ form
+ (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num)))
ev (if duration (org-table-time-seconds-to-string
- (string-to-number ev)
- duration-output-format) ev)))
+ (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev)
+ (string-to-number (org-table-time-string-to-seconds ev))
+ (string-to-number ev))
+ duration-output-format)
+ ev)))
(when org-table-formula-debug
(with-output-to-temp-buffer "*Substitution History*"
@@ -2666,7 +2688,7 @@ in the buffer and column1 and column2 are table column numbers."
(if (equal r2 "") (setq r2 nil))
(if r1 (setq r1 (org-table-get-descriptor-line r1)))
(if r2 (setq r2 (org-table-get-descriptor-line r2)))
-; (setq r2 (or r2 r1) c2 (or c2 c1))
+ ; (setq r2 (or r2 r1) c2 (or c2 c1))
(if (not r1) (setq r1 thisline))
(if (not r2) (setq r2 thisline))
(if (or (not c1) (= 0 c1)) (setq c1 col))
@@ -2881,7 +2903,7 @@ known that the table will be realigned a little later anyway."
(if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
(nth 2 a))))
(when (member name1 seen-fields)
- (error "Several field/range formulas try to set %s" name1))
+ (error "Several field/range formulas try to set %s" name1))
(push name1 seen-fields)
(and (not a)
@@ -2961,6 +2983,7 @@ with the prefix ARG."
(throw 'exit t)))
(error "No convergence after %d iterations" i))))
+;;;###autoload
(defun org-table-recalculate-buffer-tables ()
"Recalculate all tables in the current buffer."
(interactive)
@@ -2969,27 +2992,28 @@ with the prefix ARG."
(widen)
(org-table-map-tables (lambda () (org-table-recalculate t)) t))))
+;;;###autoload
(defun org-table-iterate-buffer-tables ()
"Iterate all tables in the buffer, to converge inter-table dependencies."
- (interactive)
- (let* ((imax 10)
- (checksum (md5 (buffer-string)))
-
- c1
- (i imax))
- (save-excursion
- (save-restriction
- (widen)
- (catch 'exit
- (while (> i 0)
- (setq i (1- i))
- (org-table-map-tables (lambda () (org-table-recalculate t)) t)
- (if (equal checksum (setq c1 (md5 (buffer-string))))
- (progn
- (message "Convergence after %d iterations" (- imax i))
- (throw 'exit t))
- (setq checksum c1)))
- (error "No convergence after %d iterations" imax))))))
+ (interactive)
+ (let* ((imax 10)
+ (checksum (md5 (buffer-string)))
+
+ c1
+ (i imax))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (catch 'exit
+ (while (> i 0)
+ (setq i (1- i))
+ (org-table-map-tables (lambda () (org-table-recalculate t)) t)
+ (if (equal checksum (setq c1 (md5 (buffer-string))))
+ (progn
+ (message "Convergence after %d iterations" (- imax i))
+ (throw 'exit t))
+ (setq checksum c1)))
+ (error "No convergence after %d iterations" imax))))))
(defun org-table-expand-lhs-ranges (equations)
"Expand list of formulas.
@@ -2999,7 +3023,7 @@ them to individual field equations for each field."
(while (setq e (pop equations))
(setq lhs (car e) rhs (cdr e))
(cond
- ((string-match "^@-?[-+I0-9]+\\$-?[0-9]+$" lhs)
+ ((string-match "^@-?[-+0-9]+\\$-?[0-9]+$" lhs)
;; This just refers to one fixed field
(push e res))
((string-match "^[a-zA-Z][_a-zA-Z0-9]*$" lhs)
@@ -3143,7 +3167,7 @@ Parameters get priority."
(defun org-table-edit-formulas ()
"Edit the formulas of the current table in a separate buffer."
(interactive)
- (when (save-excursion (beginning-of-line 1) (looking-at "[ \t]*#\\+TBLFM"))
+ (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM")))
(beginning-of-line 0))
(unless (org-at-table-p) (error "Not at a table"))
(org-table-get-specials)
@@ -3217,7 +3241,7 @@ Parameters get priority."
Works for single references, but also for entire formulas and even the
full TBLFM line."
(let ((start 0))
- (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^)]*)\\)" s start)
+ (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^,)]*)\\)" s start)
(cond
((match-end 3)
;; format match, just advance
@@ -3268,8 +3292,8 @@ For example: AB -> 28."
(let ((n 0))
(setq s (upcase s))
(while (> (length s) 0)
- (setq n (+ (* n 26) (string-to-char s) (- ?A) 1)
- s (substring s 1)))
+ (setq n (+ (* n 26) (string-to-char s) (- ?A) 1)
+ s (substring s 1)))
n))
(defun org-number-to-letters (n)
@@ -3285,26 +3309,28 @@ For example: 28 -> AB."
"Convert a time string into numerical duration in seconds.
S can be a string matching either -?HH:MM:SS or -?HH:MM.
If S is a string representing a number, keep this number."
- (let (hour minus min sec res)
- (cond
- ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
- (setq minus (< 0 (length (match-string 1 s)))
- hour (string-to-number (match-string 2 s))
- min (string-to-number (match-string 3 s))
- sec (string-to-number (match-string 4 s)))
- (if minus
- (setq res (- (+ (* hour 3600) (* min 60) sec)))
- (setq res (+ (* hour 3600) (* min 60) sec))))
- ((and (not (string-match org-ts-regexp-both s))
- (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s))
- (setq minus (< 0 (length (match-string 1 s)))
- hour (string-to-number (match-string 2 s))
- min (string-to-number (match-string 3 s)))
- (if minus
- (setq res (- (+ (* hour 3600) (* min 60))))
- (setq res (+ (* hour 3600) (* min 60)))))
- (t (setq res (string-to-number s))))
- (number-to-string res)))
+ (if (equal s "")
+ s
+ (let (hour minus min sec res)
+ (cond
+ ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
+ (setq minus (< 0 (length (match-string 1 s)))
+ hour (string-to-number (match-string 2 s))
+ min (string-to-number (match-string 3 s))
+ sec (string-to-number (match-string 4 s)))
+ (if minus
+ (setq res (- (+ (* hour 3600) (* min 60) sec)))
+ (setq res (+ (* hour 3600) (* min 60) sec))))
+ ((and (not (string-match org-ts-regexp-both s))
+ (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s))
+ (setq minus (< 0 (length (match-string 1 s)))
+ hour (string-to-number (match-string 2 s))
+ min (string-to-number (match-string 3 s)))
+ (if minus
+ (setq res (- (+ (* hour 3600) (* min 60))))
+ (setq res (+ (* hour 3600) (* min 60)))))
+ (t (setq res (string-to-number s))))
+ (number-to-string res))))
(defun org-table-time-seconds-to-string (secs &optional output-format)
"Convert a number of seconds to a time string.
@@ -3570,7 +3596,7 @@ With prefix ARG, apply the new formulas to the table."
(if (get-buffer-window (marker-buffer pos))
(select-window (get-buffer-window (marker-buffer pos)))
(org-switch-to-buffer-other-window (get-buffer-window
- (marker-buffer pos)))))
+ (marker-buffer pos)))))
(goto-char pos)
(org-table-force-dataline)
(when dest
@@ -3779,7 +3805,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
"Toggle the display of Row/Column numbers in tables."
(interactive)
(setq org-table-overlay-coordinates (not org-table-overlay-coordinates))
- (message "Row/Column number display turned %s"
+ (message "Tables Row/Column numbers display turned %s"
(if org-table-overlay-coordinates "on" "off"))
(if (and (org-at-table-p) org-table-overlay-coordinates)
(org-table-align))
@@ -3835,7 +3861,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
"Local variable used by `orgtbl-mode'.")
(defconst orgtbl-line-start-regexp
- "[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\|TBLNAME\\):\\)"
+ "[ \t]*\\(|\\|#\\+\\(tblfm\\|orgtbl\\|tblname\\):\\)"
"Matches a line belonging to an orgtbl.")
(defconst orgtbl-extra-font-lock-keywords
@@ -3853,7 +3879,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
:lighter " OrgTbl" :keymap orgtbl-mode-map
(org-load-modules-maybe)
(cond
- ((eq major-mode 'org-mode)
+ ((derived-mode-p 'org-mode)
;; Exit without error, in case some hook functions calls this
;; by accident in org-mode.
(message "Orgtbl-mode is not useful in org-mode, command ignored"))
@@ -3975,37 +4001,37 @@ to execute outside of tables."
;; Special treatment needed for TAB and RET
(org-defkey orgtbl-mode-map [(return)]
- (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
+ (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
(org-defkey orgtbl-mode-map "\C-m"
- (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
+ (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
(org-defkey orgtbl-mode-map [(tab)]
- (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
+ (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
(org-defkey orgtbl-mode-map "\C-i"
- (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
+ (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
(org-defkey orgtbl-mode-map [(shift tab)]
- (orgtbl-make-binding 'org-table-previous-field 104
- [(shift tab)] [(tab)] "\C-i"))
+ (orgtbl-make-binding 'org-table-previous-field 104
+ [(shift tab)] [(tab)] "\C-i"))
(unless (featurep 'xemacs)
(org-defkey orgtbl-mode-map [S-iso-lefttab]
- (orgtbl-make-binding 'org-table-previous-field 107
- [S-iso-lefttab] [backtab] [(shift tab)]
- [(tab)] "\C-i")))
+ (orgtbl-make-binding 'org-table-previous-field 107
+ [S-iso-lefttab] [backtab] [(shift tab)]
+ [(tab)] "\C-i")))
(org-defkey orgtbl-mode-map [backtab]
- (orgtbl-make-binding 'org-table-previous-field 108
- [backtab] [S-iso-lefttab] [(shift tab)]
- [(tab)] "\C-i"))
+ (orgtbl-make-binding 'org-table-previous-field 108
+ [backtab] [S-iso-lefttab] [(shift tab)]
+ [(tab)] "\C-i"))
(org-defkey orgtbl-mode-map "\M-\C-m"
- (orgtbl-make-binding 'org-table-wrap-region 105
- "\M-\C-m" [(meta return)]))
+ (orgtbl-make-binding 'org-table-wrap-region 105
+ "\M-\C-m" [(meta return)]))
(org-defkey orgtbl-mode-map [(meta return)]
- (orgtbl-make-binding 'org-table-wrap-region 106
- [(meta return)] "\M-\C-m"))
+ (orgtbl-make-binding 'org-table-wrap-region 106
+ [(meta return)] "\M-\C-m"))
(org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c)
(org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region)
@@ -4083,13 +4109,13 @@ to execute outside of tables."
If it is a table to be sent away to a receiver, do it.
With prefix arg, also recompute table."
(interactive "P")
- (let ((pos (point)) action consts-str consts cst const-str)
+ (let ((case-fold-search t) (pos (point)) action consts-str consts cst const-str)
(save-excursion
(beginning-of-line 1)
(setq action (cond
((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0))
((looking-at "[ \t]*|") pos)
- ((looking-at "[ \t]*#\\+TBLFM:") 'recalc))))
+ ((looking-at "[ \t]*#\\+tblfm:") 'recalc))))
(cond
((integerp action)
(goto-char action)
@@ -4178,7 +4204,7 @@ overwritten, and the table is not marked as requiring realignment."
(setq a (assoc last-input-event function-key-map))
(cdr a))
(vector last-input-event)))
- 'self-insert-command)))
+ 'self-insert-command)))
(call-interactively cmd)
(if (and org-self-insert-cluster-for-undo
(eq cmd 'self-insert-command))
@@ -4298,11 +4324,15 @@ this table."
(params (plist-get dest :params))
(skip (plist-get params :skip))
(skipcols (plist-get params :skipcols))
+ (no-escape (plist-get params :no-escape))
beg
(lines (org-table-clean-before-export
(nthcdr (or skip 0)
(org-split-string txt "[ \t]*\n[ \t]*"))))
(i0 (if org-table-clean-did-remove-column 2 1))
+ (lines (if no-escape lines
+ (mapcar (lambda(l) (replace-regexp-in-string
+ "\\([&%#_^]\\)" "\\\\\\1{}" l)) lines)))
(table (mapcar
(lambda (x)
(if (string-match org-table-hline-regexp x)
@@ -4324,7 +4354,7 @@ this table."
(orgtbl-send-replace-tbl name txt))
(setq ntbl (1+ ntbl)))
(message "Table converted and installed at %d receiver location%s"
- ntbl (if (> ntbl 1) "s" ""))
+ ntbl (if (> ntbl 1) "s" ""))
(if (> ntbl 0)
ntbl
nil))))
@@ -4344,12 +4374,13 @@ First element has index 0, or I0 if given."
(defun orgtbl-toggle-comment ()
"Comment or uncomment the orgtbl at point."
(interactive)
- (let* ((re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp))
+ (let* ((case-fold-search t)
+ (re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp))
(re2 (concat "^" orgtbl-line-start-regexp))
(commented (save-excursion (beginning-of-line 1)
- (cond ((looking-at re1) t)
- ((looking-at re2) nil)
- (t (error "Not at an org table")))))
+ (cond ((looking-at re1) t)
+ ((looking-at re2) nil)
+ (t (error "Not at an org table")))))
(re (if commented re1 re2))
beg end)
(save-excursion
@@ -4458,7 +4489,7 @@ PARAMS is a property list of parameters that can influence the conversion.
For the generic converter, some parameters are obligatory: you need to
specify either :lfmt, or all of (:lstart :lend :sep).
-Valid parameters are
+Valid parameters are:
:splice When set to t, return only table body lines, don't wrap
them into :tstart and :tend. Default is nil. When :splice
@@ -4471,9 +4502,9 @@ Valid parameters are
:sep Separator between two fields
:remove-nil-lines Do not include lines that evaluate to nil.
-
Each in the following group may be either a string or a function
of no arguments returning a string:
+
:tstart String to start the table. Ignored when :splice is t.
:tend String to end the table. Ignored when :splice is t.
:lstart String to start a new table line.
@@ -4484,6 +4515,7 @@ of no arguments returning a string:
Each in the following group may be a string, a function of one
argument (the field or line) returning a string, or a plist
mapping columns to either of the above:
+
:lfmt Format for entire line, with enough %s to capture all fields.
If this is present, :lstart, :lend, and :sep are ignored.
:llfmt Format for the entire last line, defaults to :lfmt.
@@ -4491,14 +4523,14 @@ mapping columns to either of the above:
%s for the original field value. For example, to wrap
everything in dollars, you could use :fmt \"$%s$\".
This may also be a property list with column numbers and
- formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
-
+ formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt
Same as above, specific for the header lines in the table.
All lines before the first hline are treated as header.
If any of these is not present, the data line value is used.
This may be either a string or a function of two arguments:
+
:efmt Use this format to print numbers with exponentials.
The format should have %s twice for inserting mantissa
and exponent, for example \"%s\\\\times10^{%s}\". This
@@ -4507,10 +4539,9 @@ This may be either a string or a function of two arguments:
In addition to this, the parameters :skip and :skipcols are always handled
directly by `orgtbl-send-table'. See manual."
- (interactive)
-
(let* ((splicep (plist-get params :splice))
(hline (plist-get params :hline))
+ (skipheadrule (plist-get params :skipheadrule))
(remove-nil-linesp (plist-get params :remove-nil-lines))
(remove-newlines (plist-get params :remove-newlines))
(*orgtbl-hline* hline)
@@ -4556,7 +4587,7 @@ directly by `orgtbl-send-table'. See manual."
(*orgtbl-sep* (or (plist-get params :hlsep) *orgtbl-sep*))
(*orgtbl-fmt* (or (plist-get params :hfmt) *orgtbl-fmt*)))
(orgtbl-format-section 'hline))
- (if hline (push hline *orgtbl-rtn*))
+ (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*))
(pop *orgtbl-table*)))
;; Now format the main section.
@@ -4706,7 +4737,37 @@ provide ORGTBL directives for the generated table."
:lstart "| "
:lend " |"))
(params (org-combine-plists params2 params)))
- (orgtbl-to-generic table params)))
+ (with-temp-buffer
+ (insert (orgtbl-to-generic table params))
+ (goto-char (point-min))
+ (while (re-search-forward org-table-hline-regexp nil t)
+ (org-table-align))
+ (buffer-substring 1 (buffer-size)))))
+
+(defun orgtbl-to-table.el (table params)
+ "Convert the orgtbl-mode TABLE into a table.el table."
+ (with-temp-buffer
+ (insert (orgtbl-to-orgtbl table params))
+ (org-table-align)
+ (replace-regexp-in-string
+ "-|" "-+"
+ (replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size))))))
+
+(defun orgtbl-to-unicode (table params)
+ "Convert the orgtbl-mode TABLE into a table with unicode characters.
+You need the ascii-art-to-unicode.el package for this. You can download
+it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
+ (with-temp-buffer
+ (insert (orgtbl-to-table.el table params))
+ (goto-char (point-min))
+ (if (or (featurep 'ascii-art-to-unicode)
+ (require 'ascii-art-to-unicode nil t))
+ (aa2u)
+ (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links))
+ (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el"
+ "Link to ascii-art-to-unicode.el") org-stored-links))
+ (error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)"))
+ (buffer-string)))
(defun org-table-get-remote-range (name-or-id form)
"Get a field value or a list of values in a range from table at ID.
@@ -4722,7 +4783,7 @@ FORM is a field or range descriptor like \"@2$3\" or \"B3\" or
The return value is either a single string for a single field, or a
list of the fields in the rectangle ."
(save-match-data
- (let ((id-loc nil)
+ (let ((case-fold-search t) (id-loc nil)
;; Protect a bunch of variables from being overwritten
;; by the context of the remote table
org-table-column-names org-table-column-name-regexp
@@ -4741,7 +4802,7 @@ list of the fields in the rectangle ."
(save-excursion
(goto-char (point-min))
(if (re-search-forward
- (concat "^[ \t]*#\\+TBLNAME:[ \t]*" (regexp-quote name-or-id) "[ \t]*$")
+ (concat "^[ \t]*#\\+tblname:[ \t]*" (regexp-quote name-or-id) "[ \t]*$")
nil t)
(setq buffer (current-buffer) loc (match-beginning 0))
(setq id-loc (org-id-find name-or-id 'marker))
diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el
index 4409013589f..aa645d296e8 100644
--- a/lisp/org/org-taskjuggler.el
+++ b/lisp/org/org-taskjuggler.el
@@ -29,7 +29,7 @@
;;
;; This library implements a TaskJuggler exporter for org-mode.
;; TaskJuggler uses a text format to define projects, tasks and
-;; resources, so it is a natural fit for org-mode. It can produce all
+;; resources, so it is a natural fit for org-mode. It can produce all
;; sorts of reports for tasks or resources in either HTML, CSV or PDF.
;; The current version of TaskJuggler requires KDE but the next
;; version is implemented in Ruby and should therefore run on any
@@ -42,7 +42,7 @@
;;
;; Instead the TaskJuggler exporter looks for a tree that defines the
;; tasks and a optionally tree that defines the resources for this
-;; project. It then creates a TaskJuggler file based on these trees
+;; project. It then creates a TaskJuggler file based on these trees
;; and the attributes defined in all the nodes.
;;
;; * Installation
@@ -60,8 +60,8 @@
;;
;; * Tasks
;;
-;; Let's illustrate the usage with a small example. Create your tasks
-;; as you usually do with org-mode. Assign efforts to each task using
+;; Let's illustrate the usage with a small example. Create your tasks
+;; as you usually do with org-mode. Assign efforts to each task using
;; properties (it's easiest to do this in the column view). You should
;; end up with something similar to the example by Peter Jones in
;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org.
@@ -75,7 +75,7 @@
;; * Resources
;;
;; Next you can define resources and assign those to work on specific
-;; tasks. You can group your resources hierarchically. Tag the top
+;; tasks. You can group your resources hierarchically. Tag the top
;; node of the resources with "taskjuggler_resource" (or whatever you
;; customized `org-export-taskjuggler-resource-tag' to). You can
;; optionally assign an identifier (named "resource_id") to the
@@ -84,8 +84,8 @@
;; picks the first word of the headline as the identifier as long as
;; it is unique, see the documentation of
;; `org-taskjuggler-get-unique-id'). Using that identifier you can
-;; then allocate resources to tasks. This is again done with the
-;; "allocate" property on the tasks. Do this in column view or when on
+;; then allocate resources to tasks. This is again done with the
+;; "allocate" property on the tasks. Do this in column view or when on
;; the task type
;;
;; C-c C-x p allocate RET <resource_id> RET
@@ -110,13 +110,13 @@
;; The exporter will handle dependencies that are defined in the tasks
;; either with the ORDERED attribute (see TODO dependencies in the Org
;; mode manual) or with the BLOCKER attribute (see org-depend.el) or
-;; alternatively with a depends attribute. Both the BLOCKER and the
+;; alternatively with a depends attribute. Both the BLOCKER and the
;; depends attribute can be either "previous-sibling" or a reference
;; to an identifier (named "task_id") which is defined for another
-;; task in the project. BLOCKER and the depends attribute can define
-;; multiple dependencies separated by either space or comma. You can
+;; task in the project. BLOCKER and the depends attribute can define
+;; multiple dependencies separated by either space or comma. You can
;; also specify optional attributes on the dependency by simply
-;; appending it. The following examples should illustrate this:
+;; appending it. The following examples should illustrate this:
;;
;; * Training material
;; :PROPERTIES:
@@ -144,7 +144,7 @@
;; org-global-properties-fixed
;; - What about property inheritance and org-property-inherit-p?
;; - Use TYPE_TODO as an way to assign resources
-;; - Make sure multiple dependency definitions (i.e. BLOCKER on
+;; - Make sure multiple dependency definitions (i.e. BLOCKER on
;; previous-sibling and on a specific task_id) in multiple
;; attributes are properly exported.
;;
@@ -211,7 +211,7 @@ with `org-export-taskjuggler-project-tag'"
hideresource 1
loadunit shortauto
}"
-"resourcereport \"Resource Graph\" {
+ "resourcereport \"Resource Graph\" {
headline \"Resource Allocation Graph\"
columns no, name, utilization, freeload, chart
loadunit shortauto
@@ -228,10 +228,10 @@ with `org-export-taskjuggler-project-tag'"
workinghours wed, thu, fri off
}
"
- "Default global properties for the project. Here you typically
+ "Default global properties for the project. Here you typically
define global properties such as shifts, accounts, rates,
-vacation, macros and flags. Any property that is allowed within
-the TaskJuggler file can be inserted. You could for example
+vacation, macros and flags. Any property that is allowed within
+the TaskJuggler file can be inserted. You could for example
include another TaskJuggler file.
The global properties are inserted after the project declaration
@@ -255,12 +255,12 @@ but before any resource and task declarations."
"Export parts of the current buffer as a TaskJuggler file.
The exporter looks for a tree with tag, property or todo that
matches `org-export-taskjuggler-project-tag' and takes this as
-the tasks for this project. The first node of this tree defines
+the tasks for this project. The first node of this tree defines
the project properties such as project name and project period.
If there is a tree with tag, property or todo that matches
`org-export-taskjuggler-resource-tag' this three is taken as
-resources for the project. If no resources are specified, a
-default resource is created and allocated to the project. Also
+resources for the project. If no resources are specified, a
+default resource is created and allocated to the project. Also
the taskjuggler project will be created with default reports as
defined in `org-export-taskjuggler-default-reports'."
(interactive)
@@ -352,7 +352,7 @@ with the TaskJuggler GUI."
(defun org-taskjuggler-parent-is-ordered-p ()
"Return true if the parent of the current node has a property
-\"ORDERED\". Return nil otherwise."
+\"ORDERED\". Return nil otherwise."
(save-excursion
(and (org-up-heading-safe) (org-entry-get (point) "ORDERED"))))
@@ -373,7 +373,7 @@ information, all the properties, etc."
(defun org-taskjuggler-assign-task-ids (tasks)
"Given a list of tasks return the same list assigning a unique id
-and the full path to each task. Taskjuggler takes hierarchical ids.
+and the full path to each task. Taskjuggler takes hierarchical ids.
For that reason we have to make ids locally unique and we have to keep
a path to the current task."
(let ((previous-level 0)
@@ -406,7 +406,7 @@ a path to the current task."
(defun org-taskjuggler-compute-task-leafiness (tasks)
"Figure out if each task is a leaf by looking at it's level,
-and the level of its successor. If the successor is higher (ie
+and the level of its successor. If the successor is higher (ie
deeper), then it's not a leaf."
(let (new-list)
(while (car tasks)
@@ -452,8 +452,8 @@ unique id to each resource."
(and depends (org-taskjuggler-tokenize-dependencies depends))
(and blocker (org-taskjuggler-tokenize-dependencies blocker)))
tasks))
- previous-sibling)
- ; update previous sibling info
+ previous-sibling)
+ ; update previous sibling info
(cond
((< previous-level level)
(dotimes (tmp (- level previous-level))
@@ -466,11 +466,11 @@ unique id to each resource."
(pop siblings))
(setq previous-sibling (car siblings))
(setcar siblings task)))
- ; insert a dependency on previous sibling if the parent is
- ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling"
+ ; insert a dependency on previous sibling if the parent is
+ ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling"
(when (or (and previous-sibling parent-ordered) blocked-on-previous)
(push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies))
- ; store dependency information
+ ; store dependency information
(when dependencies
(push (cons "depends" (mapconcat 'identity dependencies ", ")) task))
(setq previous-level level)
@@ -480,7 +480,7 @@ unique id to each resource."
"Split a dependency property value DEPENDENCIES into the
individual dependencies and return them as a list while keeping
the optional arguments (such as gapduration) for the
-dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'."
+dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'."
(cond
((string-match "^ *$" dependencies) nil)
((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies)
@@ -493,7 +493,7 @@ dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'."
"For each dependency in DEPENDENCIES try to find a
corresponding task with a matching property \"task_id\" in TASKS.
Return a list containing the resolved links for all DEPENDENCIES
-where a matching tasks was found. If the dependency is
+where a matching tasks was found. If the dependency is
\"previous-sibling\" it is ignored (as this is dealt with in
`org-taskjuggler-resolve-dependencies'). If there is no matching
task the dependency is ignored and a warning is displayed ."
@@ -523,7 +523,7 @@ task the dependency is ignored and a warning is displayed ."
(org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))))))
(defun org-taskjuggler-find-task-with-id (id tasks)
- "Find ID in tasks. If found return the path of task. Otherwise
+ "Find ID in tasks. If found return the path of task. Otherwise
return nil."
(let ((task-id (cdr (assoc "task_id" (car tasks))))
(path (cdr (assoc "path" (car tasks)))))
@@ -541,10 +541,10 @@ finally add more underscore characters (\"_\")."
(let* ((headline (cdr (assoc "headline" item)))
(parts (split-string headline))
(id (org-taskjuggler-clean-id (downcase (pop parts)))))
- ; try to add more parts of the headline to make it unique
+ ; try to add more parts of the headline to make it unique
(while (and (member id unique-ids) (car parts))
(setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts))))))
- ; if its still not unique add "_"
+ ; if its still not unique add "_"
(while (member id unique-ids)
(setq id (concat id "_")))
id))
@@ -559,8 +559,8 @@ finally add more underscore characters (\"_\")."
(replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id))))
(defun org-taskjuggler-open-project (project)
- "Insert the beginning of a project declaration. All valid
-attributes from the PROJECT alist are inserted. If no end date is
+ "Insert the beginning of a project declaration. All valid
+attributes from the PROJECT alist are inserted. If no end date is
specified it is calculated
`org-export-taskjuggler-default-project-duration' days from now."
(let* ((unique-id (cdr (assoc "unique-id" project)))
@@ -580,9 +580,9 @@ with separator \"\n\"."
(and filtered-items (mapconcat 'identity filtered-items "\n"))))
(defun org-taskjuggler-get-attributes (item attributes)
- "Return all attribute as a single formatted string. ITEM is an
-alist representing either a resource or a task. ATTRIBUTES is a
-list of symbols. Only entries from ITEM are considered that are
+ "Return all attribute as a single formatted string. ITEM is an
+alist representing either a resource or a task. ATTRIBUTES is a
+list of symbols. Only entries from ITEM are considered that are
listed in ATTRIBUTES."
(org-taskjuggler-filter-and-join
(mapcar
@@ -603,10 +603,10 @@ If the ATTRIBUTE is not in ITEM return nil."
(t (org-taskjuggler-get-attribute (cdr item) attribute))))
(defun org-taskjuggler-open-resource (resource)
- "Insert the beginning of a resource declaration. All valid
-attributes from the RESOURCE alist are inserted. If the RESOURCE
+ "Insert the beginning of a resource declaration. All valid
+attributes from the RESOURCE alist are inserted. If the RESOURCE
defines a property \"resource_id\" it will be used as the id for
-this resource. Otherwise it will use the ID property. If neither
+this resource. Otherwise it will use the ID property. If neither
is defined it will calculate a unique id for the resource using
`org-taskjuggler-get-unique-id'."
(let ((id (org-taskjuggler-clean-id
@@ -622,7 +622,7 @@ is defined it will calculate a unique id for the resource using
(defun org-taskjuggler-clean-effort (effort)
"Translate effort strings into a format acceptable to taskjuggler,
-i.e. REAL UNIT. A valid effort string can be anything that is
+i.e. REAL UNIT. A valid effort string can be anything that is
accepted by `org-duration-string-to-minutes´."
(cond
((null effort) effort)
diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el
index a3bde0fd7f6..92aaf1c7bb8 100644
--- a/lisp/org/org-timer.el
+++ b/lisp/org/org-timer.el
@@ -56,6 +56,22 @@ When 0, the user is prompted for a value."
:version "24.1"
:type 'number)
+(defcustom org-timer-display 'mode-line
+ "When a timer is running, org-mode can display it in the mode
+line and/or frame title.
+Allowed values are:
+
+both displays in both mode line and frame title
+mode-line displays only in mode line (default)
+frame-title displays only in frame title
+nil current timer is not displayed"
+ :group 'org-time
+ :type '(choice
+ (const :tag "Mode line" mode-line)
+ (const :tag "Frame title" frame-title)
+ (const :tag "Both" both)
+ (const :tag "None" nil)))
+
(defvar org-timer-start-hook nil
"Hook run after relative timer is started.")
@@ -66,7 +82,7 @@ When 0, the user is prompted for a value."
"Hook run before relative timer is paused.")
(defvar org-timer-continue-hook nil
- "Hook run after relative timer is continued.")
+ "Hook run after relative timer is continued.")
(defvar org-timer-set-hook nil
"Hook run after countdown timer is set.")
@@ -114,6 +130,7 @@ the region 0:00:00."
(org-timer-secs-to-hms (or delta 0)))
(run-hooks 'org-timer-start-hook))))
+;;;###autoload
(defun org-timer-pause-or-continue (&optional stop)
"Pause or continue the relative timer.
With prefix arg STOP, stop it entirely."
@@ -140,6 +157,7 @@ With prefix arg STOP, stop it entirely."
(org-timer-set-mode-line 'pause)
(message "Timer paused at %s" (org-timer-value-string)))))
+;;;###autoload
(defun org-timer-stop ()
"Stop the relative timer."
(interactive)
@@ -181,7 +199,7 @@ it in the buffer."
(defun org-timer-change-times-in-region (beg end delta)
"Change all h:mm:ss time in region by a DELTA."
(interactive
- "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ")
+ "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ")
(let ((re "[-+]?[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}") p)
(unless (string-match "\\S-" delta)
(save-excursion
@@ -224,7 +242,7 @@ it in the buffer."
;; Else, start a new list.
(t
(beginning-of-line)
- (org-indent-line-function)
+ (org-indent-line)
(insert "- ")
(org-timer (when arg '(4)))
(insert ":: ")))))
@@ -270,32 +288,54 @@ If the integer is negative, the string will start with \"-\"."
(defun org-timer-set-mode-line (value)
"Set the mode-line display of the relative timer.
VALUE can be `on', `off', or `pause'."
- (or global-mode-string (setq global-mode-string '("")))
- (or (memq 'org-timer-mode-line-string global-mode-string)
- (setq global-mode-string
- (append global-mode-string '(org-timer-mode-line-string))))
+ (when (or (eq org-timer-display 'mode-line)
+ (eq org-timer-display 'both))
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'org-timer-mode-line-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(org-timer-mode-line-string)))))
+ (when (or (eq org-timer-display 'frame-title)
+ (eq org-timer-display 'both))
+ (or (memq 'org-timer-mode-line-string frame-title-format)
+ (setq frame-title-format
+ (append frame-title-format '(org-timer-mode-line-string)))))
(cond
((equal value 'off)
(when org-timer-mode-line-timer
(cancel-timer org-timer-mode-line-timer)
(setq org-timer-mode-line-timer nil))
- (setq global-mode-string
- (delq 'org-timer-mode-line-string global-mode-string))
+ (when (or (eq org-timer-display 'mode-line)
+ (eq org-timer-display 'both))
+ (setq global-mode-string
+ (delq 'org-timer-mode-line-string global-mode-string)))
+ (when (or (eq org-timer-display 'frame-title)
+ (eq org-timer-display 'both))
+ (setq frame-title-format
+ (delq 'org-timer-mode-line-string frame-title-format)))
(force-mode-line-update))
((equal value 'pause)
(when org-timer-mode-line-timer
(cancel-timer org-timer-mode-line-timer)
(setq org-timer-mode-line-timer nil)))
((equal value 'on)
- (or global-mode-string (setq global-mode-string '("")))
- (or (memq 'org-timer-mode-line-string global-mode-string)
- (setq global-mode-string
- (append global-mode-string '(org-timer-mode-line-string))))
+ (when (or (eq org-timer-display 'mode-line)
+ (eq org-timer-display 'both))
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'org-timer-mode-line-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(org-timer-mode-line-string)))))
+ (when (or (eq org-timer-display 'frame-title)
+ (eq org-timer-display 'both))
+ (or (memq 'org-timer-mode-line-string frame-title-format)
+ (setq frame-title-format
+ (append frame-title-format '(org-timer-mode-line-string)))))
(org-timer-update-mode-line)
(when org-timer-mode-line-timer
- (cancel-timer org-timer-mode-line-timer))
- (setq org-timer-mode-line-timer
- (run-with-timer 1 1 'org-timer-update-mode-line)))))
+ (cancel-timer org-timer-mode-line-timer)
+ (setq org-timer-mode-line-timer nil))
+ (when org-timer-display
+ (setq org-timer-mode-line-timer
+ (run-with-timer 1 1 'org-timer-update-mode-line))))))
(defun org-timer-update-mode-line ()
"Update the timer time in the mode line."
@@ -358,48 +398,48 @@ replace any running timer."
(number-to-string org-timer-default-timer))))))
(if (not (string-match "[0-9]+" minutes))
(org-timer-show-remaining-time)
- (let* ((mins (string-to-number (match-string 0 minutes)))
- (secs (* mins 60))
- (hl (cond
- ((string-match "Org Agenda" (buffer-name))
- (let* ((marker (or (get-text-property (point) 'org-marker)
- (org-agenda-error)))
- (hdmarker (or (get-text-property (point) 'org-hd-marker)
- marker))
- (pos (marker-position marker)))
- (with-current-buffer (marker-buffer marker)
- (widen)
- (goto-char pos)
- (org-show-entry)
- (or (ignore-errors (org-get-heading))
- (concat "File:" (file-name-nondirectory (buffer-file-name)))))))
- ((eq major-mode 'org-mode)
- (or (ignore-errors (org-get-heading))
- (concat "File:" (file-name-nondirectory (buffer-file-name)))))
- (t (error "Not in an Org buffer"))))
- timer-set)
- (if (or (and org-timer-current-timer
- (or (equal opt '(16))
- (y-or-n-p "Replace current timer? ")))
- (not org-timer-current-timer))
- (progn
- (require 'org-clock)
- (when org-timer-current-timer
- (cancel-timer org-timer-current-timer))
- (setq org-timer-current-timer
- (run-with-timer
- secs nil `(lambda ()
- (setq org-timer-current-timer nil)
- (org-notify ,(format "%s: time out" hl) t)
- (setq org-timer-timer-is-countdown nil)
- (org-timer-set-mode-line 'off)
- (run-hooks 'org-timer-done-hook))))
- (run-hooks 'org-timer-set-hook)
- (setq org-timer-timer-is-countdown t
- org-timer-start-time
- (time-add (current-time) (seconds-to-time (* mins 60))))
- (org-timer-set-mode-line 'on))
- (message "No timer set"))))))
+ (let* ((mins (string-to-number (match-string 0 minutes)))
+ (secs (* mins 60))
+ (hl (cond
+ ((string-match "Org Agenda" (buffer-name))
+ (let* ((marker (or (get-text-property (point) 'org-marker)
+ (org-agenda-error)))
+ (hdmarker (or (get-text-property (point) 'org-hd-marker)
+ marker))
+ (pos (marker-position marker)))
+ (with-current-buffer (marker-buffer marker)
+ (widen)
+ (goto-char pos)
+ (org-show-entry)
+ (or (ignore-errors (org-get-heading))
+ (concat "File:" (file-name-nondirectory (buffer-file-name)))))))
+ ((derived-mode-p 'org-mode)
+ (or (ignore-errors (org-get-heading))
+ (concat "File:" (file-name-nondirectory (buffer-file-name)))))
+ (t (error "Not in an Org buffer"))))
+ timer-set)
+ (if (or (and org-timer-current-timer
+ (or (equal opt '(16))
+ (y-or-n-p "Replace current timer? ")))
+ (not org-timer-current-timer))
+ (progn
+ (require 'org-clock)
+ (when org-timer-current-timer
+ (cancel-timer org-timer-current-timer))
+ (setq org-timer-current-timer
+ (run-with-timer
+ secs nil `(lambda ()
+ (setq org-timer-current-timer nil)
+ (org-notify ,(format "%s: time out" hl) t)
+ (setq org-timer-timer-is-countdown nil)
+ (org-timer-set-mode-line 'off)
+ (run-hooks 'org-timer-done-hook))))
+ (run-hooks 'org-timer-set-hook)
+ (setq org-timer-timer-is-countdown t
+ org-timer-start-time
+ (time-add (current-time) (seconds-to-time (* mins 60))))
+ (org-timer-set-mode-line 'on))
+ (message "No timer set"))))))
(provide 'org-timer)
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
new file mode 100644
index 00000000000..688947def52
--- /dev/null
+++ b/lisp/org/org-version.el
@@ -0,0 +1,27 @@
+;;; org-version.el --- autogenerated file, do not edit
+;;
+;;; Code:
+;;;###autoload
+(defun org-release ()
+ "The release version of org-mode.
+ Inserted by installing org-mode or when a release is made."
+ (let ((org-release "7.9.2"))
+ org-release))
+;;;###autoload
+(defun org-git-version ()
+ "The Git version of org-mode.
+ Inserted by installing org-mode or when a release is made."
+ (let ((org-git-version "7.9.2-GNU-Emacs-24-3"))
+ org-git-version))
+;;;###autoload
+(defconst org-odt-data-dir "/usr/share/emacs/etc/org"
+ "The location of ODT styles.")
+
+(provide 'org-version)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; coding: utf-8
+;; End:
+;;; org-version.el ends here
diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el
index b6975ff1157..b919cd19fea 100644
--- a/lisp/org/org-vm.el
+++ b/lisp/org/org-vm.el
@@ -6,6 +6,10 @@
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;;
+;; Support for IMAP folders added
+;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net>
+;; Requires VM 8.2.0a or later.
+;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -42,11 +46,17 @@
(declare-function vm-su-message-id "ext:vm-summary" (m))
(declare-function vm-su-subject "ext:vm-summary" (m))
(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
+(declare-function vm-imap-folder-p "ext:vm-save" ())
+(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer))
+(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec))
+(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec))
+(declare-function vm-imap-spec-for-account "ext:vm-imap" (account))
(defvar vm-message-pointer)
(defvar vm-folder-directory)
;; Install the link type
(org-add-link-type "vm" 'org-vm-open)
+(org-add-link-type "vm-imap" 'org-vm-imap-open)
(add-hook 'org-store-link-functions 'org-vm-store-link)
;; Implementation
@@ -61,11 +71,11 @@
(save-excursion
(vm-select-folder-buffer)
(let* ((message (car vm-message-pointer))
- (folder buffer-file-name)
- (subject (vm-su-subject message))
+ (subject (vm-su-subject message))
(to (vm-get-header-contents message "To"))
(from (vm-get-header-contents message "From"))
- (message-id (vm-su-message-id message))
+ (message-id (vm-su-message-id message))
+ (link-type (if (vm-imap-folder-p) "vm-imap" "vm"))
(date (vm-get-header-contents message "Date"))
(date-ts (and date (format-time-string
(org-time-stamp-format t)
@@ -73,20 +83,24 @@
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
- desc link)
- (org-store-link-props :type "vm" :from from :to to :subject subject
+ folder desc link)
+ (if (vm-imap-folder-p)
+ (let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
+ (setq folder (vm-imap-folder-for-spec spec)))
+ (progn
+ (setq folder (abbreviate-file-name buffer-file-name))
+ (if (and vm-folder-directory
+ (string-match (concat "^" (regexp-quote vm-folder-directory))
+ folder))
+ (setq folder (replace-match "" t t folder)))))
+ (setq message-id (org-remove-angle-brackets message-id))
+ (org-store-link-props :type link-type :from from :to to :subject subject
:message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
- (setq message-id (org-remove-angle-brackets message-id))
- (setq folder (abbreviate-file-name folder))
- (if (and vm-folder-directory
- (string-match (concat "^" (regexp-quote vm-folder-directory))
- folder))
- (setq folder (replace-match "" t t folder)))
(setq desc (org-email-link-description))
- (setq link (org-make-link "vm:" folder "#" message-id))
+ (setq link (concat (concat link-type ":") folder "#" message-id))
(org-add-link-props :link link :description desc)
link))))
@@ -121,21 +135,46 @@
(setq folder (format "/%s@%s:%s" user host file))))))
(when folder
(funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
- (sit-for 0.1)
(when article
- (require 'vm-search)
- (vm-select-folder-buffer)
- (widen)
- (let ((case-fold-search t))
- (goto-char (point-min))
- (if (not (re-search-forward
- (concat "^" "message-id: *" (regexp-quote article))))
- (error "Could not find the specified message in this folder"))
- (vm-isearch-update)
- (vm-isearch-narrow)
- (vm-preview-current-message)
- (vm-summarize)))))
+ (org-vm-select-message (org-add-angle-brackets article)))))
+
+(defun org-vm-imap-open (path)
+ "Follow a VM link to an IMAP folder."
+ (require 'vm-imap)
+ (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path)
+ (let* ((account-name (match-string 1 path))
+ (mailbox-name (match-string 2 path))
+ (message-id (match-string 3 path))
+ (account-spec (vm-imap-parse-spec-to-list
+ (vm-imap-spec-for-account account-name)))
+ (mailbox-spec (mapconcat 'identity
+ (append (butlast account-spec 4)
+ (cons mailbox-name
+ (last account-spec 3)))
+ ":")))
+ (funcall (cdr (assq 'vm-imap org-link-frame-setup))
+ mailbox-spec)
+ (when message-id
+ (org-vm-select-message (org-add-angle-brackets message-id))))))
+
+(defun org-vm-select-message (message-id)
+ "Go to the message with message-id in the current folder."
+ (require 'vm-search)
+ (sit-for 0.1)
+ (vm-select-folder-buffer)
+ (widen)
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (if (not (re-search-forward
+ (concat "^" "message-id: *" (regexp-quote message-id))))
+ (error "Could not find the specified message in this folder"))
+ (vm-isearch-update)
+ (vm-isearch-narrow)
+ (vm-preview-current-message)
+ (vm-summarize)))
(provide 'org-vm)
+
+
;;; org-vm.el ends here
diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el
index 8a79ec0d765..724b07a288c 100644
--- a/lisp/org/org-wl.el
+++ b/lisp/org/org-wl.el
@@ -34,9 +34,9 @@
(require 'org)
(defgroup org-wl nil
- "Options concerning the Wanderlust link."
- :tag "Org Startup"
- :group 'org-link)
+ "Options concerning the Wanderlust link."
+ :tag "Org Startup"
+ :group 'org-link)
(defcustom org-wl-link-to-refile-destination t
"Create a link to the refile destination if the message is marked as refile."
@@ -161,7 +161,7 @@ ENTITY is a message entity."
"Store a link to a WL folder."
(let* ((folder (wl-folder-get-entity-from-buffer))
(petname (wl-folder-get-petname folder))
- (link (org-make-link "wl:" folder)))
+ (link (concat "wl:" folder)))
(save-excursion
(beginning-of-line)
(unless (and (wl-folder-buffer-group-p)
@@ -246,7 +246,7 @@ ENTITY is a message entity."
:subject subject :message-id message-id
:message-id-no-brackets message-id-no-brackets)
(setq desc (org-email-link-description))
- (setq link (org-make-link "wl:" folder-name "#" message-id-no-brackets))
+ (setq link (concat "wl:" folder-name "#" message-id-no-brackets))
(org-add-link-props :link link :description desc)))
(when date
(org-add-link-props :date date :date-timestamp date-ts
@@ -309,7 +309,7 @@ for namazu index."
article))
(or (wl-summary-jump-to-msg (string-to-number article))
(error "No such message: %s" article)))
- (wl-summary-redisplay))))))
+ (wl-summary-redisplay))))))
(provide 'org-wl)
diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el
index a282fbf1808..ee549627a85 100644
--- a/lisp/org/org-xoxo.el
+++ b/lisp/org/org-xoxo.el
@@ -49,7 +49,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
(with-current-buffer (get-buffer buffer)
(let* ((pos (point))
(opt-plist (org-combine-plists (org-default-export-plist)
- (org-infile-export-plist)))
+ (org-infile-export-plist)))
(filename (concat (file-name-as-directory
(org-export-directory :xoxo opt-plist))
(file-name-sans-extension
diff --git a/lisp/org/org.el b/lisp/org/org.el
index f431c19bf51..cfd86513fbc 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -1,4 +1,5 @@
;;; org.el --- Outline-based notes management and organizer
+
;; Carstens outline-mode for keeping track of everything.
;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;;
@@ -6,7 +7,6 @@
;; Maintainer: Bastien Guerry <bzg at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.8.11
;;
;; This file is part of GNU Emacs.
;;
@@ -75,8 +75,28 @@
(require 'gnus-sum))
(require 'calendar)
+(require 'find-func)
(require 'format-spec)
+;; `org-outline-regexp' ought to be a defconst but is let-binding in
+;; some places -- e.g. see the macro org-with-limited-levels.
+;;
+;; In Org buffers, the value of `outline-regexp' is that of
+;; `org-outline-regexp'. The only function still directly relying on
+;; `outline-regexp' is `org-overview' so that `org-cycle' can do its
+;; job when `orgstruct-mode' is active.
+(defvar org-outline-regexp "\\*+ "
+ "Regexp to match Org headlines.")
+
+(defvar org-outline-regexp-bol "^\\*+ "
+ "Regexp to match Org headlines.
+This is similar to `org-outline-regexp' but additionally makes
+sure that we are at the beginning of the line.")
+
+(defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Matches an headline, putting stars and text into groups.
+Stars are put in group 1 and the trimmed body in group 2.")
+
;; Emacs 22 calendar compatibility: Make sure the new variables are available
(when (fboundp 'defvaralias)
(unless (boundp 'calendar-view-holidays-initially-flag)
@@ -88,22 +108,6 @@
(unless (boundp 'diary-fancy-buffer)
(defvaralias 'diary-fancy-buffer 'fancy-diary-buffer)))
-(require 'outline) (require 'noutline)
-;; Other stuff we need.
-(require 'time-date)
-(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
-(require 'easymenu)
-(require 'overlay)
-
-(require 'org-macs)
-(require 'org-entities)
-(require 'org-compat)
-(require 'org-faces)
-(require 'org-list)
-(require 'org-pcomplete)
-(require 'org-src)
-(require 'org-footnote)
-
(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
@@ -111,15 +115,7 @@
(declare-function org-at-clock-log-p "org-clock" ())
(declare-function org-clock-timestamps-up "org-clock" ())
(declare-function org-clock-timestamps-down "org-clock" ())
-
-;; babel
-(require 'ob)
-(require 'ob-table)
-(require 'ob-lob)
-(require 'ob-ref)
-(require 'ob-tangle)
-(require 'ob-comint)
-(require 'ob-keys)
+(declare-function org-clock-sum-current-item "org-clock" (&optional tstart))
;; load languages based on value of `org-babel-load-languages'
(defvar org-babel-load-languages)
@@ -169,11 +165,13 @@ requirements) is loaded."
(const :tag "Fortran" fortran)
(const :tag "Gnuplot" gnuplot)
(const :tag "Haskell" haskell)
+ (const :tag "IO" io)
(const :tag "Java" java)
(const :tag "Javascript" js)
- (const :tag "Latex" latex)
+ (const :tag "LaTeX" latex)
(const :tag "Ledger" ledger)
(const :tag "Lilypond" lilypond)
+ (const :tag "Lisp" lisp)
(const :tag "Maxima" maxima)
(const :tag "Matlab" matlab)
(const :tag "Mscgen" mscgen)
@@ -186,6 +184,7 @@ requirements) is loaded."
(const :tag "Python" python)
(const :tag "Ruby" ruby)
(const :tag "Sass" sass)
+ (const :tag "Scala" scala)
(const :tag "Scheme" scheme)
(const :tag "Screen" screen)
(const :tag "Shell Script" sh)
@@ -205,38 +204,40 @@ identifier."
:group 'org-id)
;;; Version
-
-(defconst org-version "7.8.11"
- "The version number of the file org.el.")
-
+(require 'org-compat)
+(org-check-version)
;;;###autoload
-(defun org-version (&optional here)
+(defun org-version (&optional here full message)
"Show the org-mode version in the echo area.
-With prefix arg HERE, insert it at point."
+With prefix argument HERE, insert it at point.
+When FULL is non-nil, use a verbose version string.
+When MESSAGE is non-nil, display a message with the version."
(interactive "P")
- (let* ((origin default-directory)
- (version org-version)
- (git-version)
- (dir (concat (file-name-directory (locate-library "org")) "../" )))
- (when (and (file-exists-p (expand-file-name ".git" dir))
- (executable-find "git"))
- (unwind-protect
- (progn
- (cd dir)
- (when (eql 0 (shell-command "git describe --abbrev=4 HEAD"))
- (with-current-buffer "*Shell Command Output*"
- (goto-char (point-min))
- (setq git-version (buffer-substring (point) (point-at-eol))))
- (subst-char-in-string ?- ?. git-version t)
- (when (string-match "\\S-"
- (shell-command-to-string
- "git diff-index --name-only HEAD --"))
- (setq git-version (concat git-version ".dirty")))
- (setq version (concat version " (" git-version ")"))))
- (cd origin)))
- (setq version (format "Org-mode version %s" version))
- (if here (insert version))
- (message version)))
+ (let* ((org-dir (ignore-errors (org-find-library-dir "org")))
+ (org-install-dir (ignore-errors (org-find-library-dir "org-install.el")))
+ (org-trash (or
+ (and (fboundp 'org-release) (fboundp 'org-git-version))
+ (load (concat org-dir "org-version.el")
+ 'noerror 'nomessage 'nosuffix)))
+ (org-version (org-release))
+ (git-version (org-git-version))
+ (version (format "Org-mode version %s (%s @ %s)"
+ org-version
+ git-version
+ (if org-install-dir
+ (if (string= org-dir org-install-dir)
+ org-install-dir
+ (concat "mixed installation! " org-install-dir " and " org-dir))
+ "org-install.el can not be found!")))
+ (_version (if full version org-version)))
+ (if (org-called-interactively-p 'interactive)
+ (if here
+ (insert version)
+ (message version))
+ (if message (message _version))
+ _version)))
+
+(defconst org-version (org-version))
;;; Compatibility constants
@@ -497,7 +498,7 @@ frequently in plain text.
Not all export backends support this, but HTML does.
-This option can also be set with the +OPTIONS line, e.g. \"^:nil\"."
+This option can also be set with the #+OPTIONS line, e.g. \"^:nil\"."
:group 'org-startup
:group 'org-export-translation
:version "24.1"
@@ -673,6 +674,13 @@ Changes become only effective after restarting Emacs."
:group 'org-keywords
:type 'string)
+(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\("
+ org-scheduled-string "\\|"
+ org-deadline-string "\\|"
+ org-closed-string "\\|"
+ org-clock-string "\\)")
+ "Matches a line with planning or clock info.")
+
(defcustom org-comment-string "COMMENT"
"Entries starting with this keyword will never be exported.
An entry can be toggled between COMMENT and normal with
@@ -691,7 +699,7 @@ An entry can be toggled between QUOTE and normal with
:type 'string)
(defconst org-repeat-re
- "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)"
+ "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)"
"Regular expression for specifying repeated events.
After a match, group 1 contains the repeat expression.")
@@ -815,7 +823,7 @@ commands should be active."
(function)))
(defcustom org-speed-commands-user nil
- "Alist of additional speed commands.
+ "Alist of additional speed commands.
This list will be checked before `org-speed-commands-default'
when the variable `org-use-speed-commands' is non-nil
and when the cursor is at the beginning of a headline.
@@ -826,15 +834,15 @@ to be called, or a form to be evaluated.
An entry that is just a list with a single string will be interpreted
as a descriptive headline that will be added when listing the speed
commands in the Help buffer using the `?' speed command."
- :group 'org-structure
- :type '(repeat :value ("k" . ignore)
- (choice :value ("k" . ignore)
- (list :tag "Descriptive Headline" (string :tag "Headline"))
- (cons :tag "Letter and Command"
- (string :tag "Command letter")
- (choice
- (function)
- (sexp))))))
+ :group 'org-structure
+ :type '(repeat :value ("k" . ignore)
+ (choice :value ("k" . ignore)
+ (list :tag "Descriptive Headline" (string :tag "Headline"))
+ (cons :tag "Letter and Command"
+ (string :tag "Command letter")
+ (choice
+ (function)
+ (sexp))))))
(defgroup org-cycle nil
"Options concerning visibility cycling in Org-mode."
@@ -891,13 +899,11 @@ This can also be set in on a per-file basis with
(defcustom org-cycle-global-at-bob nil
"Cycle globally if cursor is at beginning of buffer and not at a headline.
This makes it possible to do global cycling without having to use S-TAB or
-\\[universal-argument] TAB. For this special case to work, the first line \
-of the buffer
-must not be a headline - it may be empty or some other text. When used in
-this way, `org-cycle-hook' is disables temporarily, to make sure the
-cursor stays at the beginning of the buffer.
-When this option is nil, don't do anything special at the beginning
-of the buffer."
+\\[universal-argument] TAB. For this special case to work, the first line
+of the buffer must not be a headline -- it may be empty or some other text.
+When used in this way, `org-cycle-hook' is disabled temporarily to make
+sure the cursor stays at the beginning of the buffer. When this option is
+nil, don't do anything special at the beginning of the buffer."
:group 'org-cycle
:type 'boolean)
@@ -969,7 +975,7 @@ the values `folded', `children', or `subtree'."
The function(s) in this hook must accept a single argument which indicates
the new state that was set by the most recent `org-cycle' command. The
argument is a symbol. After a global state change, it can have the values
-`overview', `content', or `all'. After a local state change, it can have
+`overview', `contents', or `all'. After a local state change, it can have
the values `folded', `children', or `subtree'."
:group 'org-cycle
:type 'hook)
@@ -1023,23 +1029,25 @@ indentation in a virtual way, i.e. at display time in Emacs."
"Non-nil means `C-a' and `C-e' behave specially in headlines and items.
When t, `C-a' will bring back the cursor to the beginning of the
-headline text, i.e. after the stars and after a possible TODO keyword.
-In an item, this will be the position after the bullet.
-When the cursor is already at that position, another `C-a' will bring
-it to the beginning of the line.
-
-`C-e' will jump to the end of the headline, ignoring the presence of tags
-in the headline. A second `C-e' will then jump to the true end of the
-line, after any tags. This also means that, when this variable is
-non-nil, `C-e' also will never jump beyond the end of the heading of a
-folded section, i.e. not after the ellipses.
-
-When set to the symbol `reversed', the first `C-a' or `C-e' works normally,
-going to the true line boundary first. Only a directly following, identical
-keypress will bring the cursor to the special positions.
-
-This may also be a cons cell where the behavior for `C-a' and `C-e' is
-set separately."
+headline text, i.e. after the stars and after a possible TODO
+keyword. In an item, this will be the position after bullet and
+check-box, if any. When the cursor is already at that position,
+another `C-a' will bring it to the beginning of the line.
+
+`C-e' will jump to the end of the headline, ignoring the presence
+of tags in the headline. A second `C-e' will then jump to the
+true end of the line, after any tags. This also means that, when
+this variable is non-nil, `C-e' also will never jump beyond the
+end of the heading of a folded section, i.e. not after the
+ellipses.
+
+When set to the symbol `reversed', the first `C-a' or `C-e' works
+normally, going to the true line boundary first. Only a directly
+following, identical keypress will bring the cursor to the
+special positions.
+
+This may also be a cons cell where the behavior for `C-a' and
+`C-e' is set separately."
:group 'org-edit-structure
:type '(choice
(const :tag "off" nil)
@@ -1274,7 +1282,8 @@ See also the variable `org-table-auto-blank-field'."
(const :tag "on" t)
(const :tag "on, optimized" optimized)))
-(defcustom org-self-insert-cluster-for-undo t
+(defcustom org-self-insert-cluster-for-undo (or (featurep 'xemacs)
+ (version<= emacs-version "24.1"))
"Non-nil means cluster self-insert commands for undo when possible.
If this is set, then, like in the Emacs command loop, 20 consecutive
characters will be undone together.
@@ -1311,9 +1320,12 @@ The 'linkkey' must be a word word, starting with a letter, followed
by letters, numbers, '-' or '_'.
If REPLACE is a string, the tag will simply be appended to create the link.
-If the string contains \"%s\", the tag will be inserted there. Alternatively,
-the placeholder \"%h\" will cause a url-encoded version of the tag to
-be inserted at that point (see the function `url-hexify-string').
+If the string contains \"%s\", the tag will be inserted there. If the string
+contains \"%h\", it will cause a url-encoded version of the tag to be inserted
+at that point (see the function `url-hexify-string'). If the string contains
+the specifier \"%(my-function)\", then the custom function `my-function' will
+be invoked: this function takes the tag as its only argument and must return
+a string.
REPLACE may also be a function that will be called with the tag as the
only argument to create the link, which should be returned as a string.
@@ -1383,11 +1395,11 @@ Changing this variable requires a restart of Emacs to become effective."
(const :tag "Footnotes" footnote)))
(defcustom org-make-link-description-function nil
- "Function to use to generate link descriptions from links.
-If nil the link location will be used. This function must take
-two parameters; the first is the link and the second the
-description `org-insert-link' has generated, and should return the
-description to use."
+ "Function to use for generating link descriptions from links.
+When nil, the link location will be used. This function must take
+two parameters: the first one is the link, the second one is the
+description generated by `org-insert-link'. The function should
+return the description to use."
:group 'org-link
:type 'function)
@@ -1396,6 +1408,12 @@ description to use."
:tag "Org Store Link"
:group 'org-link)
+(defcustom org-url-hexify-p t
+ "When non-nil, hexify URL when creating a link."
+ :type 'boolean
+ :version "24.3"
+ :group 'org-link-store)
+
(defcustom org-email-link-description-format "Email %c: %.30s"
"Format of the description part of a link to an email or usenet message.
The following %-escapes will be replaced by corresponding information:
@@ -1429,46 +1447,6 @@ It should match if the message is from the user him/herself."
:group 'org-link-store
:type 'regexp)
-(defcustom org-link-to-org-use-id 'create-if-interactive-and-no-custom-id
- "Non-nil means storing a link to an Org file will use entry IDs.
-
-Note that before this variable is even considered, org-id must be loaded,
-so please customize `org-modules' and turn it on.
-
-The variable can have the following values:
-
-t Create an ID if needed to make a link to the current entry.
-
-create-if-interactive
- If `org-store-link' is called directly (interactively, as a user
- command), do create an ID to support the link. But when doing the
- job for remember, only use the ID if it already exists. The
- purpose of this setting is to avoid proliferation of unwanted
- IDs, just because you happen to be in an Org file when you
- call `org-remember' that automatically and preemptively
- creates a link. If you do want to get an ID link in a remember
- template to an entry not having an ID, create it first by
- explicitly creating a link to it, using `C-c C-l' first.
-
-create-if-interactive-and-no-custom-id
- Like create-if-interactive, but do not create an ID if there is
- a CUSTOM_ID property defined in the entry. This is the default.
-
-use-existing
- Use existing ID, do not create one.
-
-nil Never use an ID to make a link, instead link using a text search for
- the headline text."
- :group 'org-link-store
- :type '(choice
- (const :tag "Create ID to make link" t)
- (const :tag "Create if storing link interactively"
- create-if-interactive)
- (const :tag "Create if storing link interactively and no CUSTOM_ID is present"
- create-if-interactive-and-no-custom-id)
- (const :tag "Only use existing" use-existing)
- (const :tag "Do not use ID to create link" nil)))
-
(defcustom org-context-in-file-links t
"Non-nil means file links from `org-store-link' contain context.
A search string will be added to the file name with :: as separator and
@@ -1560,6 +1538,7 @@ in the search text."
(defcustom org-link-frame-setup
'((vm . vm-visit-folder-other-frame)
+ (vm-imap . vm-visit-imap-folder-other-frame)
(gnus . org-gnus-no-new-news)
(file . find-file-other-window)
(wl . wl-other-frame))
@@ -1833,7 +1812,11 @@ For more examples, see the system specific constants
(string :tag "Command")
(sexp :tag "Lisp form")))))
-
+(defcustom org-doi-server-url "http://dx.doi.org/"
+ "The URL of the DOI server."
+ :type 'string
+ :version "24.3"
+ :group 'org-link-follow)
(defgroup org-refile nil
"Options concerning refiling entries in Org-mode."
@@ -1846,14 +1829,15 @@ This is just a default location to look for Org files. There is no need
at all to put your files into this directory. It is only used in the
following situations:
-1. When a remember template specifies a target file that is not an
+1. When a capture template specifies a target file that is not an
absolute path. The path will then be interpreted relative to
`org-directory'
-2. When a remember note is filed away in an interactive way (when exiting the
+2. When a capture note is filed away in an interactive way (when exiting the
note buffer with `C-1 C-c C-c'. The user is prompted for an org file,
with `org-directory' as the default path."
:group 'org-refile
:group 'org-remember
+ :group 'org-capture
:type 'directory)
(defcustom org-default-notes-file (convert-standard-filename "~/.notes")
@@ -1862,6 +1846,7 @@ Used as a fall back file for org-remember.el and org-capture.el, for
templates that do not specify a target file."
:group 'org-refile
:group 'org-remember
+ :group 'org-capture
:type '(choice
(const :tag "Default from remember-data-file" nil)
file))
@@ -1891,6 +1876,7 @@ When nil, new notes will be filed to the end of a file or entry.
This can also be a list with cons cells of regular expressions that
are matched against file names, and values."
:group 'org-remember
+ :group 'org-capture
:group 'org-refile
:type '(choice
(const :tag "Reverse always" t)
@@ -1967,11 +1953,11 @@ are used, equivalent to the value `((nil . (:level . 1))'."
(const :tag "Current buffer" nil)
(function) (variable) (file))
(choice :tag "Identify target headline by"
- (cons :tag "Specific tag" (const :value :tag) (string))
- (cons :tag "TODO keyword" (const :value :todo) (string))
- (cons :tag "Regular expression" (const :value :regexp) (regexp))
- (cons :tag "Level number" (const :value :level) (integer))
- (cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
+ (cons :tag "Specific tag" (const :value :tag) (string))
+ (cons :tag "TODO keyword" (const :value :todo) (string))
+ (cons :tag "Regular expression" (const :value :regexp) (regexp))
+ (cons :tag "Level number" (const :value :level) (integer))
+ (cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
(defcustom org-refile-target-verify-function nil
"Function to verify if the headline at point should be a refile target.
@@ -2093,9 +2079,9 @@ the special #+SEQ_TODO and #+TYP_TODO lines.
Each keyword can optionally specify a character for fast state selection
\(in combination with the variable `org-use-fast-todo-selection')
-and specifiers for state change logging, using the same syntax
-that is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says
-that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\"
+and specifiers for state change logging, using the same syntax that
+is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says that
+the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\"
indicates to record a time stamp each time this state is selected.
Each keyword may also specify if a timestamp or a note should be
@@ -2109,7 +2095,7 @@ define X. You may omit any of the fast-selection key or X or /Y,
so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid.
For backward compatibility, this variable may also be just a list
-of keywords - in this case the interpretation (sequence or type) will be
+of keywords. In this case the interpretation (sequence or type) will be
taken from the (otherwise obsolete) variable `org-todo-interpretation'."
:group 'org-todo
:group 'org-keywords
@@ -2180,16 +2166,16 @@ selection scheme.
When nil, fast selection is never used.
-When the symbol `prefix', it will be used when `org-todo' is called with
-a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t'
-in an agenda buffer.
+When the symbol `prefix', it will be used when `org-todo' is called
+with a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and
+`C-u t' in an agenda buffer.
When t, fast selection is used by default. In this case, the prefix
argument forces cycling instead.
-In all cases, the special interface is only used if access keys have actually
-been assigned by the user, i.e. if keywords in the configuration are followed
-by a letter in parenthesis, like TODO(t)."
+In all cases, the special interface is only used if access keys have
+actually been assigned by the user, i.e. if keywords in the configuration
+are followed by a letter in parenthesis, like TODO(t)."
:group 'org-todo
:type '(choice
(const :tag "Never" nil)
@@ -2321,9 +2307,9 @@ or `done', meaning any not-done or done state, respectively."
:group 'org-tags
:type '(repeat
(cons (choice :tag "When changing to"
- (const :tag "Not-done state" todo)
- (const :tag "Done state" done)
- (string :tag "State"))
+ (const :tag "Not-done state" todo)
+ (const :tag "Done state" done)
+ (string :tag "State"))
(repeat
(cons :tag "Tag action"
(string :tag "Tag")
@@ -2449,17 +2435,17 @@ agenda log mode depends on the format of these entries."
:group 'org-todo
:group 'org-progress
:type '(list :greedy t
- (cons (const :tag "Heading when closing an item" done) string)
- (cons (const :tag
- "Heading when changing todo state (todo sequence only)"
- state) string)
- (cons (const :tag "Heading when just taking a note" note) string)
- (cons (const :tag "Heading when clocking out" clock-out) string)
- (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string)
- (cons (const :tag "Heading when rescheduling" reschedule) string)
- (cons (const :tag "Heading when changing deadline" redeadline) string)
- (cons (const :tag "Heading when deleting a deadline" deldeadline) string)
- (cons (const :tag "Heading when refiling" refile) string)))
+ (cons (const :tag "Heading when closing an item" done) string)
+ (cons (const :tag
+ "Heading when changing todo state (todo sequence only)"
+ state) string)
+ (cons (const :tag "Heading when just taking a note" note) string)
+ (cons (const :tag "Heading when clocking out" clock-out) string)
+ (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string)
+ (cons (const :tag "Heading when rescheduling" reschedule) string)
+ (cons (const :tag "Heading when changing deadline" redeadline) string)
+ (cons (const :tag "Heading when deleting a deadline" deldeadline) string)
+ (cons (const :tag "Heading when refiling" refile) string)))
(unless (assq 'note org-log-note-headings)
(push '(note . "%t") org-log-note-headings))
@@ -2540,13 +2526,13 @@ through DONE. This variable forces taking a note anyway.
nil Don't force a record
time Record a time stamp
-note Record a note
+note Prompt for a note and add it with template `org-log-note-headings'
This option can also be set with on a per-file-basis with
+ #+STARTUP: nologrepeat
#+STARTUP: logrepeat
#+STARTUP: lognoterepeat
- #+STARTUP: nologrepeat
You can have local logging settings for a subtree by setting the LOGGING
property to one or more of these keywords."
@@ -2647,9 +2633,9 @@ and by using a prefix arg to `S-up/down' to specify the exact number
of minutes to shift."
:group 'org-time
:get #'(lambda (var) ; Make sure both elements are there
- (if (integerp (default-value var))
- (list (default-value var) 5)
- (default-value var)))
+ (if (integerp (default-value var))
+ (list (default-value var) 5)
+ (default-value var)))
:type '(list
(integer :tag "when inserting times")
(integer :tag "when modifying times")))
@@ -2731,8 +2717,8 @@ This affects the following situations:
If you set this variable to the symbol `time', then also the following
will work:
-3. If the user gives a time, but no day. If the time is before now,
- to will be interpreted as tomorrow.
+3. If the user gives a time.
+ If the time is before now, it will be interpreted as tomorrow.
Currently none of this works for ISO week specifications.
@@ -2822,7 +2808,7 @@ This has influence for the following applications:
the time given here, the day recognized as TODAY is actually yesterday.
- When a date is read from the user and it is still before the time given
here, the current date and time will be assumed to be yesterday, 23:59.
- Also, timestamps inserted in remember templates follow this rule.
+ Also, timestamps inserted in capture templates follow this rule.
IMPORTANT: This is a feature whose implementation is and likely will
remain incomplete. Really, it is only here because past midnight seems to
@@ -3031,7 +3017,7 @@ is better to limit inheritance to certain tags using the variables
(const :tag "List them, indented with leading dots" indented)))
(defcustom org-tags-sort-function nil
- "When set, tags are sorted using this comparison function."
+ "When set, tags are sorted using this function as a comparator."
:group 'org-tags
:type '(choice
(const :tag "No sorting" nil)
@@ -3080,7 +3066,8 @@ and the clock summary:
(org-minutes-to-hh:mm-string (- effort clocksum))))))"
:group 'org-properties
:version "24.1"
- :type 'alist)
+ :type '(alist :key-type (string :tag "Property")
+ :value-type (function :tag "Function")))
(defcustom org-use-property-inheritance nil
"Non-nil means properties apply also for sublevels.
@@ -3256,8 +3243,8 @@ than all archive files of all agenda files will be added to the search
scope."
:group 'org-agenda
:type '(set :greedy t
- (const :tag "Agenda Archives" agenda-archives)
- (repeat :inline t (file))))
+ (const :tag "Agenda Archives" agenda-archives)
+ (repeat :inline t (file))))
(if (fboundp 'defvaralias)
(defvaralias 'org-agenda-multi-occur-extra-files
@@ -3325,8 +3312,8 @@ points to a file, `org-agenda-diary-entry' will be used instead."
(defcustom org-format-latex-options
'(:foreground default :background default :scale 1.0
- :html-foreground "Black" :html-background "Transparent"
- :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\["))
+ :html-foreground "Black" :html-background "Transparent"
+ :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\["))
"Options for creating images from LaTeX fragments.
This is a property list with the following properties:
:foreground the foreground color for images embedded in Emacs, e.g. \"Black\".
@@ -3353,6 +3340,7 @@ When nil, just push out a message."
:group 'org-latex
:version "24.1"
:type 'boolean)
+
(defcustom org-latex-to-mathml-jar-file nil
"Value of\"%j\" in `org-latex-to-mathml-convert-command'.
Use this to specify additional executable file say a jar file.
@@ -3383,6 +3371,28 @@ When using MathToWeb as the converter, set this to
(const :tag "None" nil)
(string :tag "\nShell command")))
+(defcustom org-latex-create-formula-image-program 'dvipng
+ "Program to convert LaTeX fragments with.
+
+dvipng Process the LaTeX fragments to dvi file, then convert
+ dvi files to png files using dvipng.
+ This will also include processing of non-math environments.
+imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
+ to convert pdf files to png files"
+ :group 'org-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "dvipng" dvipng)
+ (const :tag "imagemagick" imagemagick)))
+
+(defcustom org-latex-preview-ltxpng-directory "ltxpng/"
+ "Path to store latex preview images. A relative path here creates many
+ directories relative to the processed org files paths. An absolute path
+ puts all preview images at the same place."
+ :group 'org-latex
+ :version "24.3"
+ :type 'string)
+
(defun org-format-latex-mathml-available-p ()
"Return t if `org-latex-to-mathml-convert-command' is usable."
(save-match-data
@@ -3560,6 +3570,15 @@ appear in the buffer without the initial #+TITLE: keyword."
(const :tag "#+EMAIL" email)
(const :tag "#+TITLE" title)))
+(defcustom org-custom-properties nil
+ "List of properties (as strings) with a special meaning.
+The default use of these custom properties is to let the user
+hide them with `org-toggle-custom-properties-visibility'."
+ :group 'org-properties
+ :group 'org-appearance
+ :version "24.3"
+ :type '(repeat (string :tag "Property Name")))
+
(defcustom org-fontify-done-headline nil
"Non-nil means change the face of a headline if it is marked DONE.
Normally, only the TODO/DONE keyword indicates the state of a headline.
@@ -3608,7 +3627,7 @@ When nil, the \\name form remains in the buffer."
"Regular expression for matching emphasis.
After a match, the match groups contain these elements:
0 The match of the full regular expression, including the characters
- before and after the proper match
+ before and after the proper match
1 The character before the proper match, or empty at beginning of line
2 The proper match, including the leading and trailing markers
3 The leading marker like * or /, indicating the type of highlighting
@@ -3851,29 +3870,29 @@ This works for both table types.")
(eval-and-compile
(org-autoload "org-table"
'(org-table-align org-table-begin org-table-blank-field
- org-table-convert org-table-convert-region org-table-copy-down
- org-table-copy-region org-table-create
- org-table-create-or-convert-from-region
- org-table-create-with-table.el org-table-current-dline
- org-table-cut-region org-table-delete-column org-table-edit-field
- org-table-edit-formulas org-table-end org-table-eval-formula
- org-table-export org-table-field-info
- org-table-get-stored-formulas org-table-goto-column
- org-table-hline-and-move org-table-import org-table-insert-column
- org-table-insert-hline org-table-insert-row org-table-iterate
- org-table-justify-field-maybe org-table-kill-row
- org-table-maybe-eval-formula org-table-maybe-recalculate-line
- org-table-move-column org-table-move-column-left
- org-table-move-column-right org-table-move-row
- org-table-move-row-down org-table-move-row-up
- org-table-next-field org-table-next-row org-table-paste-rectangle
- org-table-previous-field org-table-recalculate
- org-table-rotate-recalc-marks org-table-sort-lines org-table-sum
- org-table-toggle-coordinate-overlays
- org-table-toggle-formula-debugger org-table-wrap-region
- orgtbl-mode turn-on-orgtbl org-table-to-lisp
- orgtbl-to-generic orgtbl-to-tsv orgtbl-to-csv orgtbl-to-latex
- orgtbl-to-orgtbl orgtbl-to-html orgtbl-to-texinfo)))
+ org-table-convert org-table-convert-region org-table-copy-down
+ org-table-copy-region org-table-create
+ org-table-create-or-convert-from-region
+ org-table-create-with-table.el org-table-current-dline
+ org-table-cut-region org-table-delete-column org-table-edit-field
+ org-table-edit-formulas org-table-end org-table-eval-formula
+ org-table-export org-table-field-info
+ org-table-get-stored-formulas org-table-goto-column
+ org-table-hline-and-move org-table-import org-table-insert-column
+ org-table-insert-hline org-table-insert-row org-table-iterate
+ org-table-justify-field-maybe org-table-kill-row
+ org-table-maybe-eval-formula org-table-maybe-recalculate-line
+ org-table-move-column org-table-move-column-left
+ org-table-move-column-right org-table-move-row
+ org-table-move-row-down org-table-move-row-up
+ org-table-next-field org-table-next-row org-table-paste-rectangle
+ org-table-previous-field org-table-recalculate
+ org-table-rotate-recalc-marks org-table-sort-lines org-table-sum
+ org-table-toggle-coordinate-overlays
+ org-table-toggle-formula-debugger org-table-wrap-region
+ orgtbl-mode turn-on-orgtbl org-table-to-lisp
+ orgtbl-to-generic orgtbl-to-tsv orgtbl-to-csv orgtbl-to-latex
+ orgtbl-to-orgtbl orgtbl-to-html orgtbl-to-texinfo)))
(defun org-at-table-p (&optional table-type)
"Return t if the cursor is inside an org-type table.
@@ -3938,7 +3957,9 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(unless quietly
(message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))))
(beginning-of-line 1)
- (when (looking-at org-table-line-regexp)
+ (when (and (looking-at org-table-line-regexp)
+ ;; Exclude tables in src/example/verbatim/clocktable blocks
+ (not (org-in-block-p '("src" "example"))))
(save-excursion (funcall function))
(or (looking-at org-table-line-regexp)
(forward-char 1)))
@@ -3957,13 +3978,13 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
org-table-clean-before-export))
(org-autoload "org-ascii"
'(org-export-as-ascii org-export-ascii-preprocess
- org-export-as-ascii-to-buffer org-replace-region-by-ascii
- org-export-region-as-ascii))
+ org-export-as-ascii-to-buffer org-replace-region-by-ascii
+ org-export-region-as-ascii))
(org-autoload "org-latex"
'(org-export-as-latex-batch org-export-as-latex-to-buffer
- org-replace-region-by-latex org-export-region-as-latex
- org-export-as-latex org-export-as-pdf
- org-export-as-pdf-and-open))
+ org-replace-region-by-latex org-export-region-as-latex
+ org-export-as-latex org-export-as-pdf
+ org-export-as-pdf-and-open))
(org-autoload "org-html"
'(org-export-as-html-and-open
org-export-as-html-batch org-export-as-html-to-buffer
@@ -3971,9 +3992,9 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
org-export-as-html))
(org-autoload "org-docbook"
'(org-export-as-docbook-batch org-export-as-docbook-to-buffer
- org-replace-region-by-docbook org-export-region-as-docbook
- org-export-as-docbook-pdf org-export-as-docbook-pdf-and-open
- org-export-as-docbook))
+ org-replace-region-by-docbook org-export-region-as-docbook
+ org-export-as-docbook-pdf org-export-as-docbook-pdf-and-open
+ org-export-as-docbook))
(org-autoload "org-icalendar"
'(org-export-icalendar-this-file
org-export-icalendar-all-agenda-files
@@ -3986,21 +4007,21 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(eval-and-compile
(org-autoload "org-agenda"
'(org-agenda org-agenda-list org-search-view
- org-todo-list org-tags-view org-agenda-list-stuck-projects
- org-diary org-agenda-to-appt
- org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))
+ org-todo-list org-tags-view org-agenda-list-stuck-projects
+ org-diary org-agenda-to-appt
+ org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))
;; Autoload org-remember
(eval-and-compile
(org-autoload "org-remember"
'(org-remember-insinuate org-remember-annotation
- org-remember-apply-template org-remember org-remember-handler)))
+ org-remember-apply-template org-remember org-remember-handler)))
(eval-and-compile
(org-autoload "org-capture"
'(org-capture org-capture-insert-template-here
- org-capture-import-remember-templates)))
+ org-capture-import-remember-templates)))
;; Autoload org-clock.el
@@ -4017,9 +4038,9 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(defvar org-clock-heading ""
"The heading of the current clock entry.")
(defun org-clock-is-active ()
- "Return non-nil if clock is currently running.
+ "Return non-nil if clock is currently running.
The return value is actually the clock marker."
- (marker-buffer org-clock-marker))
+ (marker-buffer org-clock-marker))
(eval-and-compile
(org-autoload
@@ -4168,6 +4189,15 @@ Here are a few examples:
Archive in file ~/org/archive.org (absolute path), under headlines
\"From FILENAME\" where file name is the current file name.
+\"~/org/datetree.org::datetree/* Finished Tasks\"
+ The \"datetree/\" string is special, signifying to archive
+ items to the datetree. Items are placed in either the CLOSED
+ date of the item, or the current date if there is no CLOSED date.
+ The heading will be a subentry to the current date. There doesn't
+ need to be a heading, but there always needs to be a slash after
+ datetree. For example, to store archived items directly in the
+ datetree, use \"~/org/datetree.org::datetree/\".
+
\"basement::** Finished Tasks\"
Archive in file ./basement (relative path), as level 3 trees
below the level 2 heading \"** Finished Tasks\".
@@ -4225,6 +4255,25 @@ collapsed state."
:group 'org-sparse-trees
:type 'boolean)
+(defcustom org-sparse-tree-default-date-type 'scheduled-or-deadline
+ "The default date type when building a sparse tree.
+When this is nil, a date is a scheduled or a deadline timestamp.
+Otherwise, these types are allowed:
+
+ all: all timestamps
+ active: only active timestamps (<...>)
+ inactive: only inactive timestamps (<...)
+ scheduled: only scheduled timestamps
+ deadline: only deadline timestamps"
+ :type '(choice (const :tag "Scheduled or deadline" 'scheduled-or-deadline)
+ (const :tag "All timestamps" all)
+ (const :tag "Only active timestamps" active)
+ (const :tag "Only inactive timestamps" inactive)
+ (const :tag "Only scheduled timestamps" scheduled)
+ (const :tag "Only deadline timestamps" deadline))
+ :version "24.3"
+ :group 'org-sparse-trees)
+
(defun org-cycle-hide-archived-subtrees (state)
"Re-hide all archived subtrees after a visibility state change."
(when (and (not org-cycle-open-archived-trees)
@@ -4256,6 +4305,8 @@ collapsed state."
(org-flag-subtree t)
(org-end-of-subtree t))))))
+(declare-function outline-end-of-heading "outline" ())
+(declare-function outline-flag-region "outline" (from to flag))
(defun org-flag-subtree (flag)
(save-excursion
(org-back-to-heading t)
@@ -4268,21 +4319,21 @@ collapsed state."
(eval-and-compile
(org-autoload "org-archive"
- '(org-add-archive-files org-archive-subtree
- org-archive-to-archive-sibling org-toggle-archive-tag
- org-archive-subtree-default
- org-archive-subtree-default-with-confirmation)))
+ '(org-add-archive-files org-archive-subtree
+ org-archive-to-archive-sibling org-toggle-archive-tag
+ org-archive-subtree-default
+ org-archive-subtree-default-with-confirmation)))
;; Autoload Column View Code
-(declare-function org-columns-number-to-string "org-colview")
-(declare-function org-columns-get-format-and-top-level "org-colview")
-(declare-function org-columns-compute "org-colview")
+(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf))
+(declare-function org-columns-get-format-and-top-level "org-colview" ())
+(declare-function org-columns-compute "org-colview" (property))
(org-autoload (if (featurep 'xemacs) "org-colview-xemacs" "org-colview")
- '(org-columns-number-to-string org-columns-get-format-and-top-level
- org-columns-compute org-agenda-columns org-columns-remove-overlays
- org-columns org-insert-columns-dblock org-dblock-write:columnview))
+ '(org-columns-number-to-string org-columns-get-format-and-top-level
+ org-columns-compute org-agenda-columns org-columns-remove-overlays
+ org-columns org-insert-columns-dblock org-dblock-write:columnview))
;; Autoload ID code
@@ -4291,19 +4342,19 @@ collapsed state."
(declare-function org-id-locations-save "org-id")
(defvar org-id-track-globally)
(org-autoload "org-id"
- '(org-id-get-create org-id-new org-id-copy org-id-get
- org-id-get-with-outline-path-completion
- org-id-get-with-outline-drilling org-id-store-link
- org-id-goto org-id-find org-id-store-link))
+ '(org-id-get-create org-id-new org-id-copy org-id-get
+ org-id-get-with-outline-path-completion
+ org-id-get-with-outline-drilling org-id-store-link
+ org-id-goto org-id-find org-id-store-link))
;; Autoload Plotting Code
(org-autoload "org-plot"
- '(org-plot/gnuplot))
+ '(org-plot/gnuplot))
;;; Variables for pre-computed regular expressions, all buffer local
-(defvar org-drawer-regexp nil
+(defvar org-drawer-regexp "^[ \t]*:PROPERTIES:[ \t]*$"
"Matches first line of a hidden block.")
(make-variable-buffer-local 'org-drawer-regexp)
(defvar org-todo-regexp nil
@@ -4337,7 +4388,7 @@ TODO state, priority and tags.")
Also put tags into group 4 if tags are present.")
(make-variable-buffer-local 'org-todo-line-tags-regexp)
(defvar org-ds-keyword-length 12
- "Maximum length of the Deadline and SCHEDULED keywords.")
+ "Maximum length of the DEADLINE and SCHEDULED keywords.")
(make-variable-buffer-local 'org-ds-keyword-length)
(defvar org-deadline-regexp nil
"Matches the DEADLINE keyword.")
@@ -4367,9 +4418,6 @@ Also put tags into group 4 if tags are present.")
(defvar org-maybe-keyword-time-regexp nil
"Matches a timestamp, possibly preceded by a keyword.")
(make-variable-buffer-local 'org-maybe-keyword-time-regexp)
-(defvar org-planning-or-clock-line-re nil
- "Matches a line with planning or clock info.")
-(make-variable-buffer-local 'org-planning-or-clock-line-re)
(defvar org-all-time-keywords nil
"List of time keywords.")
(make-variable-buffer-local 'org-all-time-keywords)
@@ -4467,9 +4515,9 @@ After a match, the following groups carry important information:
("entitiespretty" org-pretty-entities t)
("entitiesplain" org-pretty-entities nil))
"Variable associated with STARTUP options for org-mode.
-Each element is a list of three items: The startup options as written
-in the #+STARTUP line, the corresponding variable, and the value to
-set this variable to if the option is found. An optional forth element PUSH
+Each element is a list of three items: the startup options (as written
+in the #+STARTUP line), the corresponding variable, and the value to set
+this variable to if the option is found. An optional forth element PUSH
means to push this value onto the list in the variable.")
(defun org-update-property-plist (key val props)
@@ -4500,7 +4548,7 @@ but the stars and the body are.")
(defun org-set-regexps-and-options ()
"Precompute regular expressions for current buffer."
- (when (eq major-mode 'org-mode)
+ (when (derived-mode-p 'org-mode)
(org-set-local 'org-todo-kwd-alist nil)
(org-set-local 'org-todo-key-alist nil)
(org-set-local 'org-todo-key-trigger nil)
@@ -4571,7 +4619,7 @@ but the stars and the body are.")
(mapcar (lambda (x) (org-split-string x ":"))
(org-split-string value)))))))
((equal key "DRAWERS")
- (setq drawers (org-split-string value splitre)))
+ (setq drawers (delete-dups (append org-drawers (org-split-string value splitre)))))
((equal key "CONSTANTS")
(setq const (append const (org-split-string value splitre))))
((equal key "STARTUP")
@@ -4738,7 +4786,7 @@ but the stars and the body are.")
(concat "^\\(\\*+\\)"
"\\(?: +" org-todo-regexp "\\)?"
"\\(?: +\\(\\[#.\\]\\)\\)?"
- "\\(?: +\\(.*?\\)\\)?"
+ "\\(?: +\\(.*?\\)\\)??"
(org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?")
"[ \t]*$")
org-complex-heading-regexp-format
@@ -4756,7 +4804,7 @@ but the stars and the body are.")
org-todo-line-tags-regexp
(concat "^\\(\\*+\\)"
"\\(?: +" org-todo-regexp "\\)?"
- "\\(?: +\\(.*?\\)\\)?"
+ "\\(?: +\\(.*?\\)\\)??"
(org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?")
"[ \t]*$")
org-deadline-regexp (concat "\\<" org-deadline-string)
@@ -4788,12 +4836,6 @@ but the stars and the body are.")
"\\|" org-closed-string
"\\|" org-clock-string "\\)\\)?"
" *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)")
- org-planning-or-clock-line-re
- (concat "^[ \t]*\\("
- org-scheduled-string "\\|"
- org-deadline-string "\\|"
- org-closed-string "\\|"
- org-clock-string "\\)")
org-all-time-keywords
(mapcar (lambda (w) (substring w 0 -1))
(list org-scheduled-string org-deadline-string
@@ -4866,14 +4908,14 @@ Respect keys that are already there."
"Used in various places to store a window configuration.")
(defvar org-finish-function nil
"Function to be called when `C-c C-c' is used.
-This is for getting out of special buffers like remember.")
+This is for getting out of special buffers like capture.")
;; FIXME: Occasionally check by commenting these, to make sure
;; no other functions uses these, forgetting to let-bind them.
-(defvar entry)
+(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
(defvar org-last-state)
-(defvar date)
+(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
;; Defined somewhere in this file, but used before definition.
(defvar org-entities) ;; defined in org-entities.el
@@ -4883,10 +4925,6 @@ This is for getting out of special buffers like remember.")
;;;; Define the Org-mode
-(if (and (not (keymapp outline-mode-map)) (featurep 'allout))
- (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22"))
-
-
;; We use a before-change function to check if a table might need
;; an update.
(defvar org-table-may-need-update t
@@ -4904,25 +4942,37 @@ This variable is set by `org-before-change-function'.
(defvar org-inhibit-blocking nil) ; Dynamically-scoped param.
(defvar org-table-buffer-is-an nil)
-;; `org-outline-regexp' ought to be a defconst but is let-binding in
-;; some places -- e.g. see the macro org-with-limited-levels.
-;;
-;; In Org buffers, the value of `outline-regexp' is that of
-;; `org-outline-regexp'. The only function still directly relying on
-;; `outline-regexp' is `org-overview' so that `org-cycle' can do its
-;; job when `orgstruct-mode' is active.
-(defvar org-outline-regexp "\\*+ "
- "Regexp to match Org headlines.")
-(defconst org-outline-regexp-bol "^\\*+ "
- "Regexp to match Org headlines.
-This is similar to `org-outline-regexp' but additionally makes
-sure that we are at the beginning of the line.")
+(defvar bidi-paragraph-direction)
+(defvar buffer-face-mode-face)
-(defconst org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Matches an headline, putting stars and text into groups.
-Stars are put in group 1 and the trimmed body in group 2.")
+(require 'outline)
+(if (and (not (keymapp outline-mode-map)) (featurep 'allout))
+ (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22"))
+(require 'noutline "noutline" 'noerror) ;; stock XEmacs does not have it
-(defvar buffer-face-mode-face)
+;; Other stuff we need.
+(require 'time-date)
+(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
+(require 'easymenu)
+(require 'overlay)
+
+(require 'org-macs)
+(require 'org-entities)
+;; (require 'org-compat) moved higher up in the file before it is first used
+(require 'org-faces)
+(require 'org-list)
+(require 'org-pcomplete)
+(require 'org-src)
+(require 'org-footnote)
+
+;; babel
+(require 'ob)
+(require 'ob-table)
+(require 'ob-lob)
+(require 'ob-ref)
+(require 'ob-tangle)
+(require 'ob-comint)
+(require 'ob-keys)
;;;###autoload
(define-derived-mode org-mode outline-mode "Org"
@@ -4979,7 +5029,7 @@ The following commands are available:
org-display-table 4
(vconcat (mapcar
(lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis))
- org-ellipsis)))
+ org-ellipsis)))
(if (stringp org-ellipsis) org-ellipsis "..."))))
(setq buffer-display-table org-display-table))
(org-set-regexps-and-options)
@@ -4998,13 +5048,18 @@ The following commands are available:
'local)
;; Check for running clock before killing a buffer
(org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
- ;; Paragraphs and auto-filling
- (org-set-autofill-regexps)
- (setq indent-line-function 'org-indent-line-function)
+ ;; Indentation.
+ (org-set-local 'indent-line-function 'org-indent-line)
+ (org-set-local 'indent-region-function 'org-indent-region)
+ ;; Initialize radio targets.
(org-update-radio-target-regexp)
+ ;; Filling and auto-filling.
+ (org-setup-filling)
+ ;; Comments.
+ (org-setup-comments-handling)
;; Beginning/end of defun
- (org-set-local 'beginning-of-defun-function 'org-beginning-of-defun)
- (org-set-local 'end-of-defun-function 'org-end-of-defun)
+ (org-set-local 'beginning-of-defun-function 'org-back-to-heading)
+ (org-set-local 'end-of-defun-function (lambda () (interactive) (org-end-of-subtree nil t)))
;; Next error for sparse trees
(org-set-local 'next-error-function 'org-occur-next-match)
;; Make sure dependence stuff works reliably, even for users who set it
@@ -5020,10 +5075,6 @@ The following commands are available:
(remove-hook 'org-blocker-hook
'org-block-todo-from-checkboxes))
- ;; Comment characters
- (org-set-local 'comment-start "#")
- (org-set-local 'comment-padding " ")
-
;; Align options lines
(org-set-local
'align-mode-rules-list
@@ -5076,7 +5127,9 @@ The following commands are available:
(require 'org-indent)
(org-indent-mode 1))
(unless org-inhibit-startup-visibility-stuff
- (org-set-startup-visibility))))
+ (org-set-startup-visibility)))
+ ;; Try to set org-hide correctly
+ (set-face-foreground 'org-hide (org-find-invisible-foreground)))
(when (fboundp 'abbrev-table-put)
(abbrev-table-put org-mode-abbrev-table
@@ -5084,6 +5137,19 @@ The following commands are available:
(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
+
+(defun org-find-invisible-foreground ()
+ (let ((candidates (remove
+ "unspecified-bg"
+ (list
+ (face-background 'default)
+ (face-background 'org-default)
+ (cdr (assoc 'background-color default-frame-alist))
+ (cdr (assoc 'background-color initial-frame-alist))
+ (cdr (assoc 'background-color window-system-default-frame-alist))
+ (face-foreground 'org-hide)))))
+ (car (remove nil candidates))))
+
(defun org-current-time ()
"Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
(if (> (car org-time-stamp-rounding-minutes) 1)
@@ -5115,19 +5181,19 @@ The following commands are available:
(defconst org-non-link-chars "]\t\n\r<>")
(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news"
- "shell" "elisp" "doi" "message"))
+ "shell" "elisp" "doi" "message"))
(defvar org-link-types-re nil
- "Matches a link that has a url-like prefix like \"http:\"")
+ "Matches a link that has a url-like prefix like \"http:\"")
(defvar org-link-re-with-space nil
- "Matches a link with spaces, optional angular brackets around it.")
+ "Matches a link with spaces, optional angular brackets around it.")
(defvar org-link-re-with-space2 nil
- "Matches a link with spaces, optional angular brackets around it.")
+ "Matches a link with spaces, optional angular brackets around it.")
(defvar org-link-re-with-space3 nil
- "Matches a link with spaces, only for internal part in bracket links.")
+ "Matches a link with spaces, only for internal part in bracket links.")
(defvar org-angle-link-re nil
- "Matches link with angular brackets, spaces are allowed.")
+ "Matches link with angular brackets, spaces are allowed.")
(defvar org-plain-link-re nil
- "Matches plain link, without spaces.")
+ "Matches plain link, without spaces.")
(defvar org-bracket-link-regexp nil
"Matches a link in double brackets.")
(defvar org-bracket-link-analytic-regexp nil
@@ -5247,7 +5313,8 @@ This should be called after the variable `org-link-types' has changed."
"Regular expression for fast time stamp matching.")
(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]"
"Regular expression for fast time stamp matching.")
-(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+(defconst org-ts-regexp0
+ "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
"Regular expression matching time strings for analysis.
This one does not require the space after the date, so it can be used
on a string that terminates immediately after the date.")
@@ -5360,19 +5427,18 @@ will be prompted for."
"Run through the buffer and add overlays to links."
(catch 'exit
(let (f)
- (if (re-search-forward org-plain-link-re limit t)
- (progn
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (setq f (get-text-property (match-beginning 0) 'face))
- (if (or (eq f 'org-tag)
- (and (listp f) (memq 'org-tag f)))
- nil
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'face 'org-link
- 'keymap org-mouse-map))
- (org-rear-nonsticky-at (match-end 0)))
- t)))))
+ (when (re-search-forward (concat org-plain-link-re) limit t)
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (setq f (get-text-property (match-beginning 0) 'face))
+ (if (or (eq f 'org-tag)
+ (and (listp f) (memq 'org-tag f)))
+ nil
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'face 'org-link
+ 'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 0)))
+ t))))
(defun org-activate-code (limit)
(if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
@@ -5389,6 +5455,14 @@ will be prompted for."
:group 'org-appearance
:group 'org-babel)
+(defcustom org-allow-promoting-top-level-subtree nil
+ "When non-nil, allow promoting a top level subtree.
+The leading star of the top level headline will be replaced
+by a #."
+ :type 'boolean
+ :version "24.1"
+ :group 'org-appearance)
+
(defun org-fontify-meta-lines-and-blocks (limit)
(condition-case nil
(org-fontify-meta-lines-and-blocks-1 limit)
@@ -5398,7 +5472,7 @@ will be prompted for."
"Fontify #+ lines and blocks, in the correct ways."
(let ((case-fold-search t))
(if (re-search-forward
- "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
+ "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
limit t)
(let ((beg (match-beginning 0))
(block-start (match-end 0))
@@ -5409,7 +5483,7 @@ will be prompted for."
(dc3 (downcase (match-string 3)))
end end1 quoting block-type ovl)
(cond
- ((member dc1 '("html:" "ascii:" "latex:" "docbook:"))
+ ((member dc1 '("+html:" "+ascii:" "+latex:" "+docbook:"))
;; a single line of backend-specific content
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(remove-text-properties (match-beginning 0) (match-end 0)
@@ -5420,7 +5494,7 @@ will be prompted for."
'(font-lock-fontified t face org-block))
; for backend-specific code
t)
- ((and (match-end 4) (equal dc3 "begin"))
+ ((and (match-end 4) (equal dc3 "+begin"))
;; Truly a block
(setq block-type (downcase (match-string 5))
quoting (member block-type org-protecting-blocks))
@@ -5463,7 +5537,7 @@ will be prompted for."
(add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
'(face org-block-end-line))
t))
- ((member dc1 '("title:" "author:" "email:" "date:"))
+ ((member dc1 '("+title:" "+author:" "+email:" "+date:"))
(add-text-properties
beg (match-end 3)
(if (member (intern (substring dc1 0 -1)) org-hidden-keywords)
@@ -5471,19 +5545,14 @@ will be prompted for."
'(font-lock-fontified t face org-document-info-keyword)))
(add-text-properties
(match-beginning 6) (match-end 6)
- (if (string-equal dc1 "title:")
+ (if (string-equal dc1 "+title:")
'(font-lock-fontified t face org-document-title)
'(font-lock-fontified t face org-document-info))))
- ((not (member (char-after beg) '(?\ ?\t)))
- ;; just any other in-buffer setting, but not indented
- (add-text-properties
- beg (match-end 0)
- '(font-lock-fontified t face org-meta-line))
- t)
- ((or (member dc1 '("begin:" "end:" "caption:" "label:"
- "orgtbl:" "tblfm:" "tblname:" "results:"
- "call:" "header:" "headers:" "name:"))
- (and (match-end 4) (equal dc3 "attr")))
+ ((or (equal dc1 "+results")
+ (member dc1 '("+begin:" "+end:" "+caption:" "+label:"
+ "+orgtbl:" "+tblfm:" "+tblname:" "+results:"
+ "+call:" "+header:" "+headers:" "+name:"))
+ (and (match-end 4) (equal dc3 "+attr")))
(add-text-properties
beg (match-end 0)
'(font-lock-fontified t face org-meta-line))
@@ -5492,6 +5561,12 @@ will be prompted for."
(add-text-properties
beg (match-end 0)
'(font-lock-fontified t face font-lock-comment-face)))
+ ((not (member (char-after beg) '(?\ ?\t)))
+ ;; just any other in-buffer setting, but not indented
+ (add-text-properties
+ beg (match-end 0)
+ '(font-lock-fontified t face org-meta-line))
+ t)
(t nil))))))
(defun org-strip-protective-commas (beg end)
@@ -5505,7 +5580,7 @@ will be prompted for."
"[^[:space:]]" end t)
(goto-char (match-beginning 0))
(current-column))))
- (while (re-search-forward "^[ \t]*\\(,\\)\\([*]\\|#\\+\\)" end t)
+ (while (re-search-forward "^[ \t]*\\(,\\)\\([*]\\|#\\)" end t)
(goto-char (match-beginning 1))
(when (= (current-column) front-line)
(replace-match "" nil nil nil 1)))))))
@@ -5667,8 +5742,7 @@ will be prompted for."
((equal org-export-with-sub-superscripts '{})
(list org-match-substring-with-braces-regexp))
(org-export-with-sub-superscripts
- (list org-match-substring-regexp))
- (t nil)))
+ (list org-match-substring-regexp))))
(re-latex
(if org-export-with-LaTeX-fragments
(mapcar (lambda (x) (nth 1 x)) latexs)))
@@ -5689,7 +5763,7 @@ will be prompted for."
nil))
'words))) ; FIXME
))
- ;; (list "\\\\\\(?:[a-zA-Z]+\\)")))
+ ;; (list "\\\\\\(?:[a-zA-Z]+\\)")))
(re-special (if org-export-with-special-strings
(mapcar (lambda (x) (car x))
org-export-html-special-string-regexps)))
@@ -5793,9 +5867,11 @@ it is installed to be used by font lock. This can be useful if something
needs to be inserted at a specific position in the font-lock sequence.")
(defun org-font-lock-hook (limit)
+ "Run `org-font-lock-hook' within LIMIT."
(run-hook-with-args 'org-font-lock-hook limit))
(defun org-set-font-lock-defaults ()
+ "Set font lock defaults for the current buffer."
(let* ((em org-fontify-emphasized-text)
(lk org-activate-links)
(org-font-lock-extra-keywords
@@ -5869,7 +5945,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
(0 (org-get-checkbox-statistics-face) t)))
;; Description list items
'("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
- 1 'bold prepend)
+ 1 'org-list-dt prepend)
;; ARCHIVEd headings
(list (concat
org-outline-regexp-bol
@@ -5887,7 +5963,6 @@ needs to be inserted at a specific position in the font-lock sequence.")
org-comment-string "\\|" org-quote-string
"\\)"))
'(2 'org-special-keyword t))
- '("^#.*" (0 'font-lock-comment-face t))
;; Blocks and meta lines
'(org-fontify-meta-lines-and-blocks)
)))
@@ -5911,6 +5986,30 @@ needs to be inserted at a specific position in the font-lock sequence.")
(org-decompose-region (point-min) (point-max))
(message "Entities are displayed plain"))))
+(defvar org-custom-properties-overlays nil
+ "List of overlays used for custom properties.")
+(make-variable-buffer-local 'org-custom-properties-overlays)
+
+(defun org-toggle-custom-properties-visibility ()
+ "Display or hide properties in `org-custom-properties'."
+ (interactive)
+ (if org-custom-properties-overlays
+ (progn (mapc 'delete-overlay org-custom-properties-overlays)
+ (setq org-custom-properties-overlays nil))
+ (unless (not org-custom-properties)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward org-property-re nil t)
+ (mapc (lambda(p)
+ (when (equal p (substring (match-string 1) 1 -1))
+ (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
+ (overlay-put o 'invisible t)
+ (overlay-put o 'org-custom-property t)
+ (push o org-custom-properties-overlays))))
+ org-custom-properties)))))))
+
(defun org-fontify-entities (limit)
"Find an entity to fontify."
(let (ee)
@@ -5948,16 +6047,16 @@ needs to be inserted at a specific position in the font-lock sequence.")
(defvar org-l nil)
(defvar org-f nil)
(defun org-get-level-face (n)
- "Get the right face for match N in font-lock matching of headlines."
- (setq org-l (- (match-end 2) (match-beginning 1) 1))
- (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
- (if org-cycle-level-faces
- (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
- (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces)))
- (cond
- ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
- ((eq n 2) org-f)
- (t (if org-level-color-stars-only nil org-f))))
+ "Get the right face for match N in font-lock matching of headlines."
+ (setq org-l (- (match-end 2) (match-beginning 1) 1))
+ (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
+ (if org-cycle-level-faces
+ (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
+ (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces)))
+ (cond
+ ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
+ ((eq n 2) org-f)
+ (t (if org-level-color-stars-only nil org-f))))
(defun org-get-todo-face (kwd)
@@ -6017,9 +6116,9 @@ If KWD is a number, get the corresponding match group."
deactivate-mark buffer-file-name buffer-file-truename)
(org-decompose-region beg end)
(remove-text-properties beg end
- '(mouse-face t keymap t org-linked-text t
- invisible t intangible t
- org-no-flyspell t org-emphasis t))
+ '(mouse-face t keymap t org-linked-text t
+ invisible t intangible t
+ org-no-flyspell t org-emphasis t))
(org-remove-font-lock-display-properties beg end)))
(defconst org-script-display '(((raise -0.3) (height 0.7))
@@ -6152,11 +6251,11 @@ in special contexts.
org-inlinetask-min-level
(1- org-inlinetask-min-level))))
(nstars (and limit-level
- (if org-odd-levels-only
- (and limit-level (1- (* limit-level 2)))
- limit-level)))
+ (if org-odd-levels-only
+ (and limit-level (1- (* limit-level 2)))
+ limit-level)))
(org-outline-regexp
- (if (not (eq major-mode 'org-mode))
+ (if (not (derived-mode-p 'org-mode))
outline-regexp
(concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))
(bob-special (and org-cycle-global-at-bob (not arg) (bobp)
@@ -6402,7 +6501,7 @@ With \\[universal-argument] prefix arg, switch to startup visibility.
With a numeric prefix, show all headlines up to that level."
(interactive "P")
(let ((org-cycle-include-plain-lists
- (if (eq major-mode 'org-mode) org-cycle-include-plain-lists nil)))
+ (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil)))
(cond
((integerp arg)
(show-all)
@@ -6612,7 +6711,7 @@ open and agenda-wise Org files."
(let ((files (mapcar 'expand-file-name (org-agenda-files))))
(dolist (buf (buffer-list))
(with-current-buffer buf
- (if (and (eq major-mode 'org-mode) (buffer-file-name))
+ (if (and (derived-mode-p 'org-mode) (buffer-file-name))
(let ((file (expand-file-name (buffer-file-name))))
(unless (member file files)
(push file files))))))
@@ -6628,7 +6727,7 @@ open and agenda-wise Org files."
(defun org-cycle-hide-drawers (state)
"Re-hide all drawers after a visibility state change."
- (when (and (eq major-mode 'org-mode)
+ (when (and (derived-mode-p 'org-mode)
(not (memq state '(overview folded contents))))
(save-excursion
(let* ((globalp (memq state '(contents all)))
@@ -6642,6 +6741,8 @@ open and agenda-wise Org files."
(org-flag-drawer t))))))
(defun org-flag-drawer (flag)
+ "When FLAG is non-nil, hide the drawer we are within.
+Otherwise make it visible."
(save-excursion
(beginning-of-line 1)
(when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:")
@@ -6829,7 +6930,7 @@ Optional arguments START and END can be used to limit the range."
map))
(defconst org-goto-help
-"Browse buffer copy, to find location or copy text. Just type for auto-isearch.
+ "Browse buffer copy, to find location or copy text. Just type for auto-isearch.
RET=jump to location [Q]uit and return to previous location
\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
@@ -6839,18 +6940,22 @@ RET=jump to location [Q]uit and return to previous location
(defun org-goto (&optional alternative-interface)
"Look up a different location in the current file, keeping current visibility.
-When you want look-up or go to a different location in a document, the
-fastest way is often to fold the entire buffer and then dive into the tree.
-This method has the disadvantage, that the previous location will be folded,
-which may not be what you want.
-
-This command works around this by showing a copy of the current buffer
-in an indirect buffer, in overview mode. You can dive into the tree in
-that copy, use org-occur and incremental search to find a location.
-When pressing RET or `Q', the command returns to the original buffer in
-which the visibility is still unchanged. After RET it will also jump to
-the location selected in the indirect buffer and expose the headline
-hierarchy above."
+When you want look-up or go to a different location in a
+document, the fastest way is often to fold the entire buffer and
+then dive into the tree. This method has the disadvantage, that
+the previous location will be folded, which may not be what you
+want.
+
+This command works around this by showing a copy of the current
+buffer in an indirect buffer, in overview mode. You can dive
+into the tree in that copy, use org-occur and incremental search
+to find a location. When pressing RET or `Q', the command
+returns to the original buffer in which the visibility is still
+unchanged. After RET it will also jump to the location selected
+in the indirect buffer and expose the headline hierarchy above.
+
+With a prefix argument, use the alternative interface: e.g. if
+`org-goto-interface' is 'outline use 'outline-path-completion."
(interactive "P")
(let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
(org-refile-use-outline-path t)
@@ -6945,12 +7050,12 @@ or nil."
(defun org-goto-local-auto-isearch ()
"Start isearch."
- (interactive)
- (goto-char (point-min))
- (let ((keys (this-command-keys)))
- (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char)
- (isearch-mode t)
- (isearch-process-search-char (string-to-char keys)))))
+ (interactive)
+ (goto-char (point-min))
+ (let ((keys (this-command-keys)))
+ (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char)
+ (isearch-mode t)
+ (isearch-process-search-char (string-to-char keys)))))
(defun org-goto-ret (&optional arg)
"Finish `org-goto' by going to the new location."
@@ -6995,8 +7100,9 @@ or nil."
(defun org-tree-to-indirect-buffer (&optional arg)
"Create indirect buffer and narrow it to current subtree.
-With numerical prefix ARG, go up to this level and then take that tree.
+With a numerical prefix ARG, go up to this level and then take that tree.
If ARG is negative, go up that many levels.
+
If `org-indirect-buffer-display' is not `new-frame', the command removes the
indirect buffer previously made with this command, to avoid proliferation of
indirect buffers. However, when you call the command with a \
@@ -7018,7 +7124,7 @@ frame is not changed."
(setq level (org-outline-level))
(if (< arg 0) (setq arg (+ level arg)))
(while (> (setq level (org-outline-level)) arg)
- (outline-up-heading 1 t)))
+ (org-up-heading-safe)))
(setq beg (point)
heading (org-get-heading))
(org-end-of-subtree t t)
@@ -7434,6 +7540,8 @@ even level numbers will become the next higher odd number."
(define-obsolete-function-alias 'org-get-legal-level
'org-get-valid-level "23.1")))
+(defvar org-called-with-limited-levels nil) ;; Dynamically bound in
+;; ̀org-with-limited-levels'
(defun org-promote ()
"Promote the current heading higher up the tree.
If the region is active in `transient-mark-mode', promote all headings
@@ -7441,14 +7549,19 @@ in the region."
(org-back-to-heading t)
(let* ((level (save-match-data (funcall outline-level)))
(after-change-functions (remove 'flyspell-after-change-function
- after-change-functions))
+ after-change-functions))
(up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
(diff (abs (- level (length up-head) -1))))
- (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
- (replace-match up-head nil t)
+ (cond ((and (= level 1) org-called-with-limited-levels
+ org-allow-promoting-top-level-subtree)
+ (replace-match "# " nil t))
+ ((= level 1)
+ (error "Cannot promote to level 0. UNDO to recover if necessary"))
+ (t (replace-match up-head nil t)))
;; Fixup tag positioning
- (and org-auto-align-tags (org-set-tags nil t))
- (if org-adapt-indentation (org-fixup-indentation (- diff)))
+ (unless (= level 1)
+ (and org-auto-align-tags (org-set-tags nil t))
+ (if org-adapt-indentation (org-fixup-indentation (- diff))))
(run-hooks 'org-after-promote-entry-hook)))
(defun org-demote ()
@@ -7458,7 +7571,7 @@ in the region."
(org-back-to-heading t)
(let* ((level (save-match-data (funcall outline-level)))
(after-change-functions (remove 'flyspell-after-change-function
- after-change-functions))
+ after-change-functions))
(down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
(diff (abs (- level (length down-head) -1))))
(replace-match down-head nil t)
@@ -7717,7 +7830,7 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
(save-excursion (outline-end-of-heading)
(setq folded (outline-invisible-p)))
(condition-case nil
- (org-forward-same-level (1- n) t)
+ (org-forward-heading-same-level (1- n) t)
(error nil))
(org-end-of-subtree t t))
(org-back-over-empty-lines)
@@ -7761,8 +7874,8 @@ the inserted text when done."
(setq tree (or tree (and kill-ring (current-kill 0))))
(unless (org-kill-is-subtree-p tree)
(error "%s"
- (substitute-command-keys
- "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
+ (substitute-command-keys
+ "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
(org-with-limited-levels
(let* ((visp (not (outline-invisible-p)))
(txt tree)
@@ -7778,8 +7891,7 @@ the inserted text when done."
(- (match-end 1) (match-beginning 1)))
((and (bolp)
(looking-at org-outline-regexp))
- (- (match-end 0) (point) 1))
- (t nil)))
+ (- (match-end 0) (point) 1))))
(previous-level (save-excursion
(condition-case nil
(progn
@@ -7920,7 +8032,7 @@ If yes, remember the marker and the distance to BEG."
(interactive)
(let* ((case-fold-search t)
(blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*"
- "^[ \t]*#\\+end_.*")))
+ "^[ \t]*#\\+end_.*")))
(if blockp
(narrow-to-region (car blockp) (cdr blockp))
(error "Not in a block"))))
@@ -7961,7 +8073,7 @@ and still retain the repeater to cover future instances of the task."
(if (not (and (integerp n) (> n 0)))
(error "Invalid number of replications %s" n))
(if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift)))
- (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'"
+ (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'"
shift)))
(error "Invalid shift specification %s" shift))
(when doshift
@@ -7979,7 +8091,7 @@ and still retain the repeater to cover future instances of the task."
(setq end (point))
(setq template (buffer-substring beg end))
(when (and doshift
- (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[dwmy][^<>\n]*>" template))
+ (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template))
(delete-region beg end)
(setq end beg)
(setq nmin 0 nmax (1+ nmax) n-no-remove nmax))
@@ -8010,7 +8122,7 @@ and still retain the repeater to cover future instances of the task."
(while (re-search-forward org-ts-regexp nil t)
(save-excursion
(goto-char (match-beginning 0))
- (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[dwmy]\\)")
+ (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
(delete-region (match-beginning 1) (match-end 1)))))))
(setq task (buffer-string)))
(insert task))
@@ -8231,8 +8343,7 @@ WITH-CASE, the sorting considers case as well."
(cond
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
- ((member dcst '(?p ?t ?s ?d ?c)) '<)
- (t nil)))))
+ ((member dcst '(?p ?t ?s ?d ?c)) '<)))))
(run-hooks 'org-after-sorting-entries-or-items-hook)
(message "Sorting entries...done")))
@@ -8339,26 +8450,31 @@ C-c C-c Set tags / toggle checkbox"
"Unconditionally turn on `orgstruct-mode'."
(orgstruct-mode 1))
+(defvar org-fb-vars nil)
+(make-variable-buffer-local 'org-fb-vars)
(defun orgstruct++-mode (&optional arg)
"Toggle `orgstruct-mode', the enhanced version of it.
-In addition to setting orgstruct-mode, this also exports all indentation
-and autofilling variables from org-mode into the buffer. It will also
-recognize item context in multiline items.
-Note that turning off orgstruct-mode will *not* remove the
-indentation/paragraph settings. This can only be done by refreshing the
-major mode, for example with \\[normal-mode]."
+In addition to setting orgstruct-mode, this also exports all
+indentation and autofilling variables from org-mode into the
+buffer. It will also recognize item context in multiline items."
(interactive "P")
(setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
(if (< arg 1)
- (orgstruct-mode -1)
+ (progn (orgstruct-mode -1)
+ (mapc (lambda(v)
+ (org-set-local (car v)
+ (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v))))
+ org-fb-vars))
(orgstruct-mode 1)
+ (setq org-fb-vars nil)
(let (var val)
(mapc
(lambda (x)
(when (string-match
- "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)"
+ "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)"
(symbol-name (car x)))
(setq var (car x) val (nth 1 x))
+ (push (list var `(quote ,(eval var))) org-fb-vars)
(org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
org-local-vars)
(org-set-local 'orgstruct-is-++ t))))
@@ -8414,6 +8530,9 @@ major mode, for example with \\[normal-mode]."
cmd (orgstruct-make-binding fun nfunc key))
(org-defkey orgstruct-mode-map key cmd))
+ ;; Prevent an error for users who forgot to make autoloads
+ (require 'org-element)
+
;; Special treatment needed for TAB and RET
(org-defkey orgstruct-mode-map [(tab)]
(orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i"))
@@ -8422,21 +8541,21 @@ major mode, for example with \\[normal-mode]."
(org-defkey orgstruct-mode-map "\M-\C-m"
(orgstruct-make-binding 'org-insert-heading 105
- "\M-\C-m" [(meta return)]))
+ "\M-\C-m" [(meta return)]))
(org-defkey orgstruct-mode-map [(meta return)]
(orgstruct-make-binding 'org-insert-heading 106
- [(meta return)] "\M-\C-m"))
+ [(meta return)] "\M-\C-m"))
(org-defkey orgstruct-mode-map [(shift meta return)]
(orgstruct-make-binding 'org-insert-todo-heading 107
- [(meta return)] "\M-\C-m"))
+ [(meta return)] "\M-\C-m"))
(org-defkey orgstruct-mode-map "\e\C-m"
(orgstruct-make-binding 'org-insert-heading 108
- "\e\C-m" [?\e (return)]))
+ "\e\C-m" [?\e (return)]))
(org-defkey orgstruct-mode-map [?\e (return)]
(orgstruct-make-binding 'org-insert-heading 109
- [?\e (return)] "\e\C-m"))
+ [?\e (return)] "\e\C-m"))
(org-defkey orgstruct-mode-map [?\e (shift return)]
(orgstruct-make-binding 'org-insert-todo-heading 110
[?\e (return)] "\e\C-m"))
@@ -8474,6 +8593,77 @@ to execute outside of tables."
keys)
'('orgstruct-error))))))))
+(defun org-contextualize-keys (alist contexts)
+ "Return valid elements in ALIST depending on CONTEXTS.
+
+`org-agenda-custom-commands' or `org-capture-templates' are the
+values used for ALIST, and `org-agenda-custom-commands-contexts'
+or `org-capture-templates-contexts' are the associated contexts
+definitions."
+ (let ((contexts
+ ;; normalize contexts
+ (mapcar
+ (lambda(c) (cond ((listp (cadr c))
+ (list (car c) (car c) (cadr c)))
+ ((string= "" (cadr c))
+ (list (car c) (car c) (caddr c)))
+ (t c))) contexts))
+ (a alist) c r s)
+ ;; loop over all commands or templates
+ (while (setq c (pop a))
+ (let (vrules repl)
+ (cond
+ ((not (assoc (car c) contexts))
+ (push c r))
+ ((and (assoc (car c) contexts)
+ (setq vrules (org-contextualize-validate-key
+ (car c) contexts)))
+ (mapc (lambda (vr)
+ (when (not (equal (car vr) (cadr vr)))
+ (setq repl vr))) vrules)
+ (if (not repl) (push c r)
+ (push (cadr repl) s)
+ (push
+ (cons (car c)
+ (cdr (or (assoc (cadr repl) alist)
+ (error "Undefined key `%s' as contextual replacement for `%s'"
+ (cadr repl) (car c)))))
+ r))))))
+ ;; Return limited ALIST, possibly with keys modified, and deduplicated
+ (delq
+ nil
+ (delete-dups
+ (mapcar (lambda (x)
+ (let ((tpl (car x)))
+ (when (not (delq
+ nil
+ (mapcar (lambda(y)
+ (equal y tpl)) s))) x)))
+ (reverse r))))))
+
+(defun org-contextualize-validate-key (key contexts)
+ "Check CONTEXTS for agenda or capture KEY."
+ (let (r rr res)
+ (while (setq r (pop contexts))
+ (mapc
+ (lambda (rr)
+ (when
+ (and (equal key (car r))
+ (if (functionp rr) (funcall rr)
+ (or (and (eq (car rr) 'in-file)
+ (buffer-file-name)
+ (string-match (cdr rr) (buffer-file-name)))
+ (and (eq (car rr) 'in-mode)
+ (string-match (cdr rr) (symbol-name major-mode)))
+ (when (and (eq (car rr) 'not-in-file)
+ (buffer-file-name))
+ (not (string-match (cdr rr) (buffer-file-name))))
+ (when (eq (car rr) 'not-in-mode)
+ (not (string-match (cdr rr) (symbol-name major-mode)))))))
+ (push r res)))
+ (car (last r))))
+ (delete-dups (delq nil res))))
+
(defun org-context-p (&rest contexts)
"Check if local context is any of CONTEXTS.
Possible values in the list of contexts are `table', `headline', and `item'."
@@ -8490,7 +8680,7 @@ Possible values in the list of contexts are `table', `headline', and `item'."
(goto-char pos))))
(defun org-get-local-variables ()
- "Return a list of all local variables in an org-mode buffer."
+ "Return a list of all local variables in an Org mode buffer."
(let (varlist)
(with-current-buffer (get-buffer-create "*Org tmp*")
(erase-buffer)
@@ -8505,7 +8695,7 @@ Possible values in the list of contexts are `table', `headline', and `item'."
(list x)
(list (car x) (list 'quote (cdr x)))))
(if (string-match
- "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)"
+ "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)"
(symbol-name (car x)))
x nil))
varlist))))
@@ -8547,7 +8737,9 @@ call CMD."
(defun org-refresh-category-properties ()
"Refresh category text properties in the buffer."
- (let ((def-cat (cond
+ (let ((case-fold-search t)
+ (inhibit-read-only t)
+ (def-cat (cond
((null org-category)
(if buffer-file-name
(file-name-sans-extension
@@ -8593,6 +8785,8 @@ call CMD."
(setq rpl (cdr as))
(cond
((symbolp rpl) (funcall rpl tag))
+ ((string-match "%(\\([^)]+\\))" rpl)
+ (replace-match (funcall (intern-soft (match-string 1 rpl)) tag) t t rpl))
((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
((string-match "%h" rpl)
(replace-match (url-hexify-string (or tag "")) t t rpl))
@@ -8631,7 +8825,7 @@ Special properties are:
this when inserting this link into an Org-mode buffer.
In addition to these, any additional properties can be specified
-and then used in remember templates.")
+and then used in capture templates.")
(defun org-add-link-type (type &optional follow export)
"Add TYPE to the list of `org-link-types'.
@@ -8665,7 +8859,8 @@ type. For a simple example of an export function, see `org-bbdb.el'."
(setcdr (assoc type org-link-protocols) (list follow export))
(push (list type follow export) org-link-protocols)))
-(defvar org-agenda-buffer-name)
+(defvar org-agenda-buffer-name) ; Defined in org-agenda.el
+(defvar org-link-to-org-use-id) ; Defined in org-id.el
;;;###autoload
(defun org-store-link (arg)
@@ -8727,17 +8922,24 @@ For file links, arg negates `org-context-in-file-links'."
nil nil nil))))
(org-store-link-props :type "calendar" :date cd)))
+ ((eq major-mode 'help-mode)
+ (setq link (concat "help:" (save-excursion
+ (goto-char (point-min))
+ (looking-at "^[^ ]+")
+ (match-string 0))))
+ (org-store-link-props :type "help"))
+
((eq major-mode 'w3-mode)
(setq cpltxt (if (and (buffer-name)
(not (string-match "Untitled" (buffer-name))))
(buffer-name)
(url-view-url t))
- link (org-make-link (url-view-url t)))
+ link (url-view-url t))
(org-store-link-props :type "w3" :url (url-view-url t)))
((eq major-mode 'w3m-mode)
(setq cpltxt (or w3m-current-title w3m-current-url)
- link (org-make-link w3m-current-url))
+ link w3m-current-url)
(org-store-link-props :type "w3m" :url (url-view-url t)))
((setq search (run-hook-with-args-until-success
@@ -8749,7 +8951,7 @@ For file links, arg negates `org-context-in-file-links'."
((eq major-mode 'image-mode)
(setq cpltxt (concat "file:"
(abbreviate-file-name buffer-file-name))
- link (org-make-link cpltxt))
+ link cpltxt)
(org-store-link-props :type "image" :file buffer-file-name))
((eq major-mode 'dired-mode)
@@ -8761,9 +8963,9 @@ For file links, arg negates `org-context-in-file-links'."
;; otherwise, no file so use current directory.
default-directory))
(setq cpltxt (concat "file:" file)
- link (org-make-link cpltxt))))
+ link cpltxt)))
- ((and (buffer-file-name (buffer-base-buffer)) (eq major-mode 'org-mode))
+ ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
(setq custom-id (org-entry-get nil "CUSTOM_ID"))
(cond
((org-in-regexp "<<\\(.*?\\)>>")
@@ -8772,22 +8974,19 @@ For file links, arg negates `org-context-in-file-links'."
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))
"::" (match-string 1))
- link (org-make-link cpltxt)))
+ link cpltxt))
((and (featurep 'org-id)
(or (eq org-link-to-org-use-id t)
- (and (eq org-link-to-org-use-id 'create-if-interactive)
- (org-called-interactively-p 'any))
- (and (eq org-link-to-org-use-id
- 'create-if-interactive-and-no-custom-id)
- (org-called-interactively-p 'any)
- (not custom-id))
- (and org-link-to-org-use-id
- (org-entry-get nil "ID"))))
+ (and (org-called-interactively-p 'any)
+ (or (eq org-link-to-org-use-id 'create-if-interactive)
+ (and (eq org-link-to-org-use-id
+ 'create-if-interactive-and-no-custom-id)
+ (not custom-id))))
+ (and org-link-to-org-use-id (org-entry-get nil "ID"))))
;; We can make a link using the ID.
(setq link (condition-case nil
(prog1 (org-id-store-link)
- (setq desc (plist-get org-store-link-plist
- :description)))
+ (setq desc (plist-get org-store-link-plist :description)))
(error
;; probably before first headline, link to file only
(concat "file:"
@@ -8803,8 +9002,7 @@ For file links, arg negates `org-context-in-file-links'."
(setq txt (cond
((org-at-heading-p) nil)
((org-region-active-p)
- (buffer-substring (region-beginning) (region-end)))
- (t nil)))
+ (buffer-substring (region-beginning) (region-end)))))
(when (or (null txt) (string-match "\\S-" txt))
(setq cpltxt
(concat cpltxt "::"
@@ -8815,7 +9013,7 @@ For file links, arg negates `org-context-in-file-links'."
(org-heading-components))) "NONE"))))
(if (string-match "::\\'" cpltxt)
(setq cpltxt (substring cpltxt 0 -2)))
- (setq link (org-make-link cpltxt)))))
+ (setq link cpltxt))))
((buffer-file-name (buffer-base-buffer))
;; Just link to this file here.
@@ -8832,7 +9030,7 @@ For file links, arg negates `org-context-in-file-links'."
(setq cpltxt
(concat cpltxt "::" (org-make-org-heading-search-string txt))
desc "NONE")))
- (setq link (org-make-link cpltxt)))
+ (setq link cpltxt))
((org-called-interactively-p 'interactive)
(error "Cannot link to a buffer which is not visiting a file"))
@@ -8938,10 +9136,6 @@ according to FMT (default from `org-email-link-description-format')."
(reverse slines))) "\n")))))
(mapconcat 'identity (org-split-string s "[ \t]+") " ")))
-(defun org-make-link (&rest strings)
- "Concatenate STRINGS."
- (apply 'concat strings))
-
(defun org-make-link-string (link &optional description)
"Make a link with brackets, consisting of LINK and DESCRIPTION."
(unless (string-match "\\S-" link)
@@ -8978,8 +9172,6 @@ according to FMT (default from `org-email-link-description-format')."
"List of characters that should be escaped in link.
This is the list that is used for internal purposes.")
-(defvar org-url-encoding-use-url-hexify nil)
-
(defconst org-link-escape-chars-browser
'(?\ )
"List of escapes for characters that are problematic in links.
@@ -8992,25 +9184,24 @@ Optional argument TABLE is a list with characters that should be
escaped. When nil, `org-link-escape-chars' is used.
If optional argument MERGE is set, merge TABLE into
`org-link-escape-chars'."
- (if (and org-url-encoding-use-url-hexify (not table))
- (url-hexify-string text)
- (cond
- ((and table merge)
- (mapc (lambda (defchr)
- (unless (member defchr table)
- (setq table (cons defchr table)))) org-link-escape-chars))
- ((null table)
- (setq table org-link-escape-chars)))
- (mapconcat
- (lambda (char)
- (if (or (member char table)
- (< char 32) (= char 37) (> char 126))
- (mapconcat (lambda (sequence-element)
- (format "%%%.2X" sequence-element))
- (or (encode-coding-char char 'utf-8)
- (error "Unable to percent escape character: %s"
- (char-to-string char))) "")
- (char-to-string char))) text "")))
+ (cond
+ ((and table merge)
+ (mapc (lambda (defchr)
+ (unless (member defchr table)
+ (setq table (cons defchr table)))) org-link-escape-chars))
+ ((null table)
+ (setq table org-link-escape-chars)))
+ (mapconcat
+ (lambda (char)
+ (if (or (member char table)
+ (and (or (< char 32) (= char 37) (> char 126))
+ org-url-hexify-p))
+ (mapconcat (lambda (sequence-element)
+ (format "%%%.2X" sequence-element))
+ (or (encode-coding-char char 'utf-8)
+ (error "Unable to percent escape character: %s"
+ (char-to-string char))) "")
+ (char-to-string char))) text ""))
(defun org-link-unescape (str)
"Unhex hexified Unicode strings as returned from the JavaScript function
@@ -9083,6 +9274,14 @@ Note: this function also decodes single byte encodings like
(setq s (replace-match "%40" t t s)))
s)
+(defun org-link-prettify (link)
+ "Return a human-readable representation of LINK.
+The car of LINK must be a raw link the cdr of LINK must be either
+a link description or nil."
+ (let ((desc (or (cadr link) "<no description>")))
+ (concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
+ "<" (car link) ">")))
+
;;;###autoload
(defun org-insert-link-global ()
"Insert a link like Org-mode does.
@@ -9091,6 +9290,38 @@ This command can be called in any mode to insert a link in Org-mode syntax."
(org-load-modules-maybe)
(org-run-like-in-org-mode 'org-insert-link))
+(defun org-insert-all-links (&optional keep)
+ "Insert all links in `org-stored-links'."
+ (interactive "P")
+ (let ((links (copy-sequence org-stored-links)) l)
+ (while (setq l (if keep (pop links) (pop org-stored-links)))
+ (insert "- ")
+ (org-insert-link nil (car l) (cadr l))
+ (insert "\n"))))
+
+(defun org-link-fontify-links-to-this-file ()
+ "Fontify links to the current file in `org-stored-links'."
+ (let ((f (buffer-file-name)) a b)
+ (setq a (mapcar (lambda(l)
+ (let ((ll (car l)))
+ (when (and (string-match "^file:\\(.+\\)::" ll)
+ (equal f (expand-file-name (match-string 1 ll))))
+ ll)))
+ org-stored-links))
+ (when (featurep 'org-id)
+ (setq b (mapcar (lambda(l)
+ (let ((ll (car l)))
+ (when (and (string-match "^id:\\(.+\\)$" ll)
+ (equal f (expand-file-name
+ (or (org-id-find-id-file
+ (match-string 1 ll)) ""))))
+ ll)))
+ org-stored-links)))
+ (mapcar (lambda(l)
+ (put-text-property 0 (length l) 'face 'font-lock-comment-face l))
+ (delq nil (append a b)))))
+
+(defvar org-link-links-in-this-file nil)
(defun org-insert-link (&optional complete-file link-location default-description)
"Insert a link. At the prompt, enter the link.
@@ -9139,7 +9370,8 @@ be used as the default description."
(desc region)
tmphist ; byte-compile incorrectly complains about this
(link link-location)
- entry file all-prefixes)
+ (abbrevs org-link-abbrev-alist-local)
+ entry file all-prefixes auto-desc)
(cond
(link-location) ; specified by arg, just use it.
((org-in-regexp org-bracket-link-regexp 1)
@@ -9160,15 +9392,17 @@ be used as the default description."
(setq link (org-file-complete-link complete-file)))
(t
;; Read link, with completion for stored links.
- (with-output-to-temp-buffer "*Org Links*"
- (princ "Insert a link.
+ (org-link-fontify-links-to-this-file)
+ (org-switch-to-buffer-other-window "*Org Links*")
+ (with-current-buffer "*Org Links*"
+ (erase-buffer)
+ (insert "Insert a link.
Use TAB to complete link prefixes, then RET for type-specific completion support\n")
(when org-stored-links
- (princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n")
- (princ (mapconcat
- (lambda (x)
- (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x)))
- (reverse org-stored-links) "\n"))))
+ (insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n")
+ (insert (mapconcat 'org-link-prettify
+ (reverse org-stored-links) "\n")))
+ (goto-char (point-min)))
(let ((cw (selected-window)))
(select-window (get-buffer-window "*Org Links*" 'visible))
(with-current-buffer "*Org Links*" (setq truncate-lines t))
@@ -9178,7 +9412,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
;; Fake a link history, containing the stored links.
(setq tmphist (append (mapcar 'car org-stored-links)
org-insert-link-history))
- (setq all-prefixes (append (mapcar 'car org-link-abbrev-alist-local)
+ (setq all-prefixes (append (mapcar 'car abbrevs)
(mapcar 'car org-link-abbrev-alist)
org-link-types))
(unwind-protect
@@ -9191,12 +9425,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(append
(mapcar (lambda (x) (list (concat x ":")))
all-prefixes)
- (mapcar 'car org-stored-links))
+ (mapcar 'car org-stored-links)
+ (mapcar 'cadr org-stored-links))
nil nil nil
'tmphist
- (car (car org-stored-links)))))
+ (caar org-stored-links))))
(if (not (string-match "\\S-" link))
(error "No link selected"))
+ (mapc (lambda(l)
+ (when (equal link (cadr l)) (setq link (car l) auto-desc t)))
+ org-stored-links)
(if (or (member link all-prefixes)
(and (equal ":" (substring link -1))
(member (substring link 0 -1) all-prefixes)
@@ -9206,15 +9444,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(kill-buffer "*Org Links*"))
(setq entry (assoc link org-stored-links))
(or entry (push link org-insert-link-history))
- (if (funcall (if (equal complete-file '(64)) 'not 'identity)
- (not org-keep-stored-link-after-insertion))
- (setq org-stored-links (delq (assoc link org-stored-links)
- org-stored-links)))
(setq desc (or desc (nth 1 entry)))))
+ (if (funcall (if (equal complete-file '(64)) 'not 'identity)
+ (not org-keep-stored-link-after-insertion))
+ (setq org-stored-links (delq (assoc link org-stored-links)
+ org-stored-links)))
+
(if (string-match org-plain-link-re link)
;; URL-like link, normalize the use of angular brackets.
- (setq link (org-make-link (org-remove-angle-brackets link))))
+ (setq link (org-remove-angle-brackets link)))
;; Check if we are linking to the current file with a search option
;; If yes, simplify the link by using only the search option.
@@ -9258,10 +9497,17 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(setq desc path))))
(if org-make-link-description-function
- (setq desc (funcall org-make-link-description-function link desc))
- (if default-description (setq desc default-description)))
+ (setq desc
+ (or (condition-case nil
+ (funcall org-make-link-description-function link desc)
+ (error (progn (message "Can't get link description from `%s'"
+ (symbol-name org-make-link-description-function))
+ (sit-for 2) nil)))
+ (read-string "Description: " default-description)))
+ (if default-description (setq desc default-description)
+ (setq desc (or (and auto-desc desc)
+ (read-string "Description: " desc)))))
- (setq desc (read-string "Description: " desc))
(unless (string-match "\\S-" desc) (setq desc nil))
(if remove (apply 'delete-region remove))
(insert (org-make-link-string link desc))))
@@ -9282,16 +9528,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(expand-file-name ".")))))
(cond
((equal arg '(16))
- (setq link (org-make-link
+ (setq link (concat
"file:"
(abbreviate-file-name (expand-file-name file)))))
((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
- (setq link (org-make-link "file:" (match-string 1 file))))
+ (setq link (concat "file:" (match-string 1 file))))
((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
(expand-file-name file))
- (setq link (org-make-link
+ (setq link (concat
"file:" (match-string 1 (expand-file-name file)))))
- (t (setq link (org-make-link "file:" file)))))
+ (t (setq link (concat "file:" file)))))
link))
(defun org-completing-read (&rest args)
@@ -9446,24 +9692,24 @@ If the link is in hidden text, expose it."
(defun org-translate-link-from-planner (type path)
"Translate a link from Emacs Planner syntax so that Org can follow it.
This is still an experimental function, your mileage may vary."
- (cond
- ((member type '("http" "https" "news" "ftp"))
- ;; standard Internet links are the same.
- nil)
- ((and (equal type "irc") (string-match "^//" path))
- ;; Planner has two / at the beginning of an irc link, we have 1.
- ;; We should have zero, actually....
- (setq path (substring path 1)))
- ((and (equal type "lisp") (string-match "^/" path))
- ;; Planner has a slash, we do not.
- (setq type "elisp" path (substring path 1)))
- ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path)
- ;; A typical message link. Planner has the id after the final slash,
- ;; we separate it with a hash mark
- (setq path (concat (match-string 1 path) "#"
- (org-remove-angle-brackets (match-string 2 path)))))
- )
- (cons type path))
+ (cond
+ ((member type '("http" "https" "news" "ftp"))
+ ;; standard Internet links are the same.
+ nil)
+ ((and (equal type "irc") (string-match "^//" path))
+ ;; Planner has two / at the beginning of an irc link, we have 1.
+ ;; We should have zero, actually....
+ (setq path (substring path 1)))
+ ((and (equal type "lisp") (string-match "^/" path))
+ ;; Planner has a slash, we do not.
+ (setq type "elisp" path (substring path 1)))
+ ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path)
+ ;; A typical message link. Planner has the id after the final slash,
+ ;; we separate it with a hash mark
+ (setq path (concat (match-string 1 path) "#"
+ (org-remove-angle-brackets (match-string 2 path)))))
+ )
+ (cons type path))
(defun org-find-file-at-mouse (ev)
"Open file link or URL at mouse."
@@ -9518,6 +9764,7 @@ Functions in this hook must return t if they identify and follow
a link at point. If they don't find anything interesting at point,
they must return nil.")
+(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el
(defun org-open-at-point (&optional arg reference-buffer)
"Open link at or after point.
If there is no link at point, this function will search forward up to
@@ -9529,197 +9776,213 @@ application the system uses for this file type."
(interactive "P")
;; if in a code block, then open the block's results
(unless (call-interactively #'org-babel-open-src-block-result)
- (org-load-modules-maybe)
- (move-marker org-open-link-marker (point))
- (setq org-window-config-before-follow-link (current-window-configuration))
- (org-remove-occur-highlights nil nil t)
- (cond
- ((and (org-at-heading-p)
- (not (org-in-regexp
- (concat org-plain-link-re "\\|"
- org-bracket-link-regexp "\\|"
- org-angle-link-re "\\|"
- "[ \t]:[^ \t\n]+:[ \t]*$")))
- (not (get-text-property (point) 'org-linked-text)))
- (or (org-offer-links-in-entry arg)
- (progn (require 'org-attach) (org-attach-reveal 'if-exists))))
- ((run-hook-with-args-until-success 'org-open-at-point-functions))
- ((org-at-timestamp-p t) (org-follow-timestamp-link))
- ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p))
- (not (org-in-regexp org-bracket-link-regexp)))
- (org-footnote-action))
- (t
- (let (type path link line search (pos (point)))
- (catch 'match
- (save-excursion
- (skip-chars-forward "^]\n\r")
- (when (org-in-regexp org-bracket-link-regexp 1)
- (setq link (org-extract-attributes
- (org-link-unescape (org-match-string-no-properties 1))))
- (while (string-match " *\n *" link)
- (setq link (replace-match " " t t link)))
- (setq link (org-link-expand-abbrev link))
- (cond
- ((or (file-name-absolute-p link)
- (string-match "^\\.\\.?/" link))
- (setq type "file" path link))
- ((string-match org-link-re-with-space3 link)
- (setq type (match-string 1 link) path (match-string 2 link)))
- (t (setq type "thisfile" path link)))
- (throw 'match t)))
-
- (when (get-text-property (point) 'org-linked-text)
- (setq type "thisfile"
- pos (if (get-text-property (1+ (point)) 'org-linked-text)
- (1+ (point)) (point))
- path (buffer-substring
- (or (previous-single-property-change pos 'org-linked-text)
- (point-min))
- (or (next-single-property-change pos 'org-linked-text)
- (point-max))))
- (throw 'match t))
+ (org-load-modules-maybe)
+ (move-marker org-open-link-marker (point))
+ (setq org-window-config-before-follow-link (current-window-configuration))
+ (org-remove-occur-highlights nil nil t)
+ (cond
+ ((and (org-at-heading-p)
+ (not (org-at-timestamp-p t))
+ (not (org-in-regexp
+ (concat org-plain-link-re "\\|"
+ org-bracket-link-regexp "\\|"
+ org-angle-link-re "\\|"
+ "[ \t]:[^ \t\n]+:[ \t]*$")))
+ (not (get-text-property (point) 'org-linked-text)))
+ (or (org-offer-links-in-entry arg)
+ (progn (require 'org-attach) (org-attach-reveal 'if-exists))))
+ ((run-hook-with-args-until-success 'org-open-at-point-functions))
+ ((and (org-at-timestamp-p t)
+ (not (org-in-regexp org-bracket-link-regexp)))
+ (org-follow-timestamp-link))
+ ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p))
+ (not (org-in-regexp org-bracket-link-regexp)))
+ (org-footnote-action))
+ (t
+ (let (type path link line search (pos (point)))
+ (catch 'match
+ (save-excursion
+ (skip-chars-forward "^]\n\r")
+ (when (org-in-regexp org-bracket-link-regexp 1)
+ (setq link (org-extract-attributes
+ (org-link-unescape (org-match-string-no-properties 1))))
+ (while (string-match " *\n *" link)
+ (setq link (replace-match " " t t link)))
+ (setq link (org-link-expand-abbrev link))
+ (cond
+ ((or (file-name-absolute-p link)
+ (string-match "^\\.\\.?/" link))
+ (setq type "file" path link))
+ ((string-match org-link-re-with-space3 link)
+ (setq type (match-string 1 link) path (match-string 2 link)))
+ ((string-match "^help:+\\(.+\\)" link)
+ (setq type "help" path (match-string 1 link)))
+ (t (setq type "thisfile" path link)))
+ (throw 'match t)))
+
+ (when (get-text-property (point) 'org-linked-text)
+ (setq type "thisfile"
+ pos (if (get-text-property (1+ (point)) 'org-linked-text)
+ (1+ (point)) (point))
+ path (buffer-substring
+ (or (previous-single-property-change pos 'org-linked-text)
+ (point-min))
+ (or (next-single-property-change pos 'org-linked-text)
+ (point-max))))
+ (throw 'match t))
- (save-excursion
- (when (or (org-in-regexp org-angle-link-re)
- (org-in-regexp org-plain-link-re))
- (setq type (match-string 1)
- path (org-link-unescape (match-string 2)))
- (throw 'match t)))
- (save-excursion
- (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$"))
- (setq type "tags"
+ (save-excursion
+ (when (or (org-in-regexp org-angle-link-re)
+ (and (goto-char (car (org-in-regexp org-plain-link-re)))
+ (save-match-data (not (looking-back "\\[\\[")))))
+ (setq type (match-string 1)
+ path (org-link-unescape (match-string 2)))
+ (throw 'match t)))
+ (save-excursion
+ (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$"))
+ (setq type "tags"
+ path (match-string 1))
+ (while (string-match ":" path)
+ (setq path (replace-match "+" t t path)))
+ (throw 'match t)))
+ (when (org-in-regexp "<\\([^><\n]+\\)>")
+ (setq type "tree-match"
path (match-string 1))
- (while (string-match ":" path)
- (setq path (replace-match "+" t t path)))
(throw 'match t)))
- (when (org-in-regexp "<\\([^><\n]+\\)>")
- (setq type "tree-match"
- path (match-string 1))
- (throw 'match t)))
- (unless path
- (error "No link found"))
-
- ;; switch back to reference buffer
- ;; needed when if called in a temporary buffer through
- ;; org-open-link-from-string
- (with-current-buffer (or reference-buffer (current-buffer))
-
- ;; Remove any trailing spaces in path
- (if (string-match " +\\'" path)
- (setq path (replace-match "" t t path)))
- (if (and org-link-translation-function
- (fboundp org-link-translation-function))
- ;; Check if we need to translate the link
- (let ((tmp (funcall org-link-translation-function type path)))
- (setq type (car tmp) path (cdr tmp))))
+ (unless path
+ (error "No link found"))
+
+ ;; switch back to reference buffer
+ ;; needed when if called in a temporary buffer through
+ ;; org-open-link-from-string
+ (with-current-buffer (or reference-buffer (current-buffer))
+
+ ;; Remove any trailing spaces in path
+ (if (string-match " +\\'" path)
+ (setq path (replace-match "" t t path)))
+ (if (and org-link-translation-function
+ (fboundp org-link-translation-function))
+ ;; Check if we need to translate the link
+ (let ((tmp (funcall org-link-translation-function type path)))
+ (setq type (car tmp) path (cdr tmp))))
- (cond
+ (cond
- ((assoc type org-link-protocols)
- (funcall (nth 1 (assoc type org-link-protocols)) path))
-
- ((equal type "mailto")
- (let ((cmd (car org-link-mailto-program))
- (args (cdr org-link-mailto-program)) args1
- (address path) (subject "") a)
- (if (string-match "\\(.*\\)::\\(.*\\)" path)
- (setq address (match-string 1 path)
- subject (org-link-escape (match-string 2 path))))
- (while args
- (cond
- ((not (stringp (car args))) (push (pop args) args1))
- (t (setq a (pop args))
- (if (string-match "%a" a)
- (setq a (replace-match address t t a)))
- (if (string-match "%s" a)
- (setq a (replace-match subject t t a)))
- (push a args1))))
- (apply cmd (nreverse args1))))
-
- ((member type '("http" "https" "ftp" "news"))
- (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path)
- (org-link-escape
- path org-link-escape-chars-browser)
- path))))
-
- ((string= type "doi")
- (browse-url (concat "http://dx.doi.org/" (if (org-string-match-p "[[:nonascii:] ]" path)
+ ((assoc type org-link-protocols)
+ (funcall (nth 1 (assoc type org-link-protocols)) path))
+
+ ((equal type "help")
+ (let ((f-or-v (intern path)))
+ (cond ((fboundp f-or-v)
+ (describe-function f-or-v))
+ ((boundp f-or-v)
+ (describe-variable f-or-v))
+ (t (error "Not a known function or variable")))))
+
+ ((equal type "mailto")
+ (let ((cmd (car org-link-mailto-program))
+ (args (cdr org-link-mailto-program)) args1
+ (address path) (subject "") a)
+ (if (string-match "\\(.*\\)::\\(.*\\)" path)
+ (setq address (match-string 1 path)
+ subject (org-link-escape (match-string 2 path))))
+ (while args
+ (cond
+ ((not (stringp (car args))) (push (pop args) args1))
+ (t (setq a (pop args))
+ (if (string-match "%a" a)
+ (setq a (replace-match address t t a)))
+ (if (string-match "%s" a)
+ (setq a (replace-match subject t t a)))
+ (push a args1))))
+ (apply cmd (nreverse args1))))
+
+ ((member type '("http" "https" "ftp" "news"))
+ (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path)
+ (org-link-escape
+ path org-link-escape-chars-browser)
+ path))))
+
+ ((string= type "doi")
+ (browse-url (concat org-doi-server-url (if (org-string-match-p "[[:nonascii:] ]" path)
(org-link-escape
path org-link-escape-chars-browser)
path))))
- ((member type '("message"))
- (browse-url (concat type ":" path)))
-
- ((string= type "tags")
- (org-tags-view arg path))
-
- ((string= type "tree-match")
- (org-occur (concat "\\[" (regexp-quote path) "\\]")))
-
- ((string= type "file")
- (if (string-match "::\\([0-9]+\\)\\'" path)
- (setq line (string-to-number (match-string 1 path))
- path (substring path 0 (match-beginning 0)))
- (if (string-match "::\\(.+\\)\\'" path)
- (setq search (match-string 1 path)
- path (substring path 0 (match-beginning 0)))))
- (if (string-match "[*?{]" (file-name-nondirectory path))
- (dired path)
- (org-open-file path arg line search)))
-
- ((string= type "shell")
- (let ((cmd path))
- (if (or (and (not (string= org-confirm-shell-link-not-regexp ""))
- (string-match org-confirm-shell-link-not-regexp cmd))
- (not org-confirm-shell-link-function)
- (funcall org-confirm-shell-link-function
- (format "Execute \"%s\" in shell? "
- (org-add-props cmd nil
- 'face 'org-warning))))
- (progn
- (message "Executing %s" cmd)
- (shell-command cmd))
- (error "Abort"))))
-
- ((string= type "elisp")
- (let ((cmd path))
- (if (or (and (not (string= org-confirm-elisp-link-not-regexp ""))
- (string-match org-confirm-elisp-link-not-regexp cmd))
- (not org-confirm-elisp-link-function)
- (funcall org-confirm-elisp-link-function
- (format "Execute \"%s\" as elisp? "
- (org-add-props cmd nil
- 'face 'org-warning))))
- (message "%s => %s" cmd
- (if (equal (string-to-char cmd) ?\()
- (eval (read cmd))
- (call-interactively (read cmd))))
- (error "Abort"))))
-
- ((and (string= type "thisfile")
- (run-hook-with-args-until-success
- 'org-open-link-functions path)))
-
- ((string= type "thisfile")
- (if arg
- (switch-to-buffer-other-window
- (org-get-buffer-for-internal-link (current-buffer)))
- (org-mark-ring-push))
- (let ((cmd `(org-link-search
- ,path
- ,(cond ((equal arg '(4)) ''occur)
- ((equal arg '(16)) ''org-occur)
- (t nil))
- ,pos)))
- (condition-case nil (let ((org-link-search-inhibit-query t))
- (eval cmd))
- (error (progn (widen) (eval cmd))))))
-
- (t
- (browse-url-at-point)))))))
- (move-marker org-open-link-marker nil)
- (run-hook-with-args 'org-follow-link-hook)))
+ ((member type '("message"))
+ (browse-url (concat type ":" path)))
+
+ ((string= type "tags")
+ (org-tags-view arg path))
+
+ ((string= type "tree-match")
+ (org-occur (concat "\\[" (regexp-quote path) "\\]")))
+
+ ((string= type "file")
+ (if (string-match "::\\([0-9]+\\)\\'" path)
+ (setq line (string-to-number (match-string 1 path))
+ path (substring path 0 (match-beginning 0)))
+ (if (string-match "::\\(.+\\)\\'" path)
+ (setq search (match-string 1 path)
+ path (substring path 0 (match-beginning 0)))))
+ (if (string-match "[*?{]" (file-name-nondirectory path))
+ (dired path)
+ (org-open-file path arg line search)))
+
+ ((string= type "shell")
+ (let ((buf (generate-new-buffer "*Org Shell Output"))
+ (cmd path))
+ (if (or (and (not (string= org-confirm-shell-link-not-regexp ""))
+ (string-match org-confirm-shell-link-not-regexp cmd))
+ (not org-confirm-shell-link-function)
+ (funcall org-confirm-shell-link-function
+ (format "Execute \"%s\" in shell? "
+ (org-add-props cmd nil
+ 'face 'org-warning))))
+ (progn
+ (message "Executing %s" cmd)
+ (shell-command cmd buf)
+ (if (featurep 'midnight)
+ (setq clean-buffer-list-kill-buffer-names
+ (cons buf clean-buffer-list-kill-buffer-names))))
+ (error "Abort"))))
+
+ ((string= type "elisp")
+ (let ((cmd path))
+ (if (or (and (not (string= org-confirm-elisp-link-not-regexp ""))
+ (string-match org-confirm-elisp-link-not-regexp cmd))
+ (not org-confirm-elisp-link-function)
+ (funcall org-confirm-elisp-link-function
+ (format "Execute \"%s\" as elisp? "
+ (org-add-props cmd nil
+ 'face 'org-warning))))
+ (message "%s => %s" cmd
+ (if (equal (string-to-char cmd) ?\()
+ (eval (read cmd))
+ (call-interactively (read cmd))))
+ (error "Abort"))))
+
+ ((and (string= type "thisfile")
+ (run-hook-with-args-until-success
+ 'org-open-link-functions path)))
+
+ ((string= type "thisfile")
+ (if arg
+ (switch-to-buffer-other-window
+ (org-get-buffer-for-internal-link (current-buffer)))
+ (org-mark-ring-push))
+ (let ((cmd `(org-link-search
+ ,path
+ ,(cond ((equal arg '(4)) ''occur)
+ ((equal arg '(16)) ''org-occur))
+ ,pos)))
+ (condition-case nil (let ((org-link-search-inhibit-query t))
+ (eval cmd))
+ (error (progn (widen) (eval cmd))))))
+
+ (t (browse-url-at-point)))))))
+ (move-marker org-open-link-marker nil)
+ (run-hook-with-args 'org-follow-link-hook)))
(defun org-offer-links-in-entry (&optional nth zero)
"Offer links in the current entry and follow the selected link.
@@ -9903,6 +10166,22 @@ visibility around point, thus ignoring
pos (match-beginning 0))))
;; There is an exact target for this
(goto-char pos))
+ ((save-excursion
+ (goto-char (point-min))
+ (and
+ (re-search-forward
+ (format "^[ \t]*#\\+TARGET: %s" (regexp-quote s0)) nil t)
+ (setq type 'dedicated pos (match-beginning 0))))
+ ;; Found an invisible target.
+ (goto-char pos))
+ ((save-excursion
+ (goto-char (point-min))
+ (and
+ (re-search-forward
+ (format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t)
+ (setq type 'dedicated pos (match-beginning 0))))
+ ;; Found an element with a matching #+name affiliated keyword.
+ (goto-char pos))
((and (string-match "^(\\(.*\\))$" s0)
(save-excursion
(goto-char (point-min))
@@ -9919,12 +10198,12 @@ visibility around point, thus ignoring
((string-match "^/\\(.*\\)/$" s)
;; A regular expression
(cond
- ((eq major-mode 'org-mode)
+ ((derived-mode-p 'org-mode)
(org-occur (match-string 1 s)))
;;((eq major-mode 'dired-mode)
;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
(t (org-do-occur (match-string 1 s)))))
- ((and (eq major-mode 'org-mode) org-link-search-must-match-exact-headline)
+ ((and (derived-mode-p 'org-mode) org-link-search-must-match-exact-headline)
(and (equal (string-to-char s) ?*) (setq s (substring s 1)))
(goto-char (point-min))
(cond
@@ -9992,7 +10271,7 @@ visibility around point, thus ignoring
(goto-char (match-beginning 1))
(goto-char pos)
(error "No match"))))))
- (and (eq major-mode 'org-mode)
+ (and (derived-mode-p 'org-mode)
(not stealth)
(org-show-context 'link-search))
type))
@@ -10073,8 +10352,8 @@ to read."
(or pos (point))
(or buffer (current-buffer)))
(message "%s"
- (substitute-command-keys
- "Position saved to mark ring, go back with \\[org-mark-ring-goto].")))
+ (substitute-command-keys
+ "Position saved to mark ring, go back with \\[org-mark-ring-goto].")))
(defun org-mark-ring-goto (&optional n)
"Jump to the previous position in the mark ring.
@@ -10110,18 +10389,24 @@ onto the ring."
;;; Following specific links
(defun org-follow-timestamp-link ()
+ "Open an agenda view for the time-stamp date/range at point."
(cond
((org-at-date-range-p t)
(let ((org-agenda-start-on-weekday)
(t1 (match-string 1))
- (t2 (match-string 2)))
- (setq t1 (time-to-days (org-time-string-to-time t1))
- t2 (time-to-days (org-time-string-to-time t2)))
- (org-agenda-list nil t1 (1+ (- t2 t1)))))
+ (t2 (match-string 2)) tt1 tt2)
+ (setq tt1 (time-to-days (org-time-string-to-time t1))
+ tt2 (time-to-days (org-time-string-to-time t2)))
+ (let ((org-agenda-buffer-tmp-name
+ (format "*Org Agenda(a:%s)"
+ (concat (substring t1 0 10) "--" (substring t2 0 10)))))
+ (org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
((org-at-timestamp-p t)
- (org-agenda-list nil (time-to-days (org-time-string-to-time
- (substring (match-string 1) 0 10)))
- 1))
+ (let ((org-agenda-buffer-tmp-name
+ (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
+ (org-agenda-list nil (time-to-days (org-time-string-to-time
+ (substring (match-string 1) 0 10)))
+ 1)))
(t (error "This should not happen"))))
@@ -10170,9 +10455,9 @@ If the file does not exist, an error is thrown."
(dfile (downcase file))
;; reconstruct the original file: link from the PATH, LINE and SEARCH args
(link (cond ((and (eq line nil)
- (eq search nil))
- file)
- (line
+ (eq search nil))
+ file)
+ (line
(concat file "::" (number-to-string line)))
(search
(concat file "::" search))))
@@ -10192,8 +10477,8 @@ If the file does not exist, an error is thrown."
(t
(setq cmd (or (and remp (cdr (assoc 'remote apps)))
(and dirp (cdr (assoc 'directory apps)))
- ; first, try matching against apps-dlink
- ; if we get a match here, store the match data for later
+ ; first, try matching against apps-dlink
+ ; if we get a match here, store the match data for later
(let ((match (assoc-default dlink apps-dlink
'string-match)))
(if match
@@ -10201,8 +10486,8 @@ If the file does not exist, an error is thrown."
match)
(progn (setq in-emacs (or in-emacs line search))
nil))) ; if we have no match in apps-dlink,
- ; always open the file in emacs if line or search
- ; is given (for backwards compatibility)
+ ; always open the file in emacs if line or search
+ ; is given (for backwards compatibility)
(assoc-default dfile (org-apps-regexp-alist apps a-m-a-p)
'string-match)
(cdr (assoc ext apps))
@@ -10263,7 +10548,7 @@ If the file does not exist, an error is thrown."
(set-match-data link-match-data)
(eval cmd))))
(t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
- (and (eq major-mode 'org-mode) (eq old-mode 'org-mode)
+ (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode)
(or (not (equal old-buffer (current-buffer)))
(not (equal old-pos (point))))
(org-mark-ring-push old-pos old-buffer))))
@@ -10328,8 +10613,7 @@ on the system \"/user@host:\"."
(tramp-handle-file-remote-p file))
((and (boundp 'ange-ftp-name-format)
(string-match (car ange-ftp-name-format) file))
- t)
- (t nil)))
+ t)))
;;;; Refiling
@@ -10587,7 +10871,7 @@ such as the file name."
(interactive "P")
(let* ((bfn (buffer-file-name (buffer-base-buffer)))
(case-fold-search nil)
- (path (and (eq major-mode 'org-mode) (org-get-outline-path))))
+ (path (and (derived-mode-p 'org-mode) (org-get-outline-path))))
(if current (setq path (append path
(save-excursion
(org-back-to-heading t)
@@ -10634,7 +10918,7 @@ RFLOC can be a refile location obtained in a different way.
See also `org-refile-use-outline-path' and `org-completion-use-ido'.
If you are using target caching (see `org-refile-use-cache'),
-You have to clear the target cache in order to find new targets.
+you have to clear the target cache in order to find new targets.
This can be done with a 0 prefix (`C-0 C-c C-w') or a triple
prefix argument (`C-u C-u C-u C-c C-w')."
@@ -10741,7 +11025,9 @@ prefix argument (`C-u C-u C-u C-c C-w')."
org-log-refile)
(unless (eq org-log-refile 'note)
(save-excursion (org-add-log-note))))
- (and org-auto-align-tags (org-set-tags nil t))
+ (and org-auto-align-tags
+ (let ((org-loop-over-headlines-in-active-region nil))
+ (org-set-tags nil t)))
(bookmark-set "org-refile-last-stored")
;; If we are refiling for capture, make sure that the
;; last-capture pointers point here
@@ -10775,7 +11061,7 @@ this is used for the GOTO interface."
(let ((org-refile-targets org-refile-targets)
(org-refile-use-outline-path org-refile-use-outline-path)
excluded-entries)
- (when (and (eq major-mode 'org-mode)
+ (when (and (derived-mode-p 'org-mode)
(not org-refile-use-cache)
(not no-exclude))
(org-map-tree
@@ -10842,6 +11128,7 @@ this is used for the GOTO interface."
(org-refile-new-child parent-target child)))
(error "Invalid target location")))))
+(declare-function org-string-nw-p "org-macs.el" (s))
(defun org-refile-check-position (refile-pointer)
"Check if the refile pointer matches the readline to which it points."
(let* ((file (nth 1 refile-pointer))
@@ -10916,8 +11203,7 @@ this is used for the GOTO interface."
rtn))
((eq flag 'lambda)
;; exact match?
- (assoc string thetable)))
- ))
+ (assoc string thetable)))))
args)))
;;;; Dynamic blocks
@@ -10925,20 +11211,20 @@ this is used for the GOTO interface."
(defun org-find-dblock (name)
"Find the first dynamic block with name NAME in the buffer.
If not found, stay at current position and return nil."
- (let (pos)
+ (let ((case-fold-search t) pos)
(save-excursion
(goto-char (point-min))
- (setq pos (and (re-search-forward (concat "^[ \t]*#\\+BEGIN:[ \t]+" name "\\>")
- nil t)
+ (setq pos (and (re-search-forward
+ (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t)
(match-beginning 0))))
(if pos (goto-char pos))
pos))
(defconst org-dblock-start-re
- "^[ \t]*#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
+ "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
"Matches the start line of a dynamic block, with parameters.")
-(defconst org-dblock-end-re "^[ \t]*#\\+END\\([: \t\r\n]\\|$\\)"
+(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)"
"Matches the end of a dynamic block.")
(defun org-create-dblock (plist)
@@ -11027,15 +11313,15 @@ the correct writing function."
(when (and indent (> indent 0))
(setq indent (make-string indent ?\ ))
(save-excursion
- (org-beginning-of-dblock)
- (forward-line 1)
- (while (not (looking-at org-dblock-end-re))
- (insert indent)
- (beginning-of-line 2))
- (when (looking-at org-dblock-end-re)
- (and (looking-at "[ \t]+")
- (replace-match ""))
- (insert indent)))))))
+ (org-beginning-of-dblock)
+ (forward-line 1)
+ (while (not (looking-at org-dblock-end-re))
+ (insert indent)
+ (beginning-of-line 2))
+ (when (looking-at org-dblock-end-re)
+ (and (looking-at "[ \t]+")
+ (replace-match ""))
+ (insert indent)))))))
(defun org-beginning-of-dblock ()
"Find the beginning of the dynamic block at point.
@@ -11051,11 +11337,12 @@ Error if there is no such block at point."
(goto-char pos)
(error "Not in a dynamic block"))))
+;;;###autoload
(defun org-update-all-dblocks ()
"Update all dynamic blocks in the buffer.
This function can be used in a hook."
(interactive)
- (when (eq major-mode 'org-mode)
+ (when (derived-mode-p 'org-mode)
(org-map-dblocks 'org-update-dblock)))
@@ -11069,46 +11356,68 @@ This function can be used in a hook."
"BEGIN:" "END:"
"ORGTBL" "TBLFM:" "TBLNAME:"
"BEGIN_EXAMPLE" "END_EXAMPLE"
+ "BEGIN_VERBATIM" "END_VERBATIM"
"BEGIN_QUOTE" "END_QUOTE"
"BEGIN_VERSE" "END_VERSE"
"BEGIN_CENTER" "END_CENTER"
"BEGIN_SRC" "END_SRC"
"BEGIN_RESULT" "END_RESULT"
+ "BEGIN_lstlisting" "END_lstlisting"
"NAME:" "RESULTS:"
"HEADER:" "HEADERS:"
- "CATEGORY:" "COLUMNS:" "PROPERTY:"
+ "COLUMNS:" "PROPERTY:"
"CAPTION:" "LABEL:"
"SETUPFILE:"
"INCLUDE:"
"BIND:"
"MACRO:"))
+(defconst org-options-keywords
+ '("TITLE:" "AUTHOR:" "EMAIL:" "DATE:"
+ "DESCRIPTION:" "KEYWORDS:" "LANGUAGE:" "OPTIONS:"
+ "EXPORT_SELECT_TAGS:" "EXPORT_EXCLUDE_TAGS:"
+ "LINK_UP:" "LINK_HOME:" "LINK:" "TODO:"
+ "XSLT:" "MATHJAX:" "CATEGORY:" "SEQ_TODO:" "TYP_TODO:"
+ "PRIORITIES:" "DRAWERS:" "STARTUP:" "TAGS:" "STYLE:"
+ "FILETAGS:" "ARCHIVE:" "INFOJS_OPT:"))
+
+(defconst org-additional-option-like-keywords-for-flyspell
+ (delete-dups
+ (split-string
+ (mapconcat (lambda(k)
+ (replace-regexp-in-string
+ "_\\|:" " "
+ (concat k " " (downcase k) " " (upcase k))))
+ (append org-options-keywords org-additional-option-like-keywords)
+ " ")
+ " +" t)))
+
(defcustom org-structure-template-alist
'(
- ("s" "#+begin_src ?\n\n#+end_src"
- "<src lang=\"?\">\n\n</src>")
- ("e" "#+begin_example\n?\n#+end_example"
- "<example>\n?\n</example>")
- ("q" "#+begin_quote\n?\n#+end_quote"
- "<quote>\n?\n</quote>")
+ ("s" "#+BEGIN_SRC ?\n\n#+END_SRC"
+ "<src lang=\"?\">\n\n</src>")
+ ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE"
+ "<example>\n?\n</example>")
+ ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE"
+ "<quote>\n?\n</quote>")
("v" "#+BEGIN_VERSE\n?\n#+END_VERSE"
- "<verse>\n?\n</verse>")
+ "<verse>\n?\n</verse>")
("c" "#+BEGIN_CENTER\n?\n#+END_CENTER"
- "<center>\n?\n</center>")
+ "<center>\n?\n</center>")
("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX"
- "<literal style=\"latex\">\n?\n</literal>")
- ("L" "#+latex: "
- "<literal style=\"latex\">?</literal>")
- ("h" "#+begin_html\n?\n#+end_html"
- "<literal style=\"html\">\n?\n</literal>")
- ("H" "#+html: "
- "<literal style=\"html\">?</literal>")
- ("a" "#+begin_ascii\n?\n#+end_ascii")
- ("A" "#+ascii: ")
- ("i" "#+index: ?"
- "#+index: ?")
- ("I" "#+include %file ?"
- "<include file=%file markup=\"?\">")
+ "<literal style=\"latex\">\n?\n</literal>")
+ ("L" "#+LaTeX: "
+ "<literal style=\"latex\">?</literal>")
+ ("h" "#+BEGIN_HTML\n?\n#+END_HTML"
+ "<literal style=\"html\">\n?\n</literal>")
+ ("H" "#+HTML: "
+ "<literal style=\"html\">?</literal>")
+ ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII")
+ ("A" "#+ASCII: ")
+ ("i" "#+INDEX: ?"
+ "#+INDEX: ?")
+ ("I" "#+INCLUDE: %file ?"
+ "<include file=%file markup=\"?\">")
)
"Structure completion elements.
This is a list of abbreviation keys and values. The value gets inserted
@@ -11119,8 +11428,7 @@ of the `?` in the template.
There are two templates for each key, the first uses the original Org syntax,
the second uses Emacs Muse-like syntax tags. These Muse-like tags become
the default when the /org-mtags.el/ module has been loaded. See also the
-variable `org-mtags-prefer-muse-templates'.
-This is an experimental feature, it is undecided if it is going to stay in."
+variable `org-mtags-prefer-muse-templates'."
:group 'org-completion
:type '(repeat
(string :tag "Key")
@@ -11205,14 +11513,14 @@ nil or a string to be used for the todo mark." )
(defvar org-agenda-headline-snapshot-before-repeat)
(defun org-current-effective-time ()
- "Return current time adjusted for `org-extend-today-until' variable"
+ "Return current time adjusted for `org-extend-today-until' variable."
(let* ((ct (org-current-time))
- (dct (decode-time ct))
- (ct1
- (if (and org-use-effective-time
- (< (nth 2 dct) org-extend-today-until))
- (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
- ct)))
+ (dct (decode-time ct))
+ (ct1
+ (if (and org-use-effective-time
+ (< (nth 2 dct) org-extend-today-until))
+ (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
+ ct)))
ct1))
(defun org-todo-yesterday (&optional arg)
@@ -11310,54 +11618,54 @@ For calling through lisp, arg is also interpreted in the following way:
((and (equal arg '(4))
(or (not org-use-fast-todo-selection)
(not org-todo-key-trigger)))
- ;; Read a state with completion
- (org-icompleting-read
- "State: " (mapcar (lambda(x) (list x))
- org-todo-keywords-1)
- nil t))
- ((eq arg 'right)
- (if this
- (if tail (car tail) nil)
- (car org-todo-keywords-1)))
- ((eq arg 'left)
- (if (equal member org-todo-keywords-1)
- nil
- (if this
- (nth (- (length org-todo-keywords-1)
- (length tail) 2)
- org-todo-keywords-1)
- (org-last org-todo-keywords-1))))
- ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
- (setq arg nil))) ; hack to fall back to cycling
- (arg
- ;; user or caller requests a specific state
- (cond
- ((equal arg "") nil)
- ((eq arg 'none) nil)
- ((eq arg 'done) (or done-word (car org-done-keywords)))
- ((eq arg 'nextset)
- (or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads)))
- ((eq arg 'previousset)
- (let ((org-todo-heads (reverse org-todo-heads)))
- (or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads))))
- ((car (member arg org-todo-keywords-1)))
- ((stringp arg)
- (error "State `%s' not valid in this file" arg))
- ((nth (1- (prefix-numeric-value arg))
- org-todo-keywords-1))))
- ((null member) (or head (car org-todo-keywords-1)))
- ((equal this final-done-word) nil) ;; -> make empty
- ((null tail) nil) ;; -> first entry
- ((memq interpret '(type priority))
- (if (eq this-command last-command)
- (car tail)
- (if (> (length tail) 0)
- (or done-word (car org-done-keywords))
- nil)))
- (t
- (car tail))))
+ ;; Read a state with completion
+ (org-icompleting-read
+ "State: " (mapcar (lambda(x) (list x))
+ org-todo-keywords-1)
+ nil t))
+ ((eq arg 'right)
+ (if this
+ (if tail (car tail) nil)
+ (car org-todo-keywords-1)))
+ ((eq arg 'left)
+ (if (equal member org-todo-keywords-1)
+ nil
+ (if this
+ (nth (- (length org-todo-keywords-1)
+ (length tail) 2)
+ org-todo-keywords-1)
+ (org-last org-todo-keywords-1))))
+ ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
+ (setq arg nil))) ; hack to fall back to cycling
+ (arg
+ ;; user or caller requests a specific state
+ (cond
+ ((equal arg "") nil)
+ ((eq arg 'none) nil)
+ ((eq arg 'done) (or done-word (car org-done-keywords)))
+ ((eq arg 'nextset)
+ (or (car (cdr (member head org-todo-heads)))
+ (car org-todo-heads)))
+ ((eq arg 'previousset)
+ (let ((org-todo-heads (reverse org-todo-heads)))
+ (or (car (cdr (member head org-todo-heads)))
+ (car org-todo-heads))))
+ ((car (member arg org-todo-keywords-1)))
+ ((stringp arg)
+ (error "State `%s' not valid in this file" arg))
+ ((nth (1- (prefix-numeric-value arg))
+ org-todo-keywords-1))))
+ ((null member) (or head (car org-todo-keywords-1)))
+ ((equal this final-done-word) nil) ;; -> make empty
+ ((null tail) nil) ;; -> first entry
+ ((memq interpret '(type priority))
+ (if (eq this-command last-command)
+ (car tail)
+ (if (> (length tail) 0)
+ (or done-word (car org-done-keywords))
+ nil)))
+ (t
+ (car tail))))
(org-state (or
(run-hook-with-args-until-success
'org-todo-get-default-hook org-state org-last-state)
@@ -11913,7 +12221,7 @@ This function is run automatically after each state change to a DONE state."
(aa (assoc org-last-state org-todo-kwd-alist))
(interpret (nth 1 aa))
(head (nth 2 aa))
- (whata '(("d" . day) ("m" . month) ("y" . year)))
+ (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
(msg "Entry repeats: ")
(org-log-done nil)
(org-todo-log-states nil)
@@ -11949,10 +12257,12 @@ This function is run automatically after each state change to a DONE state."
(setq type (if (match-end 1) org-scheduled-string
(if (match-end 3) org-deadline-string "Plain:"))
ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0))))
- (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts)
+ (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)
(setq n (string-to-number (match-string 2 ts))
what (match-string 3 ts))
(if (equal what "w") (setq n (* n 7) what "d"))
+ (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)))
+ (error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n))
;; Preparation, see if we need to modify the start date for the change
(when (match-end 1)
(setq time (save-match-data (org-time-string-to-time ts)))
@@ -11978,7 +12288,7 @@ This function is run automatically after each state change to a DONE state."
;; rematch, so that we have everything in place for the real shift
(org-at-timestamp-p t)
(setq ts (match-string 1))
- (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts))))
+ (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))))
(org-timestamp-change n (cdr (assoc what whata)))
(setq msg (concat msg type " " org-last-changed-timestamp " "))))
(setq org-log-post-message msg)
@@ -11997,7 +12307,7 @@ of `org-todo-keywords-1'."
(cond ((null arg) org-not-done-regexp)
((equal arg '(4))
(let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): "
- (mapcar 'list org-todo-keywords-1))))
+ (mapcar 'list org-todo-keywords-1))))
(concat "\\("
(mapconcat 'identity (org-split-string kwd "|") "\\|")
"\\)\\>")))
@@ -12025,7 +12335,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(let* ((old-date (org-entry-get nil "DEADLINE"))
(repeater (and old-date
(string-match
- "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
+ "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
old-date)
(match-string 1 old-date))))
(if remove
@@ -12073,7 +12383,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(let* ((old-date (org-entry-get nil "SCHEDULED"))
(repeater (and old-date
(string-match
- "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
+ "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
old-date)
(match-string 1 old-date))))
(if remove
@@ -12281,8 +12591,7 @@ EXTRA is additional text that will be inserted into the notes buffer."
(let* ((org-log-into-drawer (org-log-into-drawer))
(drawer (cond ((stringp org-log-into-drawer)
org-log-into-drawer)
- (org-log-into-drawer "LOGBOOK")
- (t nil))))
+ (org-log-into-drawer "LOGBOOK"))))
(save-restriction
(save-excursion
(when findpos
@@ -12304,9 +12613,9 @@ EXTRA is additional text that will be inserted into the notes buffer."
(goto-char (1- (match-beginning 0))))))
(insert "\n:" drawer ":\n:END:")
(beginning-of-line 0)
- (org-indent-line-function)
+ (org-indent-line)
(beginning-of-line 2)
- (org-indent-line-function)
+ (org-indent-line)
(end-of-line 0)))
((and org-log-state-notes-insert-after-drawers
(save-excursion
@@ -12386,7 +12695,7 @@ EXTRA is additional text that will be inserted into the notes buffer."
(note (cdr (assq org-log-note-purpose org-log-note-headings)))
lines ind bul)
(kill-buffer (current-buffer))
- (while (string-match "\\`#.*\n[ \t\n]*" txt)
+ (while (string-match "\\`# .*\n[ \t\n]*" txt)
(setq txt (replace-match "" t t txt)))
(if (string-match "\\s-+\\'" txt)
(setq txt (replace-match "" t t txt)))
@@ -12471,7 +12780,8 @@ POS may also be a marker."
(concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2)
(replace-match ""))))))
-(defun org-sparse-tree (&optional arg)
+(defvar org-ts-type nil)
+(defun org-sparse-tree (&optional arg type)
"Create a sparse tree, prompt for the details.
This command can create sparse trees. You first need to select the type
of match used to create the tree:
@@ -12481,15 +12791,27 @@ T Show entries with a specific TODO keyword.
m Show entries selected by a tags/property match.
p Enter a property name and its value (both with completion on existing
names/values) and show entries with that property.
-r Show entries matching a regular expression (`/' can be used as well)
-d Show deadlines due within `org-deadline-warning-days'.
+r Show entries matching a regular expression (`/' can be used as well).
b Show deadlines and scheduled items before a date.
-a Show deadlines and scheduled items after a date."
+a Show deadlines and scheduled items after a date.
+d Show deadlines due within `org-deadline-warning-days'.
+D Show deadlines and scheduled items between a date range."
(interactive "P")
- (let (ans kwd value)
- (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range")
+ (let (ans kwd value ts-type)
+ (setq type (or type org-sparse-tree-default-date-type))
+ (setq org-ts-type type)
+ (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range\n [c]ycle through date types: %s"
+ (cond ((eq type 'all) "all timestamps")
+ ((eq type 'scheduled) "only scheduled")
+ ((eq type 'deadline) "only deadline")
+ ((eq type 'active) "only active timestamps")
+ ((eq type 'inactive) "only inactive timestamps")
+ ((eq type 'scheduled-or-deadline) "scheduled/deadline")
+ (t "scheduled/deadline")))
(setq ans (read-char-exclusive))
(cond
+ ((equal ans ?c)
+ (org-sparse-tree arg (cadr (member type '(scheduled-or-deadline all scheduled deadline active inactive)))))
((equal ans ?d)
(call-interactively 'org-check-deadlines))
((equal ans ?b)
@@ -12506,9 +12828,9 @@ a Show deadlines and scheduled items after a date."
(call-interactively 'org-match-sparse-tree))
((member ans '(?p ?P))
(setq kwd (org-icompleting-read "Property: "
- (mapcar 'list (org-buffer-property-keys))))
+ (mapcar 'list (org-buffer-property-keys))))
(setq value (org-icompleting-read "Value: "
- (mapcar 'list (org-property-values kwd))))
+ (mapcar 'list (org-property-values kwd))))
(unless (string-match "\\`{.*}\\'" value)
(setq value (concat "\"" value "\"")))
(org-match-sparse-tree arg (concat kwd "=" value)))
@@ -12693,10 +13015,12 @@ from the `before-change-functions' in the current buffer."
(interactive)
(org-priority 'down))
-(defun org-priority (&optional action)
- "Change the priority of an item by ARG.
+(defun org-priority (&optional action show)
+ "Change the priority of an item.
ACTION can be `set', `up', `down', or a character."
- (interactive)
+ (interactive "P")
+ (if (equal action '(4))
+ (org-show-priority)
(unless org-enable-priority-commands
(error "Priority commands are disabled"))
(setq action (or action 'set))
@@ -12773,7 +13097,21 @@ ACTION can be `set', `up', `down', or a character."
(org-preserve-lc (org-set-tags nil 'align)))
(if remove
(message "Priority removed")
- (message "Priority of current item set to %s" news))))
+ (message "Priority of current item set to %s" news)))))
+
+(defun org-show-priority ()
+ "Show the priority of the current item.
+This priority is composed of the main priority given with the [#A] cookies,
+and by additional input from the age of a schedules or deadline entry."
+ (interactive)
+ (let ((pri (if (eq major-mode 'org-agenda-mode)
+ (org-get-at-bol 'priority)
+ (save-excursion
+ (save-match-data
+ (beginning-of-line)
+ (and (looking-at org-heading-regexp)
+ (org-get-priority (match-string 0))))))))
+ (message "Priority is %d" (if pri pri -1000))))
(defun org-get-priority (s)
"Find priority cookie and return priority."
@@ -12896,7 +13234,8 @@ headlines matching this string."
;; eval matcher only when the todo condition is OK
(and (or (not todo-only) (member todo org-not-done-keywords))
- (let ((case-fold-search t)) (eval matcher)))
+ (let ((case-fold-search t) (org-trust-scanner-tags t))
+ (eval matcher)))
;; Call the skipper, but return t if it does not skip,
;; so that the `and' form continues evaluating
@@ -12935,8 +13274,7 @@ headlines matching this string."
(make-string (1- level) ?.) "")
(org-get-heading))
category
- tags-list
- )
+ tags-list)
priority (org-get-priority txt))
(goto-char lspos)
(setq marker (org-agenda-new-marker))
@@ -12993,7 +13331,7 @@ MATCH can contain positive and negative selection of tags, like
If optional argument TODO-ONLY is non-nil, only select lines that are
also TODO lines."
(interactive "P")
- (org-prepare-agenda-buffers (list (current-buffer)))
+ (org-agenda-prepare-buffers (list (current-buffer)))
(org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
@@ -13014,7 +13352,7 @@ also TODO lines."
(defun org-global-tags-completion-table (&optional files)
"Return the list of all tags in all agenda buffer/files.
-Optional FILES argument is a list of files to which can be used
+Optional FILES argument is a list of files which can be used
instead of the agenda files."
(save-excursion
(org-uniquify
@@ -13034,19 +13372,18 @@ instead of the agenda files."
(defun org-make-tags-matcher (match)
"Create the TAGS/TODO matcher form for the selection string MATCH.
-The variable `todo-only' is scoped dynamically into this function; it will be
-set to t if the matcher restricts matching to TODO entries,
+The variable `todo-only' is scoped dynamically into this function.
+It will be set to t if the matcher restricts matching to TODO entries,
otherwise will not be touched.
Returns a cons of the selection string MATCH and the constructed
-lisp form implementing the matcher. The matcher is to be
-evaluated at an Org entry, with point on the headline,
-and returns t if the entry matches the
-selection string MATCH. The returned lisp form references
-two variables with information about the entry, which must be
-bound around the form's evaluation: todo, the TODO keyword at the
-entry (or nil of none); and tags-list, the list of all tags at the
-entry including inherited ones. Additionally, the category
+lisp form implementing the matcher. The matcher is to be evaluated
+at an Org entry, with point on the headline, and returns t if the
+entry matches the selection string MATCH. The returned lisp form
+references two variables with information about the entry, which
+must be bound around the form's evaluation: todo, the TODO keyword
+at the entry (or nil of none); and tags-list, the list of all tags
+at the entry including inherited ones. Additionally, the category
of the entry (if any) must be specified as the text property
'org-category on the headline.
@@ -13226,7 +13563,7 @@ epoch to the beginning of today (00:00)."
((string= s "<today>") (org-time-today))
((string= s "<tomorrow>") (+ 86400.0 (org-time-today)))
((string= s "<yesterday>") (- (org-time-today) 86400.0))
- ((string-match "^<\\([-+][0-9]+\\)\\([dwmy]\\)>$" s)
+ ((string-match "^<\\([-+][0-9]+\\)\\([hdwmy]\\)>$" s)
(+ (org-time-today)
(* (string-to-number (match-string 1 s))
(cdr (assoc (match-string 2 s)
@@ -13357,7 +13694,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
(defun org-set-tags-command (&optional arg just-align)
"Call the set-tags command for the current entry."
(interactive "P")
- (if (org-at-heading-p)
+ (if (or (org-at-heading-p) (and arg (org-before-first-heading-p)))
(org-set-tags arg just-align)
(save-excursion
(org-back-to-heading t)
@@ -13376,8 +13713,7 @@ If DATA is nil or the empty string, any tags will be removed."
(concat ":" (mapconcat 'identity (org-split-string data ":+") ":")
":"))
((listp data)
- (concat ":" (mapconcat 'identity data ":") ":"))
- (t nil)))
+ (concat ":" (mapconcat 'identity data ":") ":"))))
(when data
(save-excursion
(org-back-to-heading t)
@@ -13410,94 +13746,104 @@ If DATA is nil or the empty string, any tags will be removed."
"Set the tags for the current headline.
With prefix ARG, realign all tags in headings in the current buffer."
(interactive "P")
- (let* ((re org-outline-regexp-bol)
- (current (org-get-tags-string))
- (col (current-column))
- (org-setting-tags t)
- table current-tags inherited-tags ; computed below when needed
- tags p0 c0 c1 rpl di tc level)
- (if arg
- (save-excursion
- (goto-char (point-min))
- (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
- (while (re-search-forward re nil t)
- (org-set-tags nil t)
- (end-of-line 1)))
- (message "All tags realigned to column %d" org-tags-column))
- (if just-align
- (setq tags current)
- ;; Get a new set of tags from the user
- (save-excursion
- (setq table (append org-tag-persistent-alist
- (or org-tag-alist (org-get-buffer-tags))
- (and
- org-complete-tags-always-offer-all-agenda-tags
- (org-global-tags-completion-table
- (org-agenda-files))))
- org-last-tags-completion-table table
- current-tags (org-split-string current ":")
- inherited-tags (nreverse
- (nthcdr (length current-tags)
- (nreverse (org-get-tags-at))))
- tags
- (if (or (eq t org-use-fast-tag-selection)
- (and org-use-fast-tag-selection
- (delq nil (mapcar 'cdr table))))
- (org-fast-tag-selection
- current-tags inherited-tags table
- (if org-fast-tag-selection-include-todo
- org-todo-key-alist))
- (let ((org-add-colon-after-tag-completion (< 1 (length table))))
- (org-trim
- (org-icompleting-read "Tags: "
- 'org-tags-completion-function
- nil nil current 'org-tags-history))))))
- (while (string-match "[-+&]+" tags)
- ;; No boolean logic, just a list
- (setq tags (replace-match ":" t t tags))))
-
- (setq tags (replace-regexp-in-string "[,]" ":" tags))
-
- (if org-tags-sort-function
- (setq tags (mapconcat 'identity
- (sort (org-split-string
- tags (org-re "[^[:alnum:]_@#%]+"))
- org-tags-sort-function) ":")))
-
- (if (string-match "\\`[\t ]*\\'" tags)
- (setq tags "")
- (unless (string-match ":$" tags) (setq tags (concat tags ":")))
- (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
-
- ;; Insert new tags at the correct column
- (beginning-of-line 1)
- (setq level (or (and (looking-at org-outline-regexp)
- (- (match-end 0) (point) 1))
- 1))
- (cond
- ((and (equal current "") (equal tags "")))
- ((re-search-forward
- (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
- (point-at-eol) t)
- (if (equal tags "")
- (setq rpl "")
- (goto-char (match-beginning 0))
- (setq c0 (current-column)
- ;; compute offset for the case of org-indent-mode active
- di (if org-indent-mode
- (* (1- org-indent-indentation-per-level) (1- level))
- 0)
- p0 (if (equal (char-before) ?*) (1+ (point)) (point))
- tc (+ org-tags-column (if (> org-tags-column 0) (- di) di))
- c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags))))
- rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
- (replace-match rpl t t)
- (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
- tags)
- (t (error "Tags alignment failed")))
- (org-move-to-column col)
- (unless just-align
- (run-hooks 'org-after-tags-change-hook)))))
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ ;; We don't use ARG and JUST-ALIGN here these args are not
+ ;; useful when looping over headlines
+ `(org-set-tags)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (let* ((re org-outline-regexp-bol)
+ (current (unless arg (org-get-tags-string)))
+ (col (current-column))
+ (org-setting-tags t)
+ table current-tags inherited-tags ; computed below when needed
+ tags p0 c0 c1 rpl di tc level)
+ (if arg
+ (save-excursion
+ (goto-char (point-min))
+ (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
+ (while (re-search-forward re nil t)
+ (org-set-tags nil t)
+ (end-of-line 1)))
+ (message "All tags realigned to column %d" org-tags-column))
+ (if just-align
+ (setq tags current)
+ ;; Get a new set of tags from the user
+ (save-excursion
+ (setq table (append org-tag-persistent-alist
+ (or org-tag-alist (org-get-buffer-tags))
+ (and
+ org-complete-tags-always-offer-all-agenda-tags
+ (org-global-tags-completion-table
+ (org-agenda-files))))
+ org-last-tags-completion-table table
+ current-tags (org-split-string current ":")
+ inherited-tags (nreverse
+ (nthcdr (length current-tags)
+ (nreverse (org-get-tags-at))))
+ tags
+ (if (or (eq t org-use-fast-tag-selection)
+ (and org-use-fast-tag-selection
+ (delq nil (mapcar 'cdr table))))
+ (org-fast-tag-selection
+ current-tags inherited-tags table
+ (if org-fast-tag-selection-include-todo
+ org-todo-key-alist))
+ (let ((org-add-colon-after-tag-completion (< 1 (length table))))
+ (org-trim
+ (org-icompleting-read "Tags: "
+ 'org-tags-completion-function
+ nil nil current 'org-tags-history))))))
+ (while (string-match "[-+&]+" tags)
+ ;; No boolean logic, just a list
+ (setq tags (replace-match ":" t t tags))))
+
+ (setq tags (replace-regexp-in-string "[,]" ":" tags))
+
+ (if org-tags-sort-function
+ (setq tags (mapconcat 'identity
+ (sort (org-split-string
+ tags (org-re "[^[:alnum:]_@#%]+"))
+ org-tags-sort-function) ":")))
+
+ (if (string-match "\\`[\t ]*\\'" tags)
+ (setq tags "")
+ (unless (string-match ":$" tags) (setq tags (concat tags ":")))
+ (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
+
+ ;; Insert new tags at the correct column
+ (beginning-of-line 1)
+ (setq level (or (and (looking-at org-outline-regexp)
+ (- (match-end 0) (point) 1))
+ 1))
+ (cond
+ ((and (equal current "") (equal tags "")))
+ ((re-search-forward
+ (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
+ (point-at-eol) t)
+ (if (equal tags "")
+ (setq rpl "")
+ (goto-char (match-beginning 0))
+ (setq c0 (current-column)
+ ;; compute offset for the case of org-indent-mode active
+ di (if org-indent-mode
+ (* (1- org-indent-indentation-per-level) (1- level))
+ 0)
+ p0 (if (equal (char-before) ?*) (1+ (point)) (point))
+ tc (+ org-tags-column (if (> org-tags-column 0) (- di) di))
+ c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags))))
+ rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
+ (replace-match rpl t t)
+ (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
+ tags)
+ (t (error "Tags alignment failed")))
+ (org-move-to-column col)
+ (unless just-align
+ (run-hooks 'org-after-tags-change-hook))))))
(defun org-change-tag-in-region (beg end tag off)
"Add or remove TAG for each entry in the region.
@@ -13505,7 +13851,7 @@ This works in the agenda, and also in an org-mode buffer."
(interactive
(list (region-beginning) (region-end)
(let ((org-last-tags-completion-table
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(org-get-buffer-tags)
(org-global-tags-completion-table))))
(org-icompleting-read
@@ -13524,7 +13870,7 @@ This works in the agenda, and also in an org-mode buffer."
(loop for l from l1 to l2 do
(org-goto-line l)
(setq m (get-text-property (point) 'org-hd-marker))
- (when (or (and (eq major-mode 'org-mode) (org-at-heading-p))
+ (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p))
(and agendap m))
(setq buf (if agendap (marker-buffer m) (current-buffer))
pos (if agendap m (point)))
@@ -13683,8 +14029,7 @@ Returns the new tags string, or nil to not change the current settings."
((not (assoc tg table))
(org-get-todo-face tg))
((member tg current) c-face)
- ((member tg inherited) i-face)
- (t nil))))
+ ((member tg inherited) i-face))))
(if (and (= cnt 0) (not ingroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
@@ -13919,7 +14264,7 @@ a *different* entry, you cannot use these techniques."
(if (not scope)
(progn
- (org-prepare-agenda-buffers
+ (org-agenda-prepare-buffers
(list (buffer-file-name (current-buffer))))
(setq res (org-scan-tags func matcher todo-only start-level)))
;; Get the right scope
@@ -13935,7 +14280,7 @@ a *different* entry, you cannot use these techniques."
(setq scope (list (buffer-file-name))))
((eq scope 'file-with-archives)
(setq scope (org-add-archive-files (list (buffer-file-name))))))
- (org-prepare-agenda-buffers scope)
+ (org-agenda-prepare-buffers scope)
(while (setq file (pop scope))
(with-current-buffer (org-find-base-buffer-visiting file)
(save-excursion
@@ -13951,7 +14296,7 @@ a *different* entry, you cannot use these techniques."
(defconst org-special-properties
'("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY"
- "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM")
+ "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM" "CLOCKSUM_T")
"The special properties valid in Org-mode.
These are properties that are not defined in the property drawer,
@@ -13991,10 +14336,15 @@ Being in this list makes sure that they are offered for completion.")
"Matches an entire clock drawer.")
(defsubst org-re-property (property)
- "Return a regexp matching PROPERTY.
-Match group 1 will be set to the value "
+ "Return a regexp matching a PROPERTY line.
+Match group 1 will be set to the value."
(concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)"))
+(defsubst org-re-property-keyword (property)
+ "Return a regexp matching a PROPERTY line, possibly with no
+value for the property."
+ (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)?"))
+
(defun org-property-action ()
"Do an action on properties."
(interactive)
@@ -14013,10 +14363,17 @@ Match group 1 will be set to the value "
(call-interactively 'org-compute-property-at-point))
(t (error "No such property action %c" c)))))
-(defun org-set-effort (&optional value)
+(defun org-inc-effort ()
+ "Increment the value of the effort property in the current entry."
+ (interactive)
+ (org-set-effort nil t))
+
+(defun org-set-effort (&optional value increment)
"Set the effort property of the current entry.
-With numerical prefix arg, use the nth allowed value, 0 stands for the 10th
-allowed value."
+With numerical prefix arg, use the nth allowed value, 0 stands for the
+10th allowed value.
+
+When INCREMENT is non-nil, set the property to the next allowed value."
(interactive "P")
(if (equal value 0) (setq value 10))
(let* ((completion-ignore-case t)
@@ -14030,6 +14387,9 @@ allowed value."
((and allowed (integerp value))
(or (car (nth (1- value) allowed))
(car (org-last allowed))))
+ ((and allowed increment)
+ (or (caadr (member (list cur) allowed))
+ (error "Allowed effort values are not set")))
(allowed
(message "Select 1-9,0, [RET%s]: %s"
(if cur (concat "=" cur) "")
@@ -14046,7 +14406,7 @@ allowed value."
(let (org-completion-use-ido org-completion-use-iswitchb)
(org-completing-read
(concat "Effort " (if (and cur (string-match "\\S-" cur))
- (concat "[" cur "]") "")
+ (concat "[" cur "]") "")
": ")
existing nil nil "" nil cur))))))
(unless (equal (org-entry-get nil prop) val)
@@ -14066,13 +14426,16 @@ allowed value."
(defun org-get-property-block (&optional beg end force)
"Return the (beg . end) range of the body of the property drawer.
-BEG and END can be beginning and end of subtree, if not given
-they will be found.
-If the drawer does not exist and FORCE is non-nil, create the drawer."
+BEG and END are the beginning and end of the current subtree, or of
+the part before the first headline. If they are not given, they will
+be found. If the drawer does not exist and FORCE is non-nil, create
+the drawer."
(catch 'exit
(save-excursion
- (let* ((beg (or beg (progn (org-back-to-heading t) (point))))
- (end (or end (progn (outline-next-heading) (point)))))
+ (let* ((beg (or beg (and (org-before-first-heading-p) (point-min))
+ (progn (org-back-to-heading t) (point))))
+ (end (or end (and (not (outline-next-heading)) (point-max))
+ (point))))
(goto-char beg)
(if (re-search-forward org-property-start-re end t)
(setq beg (1+ (match-end 0)))
@@ -14089,7 +14452,7 @@ If the drawer does not exist and FORCE is non-nil, create the drawer."
(or force (throw 'exit nil))
(goto-char beg)
(setq end beg)
- (org-indent-line-function)
+ (org-indent-line)
(insert ":END:\n"))
(cons beg end)))))
@@ -14110,14 +14473,15 @@ things up because then unnecessary parsing is avoided."
(let ((clockstr (substring org-clock-string 0 -1))
(excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED"))
(case-fold-search nil)
- beg end range props sum-props key key1 value string clocksum)
+ beg end range props sum-props key key1 value string clocksum clocksumt)
(save-excursion
(when (condition-case nil
- (and (eq major-mode 'org-mode) (org-back-to-heading t))
+ (and (derived-mode-p 'org-mode) (org-back-to-heading t))
(error nil))
(setq beg (point))
(setq sum-props (get-text-property (point) 'org-summaries))
- (setq clocksum (get-text-property (point) :org-clock-minutes))
+ (setq clocksum (get-text-property (point) :org-clock-minutes)
+ clocksumt (get-text-property (point) :org-clock-minutes-today))
(outline-next-heading)
(setq end (point))
(when (memq which '(all special))
@@ -14152,11 +14516,10 @@ things up because then unnecessary parsing is avoided."
(substring (org-match-string-no-properties 1)
0 -1))
string (if (equal key clockstr)
- (org-no-properties
- (org-trim
- (buffer-substring
- (match-beginning 3) (goto-char
- (point-at-eol)))))
+ (org-trim
+ (buffer-substring-no-properties
+ (match-beginning 3) (goto-char
+ (point-at-eol))))
(substring (org-match-string-no-properties 3)
1 -1)))
;; Get the correct property name from the key. This is
@@ -14177,8 +14540,7 @@ things up because then unnecessary parsing is avoided."
;; no need to search further if match is found
(throw 'match t))
(when (or (equal key "CLOCK") (not (assoc key props)))
- (push (cons key string) props))))))
- )
+ (push (cons key string) props)))))))
(when (memq which '(all standard))
;; Get the standard properties, like :PROP: ...
@@ -14195,14 +14557,19 @@ things up because then unnecessary parsing is avoided."
(if clocksum
(push (cons "CLOCKSUM"
(org-columns-number-to-string (/ (float clocksum) 60.)
- 'add_times))
+ 'add_times))
+ props))
+ (if clocksumt
+ (push (cons "CLOCKSUM_T"
+ (org-columns-number-to-string (/ (float clocksumt) 60.)
+ 'add_times))
props))
(unless (assoc "CATEGORY" props)
(push (cons "CATEGORY" (org-get-category)) props))
(append sum-props (nreverse props)))))))
(defun org-entry-get (pom property &optional inherit literal-nil)
- "Get value of PROPERTY for entry at point-or-marker POM.
+ "Get value of PROPERTY for entry or content at point-or-marker POM.
If INHERIT is non-nil and the entry does not have the property,
then also check higher levels of the hierarchy.
If INHERIT is the symbol `selective', use inheritance only if the setting
@@ -14222,13 +14589,11 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
;; We need a special property. Use `org-entry-properties' to
;; retrieve it, but specify the wanted property
(cdr (assoc property (org-entry-properties nil 'special property)))
- (let ((range (unless (org-before-first-heading-p)
- (org-get-property-block)))
- (props (list (or (assoc property org-file-properties)
- (assoc property org-global-properties)
- (assoc property org-global-properties-fixed))))
- val)
- (flet ((ap (key)
+ (let* ((range (org-get-property-block))
+ (props (list (or (assoc property org-file-properties)
+ (assoc property org-global-properties)
+ (assoc property org-global-properties-fixed))))
+ (ap (lambda (key)
(when (re-search-forward
(org-re-property key) (cdr range) t)
(setq props
@@ -14237,12 +14602,13 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
(if (match-end 1)
(org-match-string-no-properties 1) "")
props)))))
- (when (and range (goto-char (car range)))
- (ap property)
- (goto-char (car range))
- (while (ap (concat property "+")))
- (setq val (cdr (assoc property props)))
- (when val (if literal-nil val (org-not-nil val))))))))))
+ val)
+ (when (and range (goto-char (car range)))
+ (funcall ap property)
+ (goto-char (car range))
+ (while (funcall ap (concat property "+")))
+ (setq val (cdr (assoc property props)))
+ (when val (if literal-nil val (org-not-nil val)))))))))
(defun org-property-or-variable-value (var &optional inherit)
"Check if there is a property fixing the value of VAR.
@@ -14337,24 +14703,25 @@ Note that also `org-entry-get' calls this function, if the INHERIT flag
is set.")
(defun org-entry-get-with-inheritance (property &optional literal-nil)
- "Get entry property, and search higher levels if not present.
+ "Get PROPERTY of entry or content at point, search higher levels if needed.
The search will stop at the first ancestor which has the property defined.
If the value found is \"nil\", return nil to show that the property
should be considered as undefined (this is the meaning of nil here).
However, if LITERAL-NIL is set, return the string value \"nil\" instead."
(move-marker org-entry-property-inherited-from nil)
(let (tmp)
- (unless (org-before-first-heading-p)
- (save-excursion
- (save-restriction
- (widen)
- (catch 'ex
- (while t
- (when (setq tmp (org-entry-get nil property nil 'literal-nil))
- (org-back-to-heading t)
- (move-marker org-entry-property-inherited-from (point))
- (throw 'ex tmp))
- (or (org-up-heading-safe) (throw 'ex nil)))))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (catch 'ex
+ (while t
+ (when (setq tmp (org-entry-get nil property nil 'literal-nil))
+ (or (ignore-errors (org-back-to-heading t))
+ (goto-char (point-min)))
+ (move-marker org-entry-property-inherited-from (point))
+ (throw 'ex tmp))
+ (or (ignore-errors (org-up-heading-safe))
+ (throw 'ex nil))))))
(setq tmp (or tmp
(cdr (assoc property org-file-properties))
(cdr (assoc property org-global-properties))
@@ -14384,7 +14751,7 @@ and the new value.")
(org-set-tags nil 'align))
((equal property "PRIORITY")
(org-priority (if (and value (stringp value) (string-match "\\S-" value))
- (string-to-char value) ?\ ))
+ (string-to-char value) ?\ ))
(org-set-tags nil 'align))
((equal property "SCHEDULED")
(if (re-search-forward org-scheduled-time-regexp end t)
@@ -14408,17 +14775,17 @@ and the new value.")
(setq range (org-get-property-block beg end 'force))
(goto-char (car range))
(if (re-search-forward
- (org-re-property property) (cdr range) t)
+ (org-re-property-keyword property) (cdr range) t)
(progn
(delete-region (match-beginning 0) (match-end 0))
(goto-char (match-beginning 0)))
(goto-char (cdr range))
(insert "\n")
(backward-char 1)
- (org-indent-line-function))
+ (org-indent-line))
(insert ":" property ":")
(and value (insert " " value))
- (org-indent-line-function)))))
+ (org-indent-line)))))
(run-hook-with-args 'org-property-changed-functions property value)))
(defun org-buffer-property-keys (&optional include-specials include-defaults include-columns)
@@ -14484,11 +14851,10 @@ formats in the current buffer."
(defun org-insert-property-drawer ()
"Insert a property drawer into the current entry."
- (interactive)
(org-back-to-heading t)
(looking-at org-outline-regexp)
(let ((indent (if org-adapt-indentation
- (- (match-end 0)(match-beginning 0))
+ (- (match-end 0) (match-beginning 0))
0))
(beg (point))
(re (concat "^[ \t]*" org-keyword-time-regexp))
@@ -14522,6 +14888,71 @@ formats in the current buffer."
(hide-entry))
(org-flag-drawer t))))
+(defun org-insert-drawer (&optional arg drawer)
+ "Insert a drawer at point.
+
+Optional argument DRAWER, when non-nil, is a string representing
+drawer's name. Otherwise, the user is prompted for a name.
+
+If a region is active, insert the drawer around that region
+instead.
+
+Point is left between drawer's boundaries."
+ (interactive "P")
+ (let* ((logbook (if (stringp org-log-into-drawer) org-log-into-drawer
+ "LOGBOOK"))
+ ;; SYSTEM-DRAWERS is a list of drawer names that are used
+ ;; internally by Org. They are meant to be inserted
+ ;; automatically.
+ (system-drawers `("CLOCK" ,logbook "PROPERTIES"))
+ ;; Remove system drawers from list. Note: For some reason,
+ ;; `org-completing-read' ignores the predicate while
+ ;; `completing-read' handles it fine.
+ (drawer (if arg "PROPERTIES"
+ (or drawer
+ (completing-read
+ "Drawer: " org-drawers
+ (lambda (d) (not (member d system-drawers))))))))
+ (cond
+ ;; With C-u, fall back on `org-insert-property-drawer'
+ (arg (org-insert-property-drawer))
+ ;; With an active region, insert a drawer at point.
+ ((not (org-region-active-p))
+ (progn
+ (unless (bolp) (insert "\n"))
+ (insert (format ":%s:\n\n:END:\n" drawer))
+ (forward-line -2)))
+ ;; Otherwise, insert the drawer at point
+ (t
+ (let ((rbeg (region-beginning))
+ (rend (copy-marker (region-end))))
+ (unwind-protect
+ (progn
+ (goto-char rbeg)
+ (beginning-of-line)
+ (when (save-excursion
+ (re-search-forward org-outline-regexp-bol rend t))
+ (error "Drawers cannot contain headlines"))
+ ;; Position point at the beginning of the first
+ ;; non-blank line in region. Insert drawer's opening
+ ;; there, then indent it.
+ (org-skip-whitespace)
+ (beginning-of-line)
+ (insert ":" drawer ":\n")
+ (forward-line -1)
+ (indent-for-tab-command)
+ ;; Move point to the beginning of the first blank line
+ ;; after the last non-blank line in region. Insert
+ ;; drawer's closing, then indent it.
+ (goto-char rend)
+ (skip-chars-backward " \r\t\n")
+ (insert "\n:END:")
+ (deactivate-mark t)
+ (indent-for-tab-command)
+ (unless (eolp) (insert "\n")))
+ ;; Clear marker, whatever the outcome of insertion is.
+ (set-marker rend nil)))))))
+
(defvar org-property-set-functions-alist nil
"Property set function alist.
Each entry should have the following format:
@@ -14595,10 +15026,10 @@ in the current file."
(interactive (list nil nil))
(let* ((property (or property (org-read-property-name)))
(value (or value (org-read-property-value property)))
- (fn (assoc property org-properties-postprocess-alist)))
+ (fn (cdr (assoc property org-properties-postprocess-alist))))
(setq org-last-set-property property)
;; Possibly postprocess the inserted value:
- (when fn (setq value (funcall (cadr fn) value)))
+ (when fn (setq value (funcall fn value)))
(unless (equal (org-entry-get nil property) value)
(org-entry-put nil property value))))
@@ -14716,7 +15147,7 @@ completion."
(error "Only one allowed value for this property"))
(org-at-property-p)
(replace-match (concat " :" key ": " nval) t t)
- (org-indent-line-function)
+ (org-indent-line)
(beginning-of-line 1)
(skip-chars-forward " \t")
(run-hook-with-args 'org-property-changed-functions key nval)))
@@ -14835,13 +15266,20 @@ Return the position where this entry starts, or nil if there is no such entry."
(defun org-time-stamp (arg &optional inactive)
"Prompt for a date/time and insert a time stamp.
-If the user specifies a time like HH:MM, or if this command is called
-with a prefix argument, the time stamp will contain date and time.
-Otherwise, only the date will be included. All parts of a date not
-specified by the user will be filled in from the current date/time.
-So if you press just return without typing anything, the time stamp
-will represent the current date/time. If there is already a timestamp
-at the cursor, it will be modified."
+If the user specifies a time like HH:MM or if this command is
+called with at least one prefix argument, the time stamp contains
+the date and the time. Otherwise, only the date is be included.
+
+All parts of a date not specified by the user is filled in from
+the current date/time. So if you just press return without
+typing anything, the time stamp will represent the current
+date/time.
+
+If there is already a timestamp at the cursor, it will be
+modified.
+
+With two universal prefix arguments, insert an active timestamp
+with the current time without prompting the user."
(interactive "P")
(let* ((ts nil)
(default-time
@@ -14859,7 +15297,7 @@ at the cursor, it will be modified."
(save-match-data
(beginning-of-line)
(when (re-search-forward
- "\\([.+-]+[0-9]+[dwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
+ "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
(save-excursion (progn (end-of-line) (point))) t)
(match-string 0)))))
org-time-was-given org-end-time-was-given time)
@@ -14869,14 +15307,14 @@ at the cursor, it will be modified."
(memq this-command '(org-time-stamp org-time-stamp-inactive)))
(insert "--")
(setq time (let ((this-command this-command))
- (org-read-date arg 'totime nil nil
- default-time default-input)))
+ (org-read-date arg 'totime nil nil
+ default-time default-input inactive)))
(org-insert-time-stamp time (or org-time-was-given arg) inactive))
((org-at-timestamp-p t)
(setq time (let ((this-command this-command))
- (org-read-date arg 'totime nil nil default-time default-input)))
+ (org-read-date arg 'totime nil nil default-time default-input inactive)))
(when (org-at-timestamp-p t) ; just to get the match data
-; (setq inactive (eq (char-after (match-beginning 0)) ?\[))
+ ; (setq inactive (eq (char-after (match-beginning 0)) ?\[))
(replace-match "")
(setq org-last-changed-timestamp
(org-insert-time-stamp
@@ -14887,9 +15325,11 @@ at the cursor, it will be modified."
(concat (substring org-last-inserted-timestamp 0 -1)
" " repeater ">"))))
(message "Timestamp updated"))
+ ((equal arg '(16))
+ (org-insert-time-stamp (current-time) t))
(t
(setq time (let ((this-command this-command))
- (org-read-date arg 'totime nil nil default-time default-input)))
+ (org-read-date arg 'totime nil nil default-time default-input inactive)))
(org-insert-time-stamp time (or org-time-was-given arg) inactive
nil nil (list org-end-time-was-given))))))
@@ -14935,9 +15375,10 @@ So these are more for recording a certain time/date."
(defvar org-read-date-final-answer nil)
(defvar org-read-date-analyze-futurep nil)
(defvar org-read-date-analyze-forced-year nil)
+(defvar org-read-date-inactive)
(defun org-read-date (&optional org-with-time to-time from-string prompt
- default-time default-input)
+ default-time default-input inactive)
"Read a date, possibly a time, and make things smooth for the user.
The prompt will suggest to enter an ISO date, but you can also enter anything
which will at least partially be understood by `parse-time-string'.
@@ -14960,7 +15401,7 @@ mean next year. For details, see the manual. A few examples:
etc.
Furthermore you can specify a relative date by giving, as the *first* thing
-in the input: a plus/minus sign, a number and a letter [dwmy] to indicate
+in the input: a plus/minus sign, a number and a letter [hdwmy] to indicate
change in days weeks, months, years.
With a single plus or minus, the date is relative to today. With a double
plus or minus, it is relative to the date in DEFAULT-TIME. E.g.
@@ -14979,11 +15420,11 @@ If you don't like the calendar, turn it off with
With optional argument TO-TIME, the date will immediately be converted
to an internal time.
-With an optional argument WITH-TIME, the prompt will suggest to also
-insert a time. Note that when WITH-TIME is not set, you can still
-enter a time, and this function will inform the calling routine about
-this change. The calling routine may then choose to change the format
-used to insert the time stamp into the buffer to include the time.
+With an optional argument ORG-WITH-TIME, the prompt will suggest to
+also insert a time. Note that when ORG-WITH-TIME is not set, you can
+still enter a time, and this function will inform the calling routine
+about this change. The calling routine may then choose to change the
+format used to insert the time stamp into the buffer to include the time.
With optional argument FROM-STRING, read from this string instead from
the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is
the time/date that is used for everything that is not specified by the
@@ -15018,6 +15459,7 @@ user."
(save-excursion
(save-window-excursion
(calendar)
+ (org-eval-in-calendar '(setq cursor-type nil) t)
(unwind-protect
(progn
(calendar-forward-day (- (time-to-days org-def)
@@ -15084,6 +15526,7 @@ user."
(unwind-protect
(progn
(use-local-map map)
+ (setq org-read-date-inactive inactive)
(add-hook 'post-command-hook 'org-read-date-display)
(setq org-ans0 (read-string prompt default-input
'org-read-date-history nil))
@@ -15154,7 +15597,9 @@ user."
(and (boundp 'org-time-was-given) org-time-was-given))
(cdr fmts)
(car fmts)))
- (txt (concat "=> " (format-time-string fmt (apply 'encode-time f)))))
+ (txt (format-time-string fmt (apply 'encode-time f)))
+ (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt))
+ (txt (concat "=> " txt)))
(when (and org-end-time-was-given
(string-match org-plain-time-of-day-regexp txt))
(setq txt (concat (substring txt 0 (match-end 0)) "-"
@@ -15182,11 +15627,11 @@ user."
(setq ans (replace-match "" t t ans)
deltan (car delta)
deltaw (nth 1 delta)
- deltadef (nth 2 delta)))
+ deltadef (nth 2 delta)))
- ;; Check if there is an iso week date in there
- ;; If yes, store the info and postpone interpreting it until the rest
- ;; of the parsing is done
+ ;; Check if there is an iso week date in there. If yes, store the
+ ;; info and postpone interpreting it until the rest of the parsing
+ ;; is done.
(when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
(setq iso-year (if (match-end 1)
(org-small-year-to-year
@@ -15219,7 +15664,7 @@ user."
day (string-to-number (match-string 1 ans))
month (string-to-number (match-string 2 ans))
ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
- t nil ans)))
+ t nil ans)))
;; Help matching american dates, like 5/30 or 5/30/7
(when (string-match
@@ -15313,15 +15758,15 @@ user."
iso-date (calendar-gregorian-from-absolute
(calendar-absolute-from-iso
(list iso-week day year))))
-; FIXME: Should we also push ISO weeks into the future?
-; (when (and org-read-date-prefer-future
-; (not iso-year)
-; (< (calendar-absolute-from-gregorian iso-date)
-; (time-to-days (current-time))))
-; (setq year (1+ year)
-; iso-date (calendar-gregorian-from-absolute
-; (calendar-absolute-from-iso
-; (list iso-week day year)))))
+ ; FIXME: Should we also push ISO weeks into the future?
+ ; (when (and org-read-date-prefer-future
+ ; (not iso-year)
+ ; (< (calendar-absolute-from-gregorian iso-date)
+ ; (time-to-days (current-time))))
+ ; (setq year (1+ year)
+ ; iso-date (calendar-gregorian-from-absolute
+ ; (calendar-absolute-from-iso
+ ; (list iso-week day year)))))
(setq month (car iso-date)
year (nth 2 iso-date)
day (nth 1 iso-date)))
@@ -15335,7 +15780,6 @@ user."
((equal deltaw "m") (setq month (+ month deltan)))
((equal deltaw "y") (setq year (+ year deltan)))))
((and wday (not (nth 3 tl)))
- (setq futurep nil)
;; Weekday was given, but no day, so pick that day in the week
;; on or after the derived date.
(setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year))))
@@ -15375,7 +15819,7 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to
(concat
"\\`[ \t]*\\([-+]\\{0,2\\}\\)"
"\\([0-9]+\\)?"
- "\\([dwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
+ "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
"\\([ \t]\\|$\\)") s)
(or (> (match-end 1) (match-beginning 1)) (match-end 4)))
(let* ((dir (if (> (match-end 1) (match-beginning 1))
@@ -15409,14 +15853,15 @@ user function argument order change dependent on argument order."
(list arg2 arg1 arg3))
((eq calendar-date-style 'iso)
(list arg2 arg3 arg1)))
- (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1
- (if (org-bound-and-true-p european-calendar-style)
- (list arg2 arg1 arg3)
- (list arg1 arg2 arg3)))))
+ (org-no-warnings ;; european-calendar-style is obsolete as of version 23.1
+ (if (org-bound-and-true-p european-calendar-style)
+ (list arg2 arg1 arg3)
+ (list arg1 arg2 arg3)))))
(defun org-eval-in-calendar (form &optional keepdate)
"Eval FORM in the calendar window and return to current window.
-Also, store the cursor date in variable org-ans2."
+When KEEPDATE is non-nil, update `org-ans2' from the cursor date,
+otherwise stick to the current value of `org-ans2'."
(let ((sf (selected-frame))
(sw (selected-window)))
(select-window (get-buffer-window "*Calendar*" t))
@@ -15492,7 +15937,7 @@ The command returns the inserted time stamp."
t1 w1 with-hm tf time str w2 (off 0))
(save-match-data
(setq t1 (org-parse-time-string ts t))
- (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)?\\'" ts)
+ (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
(setq off (- (match-end 0) (match-beginning 0)))))
(setq end (- end off))
(setq w1 (- end beg)
@@ -15563,7 +16008,7 @@ Don't touch the rest."
((<= org-deadline-warning-days 0)
;; 0 or negative, enforce this value no matter what
(- org-deadline-warning-days))
- ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\| \\)" ts)
+ ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts)
;; lead time is specified.
(floor (* (string-to-number (match-string 1 ts))
(cdr (assoc (match-string 2 ts)
@@ -15604,16 +16049,34 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
(org-occur regexp nil callback)
org-warn-days)))
+(defsubst org-re-timestamp (type)
+ "Return a regexp for timestamp TYPE.
+Allowed values for TYPE are:
+
+ all: all timestamps
+ active: only active timestamps (<...>)
+ inactive: only inactive timestamps ([...])
+ scheduled: only scheduled timestamps
+ deadline: only deadline timestamps
+
+When TYPE is nil, fall back on returning a regexp that matches
+both scheduled and deadline timestamps."
+ (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9> \n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)")
+ ((eq type 'active) org-ts-regexp)
+ ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]")
+ ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>"))
+ ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
+ ((eq type 'scheduled-or-deadline)
+ (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>"))))
+
(defun org-check-before-date (date)
"Check if there are deadlines or scheduled entries before DATE."
(interactive (list (org-read-date)))
(let ((case-fold-search nil)
- (regexp (concat "\\<\\(" org-deadline-string
- "\\|" org-scheduled-string
- "\\) *<\\([^>]+\\)>"))
+ (regexp (org-re-timestamp org-ts-type))
(callback
(lambda () (time-less-p
- (org-time-string-to-time (match-string 2))
+ (org-time-string-to-time (match-string 1))
(org-time-string-to-time date)))))
(message "%d entries before %s"
(org-occur regexp nil callback) date)))
@@ -15622,13 +16085,11 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
"Check if there are deadlines or scheduled entries after DATE."
(interactive (list (org-read-date)))
(let ((case-fold-search nil)
- (regexp (concat "\\<\\(" org-deadline-string
- "\\|" org-scheduled-string
- "\\) *<\\([^>]+\\)>"))
+ (regexp (org-re-timestamp org-ts-type))
(callback
(lambda () (not
(time-less-p
- (org-time-string-to-time (match-string 2))
+ (org-time-string-to-time (match-string 1))
(org-time-string-to-time date))))))
(message "%d entries after %s"
(org-occur regexp nil callback) date)))
@@ -15638,12 +16099,10 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
(interactive (list (org-read-date nil nil nil "Range starts")
(org-read-date nil nil nil "Range end")))
(let ((case-fold-search nil)
- (regexp (concat "\\<\\(" org-deadline-string
- "\\|" org-scheduled-string
- "\\) *<\\([^>]+\\)>"))
+ (regexp (org-re-timestamp org-ts-type))
(callback
(lambda ()
- (let ((match (match-string 2)))
+ (let ((match (match-string 1)))
(and
(not (time-less-p
(org-time-string-to-time match)
@@ -15732,6 +16191,7 @@ days in order to avoid rounding problems."
(apply 'format fmt (nreverse l))))
(defun org-time-string-to-time (s &optional buffer pos)
+ "Convert a timestamp string into internal time."
(condition-case errdata
(apply 'encode-time (org-parse-time-string s))
(error (error "Bad timestamp `%s'%s\nError was: %s"
@@ -15741,6 +16201,7 @@ days in order to avoid rounding problems."
(cdr errdata)))))
(defun org-time-string-to-seconds (s)
+ "Convert a timestamp string to a number of seconds."
(org-float-time (org-time-string-to-time s)))
(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
@@ -15754,7 +16215,7 @@ The variable date is bound by the calendar when this is called."
(if (org-diary-sexp-entry (match-string 1 s) "" date)
daynr
(+ daynr 1000)))
- ((and daynr (string-match "\\+[0-9]+[dwmy]" s))
+ ((and daynr (string-match "\\+[0-9]+[hdwmy]" s))
(org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr
(time-to-days (current-time))) (match-string 0 s)
prefer show-all))
@@ -15817,8 +16278,7 @@ D may be an absolute day number, or a calendar-type list (month day year)."
(stringp (cdr result))) (cdr result))
((and (consp result)
(stringp (car result))) result)
- (result entry)
- (t nil))))
+ (result entry))))
(defun org-diary-to-ical-string (frombuf)
"Get iCalendar entries from diary entries in buffer FROMBUF.
@@ -15865,7 +16325,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp."
(if (<= cday sday) (throw 'exit sday))
- (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change)
+ (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change)
(setq dn (string-to-number (match-string 1 change))
dw (cdr (assoc (match-string 2 change) a1)))
(error "Invalid change specifier: %s" change))
@@ -15988,22 +16448,22 @@ With prefix ARG, change that many days."
(and ans
(boundp 'org-ts-what)
(setq org-ts-what
- (cond
- ((= pos (match-beginning 0)) 'bracket)
- ;; Point is considered to be "on the bracket" whether
- ;; it's really on it or right after it.
- ((or (= pos (1- (match-end 0)))
- (= pos (match-end 0))) 'bracket)
- ((org-pos-in-match-range pos 2) 'year)
- ((org-pos-in-match-range pos 3) 'month)
- ((org-pos-in-match-range pos 7) 'hour)
- ((org-pos-in-match-range pos 8) 'minute)
- ((or (org-pos-in-match-range pos 4)
- (org-pos-in-match-range pos 5)) 'day)
- ((and (> pos (or (match-end 8) (match-end 5)))
- (< pos (match-end 0)))
- (- pos (or (match-end 8) (match-end 5))))
- (t 'day))))
+ (cond
+ ((= pos (match-beginning 0)) 'bracket)
+ ;; Point is considered to be "on the bracket" whether
+ ;; it's really on it or right after it.
+ ((= pos (1- (match-end 0))) 'bracket)
+ ((= pos (match-end 0)) 'after)
+ ((org-pos-in-match-range pos 2) 'year)
+ ((org-pos-in-match-range pos 3) 'month)
+ ((org-pos-in-match-range pos 7) 'hour)
+ ((org-pos-in-match-range pos 8) 'minute)
+ ((or (org-pos-in-match-range pos 4)
+ (org-pos-in-match-range pos 5)) 'day)
+ ((and (> pos (or (match-end 8) (match-end 5)))
+ (< pos (match-end 0)))
+ (- pos (or (match-end 8) (match-end 5))))
+ (t 'day))))
ans))
(defun org-toggle-timestamp-type ()
@@ -16020,6 +16480,8 @@ With prefix ARG, change that many days."
(message "Timestamp is now %sactive"
(if (equal (char-after beg) ?<) "" "in")))))
+(defvar org-clock-history) ; defined in org-clock.el
+(defvar org-clock-adjust-closest nil) ; defined in org-clock.el
(defun org-timestamp-change (n &optional what updown)
"Change the date in the time stamp at point.
The date will be changed by N times WHAT. WHAT can be `day', `month',
@@ -16030,7 +16492,7 @@ in the timestamp determines what will be changed."
(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
org-ts-what
extra rem
- ts time time0)
+ ts time time0 fixnext clrgx)
(if (not (org-at-timestamp-p t))
(error "Not at a timestamp"))
(if (and (not what) (eq org-ts-what 'bracket))
@@ -16049,7 +16511,7 @@ in the timestamp determines what will be changed."
ts (match-string 0))
(replace-match "")
(if (string-match
- "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)*\\)[]>]"
+ "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
ts)
(setq extra (match-string 1 ts)))
(if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
@@ -16112,6 +16574,39 @@ in the timestamp determines what will be changed."
(t origin))))
;; Update clock if on a CLOCK line.
(org-clock-update-time-maybe)
+ ;; Maybe adjust the closest clock in `org-clock-history'
+ (when org-clock-adjust-closest
+ (if (not (and (org-at-clock-log-p)
+ (< 1 (length (delq nil (mapcar (lambda(m) (marker-position m))
+ org-clock-history))))))
+ (message "No clock to adjust")
+ (cond ((save-excursion ; fix previous clock?
+ (re-search-backward org-ts-regexp0 nil t)
+ (org-looking-back (concat org-clock-string " \\[")))
+ (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$")))
+ ((save-excursion ; fix next clock?
+ (re-search-backward org-ts-regexp0 nil t)
+ (looking-at (concat org-ts-regexp0 "\\] =>")))
+ (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0))))
+ (save-window-excursion
+ ;; Find closest clock to point, adjust the previous/next one in history
+ (let* ((p (save-excursion (org-back-to-heading t)))
+ (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history))
+ (clfixnth
+ (+ fixnext (- (length cl) (or (length (member (apply #'min cl) cl)) 100))))
+ (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history))))
+ (if (not clfixpos)
+ (message "No clock to adjust")
+ (save-excursion
+ (org-goto-marker-or-bmk clfixpos)
+ (org-show-subtree)
+ (when (re-search-forward clrgx nil t)
+ (goto-char (match-beginning 1))
+ (let (org-clock-adjust-closest)
+ (org-timestamp-change n org-ts-what updown))
+ (message "Clock adjusted in %s for heading: %s"
+ (file-name-nondirectory (buffer-file-name))
+ (org-get-heading t t)))))))))
;; Try to recenter the calendar window, if any.
(if (and org-calendar-follow-timestamp-change
(get-buffer-window "*Calendar*" t)
@@ -16243,7 +16738,7 @@ effort string \"2hours\" is equivalent to 120 minutes."
:type '(alist :key-type (string :tag "Modifier")
:value-type (number :tag "Minutes")))
-(defun org-duration-string-to-minutes (s)
+(defun org-duration-string-to-minutes (s &optional output-to-string)
"Convert a duration string S to minutes.
A bare number is interpreted as minutes, modifiers can be set by
@@ -16252,15 +16747,16 @@ customizing `org-effort-durations' (which see).
Entries containing a colon are interpreted as H:MM by
`org-hh:mm-string-to-minutes'."
(let ((result 0)
- (re (concat "\\([0-9]+\\) *\\("
+ (re (concat "\\([0-9.]+\\) *\\("
(regexp-opt (mapcar 'car org-effort-durations))
"\\)")))
(while (string-match re s)
(incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
(string-to-number (match-string 1 s))))
(setq s (replace-match "" nil t s)))
+ (setq result (floor result))
(incf result (org-hh:mm-string-to-minutes s))
- result))
+ (if output-to-string (number-to-string result) result)))
;;;; Files
@@ -16268,7 +16764,7 @@ Entries containing a colon are interpreted as H:MM by
"Save all Org-mode buffers without user confirmation."
(interactive)
(message "Saving all Org-mode buffers...")
- (save-some-buffers t (lambda () (eq major-mode 'org-mode)))
+ (save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
(when (featurep 'org-id) (org-id-locations-save))
(message "Saving all Org-mode buffers... done"))
@@ -16292,7 +16788,7 @@ changes from another. I believe the procedure must be like this:
(save-window-excursion
(mapc
(lambda (b)
- (when (and (with-current-buffer b (eq major-mode 'org-mode))
+ (when (and (with-current-buffer b (derived-mode-p 'org-mode))
(with-current-buffer b buffer-file-name))
(org-pop-to-buffer-same-window b)
(revert-buffer t 'no-confirm)))
@@ -16344,17 +16840,17 @@ If EXCLUDE-TMP is non-nil, ignore temporary buffers."
(filter
(cond
((eq predicate 'files)
- (lambda (b) (with-current-buffer b (eq major-mode 'org-mode))))
+ (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
((eq predicate 'export)
(lambda (b) (string-match "\*Org .*Export" (buffer-name b))))
((eq predicate 'agenda)
(lambda (b)
(with-current-buffer b
- (and (eq major-mode 'org-mode)
+ (and (derived-mode-p 'org-mode)
(setq bfn (buffer-file-name b))
(member (file-truename bfn) agenda-files)))))
(t (lambda (b) (with-current-buffer b
- (or (eq major-mode 'org-mode)
+ (or (derived-mode-p 'org-mode)
(string-match "\*Org .*Export"
(buffer-name b)))))))))
(delq nil
@@ -16571,7 +17067,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(with-current-buffer buf (save-buffer)))
(kill-buffer buf))))
-(defun org-prepare-agenda-buffers (files)
+(defun org-agenda-prepare-buffers (files)
"Create buffers for all agenda files, protect archived trees and comments."
(interactive)
(let ((pa '(:org-archived t))
@@ -16579,7 +17075,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(pall '(:org-archived t :org-comment t))
(inhibit-read-only t)
(rea (concat ":" org-archive-tag ":"))
- bmp file re)
+ bmp file re)
(save-excursion
(save-restriction
(while (setq file (pop files))
@@ -16657,7 +17153,7 @@ an embedded LaTeX fragment, let texmathp do its job.
(interactive)
(let (p)
(cond
- ((not (eq major-mode 'org-mode)) ad-do-it)
+ ((not (derived-mode-p 'org-mode)) ad-do-it)
((eq this-command 'cdlatex-math-symbol)
(setq ad-return-value t
texmathp-why '("cdlatex-math-symbol in org-mode" . 0)))
@@ -16806,11 +17302,12 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
(narrow-to-region beg end)
(goto-char beg)
(org-format-latex
- (concat "ltxpng/" (file-name-sans-extension
- (file-name-nondirectory
- buffer-file-name)))
- default-directory 'overlays msg at 'forbuffer 'dvipng)
- (message msg "done. Use `C-c C-c' to remove images.")))))
+ (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
+ (file-name-nondirectory
+ buffer-file-name)))
+ default-directory 'overlays msg at 'forbuffer
+ org-latex-create-formula-image-program)
+ (message msg "done. Use `C-c C-c' to remove images.")))))
(defvar org-latex-regexps
'(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
@@ -16873,7 +17370,8 @@ Some of the options can be changed using the variable
'(org-protected t))))
(add-text-properties (match-beginning n) (match-end n)
'(org-protected t))))
- ((eq processing-type 'dvipng)
+ ((or (eq processing-type 'dvipng)
+ (eq processing-type 'imagemagick))
;; Process to an image
(setq txt (match-string n)
beg (match-beginning n) end (match-end n)
@@ -16894,17 +17392,25 @@ Some of the options can be changed using the variable
(unless checkdir ; make sure the directory exists
(setq checkdir t)
(or (file-directory-p todir) (make-directory todir t)))
-
- (unless executables-checked
- (org-check-external-command
- "latex" "needed to convert LaTeX fragments to images")
- (org-check-external-command
- "dvipng" "needed to convert LaTeX fragments to images")
- (setq executables-checked t))
-
- (unless (file-exists-p movefile)
- (org-create-formula-image
- txt movefile opt forbuffer))
+ (cond
+ ((eq processing-type 'dvipng)
+ (unless executables-checked
+ (org-check-external-command
+ "latex" "needed to convert LaTeX fragments to images")
+ (org-check-external-command
+ "dvipng" "needed to convert LaTeX fragments to images")
+ (setq executables-checked t))
+ (unless (file-exists-p movefile)
+ (org-create-formula-image-with-dvipng
+ txt movefile opt forbuffer)))
+ ((eq processing-type 'imagemagick)
+ (unless executables-checked
+ (org-check-external-command
+ "convert" "you need to install imagemagick")
+ (setq executables-checked t))
+ (unless (file-exists-p movefile)
+ (org-create-formula-image-with-imagemagick
+ txt movefile opt forbuffer))))
(if overlays
(progn
(mapc (lambda (o)
@@ -16959,7 +17465,7 @@ write the results in to that file. When invoked as an
interactive command, prompt for LATEX-FRAG, with initial value
set to the current active region and echo the results for user
inspection."
- (interactive (list (let ((frag (when (region-active-p)
+ (interactive (list (let ((frag (when (org-region-active-p)
(buffer-substring-no-properties
(region-beginning) (region-end)))))
(read-string "LaTeX Fragment: " frag nil frag))))
@@ -17040,7 +17546,7 @@ inspection."
latex-frag)))
;; This function borrows from Ganesh Swami's latex2png.el
-(defun org-create-formula-image (string tofile options buffer)
+(defun org-create-formula-image-with-dvipng (string tofile options buffer)
"This calls dvipng."
(require 'org-latex)
(let* ((tmpdir (if (featurep 'xemacs)
@@ -17082,11 +17588,11 @@ inspection."
(progn (message "Failed to create dvi file from %s" texfile) nil)
(condition-case nil
(if (featurep 'xemacs)
- (call-process "dvipng" nil nil nil
- "-fg" fg "-bg" bg
- "-T" "tight"
- "-o" pngfile
- dvifile)
+ (call-process "dvipng" nil nil nil
+ "-fg" fg "-bg" bg
+ "-T" "tight"
+ "-o" pngfile
+ dvifile)
(call-process "dvipng" nil nil nil
"-fg" fg "-bg" bg
"-D" dpi
@@ -17102,8 +17608,115 @@ inspection."
nil)
;; Use the requested file name and clean up
(copy-file pngfile tofile 'replace)
- (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png") do
- (delete-file (concat texfilebase e)))
+ (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do
+ (if (file-exists-p (concat texfilebase e))
+ (delete-file (concat texfilebase e))))
+ pngfile))))
+
+(defvar org-latex-to-pdf-process) ;; Defined in org-latex.el
+(defun org-create-formula-image-with-imagemagick (string tofile options buffer)
+ "This calls convert, which is included into imagemagick."
+ (require 'org-latex)
+ (let* ((tmpdir (if (featurep 'xemacs)
+ (temp-directory)
+ temporary-file-directory))
+ (texfilebase (make-temp-name
+ (expand-file-name "orgtex" tmpdir)))
+ (texfile (concat texfilebase ".tex"))
+ (pdffile (concat texfilebase ".pdf"))
+ (pngfile (concat texfilebase ".png"))
+ (fnh (if (featurep 'xemacs)
+ (font-height (face-font 'default))
+ (face-attribute 'default :height nil)))
+ (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
+ (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.))))))
+ (fg (or (plist-get options (if buffer :foreground :html-foreground))
+ "black"))
+ (bg (or (plist-get options (if buffer :background :html-background))
+ "white")))
+ (if (eq fg 'default) (setq fg (org-latex-color :foreground))
+ (setq fg (org-latex-color-format fg)))
+ (if (eq bg 'default) (setq bg (org-latex-color :background))
+ (setq bg (org-latex-color-format
+ (if (string= bg "Transparent")(setq bg "white")))))
+ (with-temp-file texfile
+ (insert (org-splice-latex-header
+ org-format-latex-header
+ org-export-latex-default-packages-alist
+ org-export-latex-packages-alist t
+ org-format-latex-header-extra))
+ (insert "\n\\begin{document}\n"
+ "\\definecolor{fg}{rgb}{" fg "}\n"
+ "\\definecolor{bg}{rgb}{" bg "}\n"
+ "\n\\pagecolor{bg}\n"
+ "\n{\\color{fg}\n"
+ string
+ "\n}\n"
+ "\n\\end{document}\n" )
+ (require 'org-latex)
+ (org-export-latex-fix-inputenc))
+ (let ((dir default-directory) cmd cmds latex-frags-cmds)
+ (condition-case nil
+ (progn
+ (cd tmpdir)
+ (setq cmds org-latex-to-pdf-process)
+ (while cmds
+ (setq latex-frags-cmds (pop cmds))
+ (if (listp latex-frags-cmds)
+ (setq cmds nil)
+ (setq latex-frags-cmds (list (car org-latex-to-pdf-process)))))
+ (while latex-frags-cmds
+ (setq cmd (pop latex-frags-cmds))
+ (while (string-match "%b" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument texfile))
+ t t cmd)))
+ (while (string-match "%f" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument (file-name-nondirectory texfile)))
+ t t cmd)))
+ (while (string-match "%o" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument (file-name-directory texfile)))
+ t t cmd)))
+ (setq cmd (split-string cmd))
+ (eval (append (list 'call-process (pop cmd) nil nil nil) cmd))))
+ (error nil))
+ (cd dir))
+ (if (not (file-exists-p pdffile))
+ (progn (message "Failed to create pdf file from %s" texfile) nil)
+ (condition-case nil
+ (if (featurep 'xemacs)
+ (call-process "convert" nil nil nil
+ "-density" "96"
+ "-trim"
+ "-antialias"
+ pdffile
+ "-quality" "100"
+ ;; "-sharpen" "0x1.0"
+ pngfile)
+ (call-process "convert" nil nil nil
+ "-density" dpi
+ "-trim"
+ "-antialias"
+ pdffile
+ "-quality" "100"
+ ; "-sharpen" "0x1.0"
+ pngfile))
+ (error nil))
+ (if (not (file-exists-p pngfile))
+ (if org-format-latex-signal-error
+ (error "Failed to create png file from %s" texfile)
+ (message "Failed to create png file from %s" texfile)
+ nil)
+ ;; Use the requested file name and clean up
+ (copy-file pngfile tofile 'replace)
+ (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do
+ (if (file-exists-p (concat texfilebase e))
+ (delete-file (concat texfilebase e))))
pngfile))))
(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra)
@@ -17166,7 +17779,7 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
(if newline (concat pkg "\n") pkg))
(defun org-dvipng-color (attr)
- "Return an rgb color specification for dvipng."
+ "Return a RGB color specification for dvipng."
(apply 'format "rgb %s %s %s"
(mapcar 'org-normalize-color
(if (featurep 'xemacs)
@@ -17176,6 +17789,23 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
((eq attr :background) 'background))))
(color-values (face-attribute 'default attr nil))))))
+(defun org-latex-color (attr)
+ "Return a RGB color for the LaTeX color package."
+ (apply 'format "%s,%s,%s"
+ (mapcar 'org-normalize-color
+ (if (featurep 'xemacs)
+ (color-rgb-components
+ (face-property 'default
+ (cond ((eq attr :foreground) 'foreground)
+ ((eq attr :background) 'background))))
+ (color-values (face-attribute 'default attr nil))))))
+
+(defun org-latex-color-format (color-name)
+ "Convert COLOR-NAME to a RGB color value."
+ (apply 'format "%s,%s,%s"
+ (mapcar 'org-normalize-color
+ (color-values color-name))))
+
(defun org-normalize-color (value)
"Return string to be used as color value for an RGB component."
(format "%g" (/ value 65535.0)))
@@ -17200,6 +17830,14 @@ INCLUDE-LINKED is passed to `org-display-inline-images'."
(length org-inline-image-overlays))
(message "No images to display inline"))))
+(defun org-redisplay-inline-images ()
+ "Refresh the display of inline images."
+ (interactive)
+ (if (not org-inline-image-overlays)
+ (org-toggle-inline-images)
+ (org-toggle-inline-images)
+ (org-toggle-inline-images)))
+
(defun org-display-inline-images (&optional include-linked refresh beg end)
"Display inline images.
Normally only links without a description part are inlined, because this
@@ -17238,10 +17876,13 @@ BEG and END default to the buffer boundaries."
(overlay-put ov 'face 'default)
(overlay-put ov 'org-image-overlay t)
(overlay-put ov 'modification-hooks
- (list 'org-display-inline-modification-hook))
+ (list 'org-display-inline-remove-overlay))
(push ov org-inline-image-overlays)))))))))
-(defun org-display-inline-modification-hook (ov after beg end &optional len)
+(define-obsolete-function-alias
+ 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3")
+
+(defun org-display-inline-remove-overlay (ov after beg end &optional len)
"Remove inline-display overlay if a corresponding region is modified."
(let ((inhibit-modification-hooks t))
(when (and ov after)
@@ -17261,38 +17902,42 @@ BEG and END default to the buffer boundaries."
(define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree)
(define-key org-mode-map [remap show-subtree] 'org-show-subtree)
(define-key org-mode-map [remap outline-forward-same-level]
- 'org-forward-same-level)
+ 'org-forward-heading-same-level)
(define-key org-mode-map [remap outline-backward-same-level]
- 'org-backward-same-level)
+ 'org-backward-heading-same-level)
(define-key org-mode-map [remap show-branches]
'org-kill-note-or-show-branches)
(define-key org-mode-map [remap outline-promote] 'org-promote-subtree)
(define-key org-mode-map [remap outline-demote] 'org-demote-subtree)
(define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret)
-;; Outline functions from `outline-mode-prefix-map'
-;; that can not be remapped in Org:
+;; Outline functions from `outline-mode-prefix-map' that can not
+;; be remapped in Org:
+;;
;; - the column "key binding" shows whether the Outline function is still
;; available in Org mode on the same key that it has been bound to in
;; Outline mode:
;; - "overridden": key used for a different functionality in Org mode
;; - else: key still bound to the same Outline function in Org mode
+;;
;; | Outline function | key binding | Org replacement |
;; |------------------------------------+-------------+-----------------------|
;; | `outline-next-visible-heading' | `C-c C-n' | still same function |
;; | `outline-previous-visible-heading' | `C-c C-p' | still same function |
+;; | `outline-up-heading' | `C-c C-u' | still same function |
+;; | `outline-move-subtree-up' | overridden | better: org-shiftup |
+;; | `outline-move-subtree-down' | overridden | better: org-shiftdown |
+;; | `show-entry' | overridden | no replacement |
;; | `show-children' | `C-c C-i' | visibility cycling |
+;; | `show-branches' | `C-c C-k' | still same function |
+;; | `show-subtree' | overridden | visibility cycling |
+;; | `show-all' | overridden | no replacement |
;; | `hide-subtree' | overridden | visibility cycling |
-;; | `outline-up-heading' | `C-c C-u' | still same function |
;; | `hide-body' | overridden | no replacement |
-;; | `show-all' | overridden | no replacement |
;; | `hide-entry' | overridden | visibility cycling |
-;; | `show-entry' | overridden | no replacement |
;; | `hide-leaves' | overridden | no replacement |
;; | `hide-sublevels' | overridden | no replacement |
;; | `hide-other' | overridden | no replacement |
-;; | `outline-move-subtree-up' | `C-c C-^' | better: org-shiftup |
-;; | `outline-move-subtree-down' | overridden | better: org-shiftdown |
;; Make `C-c C-x' a prefix key
(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap))
@@ -17375,7 +18020,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup)
(org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown))
- ;; All the other keys
+;; All the other keys
(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up.
(org-defkey org-mode-map "\C-c\C-r" 'org-reveal)
@@ -17385,11 +18030,20 @@ BEG and END default to the buffer boundaries."
(if (boundp 'narrow-map)
(org-defkey narrow-map "b" 'org-narrow-to-block)
(org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block))
-(org-defkey org-mode-map "\C-c\C-f" 'org-forward-same-level)
-(org-defkey org-mode-map "\C-c\C-b" 'org-backward-same-level)
+(if (boundp 'narrow-map)
+ (org-defkey narrow-map "e" 'org-narrow-to-element)
+ (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element))
+(org-defkey org-mode-map "\C-\M-t" 'org-transpose-element)
+(org-defkey org-mode-map "\M-}" 'org-forward-element)
+(org-defkey org-mode-map "\M-{" 'org-backward-element)
+(org-defkey org-mode-map "\C-c\C-^" 'org-up-element)
+(org-defkey org-mode-map "\C-c\C-_" 'org-down-element)
+(org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level)
+(org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level)
(org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree)
(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default)
+(org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer)
(org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag)
(org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling)
(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer)
@@ -17411,6 +18065,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link)
(org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link)
(org-defkey org-mode-map "\C-c\C-l" 'org-insert-link)
+(org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links)
(org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point)
(org-defkey org-mode-map "\C-c%" 'org-mark-ring-push)
(org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto)
@@ -17454,6 +18109,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
(org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
(org-defkey org-mode-map "\C-c@" 'org-mark-subtree)
+(org-defkey org-mode-map "\M-h" 'org-mark-element)
(org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree)
;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree)
@@ -17464,18 +18120,22 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays)
(org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in)
+(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-in-last)
+(org-defkey org-mode-map "\C-c\C-x\C-z" 'org-resolve-clocks)
(org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out)
(org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
-(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel)
+(org-defkey org-mode-map "\C-c\C-x\C-q" 'org-clock-cancel)
(org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display)
(org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report)
(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment)
(org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images)
+(org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images)
(org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities)
(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort)
+(org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort)
(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock)
(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer)
@@ -17506,8 +18166,8 @@ BEG and END default to the buffer boundaries."
("Outline Navigation")
("n" . (org-speed-move-safe 'outline-next-visible-heading))
("p" . (org-speed-move-safe 'outline-previous-visible-heading))
- ("f" . (org-speed-move-safe 'org-forward-same-level))
- ("b" . (org-speed-move-safe 'org-backward-same-level))
+ ("f" . (org-speed-move-safe 'org-forward-heading-same-level))
+ ("b" . (org-speed-move-safe 'org-backward-heading-same-level))
("u" . (org-speed-move-safe 'outline-up-heading))
("j" . org-goto)
("g" . (org-refile t))
@@ -17515,6 +18175,7 @@ BEG and END default to the buffer boundaries."
("c" . org-cycle)
("C" . org-shifttab)
(" " . org-display-outline-path)
+ (":" . org-columns)
("Outline Structure Editing")
("U" . org-shiftmetaup)
("D" . org-shiftmetadown)
@@ -17528,17 +18189,22 @@ BEG and END default to the buffer boundaries."
("w" . org-refile)
("a" . org-archive-subtree-default-with-confirmation)
("." . org-mark-subtree)
+ ("#" . org-toggle-comment)
("Clock Commands")
("I" . org-clock-in)
("O" . org-clock-out)
("Meta Data Editing")
("t" . org-todo)
+ ("," . (org-priority))
("0" . (org-priority ?\ ))
("1" . (org-priority ?A))
("2" . (org-priority ?B))
("3" . (org-priority ?C))
(";" . org-set-tags-command)
("e" . org-set-effort)
+ ("E" . org-inc-effort)
+ ("W" . (lambda(m) (interactive "sMinutes before warning: ")
+ (org-entry-put (point) "APPT_WARNTIME" m)))
("Agenda Views etc")
("v" . org-agenda)
("/" . org-sparse-tree)
@@ -17594,7 +18260,10 @@ If not, return to the original position and throw an error."
(defvar org-table-auto-blank-field) ; defined in org-table.el
(defvar org-speed-command nil)
-(defun org-speed-command-default-hook (keys)
+(define-obsolete-function-alias
+ 'org-speed-command-default-hook 'org-speed-command-activate "24.3")
+
+(defun org-speed-command-activate (keys)
"Hook for activating single-letter speed commands.
`org-speed-commands-default' specifies a minimal command set.
Use `org-speed-commands-user' for further customization."
@@ -17604,7 +18273,10 @@ Use `org-speed-commands-user' for further customization."
(cdr (assoc keys (append org-speed-commands-user
org-speed-commands-default)))))
-(defun org-babel-speed-command-hook (keys)
+(define-obsolete-function-alias
+ 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3")
+
+(defun org-babel-speed-command-activate (keys)
"Hook for activating single-letter code block commands."
(when (and (bolp) (looking-at org-babel-src-block-regexp))
(cdr (assoc keys org-babel-key-bindings))))
@@ -17623,8 +18295,9 @@ and return nil or a valid handler as appropriate. Handler could
be one of an interactive command, a function, or a form.
Set `org-use-speed-commands' to non-nil value to enable this
-hook. The default setting is `org-speed-command-default-hook'."
+hook. The default setting is `org-speed-command-activate'."
:group 'org-structure
+ :version "24.1"
:type 'hook)
(defun org-self-insert-command (N)
@@ -17658,7 +18331,7 @@ overwritten, and the table is not marked as requiring realignment."
(if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |"))
;; got extra space, this field does not determine column width
(let (org-table-may-need-update) (org-table-blank-field))
- ;; no extra space, this field may determine column width
+ ;; no extra space, this field may determine column width
(org-table-blank-field)))
t)
(eq N 1)
@@ -17707,29 +18380,31 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'."
;; (and (not invisible-at-point) invisible-before-point
;; (memq kind '(insert delete)))
)))
-
- (when (or (memq invisible-at-point '(outline org-hide-block))
- (memq invisible-before-point '(outline org-hide-block)))
+ (when (or (memq invisible-at-point '(outline org-hide-block t))
+ (memq invisible-before-point '(outline org-hide-block t)))
(if (eq org-catch-invisible-edits 'error)
(error "Editing in invisible areas is prohibited - make visible first"))
- ;; Make the area visible
- (save-excursion
- (if invisible-before-point
- (goto-char (previous-single-char-property-change
- (point) 'invisible)))
- (org-cycle))
- (cond
- ((eq org-catch-invisible-edits 'show)
- ;; That's it, we do the edit after showing
- (message
- "Unfolding invisible region around point before editing")
- (sit-for 1))
- ((and (eq org-catch-invisible-edits 'smart)
- border-and-ok-direction)
- (message "Unfolding invisible region around point before editing"))
- (t
- ;; Don't do the edit, make the user repeat it in full visibility
- (error "Edit in invisible region aborted, repeat to confirm with text visible")))))))
+ (if (and org-custom-properties-overlays
+ (y-or-n-p "Display invisible properties in this buffer? "))
+ (org-toggle-custom-properties-visibility)
+ ;; Make the area visible
+ (save-excursion
+ (if invisible-before-point
+ (goto-char (previous-single-char-property-change
+ (point) 'invisible)))
+ (org-cycle))
+ (cond
+ ((eq org-catch-invisible-edits 'show)
+ ;; That's it, we do the edit after showing
+ (message
+ "Unfolding invisible region around point before editing")
+ (sit-for 1))
+ ((and (eq org-catch-invisible-edits 'smart)
+ border-and-ok-direction)
+ (message "Unfolding invisible region around point before editing"))
+ (t
+ ;; Don't do the edit, make the user repeat it in full visibility
+ (error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
(defun org-fix-tags-on-the-fly ()
(when (and (equal (char-after (point-at-bol)) ?*)
@@ -18007,27 +18682,31 @@ individual commands for more information."
(defun org-shiftmetaup (&optional arg)
"Move subtree up or kill table row.
Calls `org-move-subtree-up' or `org-table-kill-row' or
-`org-move-item-up' depending on context. See the individual commands
-for more information."
+`org-move-item-up' or `org-timestamp-up', depending on context.
+See the individual commands for more information."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftmetaup-hook))
((org-at-table-p) (call-interactively 'org-table-kill-row))
((org-at-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
+ ((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
+ (call-interactively 'org-timestamp-up)))
(t (org-modifier-cursor-error))))
(defun org-shiftmetadown (&optional arg)
"Move subtree down or insert table row.
Calls `org-move-subtree-down' or `org-table-insert-row' or
-`org-move-item-down', depending on context. See the individual
-commands for more information."
+`org-move-item-down' or `org-timestamp-up', depending on context.
+See the individual commands for more information."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftmetadown-hook))
((org-at-table-p) (call-interactively 'org-table-insert-row))
((org-at-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
+ ((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
+ (call-interactively 'org-timestamp-down)))
(t (org-modifier-cursor-error))))
(defsubst org-hidden-tree-error ()
@@ -18064,14 +18743,16 @@ See the individual commands for more information."
(t (call-interactively 'backward-word))))
(defun org-metaright (&optional arg)
- "Demote subtree or move table column to right.
-Calls `org-do-demote' or `org-table-move-column', depending on context.
+ "Demote a subtree, a list item or move table column to right.
+In front of a drawer or a block keyword, indent it correctly.
With no specific context, calls the Emacs default `forward-word'.
See the individual commands for more information."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metaright-hook))
((org-at-table-p) (call-interactively 'org-table-move-column))
+ ((org-at-drawer-p) (call-interactively 'org-indent-drawer))
+ ((org-at-block-p) (call-interactively 'org-indent-block))
((org-with-limited-levels
(or (org-at-heading-p)
(and (org-region-active-p)
@@ -18119,6 +18800,20 @@ this function returns t, nil otherwise."
(throw 'exit t))))
nil))))
+(autoload 'org-element-at-point "org-element")
+
+(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-context "org-element" ())
+(declare-function org-element-contents "org-element" (element))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-paragraph-parser "org-element" (limit))
+(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion))
+(declare-function org-element-nested-p "org-element" (elem-a elem-b))
+(declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
+(declare-function org-element--parse-objects "org-element" (beg end acc restriction))
+(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
+
(defun org-metaup (&optional arg)
"Move subtree up or move table row up.
Calls `org-move-subtree-up' or `org-table-move-row' or
@@ -18127,10 +18822,19 @@ for more information."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metaup-hook))
+ ((org-region-active-p)
+ (let* ((a (min (region-beginning) (region-end)))
+ (b (1- (max (region-beginning) (region-end))))
+ (c (save-excursion (goto-char a)
+ (move-beginning-of-line 0)))
+ (d (save-excursion (goto-char a)
+ (move-end-of-line 0) (point))))
+ (transpose-regions a b c d)
+ (goto-char c)))
((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
((org-at-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
- (t (transpose-lines 1) (beginning-of-line -1))))
+ (t (org-drag-element-backward))))
(defun org-metadown (&optional arg)
"Move subtree down or move table row down.
@@ -18140,10 +18844,19 @@ commands for more information."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metadown-hook))
+ ((org-region-active-p)
+ (let* ((a (min (region-beginning) (region-end)))
+ (b (max (region-beginning) (region-end)))
+ (c (save-excursion (goto-char b)
+ (move-beginning-of-line 1)))
+ (d (save-excursion (goto-char b)
+ (move-end-of-line 1) (1+ (point)))))
+ (transpose-regions a b c d)
+ (goto-char d)))
((org-at-table-p) (call-interactively 'org-table-move-row))
((org-at-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
- (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0))))
+ (t (org-drag-element-forward))))
(defun org-shiftup (&optional arg)
"Increase item in timestamp or increase priority of current headline.
@@ -18329,17 +19042,17 @@ Depending on context, this does one of the following:
(defun org-copy-visible (beg end)
"Copy the visible parts of the region."
- (interactive "r")
- (let (snippets s)
- (save-excursion
- (save-restriction
+ (interactive "r")
+ (let (snippets s)
+ (save-excursion
+ (save-restriction
(narrow-to-region beg end)
(setq s (goto-char (point-min)))
(while (not (= (point) (point-max)))
(goto-char (org-find-invisible))
(push (buffer-substring s (point)) snippets)
(setq s (goto-char (org-find-visible))))))
- (kill-new (apply 'concat (nreverse snippets)))))
+ (kill-new (apply 'concat (nreverse snippets)))))
(defun org-copy-special ()
"Copy region in table or copy current subtree.
@@ -18394,7 +19107,7 @@ When in an #+include line, visit the include file. Otherwise call
((or (org-at-table-p)
(save-excursion
(beginning-of-line 1)
- (looking-at "[ \t]*#\\+TBLFM:")))
+ (let ((case-fold-search )) (looking-at "[ \t]*#\\+tblfm:"))))
(call-interactively 'org-table-edit-formulas))
(t (call-interactively 'ffap))))
@@ -18480,7 +19193,7 @@ This command does many different things, depending on context:
(org-footnote-at-definition-p))
(call-interactively 'org-footnote-action))
((org-at-item-checkbox-p)
- ;; Cursor at a checkbox: repair list and update checkboxes. Send
+ ;; Cursor at a checkbox: repair list and update checkboxes. Send
;; list only if at top item.
(let* ((cbox (match-string 1))
(struct (org-list-struct))
@@ -18548,10 +19261,12 @@ This command does many different things, depending on context:
(beginning-of-line 1)
(save-excursion (org-update-dblock)))
((save-excursion
- (beginning-of-line 1)
- (looking-at "[ \t]*#\\+\\([A-Z]+\\)"))
+ (let ((case-fold-search t))
+ (beginning-of-line 1)
+ (looking-at "[ \t]*#\\+\\([a-z]+\\)")))
(cond
- ((equal (match-string 1) "TBLFM")
+ ((or (equal (match-string 1) "TBLFM")
+ (equal (match-string 1) "tblfm"))
;; Recalculate the table before this line
(save-excursion
(beginning-of-line 1)
@@ -18593,35 +19308,41 @@ Also updates the keyword regular expressions."
Calls `org-table-next-row' or `newline', depending on context.
See the individual commands for more information."
(interactive)
- (cond
- ((bobp) (if indent (newline-and-indent) (newline)))
- ((org-at-table-p)
- (org-table-justify-field-maybe)
- (call-interactively 'org-table-next-row))
- ;; when `newline-and-indent' is called within a list, make sure
- ;; text moved stays inside the item.
- ((and (org-in-item-p) indent)
- (if (and (org-at-item-p) (>= (point) (match-end 0)))
- (progn
- (save-match-data (newline))
- (org-indent-line-to (length (match-string 0))))
- (let ((ind (org-get-indentation)))
- (newline)
- (if (org-looking-back org-list-end-re)
- (org-indent-line-function)
- (org-indent-line-to ind)))))
- ((and org-return-follows-link
- (let ((tprop (get-text-property (point) 'face)))
- (or (eq tprop 'org-link)
- (and (listp tprop) (memq 'org-link tprop)))))
- (call-interactively 'org-open-at-point))
- ((and (org-at-heading-p)
- (looking-at
- (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")))
- (org-show-entry)
- (end-of-line 1)
- (newline))
- (t (if indent (newline-and-indent) (newline)))))
+ (let (org-ts-what)
+ (cond
+ ((or (bobp) (org-in-src-block-p))
+ (if indent (newline-and-indent) (newline)))
+ ((org-at-table-p)
+ (org-table-justify-field-maybe)
+ (call-interactively 'org-table-next-row))
+ ;; when `newline-and-indent' is called within a list, make sure
+ ;; text moved stays inside the item.
+ ((and (org-in-item-p) indent)
+ (if (and (org-at-item-p) (>= (point) (match-end 0)))
+ (progn
+ (save-match-data (newline))
+ (org-indent-line-to (length (match-string 0))))
+ (let ((ind (org-get-indentation)))
+ (newline)
+ (if (org-looking-back org-list-end-re)
+ (org-indent-line)
+ (org-indent-line-to ind)))))
+ ((and org-return-follows-link
+ (org-at-timestamp-p t)
+ (not (eq org-ts-what 'after)))
+ (org-follow-timestamp-link))
+ ((and org-return-follows-link
+ (let ((tprop (get-text-property (point) 'face)))
+ (or (eq tprop 'org-link)
+ (and (listp tprop) (memq 'org-link tprop)))))
+ (call-interactively 'org-open-at-point))
+ ((and (org-at-heading-p)
+ (looking-at
+ (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")))
+ (org-show-entry)
+ (end-of-line 1)
+ (newline))
+ (t (if indent (newline-and-indent) (newline))))))
(defun org-return-indent ()
"Goto next table row or insert a newline and indent.
@@ -18741,7 +19462,7 @@ argument ARG, change each line in region into an item."
((not org-adapt-indentation) 0)
((not (outline-previous-heading)) 0)
(t (length (match-string 0))))))
- ;; Level of first heading. Further headings will be
+ ;; Level of first heading. Further headings will be
;; compared to it to determine hierarchy in the list.
(ref-level (org-reduced-level (org-outline-level))))
(while (< (point) end)
@@ -18792,13 +19513,18 @@ argument ARG, change each line in region into an item."
"Convert headings to normal text, or items or text to headings.
If there is no active region, only the current line is considered.
-If the first non blank line is an headline, remove the stars from
-all headlines in the region.
+With a \\[universal-argument] prefix, convert the whole list at
+point into heading.
+
+In a region:
-If it is a plain list item, turn all plain list items into headings.
+- If the first non blank line is an headline, remove the stars
+ from all headlines in the region.
-If it is a normal line, turn each and every normal line (i.e. not
-an heading or an item) in the region into a heading.
+- If it is a normal line turn each and every normal line (i.e. not an
+ heading or an item) in the region into a heading.
+
+- If it is a plain list item, turn all plain list items into headings.
When converting a line into a heading, the number of stars is chosen
such that the lines become children of the current entry. However,
@@ -18812,11 +19538,18 @@ stars to add."
(lambda (pos)
(save-excursion
(goto-char pos)
+ (while (org-at-comment-p) (forward-line))
(skip-chars-forward " \r\t\n")
(point-at-bol)))))
- beg end)
- ;; Determine boundaries of changes. If region ends at a bol, do
- ;; not consider the last line to be in the region.
+ beg end toggled)
+ ;; Determine boundaries of changes. If a universal prefix has
+ ;; been given, put the list in a region. If region ends at a bol,
+ ;; do not consider the last line to be in the region.
+
+ (when (and current-prefix-arg (org-at-item-p))
+ (if (equal current-prefix-arg '(4)) (setq current-prefix-arg 1))
+ (org-mark-element))
+
(if (org-region-active-p)
(setq beg (funcall skip-blanks (region-beginning))
end (copy-marker (save-excursion
@@ -18833,7 +19566,8 @@ stars to add."
((org-at-heading-p)
(while (< (point) end)
(when (org-at-heading-p t)
- (looking-at org-outline-regexp) (replace-match ""))
+ (looking-at org-outline-regexp) (replace-match "")
+ (setq toggled t))
(forward-line)))
;; Case 2. Started at an item: change items into headlines.
;; One star will be added by `org-list-to-subtree'.
@@ -18861,7 +19595,8 @@ stars to add."
(org-list-to-subtree
(org-list-parse-list t)
'(:istart (concat stars add-stars (funcall get-stars depth))
- :icount (concat stars add-stars (funcall get-stars depth))))))))
+ :icount (concat stars add-stars (funcall get-stars depth)))))))
+ (setq toggled t))
(forward-line))))
;; Case 3. Started at normal text: make every line an heading,
;; skipping headlines and items.
@@ -18877,10 +19612,11 @@ stars to add."
(t "*"))) ; inside heading, oddeven
(rpl (concat stars add-stars " ")))
(while (< (point) end)
- (when (and (not (org-at-heading-p)) (not (org-at-item-p))
+ (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p)))
(looking-at "\\([ \t]*\\)\\(\\S-\\)"))
- (replace-match (concat rpl (match-string 2))))
- (forward-line)))))))))
+ (replace-match (concat rpl (match-string 2))) (setq toggled t))
+ (forward-line)))))))
+ (unless toggled (message "Cannot toggle heading from here"))))
(defun org-meta-return (&optional arg)
"Insert a new heading or wrap a region in a table.
@@ -18889,12 +19625,19 @@ See the individual commands for more information."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metareturn-hook))
+ ((or (org-at-drawer-p) (org-at-property-p))
+ (newline-and-indent))
((org-at-table-p)
(call-interactively 'org-table-wrap-region))
(t (call-interactively 'org-insert-heading))))
;;; Menu entries
+(defsubst org-in-subtree-not-table-p ()
+ "Are we in a subtree and not in a table?"
+ (and (not (org-before-first-heading-p))
+ (not (org-at-table-p))))
+
;; Define the Org-mode menus
(easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
'("Tbl"
@@ -18977,23 +19720,25 @@ See the individual commands for more information."
"--"
["Jump" org-goto t])
("Edit Structure"
- ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))]
- ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))]
+ ["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
"--"
- ["Copy Subtree" org-copy-special (not (org-at-table-p))]
- ["Cut Subtree" org-cut-special (not (org-at-table-p))]
+ ["Move Subtree Up" org-shiftmetaup (org-in-subtree-not-table-p)]
+ ["Move Subtree Down" org-shiftmetadown (org-in-subtree-not-table-p)]
+ "--"
+ ["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)]
+ ["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)]
["Paste Subtree" org-paste-special (not (org-at-table-p))]
"--"
["Clone subtree, shift time" org-clone-subtree-with-time-shift t]
"--"
["Copy visible text" org-copy-visible t]
"--"
- ["Promote Heading" org-metaleft (not (org-at-table-p))]
- ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))]
- ["Demote Heading" org-metaright (not (org-at-table-p))]
- ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))]
+ ["Promote Heading" org-metaleft (org-in-subtree-not-table-p)]
+ ["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)]
+ ["Demote Heading" org-metaright (org-in-subtree-not-table-p)]
+ ["Demote Subtree" org-shiftmetaright (org-in-subtree-not-table-p)]
"--"
- ["Sort Region/Children" org-sort (not (org-at-table-p))]
+ ["Sort Region/Children" org-sort t]
"--"
["Convert to odd levels" org-convert-to-odd-levels t]
["Convert to odd/even levels" org-convert-to-oddeven-levels t])
@@ -19004,11 +19749,11 @@ See the individual commands for more information."
["Footnote new/jump" org-footnote-action t]
["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"])
("Archive"
- ["Archive (default method)" org-archive-subtree-default t]
+ ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)]
"--"
- ["Move Subtree to Archive file" org-advertized-archive-subtree t]
- ["Toggle ARCHIVE tag" org-toggle-archive-tag t]
- ["Move subtree to Archive sibling" org-archive-to-archive-sibling t]
+ ["Move Subtree to Archive file" org-advertized-archive-subtree (org-in-subtree-not-table-p)]
+ ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)]
+ ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)]
)
"--"
("Hyperlinks"
@@ -19059,23 +19804,23 @@ See the individual commands for more information."
["Go to the inbox of a feed..." org-feed-goto-inbox t]
["Customize feeds" (customize-variable 'org-feed-alist) t])
("TAGS and Properties"
- ["Set Tags" org-set-tags-command t]
+ ["Set Tags" org-set-tags-command (not (org-before-first-heading-p))]
["Change tag in region" org-change-tag-in-region (org-region-active-p)]
"--"
- ["Set property" org-set-property t]
+ ["Set property" org-set-property (not (org-before-first-heading-p))]
["Column view of properties" org-columns t]
["Insert Column View DBlock" org-insert-columns-dblock t])
("Dates and Scheduling"
- ["Timestamp" org-time-stamp t]
- ["Timestamp (inactive)" org-time-stamp-inactive t]
+ ["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
+ ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
("Change Date"
- ["1 Day Later" org-shiftright t]
- ["1 Day Earlier" org-shiftleft t]
- ["1 ... Later" org-shiftup t]
- ["1 ... Earlier" org-shiftdown t])
+ ["1 Day Later" org-shiftright (org-at-timestamp-p)]
+ ["1 Day Earlier" org-shiftleft (org-at-timestamp-p)]
+ ["1 ... Later" org-shiftup (org-at-timestamp-p)]
+ ["1 ... Earlier" org-shiftdown (org-at-timestamp-p)])
["Compute Time Range" org-evaluate-time-range t]
- ["Schedule Item" org-schedule t]
- ["Deadline" org-deadline t]
+ ["Schedule Item" org-schedule (not (org-before-first-heading-p))]
+ ["Deadline" org-deadline (not (org-before-first-heading-p))]
"--"
["Custom time format" org-toggle-time-stamp-overlays
:style radio :selected org-display-custom-times]
@@ -19175,7 +19920,7 @@ information about your Org-mode version and configuration."
(let ((reporter-prompt-for-summary-p "Bug report subject: "))
(reporter-submit-bug-report
"emacs-orgmode@gnu.org"
- (org-version)
+ (org-version nil 'full)
(let (list)
(save-window-excursion
(org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*"))
@@ -19224,8 +19969,8 @@ Your bug report will be posted to the Org-mode mailing list.
(save-excursion
(while bl
(set-buffer (pop bl))
- (if (eq major-mode 'org-mode) (setq bl nil)))
- (when (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode) (setq bl nil)))
+ (when (derived-mode-p 'org-mode)
(easy-menu-change
'("Org") "File List for Agenda"
(append
@@ -19256,25 +20001,25 @@ Your bug report will be posted to the Org-mode mailing list.
With prefix arg UNCOMPILED, load the uncompiled versions."
(interactive "P")
(require 'find-func)
- (let* ((file-re "^\\(org\\|orgtbl\\)\\(\\.el\\|-.*\\.el\\)")
- (dir-org (file-name-directory (org-find-library-name "org")))
+ (let* ((file-re "^org\\(-.*\\)?\\.el")
+ (dir-org (file-name-directory (org-find-library-dir "org")))
(dir-org-contrib (ignore-errors
- (file-name-directory
- (org-find-library-name "org-contribdir"))))
+ (file-name-directory
+ (org-find-library-dir "org-contribdir"))))
(babel-files
(mapcar (lambda (el) (concat "ob" (when el (format "-%s" el)) ".el"))
(append (list nil "comint" "eval" "exp" "keys"
- "lob" "ref" "table" "tangle")
+ "lob" "ref" "table" "tangle")
(delq nil
(mapcar
(lambda (lang)
(when (cdr lang) (symbol-name (car lang))))
org-babel-load-languages)))))
(files
- (append (directory-files dir-org t file-re)
- babel-files
- (and dir-org-contrib
- (directory-files dir-org-contrib t file-re))))
+ (append babel-files
+ (and dir-org-contrib
+ (directory-files dir-org-contrib t file-re))
+ (directory-files dir-org t file-re)))
(remove-re (concat (if (featurep 'xemacs)
"org-colview" "org-colview-xemacs")
"\\'")))
@@ -19288,10 +20033,11 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(when (featurep (intern (file-name-nondirectory f)))
(if (and (not uncompiled)
(file-exists-p (concat f ".elc")))
- (load (concat f ".elc") nil nil t)
- (load (concat f ".el") nil nil t))))
- files))
- (org-version))
+ (load (concat f ".elc") nil nil 'nosuffix)
+ (load (concat f ".el") nil nil 'nosuffix))))
+ files)
+ (load (concat dir-org "org-version.el") 'noerror nil 'nosuffix))
+ (org-version nil 'full 'message))
;;;###autoload
(defun org-customize ()
@@ -19527,7 +20273,7 @@ N may optionally be the number of spaces to remove."
(setq template
(replace-regexp-in-string
(concat "%" (regexp-quote (car entry)))
- (cdr entry) template t t)))
+ (or (cdr entry) "") template t t)))
template))
(defun org-base-buffer (buffer)
@@ -19616,6 +20362,14 @@ and end of string."
"Is S an ID created by UUIDGEN?"
(string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s)))
+(defun org-in-src-block-p nil
+ "Whether point is in a code source block."
+ (let (ov)
+ (when (setq ov (overlays-at (point)))
+ (memq 'org-block-background
+ (overlay-properties
+ (car ov))))))
+
(defun org-context ()
"Return a list of contexts of the current cursor position.
If several contexts apply, all are returned.
@@ -19634,8 +20388,10 @@ contexts are:
:table in an org-mode table
:table-special on a special filed in a table
:table-table in a table.el table
+:clocktable in a clocktable
+:src-block in a source block
:link on a hyperlink
-:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE.
+:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT, QUOTE.
:target on a <<target>>
:radio-target on a <<<radio-target>>>
:latex-fragment on a LaTeX fragment
@@ -19646,6 +20402,7 @@ faces as a help to recognize the following contexts: :table-special, :link,
and :keyword."
(let* ((f (get-text-property (point) 'face))
(faces (if (listp f) f (list f)))
+ (case-fold-search t)
(p (point)) clist o)
;; First the large context
(cond
@@ -19680,6 +20437,24 @@ and :keyword."
(push (list :table-table) clist)))
(goto-char p)
+ (let ((case-fold-search t))
+ ;; New the "medium" contexts: clocktables, source blocks
+ (cond ((org-in-clocktable-p)
+ (push (list :clocktable
+ (and (or (looking-at "#\\+BEGIN: clocktable")
+ (search-backward "#+BEGIN: clocktable" nil t))
+ (match-beginning 0))
+ (and (re-search-forward "#\\+END:?" nil t)
+ (match-end 0))) clist))
+ ((org-in-src-block-p)
+ (push (list :src-block
+ (and (or (looking-at "#\\+BEGIN_SRC")
+ (search-backward "#+BEGIN_SRC" nil t))
+ (match-beginning 0))
+ (and (search-forward "#+END_SRC" nil t)
+ (match-beginning 0))) clist))))
+ (goto-char p)
+
;; Now the small context
(cond
((org-at-timestamp-p)
@@ -19826,18 +20601,18 @@ block from point."
;; Emacs 23
(add-hook 'occur-mode-find-occurrence-hook
(lambda ()
- (when (eq major-mode 'org-mode)
+ (when (derived-mode-p 'org-mode)
(org-reveal))))
;; Emacs 22
(defadvice occur-mode-goto-occurrence
(after org-occur-reveal activate)
- (and (eq major-mode 'org-mode) (org-reveal)))
+ (and (derived-mode-p 'org-mode) (org-reveal)))
(defadvice occur-mode-goto-occurrence-other-window
(after org-occur-reveal activate)
- (and (eq major-mode 'org-mode) (org-reveal)))
+ (and (derived-mode-p 'org-mode) (org-reveal)))
(defadvice occur-mode-display-occurrence
(after org-occur-reveal activate)
- (when (eq major-mode 'org-mode)
+ (when (derived-mode-p 'org-mode)
(let ((pos (occur-mode-find-occurrence)))
(with-current-buffer (marker-buffer pos)
(save-excursion
@@ -19910,7 +20685,7 @@ Taken from `reduce' in cl-seq.el with all keyword arguments but
Returns the number of empty lines passed."
(let ((pos (point)))
(if (cdr (assoc 'heading org-blank-before-new-entry))
- (skip-chars-backward " \t\n\r")
+ (skip-chars-backward " \t\n\r")
(unless (eobp)
(forward-line -1)))
(beginning-of-line 2)
@@ -19954,32 +20729,6 @@ ones and overrule settings in the other lists."
(setq rtn (plist-put rtn p v))))
rtn))
-(defun org-move-line-down (arg)
- "Move the current line down. With prefix argument, move it past ARG lines."
- (interactive "p")
- (let ((col (current-column))
- beg end pos)
- (beginning-of-line 1) (setq beg (point))
- (beginning-of-line 2) (setq end (point))
- (beginning-of-line (+ 1 arg))
- (setq pos (move-marker (make-marker) (point)))
- (insert (delete-and-extract-region beg end))
- (goto-char pos)
- (org-move-to-column col)))
-
-(defun org-move-line-up (arg)
- "Move the current line up. With prefix argument, move it past ARG lines."
- (interactive "p")
- (let ((col (current-column))
- beg end pos)
- (beginning-of-line 1) (setq beg (point))
- (beginning-of-line 2) (setq end (point))
- (beginning-of-line (- arg))
- (setq pos (move-marker (make-marker) (point)))
- (insert (delete-and-extract-region beg end))
- (goto-char pos)
- (org-move-to-column col)))
-
(defun org-replace-escapes (string table)
"Replace %-escapes in STRING with values in TABLE.
TABLE is an association list with keys like \"%a\" and string values.
@@ -20078,34 +20827,24 @@ which make use of the date at the cursor."
(message
"Entry marked for action; press `k' at desired date in agenda or calendar"))
-(defun org-mark-subtree ()
+(defun org-mark-subtree (&optional up)
"Mark the current subtree.
-This puts point at the start of the current subtree, and mark at the end.
-
-If point is in an inline task, mark that task instead."
- (interactive)
- (let ((inline-task-p
- (and (featurep 'org-inlinetask)
- (org-inlinetask-in-task-p)))
- (beg))
- ;; Get beginning of subtree
- (cond
- (inline-task-p (org-inlinetask-goto-beginning))
- ((org-at-heading-p) (beginning-of-line))
- (t (org-with-limited-levels (outline-previous-visible-heading 1))))
- (setq beg (point))
- ;; Get end of it
- (if inline-task-p
- (org-inlinetask-goto-end)
- (org-end-of-subtree))
- ;; Mark zone
- (push-mark (point) nil t)
- (goto-char beg)))
+This puts point at the start of the current subtree, and mark at
+the end. If a numeric prefix UP is given, move up into the
+hierarchy of headlines by UP levels before marking the subtree."
+ (interactive "P")
+ (org-with-limited-levels
+ (cond ((org-at-heading-p) (beginning-of-line))
+ ((org-before-first-heading-p) (error "Not in a subtree"))
+ (t (outline-previous-visible-heading 1))))
+ (when up (while (and (> up 0) (org-up-heading-safe)) (decf up)))
+ (if (org-called-interactively-p 'any)
+ (call-interactively 'org-mark-element)
+ (org-mark-element)))
-;;; Paragraph filling stuff.
-;; We want this to be just right, so use the full arsenal.
+;;; Indentation
-(defun org-indent-line-function ()
+(defun org-indent-line ()
"Indent line depending on context."
(interactive)
(let* ((pos (point))
@@ -20117,283 +20856,475 @@ If point is in an inline task, mark that task instead."
(inline-re (and inline-task-p
(org-inlinetask-outline-regexp)))
column)
- (beginning-of-line 1)
- (cond
- ;; Comments
- ((looking-at "# ") (setq column 0))
- ;; Headings
- ((looking-at org-outline-regexp) (setq column 0))
- ;; Included files
- ((looking-at "#\\+include:") (setq column 0))
- ;; Footnote definition
- ((looking-at org-footnote-definition-re) (setq column 0))
- ;; Literal examples
- ((looking-at "[ \t]*:\\( \\|$\\)")
- (setq column (org-get-indentation))) ; do nothing
- ;; Lists
- ((ignore-errors (goto-char (org-in-item-p)))
- (setq column (if itemp
- (org-get-indentation)
- (org-list-item-body-column (point))))
- (goto-char pos))
- ;; Drawers
- ((and (looking-at "[ \t]*:END:")
- (save-excursion (re-search-backward org-drawer-regexp nil t)))
- (save-excursion
- (goto-char (1- (match-beginning 1)))
- (setq column (current-column))))
- ;; Special blocks
- ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)")
- (save-excursion
- (re-search-backward
- (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
- (setq column (org-get-indentation (match-string 0))))
- ((and (not (looking-at "[ \t]*#\\+begin_"))
- (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
- (save-excursion
- (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t))
- (setq column
- (cond ((equal (downcase (match-string 1)) "src")
- ;; src blocks: let `org-edit-src-exit' handle them
- (org-get-indentation))
- ((equal (downcase (match-string 1)) "example")
- (max (org-get-indentation)
- (org-get-indentation (match-string 0))))
- (t
- (org-get-indentation (match-string 0))))))
- ;; This line has nothing special, look at the previous relevant
- ;; line to compute indentation
- (t
- (beginning-of-line 0)
- (while (and (not (bobp))
- (not (looking-at org-drawer-regexp))
- ;; When point started in an inline task, do not move
- ;; above task starting line.
- (not (and inline-task-p (looking-at inline-re)))
- ;; Skip drawers, blocks, empty lines, verbatim,
- ;; comments, tables, footnotes definitions, lists,
- ;; inline tasks.
- (or (and (looking-at "[ \t]*:END:")
- (re-search-backward org-drawer-regexp nil t))
- (and (looking-at "[ \t]*#\\+end_")
- (re-search-backward "[ \t]*#\\+begin_"nil t))
- (looking-at "[ \t]*[\n:#|]")
- (looking-at org-footnote-definition-re)
- (and (ignore-errors (goto-char (org-in-item-p)))
- (goto-char
- (org-list-get-top-point (org-list-struct))))
- (and (not inline-task-p)
- (featurep 'org-inlinetask)
- (org-inlinetask-in-task-p)
- (or (org-inlinetask-goto-beginning) t))))
- (beginning-of-line 0))
+ (if (and orgstruct-is-++ (eq pos (point)))
+ (let ((indent-line-function (cadadr (assoc 'indent-line-function org-fb-vars))))
+ (indent-according-to-mode))
+ (beginning-of-line 1)
(cond
- ;; There was an heading above.
- ((looking-at "\\*+[ \t]+")
- (if (not org-adapt-indentation)
- (setq column 0)
- (goto-char (match-end 0))
+ ;; Headings
+ ((looking-at org-outline-regexp) (setq column 0))
+ ;; Included files
+ ((looking-at "#\\+include:") (setq column 0))
+ ;; Footnote definition
+ ((looking-at org-footnote-definition-re) (setq column 0))
+ ;; Literal examples
+ ((looking-at "[ \t]*:\\( \\|$\\)")
+ (setq column (org-get-indentation))) ; do nothing
+ ;; Lists
+ ((ignore-errors (goto-char (org-in-item-p)))
+ (setq column (if itemp
+ (org-get-indentation)
+ (org-list-item-body-column (point))))
+ (goto-char pos))
+ ;; Drawers
+ ((and (looking-at "[ \t]*:END:")
+ (save-excursion (re-search-backward org-drawer-regexp nil t)))
+ (save-excursion
+ (goto-char (1- (match-beginning 1)))
(setq column (current-column))))
- ;; A drawer had started and is unfinished
- ((looking-at org-drawer-regexp)
- (goto-char (1- (match-beginning 1)))
- (setq column (current-column)))
- ;; Else, nothing noticeable found: get indentation and go on.
- (t (setq column (org-get-indentation))))))
- ;; Now apply indentation and move cursor accordingly
- (goto-char pos)
- (if (<= (current-column) (current-indentation))
- (org-indent-line-to column)
- (save-excursion (org-indent-line-to column)))
- ;; Special polishing for properties, see `org-property-format'
- (setq column (current-column))
- (beginning-of-line 1)
- (if (looking-at
- "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
- (replace-match (concat (match-string 1)
- (format org-property-format
- (match-string 2) (match-string 3)))
- t t))
- (org-move-to-column column)))
-
-(defvar org-adaptive-fill-regexp-backup adaptive-fill-regexp
- "Variable to store copy of `adaptive-fill-regexp'.
-Since `adaptive-fill-regexp' is set to never match, we need to
-store a backup of its value before entering `org-mode' so that
-the functionality can be provided as a fall-back.")
-
-(defun org-set-autofill-regexps ()
+ ;; Special blocks
+ ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)")
+ (save-excursion
+ (re-search-backward
+ (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
+ (setq column (org-get-indentation (match-string 0))))
+ ((and (not (looking-at "[ \t]*#\\+begin_"))
+ (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
+ (save-excursion
+ (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t))
+ (setq column
+ (cond ((equal (downcase (match-string 1)) "src")
+ ;; src blocks: let `org-edit-src-exit' handle them
+ (org-get-indentation))
+ ((equal (downcase (match-string 1)) "example")
+ (max (org-get-indentation)
+ (org-get-indentation (match-string 0))))
+ (t
+ (org-get-indentation (match-string 0))))))
+ ;; This line has nothing special, look at the previous relevant
+ ;; line to compute indentation
+ (t
+ (beginning-of-line 0)
+ (while (and (not (bobp))
+ (not (looking-at org-drawer-regexp))
+ ;; When point started in an inline task, do not move
+ ;; above task starting line.
+ (not (and inline-task-p (looking-at inline-re)))
+ ;; Skip drawers, blocks, empty lines, verbatim,
+ ;; comments, tables, footnotes definitions, lists,
+ ;; inline tasks.
+ (or (and (looking-at "[ \t]*:END:")
+ (re-search-backward org-drawer-regexp nil t))
+ (and (looking-at "[ \t]*#\\+end_")
+ (re-search-backward "[ \t]*#\\+begin_"nil t))
+ (looking-at "[ \t]*[\n:#|]")
+ (looking-at org-footnote-definition-re)
+ (and (ignore-errors (goto-char (org-in-item-p)))
+ (goto-char
+ (org-list-get-top-point (org-list-struct))))
+ (and (not inline-task-p)
+ (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p)
+ (or (org-inlinetask-goto-beginning) t))))
+ (beginning-of-line 0))
+ (cond
+ ;; There was an heading above.
+ ((looking-at "\\*+[ \t]+")
+ (if (not org-adapt-indentation)
+ (setq column 0)
+ (goto-char (match-end 0))
+ (setq column (current-column))))
+ ;; A drawer had started and is unfinished
+ ((looking-at org-drawer-regexp)
+ (goto-char (1- (match-beginning 1)))
+ (setq column (current-column)))
+ ;; Else, nothing noticeable found: get indentation and go on.
+ (t (setq column (org-get-indentation))))))
+ ;; Now apply indentation and move cursor accordingly
+ (goto-char pos)
+ (if (<= (current-column) (current-indentation))
+ (org-indent-line-to column)
+ (save-excursion (org-indent-line-to column)))
+ ;; Special polishing for properties, see `org-property-format'
+ (setq column (current-column))
+ (beginning-of-line 1)
+ (if (looking-at
+ "\\([ \t]*\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
+ (replace-match (concat (match-string 1)
+ (format org-property-format
+ (match-string 2) (match-string 3)))
+ t t))
+ (org-move-to-column column))))
+
+(defun org-indent-drawer ()
+ "Indent the drawer at point."
+ (interactive)
+ (let ((p (point))
+ (e (and (save-excursion (re-search-forward ":END:" nil t))
+ (match-end 0)))
+ (folded
+ (save-excursion
+ (end-of-line)
+ (when (overlays-at (point))
+ (member 'invisible (overlay-properties
+ (car (overlays-at (point)))))))))
+ (when folded (org-cycle))
+ (indent-for-tab-command)
+ (while (and (move-beginning-of-line 2) (< (point) e))
+ (indent-for-tab-command))
+ (goto-char p)
+ (when folded (org-cycle)))
+ (message "Drawer at point indented"))
+
+(defun org-indent-block ()
+ "Indent the block at point."
+ (interactive)
+ (let ((p (point))
+ (case-fold-search t)
+ (e (and (save-excursion (re-search-forward "#\\+end_?\\(?:[a-z]+\\)?" nil t))
+ (match-end 0)))
+ (folded
+ (save-excursion
+ (end-of-line)
+ (when (overlays-at (point))
+ (member 'invisible (overlay-properties
+ (car (overlays-at (point)))))))))
+ (when folded (org-cycle))
+ (indent-for-tab-command)
+ (while (and (move-beginning-of-line 2) (< (point) e))
+ (indent-for-tab-command))
+ (goto-char p)
+ (when folded (org-cycle)))
+ (message "Block at point indented"))
+
+(defun org-indent-region (start end)
+ "Indent region."
+ (interactive "r")
+ (save-excursion
+ (let ((line-end (org-current-line end)))
+ (goto-char start)
+ (while (< (org-current-line) line-end)
+ (cond ((org-in-src-block-p) (org-src-native-tab-command-maybe))
+ (t (call-interactively 'org-indent-line)))
+ (move-beginning-of-line 2)))))
+
+
+;;; Filling
+
+;; We use our own fill-paragraph and auto-fill functions.
+
+;; `org-fill-paragraph' relies on adaptive filling and context
+;; checking. Appropriate `fill-prefix' is computed with
+;; `org-adaptive-fill-function'.
+
+;; `org-auto-fill-function' takes care of auto-filling. It calls
+;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with
+;; `org-adaptive-fill-function' value. Internally,
+;; `org-comment-line-break-function' breaks the line.
+
+;; `org-setup-filling' installs filling and auto-filling related
+;; variables during `org-mode' initialization.
+
+(defun org-setup-filling ()
(interactive)
- ;; In the paragraph separator we include headlines, because filling
- ;; text in a line directly attached to a headline would otherwise
- ;; fill the headline as well.
- (org-set-local 'comment-start-skip "^#+[ \t]*")
- (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|#]")
- ;; The paragraph starter includes hand-formatted lists.
- (org-set-local
- 'paragraph-start
- (concat
- "\f" "\\|"
- "[ ]*$" "\\|"
- org-outline-regexp "\\|"
- "[ \t]*#" "\\|"
- (org-item-re) "\\|"
- "[ \t]*[:|]" "\\|"
- "\\$\\$" "\\|"
- "\\\\\\(begin\\|end\\|[][]\\)"))
- ;; Inhibit auto-fill for headers, tables and fixed-width lines.
- ;; But only if the user has not turned off tables or fixed-width regions
- (org-set-local
- 'auto-fill-inhibit-regexp
- (concat org-outline-regexp
- "\\|#\\+"
- "\\|[ \t]*" org-keyword-time-regexp
- (if (or org-enable-table-editor org-enable-fixed-width-editor)
- (concat
- "\\|[ \t]*["
- (if org-enable-table-editor "|" "")
- (if org-enable-fixed-width-editor ":" "")
- "]"))))
- ;; We use our own fill-paragraph function, to make sure that tables
- ;; and fixed-width regions are not wrapped. That function will pass
- ;; through to `fill-paragraph' when appropriate.
- (org-set-local 'fill-paragraph-function 'org-fill-paragraph)
;; Prevent auto-fill from inserting unwanted new items.
- (if (boundp 'fill-nobreak-predicate)
- (org-set-local 'fill-nobreak-predicate
- (if (memq 'org-fill-item-nobreak-p fill-nobreak-predicate)
- fill-nobreak-predicate
- (cons 'org-fill-item-nobreak-p fill-nobreak-predicate))))
- ;; Adaptive filling: To get full control, first make sure that
- ;; `adaptive-fill-regexp' never matches. Then install our own matcher.
- (unless (local-variable-p 'adaptive-fill-regexp (current-buffer))
- (org-set-local 'org-adaptive-fill-regexp-backup
- adaptive-fill-regexp))
- (org-set-local 'adaptive-fill-regexp "\000")
+ (when (boundp 'fill-nobreak-predicate)
+ (org-set-local
+ 'fill-nobreak-predicate
+ (org-uniquify
+ (append fill-nobreak-predicate
+ '(org-fill-paragraph-separate-nobreak-p
+ org-fill-line-break-nobreak-p)))))
+ (org-set-local 'fill-paragraph-function 'org-fill-paragraph)
+ (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function)
(org-set-local 'normal-auto-fill-function 'org-auto-fill-function)
- (org-set-local 'adaptive-fill-function
- 'org-adaptive-fill-function)
- (org-set-local
- 'align-mode-rules-list
- '((org-in-buffer-settings
- (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
- (modes . '(org-mode))))))
+ (org-set-local 'comment-line-break-function 'org-comment-line-break-function))
-(defun org-fill-item-nobreak-p ()
+(defvar org-element-paragraph-separate) ; org-element.el
+(defun org-fill-paragraph-separate-nobreak-p ()
"Non-nil when a line break at point would insert a new item."
- (and (looking-at (org-item-re)) (org-list-in-valid-context-p)))
+ (looking-at (substring org-element-paragraph-separate 1)))
-(defun org-fill-paragraph (&optional justify)
- "Re-align a table, pass through to fill-paragraph if no table."
- (let ((table-p (org-at-table-p))
- (table.el-p (org-at-table.el-p))
- (itemp (org-in-item-p)))
- (cond ((and (equal (char-after (point-at-bol)) ?*)
- (save-excursion (goto-char (point-at-bol))
- (looking-at org-outline-regexp)))
- t) ; skip headlines
- (table.el-p t) ; skip table.el tables
- (table-p (org-table-align) t) ; align Org tables
- (itemp ; align text in items
- (let* ((struct (save-excursion (goto-char itemp)
- (org-list-struct)))
- (parents (org-list-parents-alist struct))
- (children (org-list-get-children itemp struct parents))
- beg end prev next prefix)
- ;; Determine in which part of item point is: before
- ;; first child, after last child, between two
- ;; sub-lists, or simply in item if there's no child.
- (cond
- ((not children)
- (setq prefix (make-string (org-list-item-body-column itemp) ?\ )
- beg itemp
- end (org-list-get-item-end itemp struct)))
- ((< (point) (setq next (car children)))
- (setq prefix (make-string (org-list-item-body-column itemp) ?\ )
- beg itemp
- end next))
- ((> (point) (setq prev (car (last children))))
- (setq beg (org-list-get-item-end prev struct)
- end (org-list-get-item-end itemp struct)
- prefix (save-excursion
- (goto-char beg)
- (skip-chars-forward " \t")
- (make-string (current-column) ?\ ))))
- (t (catch 'exit
- (while (setq next (pop children))
- (if (> (point) next)
- (setq prev next)
- (setq beg (org-list-get-item-end prev struct)
- end next
- prefix (save-excursion
- (goto-char beg)
- (skip-chars-forward " \t")
- (make-string (current-column) ?\ )))
- (throw 'exit nil))))))
- ;; Use `fill-paragraph' with buffer narrowed to item
- ;; without any child, and with our computed PREFIX.
- (flet ((fill-context-prefix (from to &optional flr) prefix))
- (save-restriction
- (narrow-to-region beg end)
- (save-excursion (fill-paragraph justify)))) t))
- ;; Special case where point is not in a list but is on
- ;; a paragraph adjacent to a list: make sure this paragraph
- ;; doesn't get merged with the end of the list by narrowing
- ;; buffer first.
- ((save-excursion (forward-paragraph -1)
- (setq itemp (org-in-item-p)))
- (let ((struct (save-excursion (goto-char itemp)
- (org-list-struct))))
- (save-restriction
- (narrow-to-region (org-list-get-bottom-point struct)
- (save-excursion (forward-paragraph 1)
- (point)))
- (fill-paragraph justify) t)))
- ;; Else simply call `fill-paragraph'.
- (t nil))))
-
-;; For reference, this is the default value of adaptive-fill-regexp
-;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"
+(defun org-fill-line-break-nobreak-p ()
+ "Non-nil when a line break at point would create an Org line break."
+ (save-excursion
+ (skip-chars-backward "[ \t]")
+ (skip-chars-backward "\\\\")
+ (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)")))
+(declare-function message-in-body-p "message" ())
+(defvar org-element--affiliated-re) ; From org-element.el
(defun org-adaptive-fill-function ()
- "Return a fill prefix for org-mode files."
- (let (itemp)
+ "Compute a fill prefix for the current line.
+Return fill prefix, as a string, or nil if current line isn't
+meant to be filled."
+ (org-with-wide-buffer
+ (unless (and (derived-mode-p 'message-mode) (not (message-in-body-p)))
+ ;; FIXME: This is really the job of orgstruct++-mode
+ (let* ((p (line-beginning-position))
+ (element (save-excursion (beginning-of-line)
+ (org-element-at-point)))
+ (type (org-element-type element))
+ (post-affiliated
+ (save-excursion
+ (goto-char (org-element-property :begin element))
+ (while (looking-at org-element--affiliated-re) (forward-line))
+ (point))))
+ (unless (< p post-affiliated)
+ (case type
+ (comment (looking-at "[ \t]*# ?") (match-string 0))
+ (footnote-definition "")
+ ((item plain-list)
+ (make-string (org-list-item-body-column post-affiliated) ? ))
+ (paragraph
+ ;; Fill prefix is usually the same as the current line,
+ ;; except if the paragraph is at the beginning of an item.
+ (let ((parent (org-element-property :parent element)))
+ (cond ((eq (org-element-type parent) 'item)
+ (make-string (org-list-item-body-column
+ (org-element-property :begin parent))
+ ? ))
+ ((save-excursion (beginning-of-line) (looking-at "[ \t]+"))
+ (match-string 0))
+ (t ""))))
+ (comment-block
+ ;; Only fill contents if P is within block boundaries.
+ (let* ((cbeg (save-excursion (goto-char post-affiliated)
+ (forward-line)
+ (point)))
+ (cend (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))))
+ (when (and (>= p cbeg) (< p cend))
+ (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
+ (match-string 0)
+ ""))))))))))
+
+(declare-function message-goto-body "message" ())
+(defvar message-cite-prefix-regexp) ; From message.el
+(defvar org-element-all-objects) ; From org-element.el
+(defun org-fill-paragraph (&optional justify)
+ "Fill element at point, when applicable.
+
+This function only applies to comment blocks, comments, example
+blocks and paragraphs. Also, as a special case, re-align table
+when point is at one.
+
+If JUSTIFY is non-nil (interactively, with prefix argument),
+justify as well. If `sentence-end-double-space' is non-nil, then
+period followed by one space does not end a sentence, so don't
+break a line there. The variable `fill-column' controls the
+width for filling.
+
+For convenience, when point is at a plain list, an item or
+a footnote definition, try to fill the first paragraph within."
+ ;; Falls back on message-fill-paragraph when necessary
+ (interactive)
+ (if (and (derived-mode-p 'message-mode)
+ (or (not (message-in-body-p))
+ (save-excursion (move-beginning-of-line 1)
+ (looking-at message-cite-prefix-regexp))))
+ (let ((fill-paragraph-function
+ (cadadr (assoc 'fill-paragraph-function org-fb-vars)))
+ (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars)))
+ (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars)))
+ (paragraph-separate
+ (cadadr (assoc 'paragraph-separate org-fb-vars))))
+ (fill-paragraph nil))
(save-excursion
- (cond
- ;; Comment line
- ((looking-at "#[ \t]+")
- (match-string-no-properties 0))
- ;; Plain list item
- ((org-at-item-p)
- (make-string (org-list-item-body-column (point-at-bol)) ?\ ))
- ;; Point is in a list after `backward-paragraph': original
- ;; point wasn't in the list, or filling would have been taken
- ;; care of by `org-auto-fill-function', but the list and the
- ;; real paragraph are not separated by a blank line. Thus, move
- ;; point after the list to go back to real paragraph and
- ;; determine fill-prefix.
- ((setq itemp (org-in-item-p))
- (goto-char itemp)
- (let* ((struct (org-list-struct))
- (bottom (org-list-get-bottom-point struct)))
- (goto-char bottom)
- (make-string (org-get-indentation) ?\ )))
- ;; Other text
- ((looking-at org-adaptive-fill-regexp-backup)
- (match-string-no-properties 0))))))
+ ;; Move to end of line in order to get the first paragraph
+ ;; within a plain list or a footnote definition.
+ (end-of-line)
+ (let ((element (org-element-at-point)))
+ ;; First check if point is in a blank line at the beginning of
+ ;; the buffer. In that case, ignore filling.
+ (if (< (point) (org-element-property :begin element)) t
+ (case (org-element-type element)
+ ;; Align Org tables, leave table.el tables as-is.
+ (table-row (org-table-align) t)
+ (table
+ (when (eq (org-element-property :type element) 'org)
+ (org-table-align))
+ t)
+ (paragraph
+ ;; Paragraphs may contain `line-break' type objects.
+ (let ((beg (max (point-min)
+ (org-element-property :contents-begin element)))
+ (end (min (point-max)
+ (org-element-property :contents-end element))))
+ ;; Do nothing if point is at an affiliated keyword.
+ (if (< (point) beg) t
+ (when (derived-mode-p 'message-mode)
+ ;; In `message-mode', do not fill following
+ ;; citation in current paragraph nor text before
+ ;; message body.
+ (let ((body-start (save-excursion (message-goto-body))))
+ (when body-start (setq beg (max body-start beg))))
+ (when (save-excursion
+ (re-search-forward
+ (concat "^" message-cite-prefix-regexp) end t))
+ (setq end (match-beginning 0))))
+ ;; Fill paragraph, taking line breaks into
+ ;; consideration. For that, slice the paragraph
+ ;; using line breaks as separators, and fill the
+ ;; parts in reverse order to avoid messing with
+ ;; markers.
+ (save-excursion
+ (goto-char end)
+ (mapc
+ (lambda (pos)
+ (fill-region-as-paragraph pos (point) justify)
+ (goto-char pos))
+ ;; Find the list of ending positions for line
+ ;; breaks in the current paragraph. Add paragraph
+ ;; beginning to include first slice.
+ (nreverse
+ (cons
+ beg
+ (org-element-map
+ (org-element--parse-objects
+ beg end nil org-element-all-objects)
+ 'line-break
+ (lambda (lb) (org-element-property :end lb)))))))
+ t)))
+ ;; Contents of `comment-block' type elements should be
+ ;; filled as plain text, but only if point is within block
+ ;; markers.
+ (comment-block
+ (let* ((case-fold-search t)
+ (beg (save-excursion
+ (goto-char (org-element-property :begin element))
+ (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
+ (forward-line)
+ (point)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (re-search-backward "^[ \t]*#\\+end_comment" nil t)
+ (line-beginning-position))))
+ (when (and (>= (point) beg) (< (point) end))
+ (fill-region-as-paragraph
+ (save-excursion
+ (end-of-line)
+ (re-search-backward "^[ \t]*$" beg 'move)
+ (line-beginning-position))
+ (save-excursion
+ (beginning-of-line)
+ (re-search-forward "^[ \t]*$" end 'move)
+ (line-beginning-position))
+ justify)))
+ t)
+ ;; Fill comments.
+ (comment (fill-comment-paragraph justify))
+ ;; Ignore every other element.
+ (otherwise t)))))))
(defun org-auto-fill-function ()
"Auto-fill function."
- (let (itemp prefix)
- ;; When in a list, compute an appropriate fill-prefix and make
- ;; sure it will be used by `do-auto-fill'.
- (if (setq itemp (org-in-item-p))
- (progn
- (setq prefix (make-string (org-list-item-body-column itemp) ?\ ))
- (flet ((fill-context-prefix (from to &optional flr) prefix))
- (do-auto-fill)))
- ;; Else just use `do-auto-fill'.
- (do-auto-fill))))
+ ;; Check if auto-filling is meaningful.
+ (let ((fc (current-fill-column)))
+ (when (and fc (> (current-column) fc))
+ (let ((fill-prefix (org-adaptive-fill-function)))
+ (when fill-prefix (do-auto-fill))))))
+
+(defun org-comment-line-break-function (&optional soft)
+ "Break line at point and indent, continuing comment if within one.
+The inserted newline is marked hard if variable
+`use-hard-newlines' is true, unless optional argument SOFT is
+non-nil."
+ (if soft (insert-and-inherit ?\n) (newline 1))
+ (save-excursion (forward-char -1) (delete-horizontal-space))
+ (delete-horizontal-space)
+ (indent-to-left-margin)
+ (insert-before-markers-and-inherit fill-prefix))
+
+
+;;; Comments
+
+;; Org comments syntax is quite complex. It requires the entire line
+;; to be just a comment. Also, even with the right syntax at the
+;; beginning of line, some some elements (i.e. verse-block or
+;; example-block) don't accept comments. Usual Emacs comment commands
+;; cannot cope with those requirements. Therefore, Org replaces them.
+
+;; Org still relies on `comment-dwim', but cannot trust
+;; `comment-only-p'. So, `comment-region-function' and
+;; `uncomment-region-function' both point
+;; to`org-comment-or-uncomment-region'. Eventually,
+;; `org-insert-comment' takes care of insertion of comments at the
+;; beginning of line.
+
+;; `org-setup-comments-handling' install comments related variables
+;; during `org-mode' initialization.
+
+(defun org-setup-comments-handling ()
+ (interactive)
+ (org-set-local 'comment-use-syntax nil)
+ (org-set-local 'comment-start "# ")
+ (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)")
+ (org-set-local 'comment-insert-comment-function 'org-insert-comment)
+ (org-set-local 'comment-region-function 'org-comment-or-uncomment-region)
+ (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region))
+
+(defun org-insert-comment ()
+ "Insert an empty comment above current line.
+If the line is empty, insert comment at its beginning."
+ (beginning-of-line)
+ (if (looking-at "\\s-*$") (replace-match "") (open-line 1))
+ (org-indent-line)
+ (insert "# "))
+
+(defvar comment-empty-lines) ; From newcomment.el.
+(defun org-comment-or-uncomment-region (beg end &rest ignore)
+ "Comment or uncomment each non-blank line in the region.
+Uncomment each non-blank line between BEG and END if it only
+contains commented lines. Otherwise, comment them."
+ (save-restriction
+ ;; Restrict region
+ (narrow-to-region (save-excursion (goto-char beg)
+ (skip-chars-forward " \r\t\n" end)
+ (line-beginning-position))
+ (save-excursion (goto-char end)
+ (skip-chars-backward " \r\t\n" beg)
+ (line-end-position)))
+ (let ((uncommentp
+ ;; UNCOMMENTP is non-nil when every non blank line between
+ ;; BEG and END is a comment.
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (let ((element (org-element-at-point)))
+ (and (eq (org-element-type element) 'comment)
+ (goto-char (min (point-max)
+ (org-element-property
+ :end element)))))))
+ (eobp))))
+ (if uncommentp
+ ;; Only blank lines and comments in region: uncomment it.
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
+ (replace-match "" nil nil nil 1))
+ (forward-line)))
+ ;; Comment each line in region.
+ (let ((min-indent (point-max)))
+ ;; First find the minimum indentation across all lines.
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not (eobp)) (not (zerop min-indent)))
+ (unless (looking-at "[ \t]*$")
+ (setq min-indent (min min-indent (current-indentation))))
+ (forward-line)))
+ ;; Then loop over all lines.
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
+ (org-move-to-column min-indent t)
+ (insert comment-start))
+ (forward-line))))))))
+
;;; Other stuff.
@@ -20620,7 +21551,8 @@ depending on context."
(if (or (eq org-ctrl-k-protect-subtree 'error)
(not (y-or-n-p "Kill hidden subtree along with headline? ")))
(error "C-k aborted - would kill hidden subtree")))
- (call-interactively 'kill-line))
+ (call-interactively
+ (if (and (boundp 'visual-line-mode) visual-line-mode) 'kill-visual-line 'kill-line)))
((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))
(kill-region (point) (match-beginning 1))
(org-set-tags nil t))
@@ -20683,7 +21615,7 @@ interactive command with similar behavior."
end)
(if (and subtreep org-yank-adjusted-subtrees)
(org-paste-subtree nil nil 'for-yank)
- (call-interactively command))
+ (call-interactively command))
(setq end (point))
(goto-char beg)
@@ -20712,7 +21644,7 @@ interactive command with similar behavior."
(org-paste-subtree nil nil 'for-yank)
(push-mark beg 'nomsg)))
(t
- (call-interactively command))))))
+ (call-interactively command))))))
(defun org-yank-folding-would-swallow-text (beg end)
"Would hide-subtree at BEG swallow any text after END?"
@@ -20756,13 +21688,6 @@ This version does not only check the character property, but also
(error (error "Before first headline at position %d in buffer %s"
(point) (current-buffer)))))
-(defun org-beginning-of-defun ()
- "Go to the beginning of the subtree, i.e. back to the heading."
- (org-back-to-heading))
-(defun org-end-of-defun ()
- "Go to the end of the subtree."
- (org-end-of-subtree nil t))
-
(defun org-before-first-heading-p ()
"Before first heading?"
(save-excursion
@@ -20774,12 +21699,24 @@ This version does not only check the character property, but also
;; Compatibility alias with Org versions < 7.8.03
(defalias 'org-on-heading-p 'org-at-heading-p)
+(defun org-at-comment-p nil
+ "Is cursor in a line starting with a # character?"
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "^#")))
+
(defun org-at-drawer-p nil
- "Whether point is at a drawer."
+ "Is cursor at a drawer keyword?"
(save-excursion
(move-beginning-of-line 1)
(looking-at org-drawer-regexp)))
+(defun org-at-block-p nil
+ "Is cursor at a block keyword?"
+ (save-excursion
+ (move-beginning-of-line 1)
+ (looking-at org-block-regexp)))
+
(defun org-point-at-end-of-empty-headline ()
"If point is at the end of an empty headline, return t, else nil.
If the heading only contains a TODO keyword, it is still still considered
@@ -20927,18 +21864,19 @@ If there is no such heading, return nil."
nil
(point)))))
-(defun org-end-of-subtree (&optional invisible-OK to-heading)
+(defun org-end-of-subtree (&optional invisible-ok to-heading)
+ "Goto to the end of a subtree."
;; This contains an exact copy of the original function, but it uses
;; `org-back-to-heading', to make it work also in invisible
- ;; trees. And is uses an invisible-OK argument.
+ ;; trees. And is uses an invisible-ok argument.
;; Under Emacs this is not needed, but the old outline.el needs this fix.
;; Furthermore, when used inside Org, finding the end of a large subtree
;; with many children and grandchildren etc, this can be much faster
;; than the outline version.
- (org-back-to-heading invisible-OK)
+ (org-back-to-heading invisible-ok)
(let ((first t)
(level (funcall outline-level)))
- (if (and (eq major-mode 'org-mode) (< level 1000))
+ (if (and (derived-mode-p 'org-mode) (< level 1000))
;; A true heading (not a plain list item), in Org-mode
;; This means we can easily find the end by looking
;; only for the right number of stars. Using a regexp to do
@@ -20963,7 +21901,7 @@ If there is no such heading, return nil."
(defadvice outline-end-of-subtree (around prefer-org-version activate compile)
"Use Org version in org-mode, for dramatic speed-up."
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(progn
(org-end-of-subtree nil t)
(unless (eobp) (backward-char 1)))
@@ -20988,11 +21926,11 @@ clocking lines, and drawers."
(and (re-search-forward "[^\n]" nil t) (backward-char 1))
(point)))
-(defun org-forward-same-level (arg &optional invisible-ok)
+(defun org-forward-heading-same-level (arg &optional invisible-ok)
"Move forward to the arg'th subheading at same level as this one.
Stop at the first and last subheadings of a superior heading.
-Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil
-it wil also look at invisible ones."
+Normally this only looks at visible headings, but when INVISIBLE-OK is
+non-nil it will also look at invisible ones."
(interactive "p")
(org-back-to-heading invisible-ok)
(org-at-heading-p)
@@ -21010,7 +21948,7 @@ it wil also look at invisible ones."
(setq arg (1- arg)))
(beginning-of-line 1)))
-(defun org-backward-same-level (arg &optional invisible-ok)
+(defun org-backward-heading-same-level (arg &optional invisible-ok)
"Move backward to the arg'th subheading at same level as this one.
Stop at the first and last subheadings of a superior heading."
(interactive "p")
@@ -21028,6 +21966,211 @@ Stop at the first and last subheadings of a superior heading."
(if (< l level) (setq arg 1)))
(setq arg (1- arg)))))
+;;;###autoload
+(defun org-forward-element ()
+ "Move forward by one element.
+Move to the next element at the same level, when possible."
+ (interactive)
+ (cond ((eobp) (error "Cannot move further down"))
+ ((org-with-limited-levels (org-at-heading-p))
+ (let ((origin (point)))
+ (org-forward-heading-same-level 1)
+ (unless (org-with-limited-levels (org-at-heading-p))
+ (goto-char origin)
+ (error "Cannot move further down"))))
+ (t
+ (let* ((elem (org-element-at-point))
+ (end (org-element-property :end elem))
+ (parent (org-element-property :parent elem)))
+ (if (and parent (= (org-element-property :contents-end parent) end))
+ (goto-char (org-element-property :end parent))
+ (goto-char end))))))
+
+;;;###autoload
+(defun org-backward-element ()
+ "Move backward by one element.
+Move to the previous element at the same level, when possible."
+ (interactive)
+ (cond ((bobp) (error "Cannot move further up"))
+ ((org-with-limited-levels (org-at-heading-p))
+ ;; At an headline, move to the previous one, if any, or stay
+ ;; here.
+ (let ((origin (point)))
+ (org-backward-heading-same-level 1)
+ (unless (org-with-limited-levels (org-at-heading-p))
+ (goto-char origin)
+ (error "Cannot move further up"))))
+ (t
+ (let* ((trail (org-element-at-point 'keep-trail))
+ (elem (car trail))
+ (prev-elem (nth 1 trail))
+ (beg (org-element-property :begin elem)))
+ (cond
+ ;; Move to beginning of current element if point isn't
+ ;; there already.
+ ((/= (point) beg) (goto-char beg))
+ (prev-elem (goto-char (org-element-property :begin prev-elem)))
+ ((org-before-first-heading-p) (goto-char (point-min)))
+ (t (org-back-to-heading)))))))
+
+;;;###autoload
+(defun org-up-element ()
+ "Move to upper element."
+ (interactive)
+ (if (org-with-limited-levels (org-at-heading-p))
+ (unless (org-up-heading-safe) (error "No surrounding element"))
+ (let* ((elem (org-element-at-point))
+ (parent (org-element-property :parent elem)))
+ (if parent (goto-char (org-element-property :begin parent))
+ (if (org-with-limited-levels (org-before-first-heading-p))
+ (error "No surrounding element")
+ (org-with-limited-levels (org-back-to-heading)))))))
+
+;;;###autoload
+(defvar org-element-greater-elements)
+(defun org-down-element ()
+ "Move to inner element."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (cond
+ ((memq (org-element-type element) '(plain-list table))
+ (goto-char (org-element-property :contents-begin element))
+ (forward-char))
+ ((memq (org-element-type element) org-element-greater-elements)
+ ;; If contents are hidden, first disclose them.
+ (when (org-element-property :hiddenp element) (org-cycle))
+ (goto-char (or (org-element-property :contents-begin element)
+ (error "No content for this element"))))
+ (t (error "No inner element")))))
+
+;;;###autoload
+(defun org-drag-element-backward ()
+ "Move backward element at point."
+ (interactive)
+ (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up)
+ (let* ((trail (org-element-at-point 'keep-trail))
+ (elem (car trail))
+ (prev-elem (nth 1 trail)))
+ ;; Error out if no previous element or previous element is
+ ;; a parent of the current one.
+ (if (or (not prev-elem) (org-element-nested-p elem prev-elem))
+ (error "Cannot drag element backward")
+ (let ((pos (point)))
+ (org-element-swap-A-B prev-elem elem)
+ (goto-char (+ (org-element-property :begin prev-elem)
+ (- pos (org-element-property :begin elem)))))))))
+
+;;;###autoload
+(defun org-drag-element-forward ()
+ "Move forward element at point."
+ (interactive)
+ (let* ((pos (point))
+ (elem (org-element-at-point)))
+ (when (= (point-max) (org-element-property :end elem))
+ (error "Cannot drag element forward"))
+ (goto-char (org-element-property :end elem))
+ (let ((next-elem (org-element-at-point)))
+ (when (or (org-element-nested-p elem next-elem)
+ (and (eq (org-element-type next-elem) 'headline)
+ (not (eq (org-element-type elem) 'headline))))
+ (goto-char pos)
+ (error "Cannot drag element forward"))
+ ;; Compute new position of point: it's shifted by NEXT-ELEM
+ ;; body's length (without final blanks) and by the length of
+ ;; blanks between ELEM and NEXT-ELEM.
+ (let ((size-next (- (save-excursion
+ (goto-char (org-element-property :end next-elem))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ ;; Small correction if buffer doesn't end
+ ;; with a newline character.
+ (if (and (eolp) (not (bolp))) (1+ (point)) (point)))
+ (org-element-property :begin next-elem)))
+ (size-blank (- (org-element-property :end elem)
+ (save-excursion
+ (goto-char (org-element-property :end elem))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point)))))
+ (org-element-swap-A-B elem next-elem)
+ (goto-char (+ pos size-next size-blank))))))
+
+;;;###autoload
+(defun org-mark-element ()
+ "Put point at beginning of this element, mark at end.
+
+Interactively, if this command is repeated or (in Transient Mark
+mode) if the mark is active, it marks the next element after the
+ones already marked."
+ (interactive)
+ (let (deactivate-mark)
+ (if (and (org-called-interactively-p 'any)
+ (or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active)))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (goto-char (org-element-property :end (org-element-at-point)))))
+ (let ((element (org-element-at-point)))
+ (end-of-line)
+ (push-mark (org-element-property :end element) t t)
+ (goto-char (org-element-property :begin element))))))
+
+;;;###autoload
+(defun org-narrow-to-element ()
+ "Narrow buffer to current element."
+ (interactive)
+ (let ((elem (org-element-at-point)))
+ (cond
+ ((eq (car elem) 'headline)
+ (narrow-to-region
+ (org-element-property :begin elem)
+ (org-element-property :end elem)))
+ ((memq (car elem) org-element-greater-elements)
+ (narrow-to-region
+ (org-element-property :contents-begin elem)
+ (org-element-property :contents-end elem)))
+ (t
+ (narrow-to-region
+ (org-element-property :begin elem)
+ (org-element-property :end elem))))))
+
+;;;###autoload
+(defun org-transpose-element ()
+ "Transpose current and previous elements, keeping blank lines between.
+Point is moved after both elements."
+ (interactive)
+ (org-skip-whitespace)
+ (let ((end (org-element-property :end (org-element-at-point))))
+ (org-drag-element-backward)
+ (goto-char end)))
+
+;;;###autoload
+(defun org-unindent-buffer ()
+ "Un-indent the visible part of the buffer.
+Relative indentation (between items, inside blocks, etc.) isn't
+modified."
+ (interactive)
+ (unless (eq major-mode 'org-mode)
+ (error "Cannot un-indent a buffer not in Org mode"))
+ (let* ((parse-tree (org-element-parse-buffer 'greater-element))
+ unindent-tree ; For byte-compiler.
+ (unindent-tree
+ (function
+ (lambda (contents)
+ (mapc
+ (lambda (element)
+ (if (memq (org-element-type element) '(headline section))
+ (funcall unindent-tree (org-element-contents element))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (org-element-property :begin element)
+ (org-element-property :end element))
+ (org-do-remove-indentation)))))
+ (reverse contents))))))
+ (funcall unindent-tree (org-element-contents parse-tree))))
+
(defun org-show-subtree ()
"Show everything after this heading at deeper levels."
(interactive)
@@ -21059,12 +22202,10 @@ Show the heading too, if it is currently invisible."
(defun org-make-options-regexp (kwds &optional extra)
"Make a regular expression for keyword lines."
(concat
- "^"
- "#?[ \t]*\\+\\("
+ "^#\\+\\("
(mapconcat 'regexp-quote kwds "\\|")
(if extra (concat "\\|" extra))
- "\\):[ \t]*"
- "\\(.*\\)"))
+ "\\):[ \t]*\\(.*\\)"))
;; Make isearch reveal the necessary context
(defun org-isearch-end ()
@@ -21136,7 +22277,7 @@ Show the heading too, if it is currently invisible."
'(progn
(add-hook 'imenu-after-jump-hook
(lambda ()
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(org-show-context 'org-goto))))))
(defun org-link-display-format (link)
@@ -21144,11 +22285,11 @@ Show the heading too, if it is currently invisible."
if no description is present"
(save-match-data
(if (string-match org-bracket-link-analytic-regexp link)
- (replace-match (if (match-end 5)
- (match-string 5 link)
- (concat (match-string 1 link)
- (match-string 3 link)))
- nil t link)
+ (replace-match (if (match-end 5)
+ (match-string 5 link)
+ (concat (match-string 1 link)
+ (match-string 3 link)))
+ nil t link)
link)))
(defun org-toggle-link-display ()
@@ -21167,9 +22308,9 @@ if no description is present"
(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1)
"Overlay marking the agenda restriction line in speedbar.")
(overlay-put org-speedbar-restriction-lock-overlay
- 'face 'org-agenda-restriction-lock)
+ 'face 'org-agenda-restriction-lock)
(overlay-put org-speedbar-restriction-lock-overlay
- 'help-echo "Agendas are currently limited to this item.")
+ 'help-echo "Agendas are currently limited to this item.")
(org-detach-overlay org-speedbar-restriction-lock-overlay)
(defun org-speedbar-set-agenda-restriction ()
@@ -21197,7 +22338,7 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(with-current-buffer (find-file-noselect
(let ((default-directory dir))
(expand-file-name txt)))
- (unless (eq major-mode 'org-mode)
+ (unless (derived-mode-p 'org-mode)
(error "Cannot restrict to non-Org-mode file"))
(org-agenda-set-restriction-lock 'file)))
(t (error "Don't know how to restrict Org-mode's agenda")))
@@ -21214,7 +22355,7 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
(define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
(add-hook 'speedbar-visiting-tag-hook
- (lambda () (and (eq major-mode 'org-mode) (org-show-context 'org-goto))))))
+ (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
;;; Fixes and Hacks for problems with other packages
@@ -21228,7 +22369,9 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(not (get-text-property pos 'org-no-flyspell))
(not (member word org-todo-keywords-1))
(not (member word org-all-time-keywords))
- (not (member word org-additional-option-like-keywords)))))
+ (not (member word org-options-keywords))
+ (not (member word (mapcar 'car org-startup-options)))
+ (not (member word org-additional-option-like-keywords-for-flyspell)))))
(defun org-remove-flyspell-overlays-in (beg end)
"Remove flyspell overlays in region."
@@ -21257,12 +22400,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(eval-after-load "ecb"
'(defadvice ecb-method-clicked (after esf/org-show-context activate)
"Make hierarchy visible when jumping into location from ECB tree buffer."
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(org-show-context))))
(defun org-bookmark-jump-unhide ()
"Unhide the current position, to show the bookmark location."
- (and (eq major-mode 'org-mode)
+ (and (derived-mode-p 'org-mode)
(or (outline-invisible-p)
(save-excursion (goto-char (max (point-min) (1- (point))))
(outline-invisible-p)))
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index 9f5c18f3415..83815a6a270 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -102,13 +102,12 @@ Warning: the password is cached without checking that it is
correct. It is better to check the password before caching. If
you must use this function, take care to check passwords and
remove incorrect ones from the cache."
+ (declare (obsolete password-read "23.1"))
(let ((password (password-read prompt key)))
(when (and password key)
(password-cache-add key password))
password))
-(make-obsolete 'password-read-and-add 'password-read "23.1")
-
(defun password-cache-remove (key)
"Remove password indexed by KEY from password cache.
This is typically run by a timer setup from `password-cache-add',
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index da72c81c44a..be389e9c25a 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -128,8 +128,9 @@
(pcomplete-uniqify-list rules))))
(defcustom pcmpl-gnu-tarfile-regexp
- "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
+ "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|Z\\|xz\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
"A regexp which matches any tar archive."
+ :version "24.3" ; added xz
:type 'regexp
:group 'pcmpl-gnu)
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 97d8b4652a9..9e55976a8bd 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -451,9 +451,12 @@ Same as `pcomplete' but using the standard completion UI."
(list beg (point) table
:predicate pred
:exit-function
+ ;; If completion is finished, add a terminating space.
+ ;; We used to also do this if STATUS is `sole', but
+ ;; that does not work right when completion cycling.
(unless (zerop (length pcomplete-termination-string))
- (lambda (_s finished)
- (when (memq finished '(sole finished))
+ (lambda (_s status)
+ (when (eq status 'finished)
(if (looking-at
(regexp-quote pcomplete-termination-string))
(goto-char (match-end 0))
@@ -721,6 +724,7 @@ this is `comint-dynamic-complete-functions'."
(defun pcomplete-parse-comint-arguments ()
"Parse whitespace separated arguments in the current region."
+ (declare (obsolete comint-parse-pcomplete-arguments "24.1"))
(let ((begin (save-excursion (comint-bol nil) (point)))
(end (point))
begins args)
@@ -740,8 +744,6 @@ this is `comint-dynamic-complete-functions'."
(push (buffer-substring-no-properties (car begins) (point))
args))
(cons (nreverse args) (nreverse begins)))))
-(make-obsolete 'pcomplete-parse-comint-arguments
- 'comint-parse-pcomplete-arguments "24.1")
(defun pcomplete-parse-arguments (&optional expand-p)
"Parse the command line arguments. Most completions need this info."
@@ -1087,7 +1089,7 @@ Typing SPC flushes the help buffer."
(setq pcomplete-last-window-config (current-window-configuration)))
(with-output-to-temp-buffer "*Completions*"
(display-completion-list completions))
- (message "Hit space to flush")
+ (minibuffer-message "Hit space to flush")
(let (event)
(prog1
(catch 'done
diff --git a/lisp/proced.el b/lisp/proced.el
index d98bf7d2c5b..e3ff9fb5c95 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -28,8 +28,11 @@
;; listed. See `proced-mode' for getting started.
;;
;; To do:
-;; - interactive temporary customizability of flags in `proced-grammar-alist'
-;; - allow "sudo kill PID", "renice PID"
+;; - Interactive temporary customizability of flags in `proced-grammar-alist'
+;; - Allow "sudo kill PID", "sudo renice PID"
+;; `proced-send-signal' operates on multiple processes one by one.
+;; With "sudo" we want to execute one "kill" or "renice" command
+;; for all marked processes. Is there a `sudo-call-process'?
;;
;; Thoughts and Ideas
;; - Currently, `process-attributes' returns the list of
@@ -62,6 +65,12 @@ the external command (usually \"kill\")."
:type '(choice (function :tag "function")
(string :tag "command")))
+(defcustom proced-renice-command "renice"
+ "Name of renice command."
+ :group 'proced
+ :version "24.3"
+ :type '(string :tag "command"))
+
(defcustom proced-signal-list
'( ;; signals supported on all POSIX compliant systems
("HUP" . " (1. Hangup)")
@@ -491,6 +500,7 @@ Important: the match ends just after the marker.")
(define-key km "o" 'proced-omit-processes)
(define-key km "x" 'proced-send-signal) ; Dired compatibility
(define-key km "k" 'proced-send-signal) ; kill processes
+ (define-key km "r" 'proced-renice) ; renice processes
;; misc
(define-key km "h" 'describe-mode)
(define-key km "?" 'proced-help)
@@ -561,8 +571,11 @@ Important: the match ends just after the marker.")
:style toggle
:selected (eval proced-auto-update-flag)
:help "Auto Update of Proced Buffer"]
+ "--"
["Send signal" proced-send-signal
- :help "Send Signal to Marked Processes"]))
+ :help "Send Signal to Marked Processes"]
+ ["Renice" proced-renice
+ :help "Renice Marked Processes"]))
;; helper functions
(defun proced-marker-regexp ()
@@ -1686,14 +1699,11 @@ After updating a displayed Proced buffer run the normal hook
Preserves point and marks."
(proced-update t))
-(defun proced-send-signal (&optional signal)
- "Send a SIGNAL to the marked processes.
-If no process is marked, operate on current process.
-SIGNAL may be a string (HUP, INT, TERM, etc.) or a number.
-If SIGNAL is nil display marked processes and query interactively for SIGNAL.
-After sending the signal, this command runs the normal hook
-`proced-after-send-signal-hook'."
- (interactive)
+(defun proced-marked-processes ()
+ "Return marked processes as alist of PIDs.
+If no process is marked return alist with the PID of the process point is on.
+The cdrs of the alist are the text strings displayed by Proced for these
+processes. They are used for error messages."
(let ((regexp (proced-marker-regexp))
process-alist)
;; collect marked processes
@@ -1706,102 +1716,183 @@ After sending the signal, this command runs the normal hook
(+ 2 (line-beginning-position))
(line-end-position)))
process-alist)))
- (setq process-alist
- (if process-alist
- (nreverse process-alist)
- ;; take current process
- (list (cons (proced-pid-at-point)
+ (if process-alist
+ (nreverse process-alist)
+ ;; take current process
+ (let ((pid (proced-pid-at-point)))
+ (if pid
+ (list (cons pid
(buffer-substring-no-properties
(+ 2 (line-beginning-position))
- (line-end-position))))))
+ (line-end-position)))))))))
+
+(defmacro proced-with-processes-buffer (process-alist &rest body)
+ "Execute the forms in BODY in a temporary buffer displaying PROCESS-ALIST.
+PROCESS-ALIST is an alist of process PIDs as in `proced-process-alist'.
+The value returned is the value of the last form in BODY."
+ (declare (indent 1) (debug t))
+ ;; Use leading space in buffer name to make this buffer ephemeral
+ `(let ((bufname " *Marked Processes*")
+ (header-line (substring-no-properties proced-header-line)))
+ (with-current-buffer (get-buffer-create bufname)
+ (setq truncate-lines t
+ proced-header-line header-line ; inherit header line
+ header-line-format '(:eval (proced-header-line)))
+ (add-hook 'post-command-hook 'force-mode-line-update nil t)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (setq buffer-read-only t)
+ (dolist (process ,process-alist)
+ (insert " " (cdr process) "\n"))
+ (delete-char -1)
+ (goto-char (point-min)))
+ (save-window-excursion
+ ;; Analogous to `dired-pop-to-buffer'
+ ;; Don't split window horizontally. (Bug#1806)
+ (let (split-width-threshold)
+ (pop-to-buffer (current-buffer)))
+ (fit-window-to-buffer (get-buffer-window) nil 1)
+ ,@body))))
+
+(defun proced-send-signal (&optional signal process-alist)
+ "Send a SIGNAL to processes in PROCESS-ALIST.
+PROCESS-ALIST is an alist as returned by `proced-marked-processes'.
+Interactively, PROCESS-ALIST contains the marked processes.
+If no process is marked, it contains the process point is on,
+SIGNAL may be a string (HUP, INT, TERM, etc.) or a number.
+After sending SIGNAL to all processes in PROCESS-ALIST, this command
+runs the normal hook `proced-after-send-signal-hook'.
+
+For backward compatibility SIGNAL and PROCESS-ALIST may be nil.
+Then PROCESS-ALIST contains the marked processes or the process point is on
+and SIGNAL is queried interactively. This noninteractive usage is still
+supported but discouraged. It will be removed in a future version of Emacs."
+ (interactive
+ (let* ((process-alist (proced-marked-processes))
+ (pnum (if (= 1 (length process-alist))
+ "1 process"
+ (format "%d processes" (length process-alist))))
+ (completion-ignore-case t)
+ (completion-extra-properties
+ '(:annotation-function
+ (lambda (s) (cdr (assoc s proced-signal-list))))))
+ (proced-with-processes-buffer process-alist
+ (list (completing-read (concat "Send signal [" pnum
+ "] (default TERM): ")
+ proced-signal-list
+ nil nil nil nil "TERM")
+ process-alist))))
+
+ (unless (and signal process-alist)
+ ;; Discouraged usage (supported for backward compatibility):
+ ;; The new calling sequence separates more cleanly between the parts
+ ;; of the code required for interactive and noninteractive calls so that
+ ;; the command can be used more flexibly in noninteractive ways, too.
+ (unless (get 'proced-send-signal 'proced-outdated)
+ (put 'proced-send-signal 'proced-outdated t)
+ (message "Outdated usage of `proced-send-signal'")
+ (sit-for 2))
+ (setq process-alist (proced-marked-processes))
(unless signal
- ;; Display marked processes (code taken from `dired-mark-pop-up').
- (let ((bufname " *Marked Processes*") ; use leading space in buffer name
- ; to make this buffer ephemeral
- (header-line (substring-no-properties proced-header-line)))
- (with-current-buffer (get-buffer-create bufname)
- (setq truncate-lines t
- proced-header-line header-line ; inherit header line
- header-line-format '(:eval (proced-header-line)))
- (add-hook 'post-command-hook 'force-mode-line-update nil t)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (buffer-disable-undo)
- (setq buffer-read-only t)
- (dolist (process process-alist)
- (insert " " (cdr process) "\n"))
- (delete-char -1)
- (goto-char (point-min)))
- (save-window-excursion
- ;; Analogous to `dired-pop-to-buffer'
- ;; Don't split window horizontally. (Bug#1806)
- (let (split-width-threshold)
- (pop-to-buffer (current-buffer)))
- (fit-window-to-buffer (get-buffer-window) nil 1)
- (let* ((completion-ignore-case t)
- (pnum (if (= 1 (length process-alist))
- "1 process"
- (format "%d processes" (length process-alist))))
- (completion-extra-properties
- '(:annotation-function
- (lambda (s) (cdr (assoc s proced-signal-list))))))
- (setq signal
- (completing-read (concat "Send signal [" pnum
- "] (default TERM): ")
- proced-signal-list
- nil nil nil nil "TERM")))))))
- ;; send signal
- (let ((count 0)
- failures)
- ;; Why not always use `signal-process'? See
- ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html
- (if (functionp proced-signal-function)
- ;; use built-in `signal-process'
- (let ((signal (if (stringp signal)
- (if (string-match "\\`[0-9]+\\'" signal)
- (string-to-number signal)
- (make-symbol signal))
- signal))) ; number
- (dolist (process process-alist)
- (condition-case err
- (if (zerop (funcall
- proced-signal-function (car process) signal))
- (setq count (1+ count))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures))
- (error ; catch errors from failed signals
- (proced-log "%s\n" err)
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures)))))
- ;; use external system call
- (let ((signal (concat "-" (if (numberp signal)
- (number-to-string signal) signal))))
+ (let ((pnum (if (= 1 (length process-alist))
+ "1 process"
+ (format "%d processes" (length process-alist))))
+ (completion-ignore-case t)
+ (completion-extra-properties
+ '(:annotation-function
+ (lambda (s) (cdr (assoc s proced-signal-list))))))
+ (proced-with-processes-buffer process-alist
+ (setq signal (completing-read (concat "Send signal [" pnum
+ "] (default TERM): ")
+ proced-signal-list
+ nil nil nil nil "TERM"))))))
+
+ (let (failures)
+ ;; Why not always use `signal-process'? See
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html
+ (if (functionp proced-signal-function)
+ ;; use built-in `signal-process'
+ (let ((signal (if (stringp signal)
+ (if (string-match "\\`[0-9]+\\'" signal)
+ (string-to-number signal)
+ (make-symbol signal))
+ signal))) ; number
(dolist (process process-alist)
- (with-temp-buffer
- (condition-case nil
- (if (zerop (call-process
- proced-signal-function nil t nil
- signal (number-to-string (car process))))
- (setq count (1+ count))
- (proced-log (current-buffer))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures))
- (error ; catch errors from failed signals
- (proced-log (current-buffer))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures)))))))
- (if failures
- ;; Proced error message are not always very precise.
- ;; Can we issue a useful one-line summary in the
- ;; message area (using FAILURES) if only one signal failed?
- (proced-log-summary
- signal
- (format "%d of %d signal%s failed"
- (length failures) (length process-alist)
- (if (= 1 (length process-alist)) "" "s")))
- (proced-success-message "Sent signal to" count)))
- ;; final clean-up
- (run-hooks 'proced-after-send-signal-hook)))
+ (condition-case err
+ (unless (zerop (funcall
+ proced-signal-function (car process) signal))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed signals
+ (proced-log "%s\n" err)
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))
+ ;; use external system call
+ (let ((signal (format "-%s" signal)))
+ (dolist (process process-alist)
+ (with-temp-buffer
+ (condition-case nil
+ (unless (zerop (call-process
+ proced-signal-function nil t nil
+ signal (number-to-string (car process))))
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed signals
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))))
+ (if failures
+ ;; Proced error message are not always very precise.
+ ;; Can we issue a useful one-line summary in the
+ ;; message area (using FAILURES) if only one signal failed?
+ (proced-log-summary
+ (format "Signal %s" signal)
+ (format "%d of %d signal%s failed"
+ (length failures) (length process-alist)
+ (if (= 1 (length process-alist)) "" "s")))
+ (proced-success-message "Sent signal to" (length process-alist))))
+ ;; final clean-up
+ (run-hooks 'proced-after-send-signal-hook))
+
+(defun proced-renice (priority process-alist)
+ "Renice the processes in PROCESS-ALIST to PRIORITY.
+PROCESS-ALIST is an alist as returned by `proced-marked-processes'.
+Interactively, PROCESS-ALIST contains the marked processes.
+If no process is marked, it contains the process point is on,
+After renicing all processes in PROCESS-ALIST, this command runs
+the normal hook `proced-after-send-signal-hook'."
+ (interactive
+ (let ((process-alist (proced-marked-processes)))
+ (proced-with-processes-buffer process-alist
+ (list (read-number "New priority: ")
+ process-alist))))
+ (if (numberp priority)
+ (setq priority (number-to-string priority)))
+ (let (failures)
+ (dolist (process process-alist)
+ (with-temp-buffer
+ (condition-case nil
+ (unless (zerop (call-process
+ proced-renice-command nil t nil
+ priority (number-to-string (car process))))
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed renice
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))
+ (if failures
+ (proced-log-summary
+ (format "Renice %s" priority)
+ (format "%d of %d renice%s failed"
+ (length failures) (length process-alist)
+ (if (= 1 (length process-alist)) "" "s")))
+ (proced-success-message "Reniced" (length process-alist))))
+ ;; final clean-up
+ (run-hooks 'proced-after-send-signal-hook))
;; similar to `dired-why'
(defun proced-why ()
diff --git a/lisp/profiler.el b/lisp/profiler.el
new file mode 100644
index 00000000000..e9261eb1af7
--- /dev/null
+++ b/lisp/profiler.el
@@ -0,0 +1,729 @@
+;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Tomohiro Matsuyama <tomo@cx4a.org>
+;; Keywords: lisp
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defgroup profiler nil
+ "Emacs profiler."
+ :group 'lisp
+ :version "24.3"
+ :prefix "profiler-")
+
+(defconst profiler-version "24.3")
+
+(defcustom profiler-sampling-interval 1000000
+ "Default sampling interval in nanoseconds."
+ :type 'integer
+ :group 'profiler)
+
+
+;;; Utilities
+
+(defun profiler-ensure-string (object)
+ (cond ((stringp object)
+ object)
+ ((symbolp object)
+ (symbol-name object))
+ ((numberp object)
+ (number-to-string object))
+ (t
+ (format "%s" object))))
+
+(defun profiler-format-percent (number divisor)
+ (concat (number-to-string (/ (* number 100) divisor)) "%"))
+
+(defun profiler-format-number (number)
+ "Format NUMBER in human readable string."
+ (if (and (integerp number) (> number 0))
+ (cl-loop with i = (% (1+ (floor (log10 number))) 3)
+ for c in (append (number-to-string number) nil)
+ if (= i 0)
+ collect ?, into s
+ and do (setq i 3)
+ collect c into s
+ do (cl-decf i)
+ finally return
+ (apply 'string (if (eq (car s) ?,) (cdr s) s)))
+ (profiler-ensure-string number)))
+
+(defun profiler-format (fmt &rest args)
+ (cl-loop for (width align subfmt) in fmt
+ for arg in args
+ for str = (cond
+ ((consp subfmt)
+ (apply 'profiler-format subfmt arg))
+ ((stringp subfmt)
+ (format subfmt arg))
+ ((and (symbolp subfmt)
+ (fboundp subfmt))
+ (funcall subfmt arg))
+ (t
+ (profiler-ensure-string arg)))
+ for len = (length str)
+ if (< width len)
+ collect (substring str 0 width) into frags
+ else
+ collect
+ (let ((padding (make-string (- width len) ?\s)))
+ (cl-ecase align
+ (left (concat str padding))
+ (right (concat padding str))))
+ into frags
+ finally return (apply #'concat frags)))
+
+
+;;; Entries
+
+(defun profiler-format-entry (entry)
+ "Format ENTRY in human readable string. ENTRY would be a
+function name of a function itself."
+ (cond ((memq (car-safe entry) '(closure lambda))
+ (format "#<lambda 0x%x>" (sxhash entry)))
+ ((byte-code-function-p entry)
+ (format "#<compiled 0x%x>" (sxhash entry)))
+ ((or (subrp entry) (symbolp entry) (stringp entry))
+ (format "%s" entry))
+ (t
+ (format "#<unknown 0x%x>" (sxhash entry)))))
+
+(defun profiler-fixup-entry (entry)
+ (if (symbolp entry)
+ entry
+ (profiler-format-entry entry)))
+
+
+;;; Backtraces
+
+(defun profiler-fixup-backtrace (backtrace)
+ (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
+
+
+;;; Logs
+
+;; The C code returns the log in the form of a hash-table where the keys are
+;; vectors (of size profiler-max-stack-depth, holding truncated
+;; backtraces, where the first element is the top of the stack) and
+;; the values are integers (which count how many times this backtrace
+;; has been seen, multiplied by a "weight factor" which is either the
+;; sampling-interval or the memory being allocated).
+
+(defun profiler-compare-logs (log1 log2)
+ "Compare LOG1 with LOG2 and return diff."
+ (let ((newlog (make-hash-table :test 'equal)))
+ ;; Make a copy of `log1' into `newlog'.
+ (maphash (lambda (backtrace count) (puthash backtrace count newlog))
+ log1)
+ (maphash (lambda (backtrace count)
+ (puthash backtrace (- (gethash backtrace log1 0) count)
+ newlog))
+ log2)
+ newlog))
+
+(defun profiler-fixup-log (log)
+ (let ((newlog (make-hash-table :test 'equal)))
+ (maphash (lambda (backtrace count)
+ (puthash (profiler-fixup-backtrace backtrace)
+ count newlog))
+ log)
+ newlog))
+
+
+;;; Profiles
+
+(cl-defstruct (profiler-profile (:type vector)
+ (:constructor profiler-make-profile))
+ (tag 'profiler-profile)
+ (version profiler-version)
+ ;; - `type' has a value indicating the kind of profile (`memory' or `cpu').
+ ;; - `log' indicates the profile log.
+ ;; - `timestamp' has a value giving the time when the profile was obtained.
+ ;; - `diff-p' indicates if this profile represents a diff between two profiles.
+ type log timestamp diff-p)
+
+(defun profiler-compare-profiles (profile1 profile2)
+ "Compare PROFILE1 with PROFILE2 and return diff."
+ (unless (eq (profiler-profile-type profile1)
+ (profiler-profile-type profile2))
+ (error "Can't compare different type of profiles"))
+ (profiler-make-profile
+ :type (profiler-profile-type profile1)
+ :timestamp (current-time)
+ :diff-p t
+ :log (profiler-compare-logs
+ (profiler-profile-log profile1)
+ (profiler-profile-log profile2))))
+
+(defun profiler-fixup-profile (profile)
+ "Fixup PROFILE so that the profile could be serialized into file."
+ (profiler-make-profile
+ :type (profiler-profile-type profile)
+ :timestamp (profiler-profile-timestamp profile)
+ :diff-p (profiler-profile-diff-p profile)
+ :log (profiler-fixup-log (profiler-profile-log profile))))
+
+(defun profiler-write-profile (profile filename &optional confirm)
+ "Write PROFILE into file FILENAME."
+ (with-temp-buffer
+ (let (print-level print-length)
+ (print (profiler-fixup-profile profile)
+ (current-buffer)))
+ (write-file filename confirm)))
+
+(defun profiler-read-profile (filename)
+ "Read profile from file FILENAME."
+ ;; FIXME: tag and version check
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (read (current-buffer))))
+
+(defun profiler-cpu-profile ()
+ "Return CPU profile."
+ (when (and (fboundp 'profiler-cpu-running-p)
+ (fboundp 'profiler-cpu-log)
+ (profiler-cpu-running-p))
+ (profiler-make-profile
+ :type 'cpu
+ :timestamp (current-time)
+ :log (profiler-cpu-log))))
+
+(defun profiler-memory-profile ()
+ "Return memory profile."
+ (when (profiler-memory-running-p)
+ (profiler-make-profile
+ :type 'memory
+ :timestamp (current-time)
+ :log (profiler-memory-log))))
+
+
+;;; Calltrees
+
+(cl-defstruct (profiler-calltree (:constructor profiler-make-calltree))
+ entry
+ (count 0) (count-percent "")
+ parent children)
+
+(defun profiler-calltree-leaf-p (tree)
+ (null (profiler-calltree-children tree)))
+
+(defun profiler-calltree-count< (a b)
+ (cond ((eq (profiler-calltree-entry a) t) t)
+ ((eq (profiler-calltree-entry b) t) nil)
+ (t (< (profiler-calltree-count a)
+ (profiler-calltree-count b)))))
+
+(defun profiler-calltree-count> (a b)
+ (not (profiler-calltree-count< a b)))
+
+(defun profiler-calltree-depth (tree)
+ (let ((parent (profiler-calltree-parent tree)))
+ (if (null parent)
+ 0
+ (1+ (profiler-calltree-depth parent)))))
+
+(defun profiler-calltree-find (tree entry)
+ "Return a child tree of ENTRY under TREE."
+ (let (result (children (profiler-calltree-children tree)))
+ ;; FIXME: Use `assoc'.
+ (while (and children (null result))
+ (let ((child (car children)))
+ (when (equal (profiler-calltree-entry child) entry)
+ (setq result child))
+ (setq children (cdr children))))
+ result))
+
+(defun profiler-calltree-walk (calltree function)
+ (funcall function calltree)
+ (dolist (child (profiler-calltree-children calltree))
+ (profiler-calltree-walk child function)))
+
+(defun profiler-calltree-build-1 (tree log &optional reverse)
+ ;; FIXME: Do a better job of reconstructing a complete call-tree
+ ;; when the backtraces have been truncated. Ideally, we should be
+ ;; able to reduce profiler-max-stack-depth to 3 or 4 and still
+ ;; get a meaningful call-tree.
+ (maphash
+ (lambda (backtrace count)
+ (let ((node tree)
+ (max (length backtrace)))
+ (dotimes (i max)
+ (let ((entry (aref backtrace (if reverse i (- max i 1)))))
+ (when entry
+ (let ((child (profiler-calltree-find node entry)))
+ (unless child
+ (setq child (profiler-make-calltree
+ :entry entry :parent node))
+ (push child (profiler-calltree-children node)))
+ (cl-incf (profiler-calltree-count child) count)
+ (setq node child)))))))
+ log))
+
+(defun profiler-calltree-compute-percentages (tree)
+ (let ((total-count 0))
+ ;; FIXME: the memory profiler's total wraps around all too easily!
+ (dolist (child (profiler-calltree-children tree))
+ (cl-incf total-count (profiler-calltree-count child)))
+ (unless (zerop total-count)
+ (profiler-calltree-walk
+ tree (lambda (node)
+ (setf (profiler-calltree-count-percent node)
+ (profiler-format-percent (profiler-calltree-count node)
+ total-count)))))))
+
+(cl-defun profiler-calltree-build (log &key reverse)
+ (let ((tree (profiler-make-calltree)))
+ (profiler-calltree-build-1 tree log reverse)
+ (profiler-calltree-compute-percentages tree)
+ tree))
+
+(defun profiler-calltree-sort (tree predicate)
+ (let ((children (profiler-calltree-children tree)))
+ (setf (profiler-calltree-children tree) (sort children predicate))
+ (dolist (child (profiler-calltree-children tree))
+ (profiler-calltree-sort child predicate))))
+
+
+;;; Report rendering
+
+(defcustom profiler-report-closed-mark "+"
+ "An indicator of closed calltrees."
+ :type 'string
+ :group 'profiler)
+
+(defcustom profiler-report-open-mark "-"
+ "An indicator of open calltrees."
+ :type 'string
+ :group 'profiler)
+
+(defcustom profiler-report-leaf-mark " "
+ "An indicator of calltree leaves."
+ :type 'string
+ :group 'profiler)
+
+(defvar profiler-report-cpu-line-format
+ '((50 left)
+ (24 right ((19 right)
+ (5 right)))))
+
+(defvar profiler-report-memory-line-format
+ '((55 left)
+ (19 right ((14 right profiler-format-number)
+ (5 right)))))
+
+(defvar-local profiler-report-profile nil
+ "The current profile.")
+
+(defvar-local profiler-report-reversed nil
+ "True if calltree is rendered in bottom-up. Do not touch this
+variable directly.")
+
+(defvar-local profiler-report-order nil
+ "The value can be `ascending' or `descending'. Do not touch
+this variable directly.")
+
+(defun profiler-report-make-entry-part (entry)
+ (let ((string (cond
+ ((eq entry t)
+ "Others")
+ ((and (symbolp entry)
+ (fboundp entry))
+ (propertize (symbol-name entry)
+ 'face 'link
+ 'mouse-face 'highlight
+ 'help-echo "mouse-2 or RET jumps to definition"))
+ (t
+ (profiler-format-entry entry)))))
+ (propertize string 'profiler-entry entry)))
+
+(defun profiler-report-make-name-part (tree)
+ (let* ((entry (profiler-calltree-entry tree))
+ (depth (profiler-calltree-depth tree))
+ (indent (make-string (* (1- depth) 2) ?\s))
+ (mark (if (profiler-calltree-leaf-p tree)
+ profiler-report-leaf-mark
+ profiler-report-closed-mark))
+ (entry (profiler-report-make-entry-part entry)))
+ (format "%s%s %s" indent mark entry)))
+
+(defun profiler-report-header-line-format (fmt &rest args)
+ (let* ((header (apply 'profiler-format fmt args))
+ (escaped (replace-regexp-in-string "%" "%%" header)))
+ (concat " " escaped)))
+
+(defun profiler-report-line-format (tree)
+ (let ((diff-p (profiler-profile-diff-p profiler-report-profile))
+ (name-part (profiler-report-make-name-part tree))
+ (count (profiler-calltree-count tree))
+ (count-percent (profiler-calltree-count-percent tree)))
+ (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile)
+ (cpu profiler-report-cpu-line-format)
+ (memory profiler-report-memory-line-format))
+ name-part
+ (if diff-p
+ (list (if (> count 0)
+ (format "+%s" count)
+ count)
+ "")
+ (list count count-percent)))))
+
+(defun profiler-report-insert-calltree (tree)
+ (let ((line (profiler-report-line-format tree)))
+ (insert (propertize (concat line "\n") 'calltree tree))))
+
+(defun profiler-report-insert-calltree-children (tree)
+ (mapc 'profiler-report-insert-calltree
+ (profiler-calltree-children tree)))
+
+
+;;; Report mode
+
+(defvar profiler-report-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; FIXME: Add menu.
+ (define-key map "n" 'profiler-report-next-entry)
+ (define-key map "p" 'profiler-report-previous-entry)
+ ;; I find it annoying more than helpful to not be able to navigate
+ ;; normally with the cursor keys. --Stef
+ ;; (define-key map [down] 'profiler-report-next-entry)
+ ;; (define-key map [up] 'profiler-report-previous-entry)
+ (define-key map "\r" 'profiler-report-toggle-entry)
+ (define-key map "\t" 'profiler-report-toggle-entry)
+ (define-key map "i" 'profiler-report-toggle-entry)
+ (define-key map "f" 'profiler-report-find-entry)
+ (define-key map "j" 'profiler-report-find-entry)
+ (define-key map [mouse-2] 'profiler-report-find-entry)
+ (define-key map "d" 'profiler-report-describe-entry)
+ (define-key map "C" 'profiler-report-render-calltree)
+ (define-key map "B" 'profiler-report-render-reversed-calltree)
+ (define-key map "A" 'profiler-report-ascending-sort)
+ (define-key map "D" 'profiler-report-descending-sort)
+ (define-key map "=" 'profiler-report-compare-profile)
+ (define-key map (kbd "C-x C-w") 'profiler-report-write-profile)
+ (define-key map "q" 'quit-window)
+ map))
+
+(defun profiler-report-make-buffer-name (profile)
+ (format "*%s-Profiler-Report %s*"
+ (cl-ecase (profiler-profile-type profile) (cpu 'CPU) (memory 'Memory))
+ (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile))))
+
+(defun profiler-report-setup-buffer-1 (profile)
+ "Make a buffer for PROFILE and return it."
+ (let* ((buf-name (profiler-report-make-buffer-name profile))
+ (buffer (get-buffer-create buf-name)))
+ (with-current-buffer buffer
+ (profiler-report-mode)
+ (setq profiler-report-profile profile
+ profiler-report-reversed nil
+ profiler-report-order 'descending))
+ buffer))
+
+(defun profiler-report-setup-buffer (profile)
+ "Make a buffer for PROFILE with rendering the profile and
+return it."
+ (let ((buffer (profiler-report-setup-buffer-1 profile)))
+ (with-current-buffer buffer
+ (profiler-report-render-calltree))
+ buffer))
+
+(define-derived-mode profiler-report-mode special-mode "Profiler-Report"
+ "Profiler Report Mode."
+ (setq buffer-read-only t
+ buffer-undo-list t
+ truncate-lines t))
+
+
+;;; Report commands
+
+(defun profiler-report-calltree-at-point (&optional point)
+ (get-text-property (or point (point)) 'calltree))
+
+(defun profiler-report-move-to-entry ()
+ (let ((point (next-single-property-change
+ (line-beginning-position) 'profiler-entry)))
+ (if point
+ (goto-char point)
+ (back-to-indentation))))
+
+(defun profiler-report-next-entry ()
+ "Move cursor to next entry."
+ (interactive)
+ (forward-line)
+ (profiler-report-move-to-entry))
+
+(defun profiler-report-previous-entry ()
+ "Move cursor to previous entry."
+ (interactive)
+ (forward-line -1)
+ (profiler-report-move-to-entry))
+
+(defun profiler-report-expand-entry ()
+ "Expand entry at point."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (when (search-forward (concat profiler-report-closed-mark " ")
+ (line-end-position) t)
+ (let ((tree (profiler-report-calltree-at-point)))
+ (when tree
+ (let ((inhibit-read-only t))
+ (replace-match (concat profiler-report-open-mark " "))
+ (forward-line)
+ (profiler-report-insert-calltree-children tree)
+ t))))))
+
+(defun profiler-report-collapse-entry ()
+ "Collapse entry at point."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (when (search-forward (concat profiler-report-open-mark " ")
+ (line-end-position) t)
+ (let* ((tree (profiler-report-calltree-at-point))
+ (depth (profiler-calltree-depth tree))
+ (start (line-beginning-position 2))
+ d)
+ (when tree
+ (let ((inhibit-read-only t))
+ (replace-match (concat profiler-report-closed-mark " "))
+ (while (and (eq (forward-line) 0)
+ (let ((child (get-text-property (point) 'calltree)))
+ (and child
+ (numberp (setq d (profiler-calltree-depth child)))))
+ (> d depth)))
+ (delete-region start (line-beginning-position)))))
+ t)))
+
+(defun profiler-report-toggle-entry ()
+ "Expand entry at point if the tree is collapsed,
+otherwise collapse."
+ (interactive)
+ (or (profiler-report-expand-entry)
+ (profiler-report-collapse-entry)))
+
+(defun profiler-report-find-entry (&optional event)
+ "Find entry at point."
+ (interactive (list last-nonmenu-event))
+ (if event (posn-set-point (event-end event)))
+ (let ((tree (profiler-report-calltree-at-point)))
+ (when tree
+ (let ((entry (profiler-calltree-entry tree)))
+ (find-function entry)))))
+
+(defun profiler-report-describe-entry ()
+ "Describe entry at point."
+ (interactive)
+ (let ((tree (profiler-report-calltree-at-point)))
+ (when tree
+ (let ((entry (profiler-calltree-entry tree)))
+ (require 'help-fns)
+ (describe-function entry)))))
+
+(cl-defun profiler-report-render-calltree-1
+ (profile &key reverse (order 'descending))
+ (let ((calltree (profiler-calltree-build
+ (profiler-profile-log profile)
+ :reverse reverse)))
+ (setq header-line-format
+ (cl-ecase (profiler-profile-type profile)
+ (cpu
+ (profiler-report-header-line-format
+ profiler-report-cpu-line-format
+ "Function" (list "CPU samples" "%")))
+ (memory
+ (profiler-report-header-line-format
+ profiler-report-memory-line-format
+ "Function" (list "Bytes" "%")))))
+ (let ((predicate (cl-ecase order
+ (ascending #'profiler-calltree-count<)
+ (descending #'profiler-calltree-count>))))
+ (profiler-calltree-sort calltree predicate))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (profiler-report-insert-calltree-children calltree)
+ (goto-char (point-min))
+ (profiler-report-move-to-entry))))
+
+(defun profiler-report-rerender-calltree ()
+ (profiler-report-render-calltree-1 profiler-report-profile
+ :reverse profiler-report-reversed
+ :order profiler-report-order))
+
+(defun profiler-report-render-calltree ()
+ "Render calltree view."
+ (interactive)
+ (setq profiler-report-reversed nil)
+ (profiler-report-rerender-calltree))
+
+(defun profiler-report-render-reversed-calltree ()
+ "Render reversed calltree view."
+ (interactive)
+ (setq profiler-report-reversed t)
+ (profiler-report-rerender-calltree))
+
+(defun profiler-report-ascending-sort ()
+ "Sort calltree view in ascending order."
+ (interactive)
+ (setq profiler-report-order 'ascending)
+ (profiler-report-rerender-calltree))
+
+(defun profiler-report-descending-sort ()
+ "Sort calltree view in descending order."
+ (interactive)
+ (setq profiler-report-order 'descending)
+ (profiler-report-rerender-calltree))
+
+(defun profiler-report-profile (profile)
+ (switch-to-buffer (profiler-report-setup-buffer profile)))
+
+(defun profiler-report-profile-other-window (profile)
+ (switch-to-buffer-other-window (profiler-report-setup-buffer profile)))
+
+(defun profiler-report-profile-other-frame (profile)
+ (switch-to-buffer-other-frame (profiler-report-setup-buffer profile)))
+
+(defun profiler-report-compare-profile (buffer)
+ "Compare the current profile with another."
+ (interactive (list (read-buffer "Compare to: ")))
+ (let* ((profile1 (with-current-buffer buffer profiler-report-profile))
+ (profile2 profiler-report-profile)
+ (diff-profile (profiler-compare-profiles profile1 profile2)))
+ (profiler-report-profile diff-profile)))
+
+(defun profiler-report-write-profile (filename &optional confirm)
+ "Write the current profile into file FILENAME."
+ (interactive
+ (list (read-file-name "Write profile: " default-directory)
+ (not current-prefix-arg)))
+ (profiler-write-profile profiler-report-profile
+ filename
+ confirm))
+
+
+;;; Profiler commands
+
+;;;###autoload
+(defun profiler-start (mode)
+ "Start/restart profilers.
+MODE can be one of `cpu', `mem', or `cpu+mem'.
+If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
+Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
+ (interactive
+ (list (if (not (fboundp 'profiler-cpu-start)) 'mem
+ (intern (completing-read "Mode (default cpu): "
+ '("cpu" "mem" "cpu+mem")
+ nil t nil nil "cpu")))))
+ (cl-ecase mode
+ (cpu
+ (profiler-cpu-start profiler-sampling-interval)
+ (message "CPU profiler started"))
+ (mem
+ (profiler-memory-start)
+ (message "Memory profiler started"))
+ (cpu+mem
+ (profiler-cpu-start profiler-sampling-interval)
+ (profiler-memory-start)
+ (message "CPU and memory profiler started"))))
+
+(defun profiler-stop ()
+ "Stop started profilers. Profiler logs will be kept."
+ (interactive)
+ (let ((cpu (if (fboundp 'profiler-cpu-stop) (profiler-cpu-stop)))
+ (mem (profiler-memory-stop)))
+ (message "%s profiler stopped"
+ (cond ((and mem cpu) "CPU and memory")
+ (mem "Memory")
+ (cpu "CPU")
+ (t "No")))))
+
+(defun profiler-reset ()
+ "Reset profiler logs."
+ (interactive)
+ (when (fboundp 'profiler-cpu-log)
+ (ignore (profiler-cpu-log)))
+ (ignore (profiler-memory-log))
+ t)
+
+(defun profiler-report-cpu ()
+ (let ((profile (profiler-cpu-profile)))
+ (when profile
+ (profiler-report-profile-other-window profile))))
+
+(defun profiler-report-memory ()
+ (let ((profile (profiler-memory-profile)))
+ (when profile
+ (profiler-report-profile-other-window profile))))
+
+(defun profiler-report ()
+ "Report profiling results."
+ (interactive)
+ (profiler-report-cpu)
+ (profiler-report-memory))
+
+;;;###autoload
+(defun profiler-find-profile (filename)
+ "Open profile FILENAME."
+ (interactive
+ (list (read-file-name "Find profile: " default-directory)))
+ (profiler-report-profile (profiler-read-profile filename)))
+
+;;;###autoload
+(defun profiler-find-profile-other-window (filename)
+ "Open profile FILENAME."
+ (interactive
+ (list (read-file-name "Find profile: " default-directory)))
+ (profiler-report-profile-other-window (profiler-read-profile filename)))
+
+;;;###autoload
+(defun profiler-find-profile-other-frame (filename)
+ "Open profile FILENAME."
+ (interactive
+ (list (read-file-name "Find profile: " default-directory)))
+ (profiler-report-profile-other-frame(profiler-read-profile filename)))
+
+
+;;; Profiling helpers
+
+;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body)
+;; `(unwind-protect
+;; (progn
+;; (ignore (profiler-cpu-log))
+;; (profiler-cpu-start ,sampling-interval)
+;; ,@body)
+;; (profiler-cpu-stop)
+;; (profiler--report-cpu)))
+
+;; (defmacro with-memory-profiling (&rest body)
+;; `(unwind-protect
+;; (progn
+;; (ignore (profiler-memory-log))
+;; (profiler-memory-start)
+;; ,@body)
+;; (profiler-memory-stop)
+;; (profiler--report-memory)))
+
+(provide 'profiler)
+;;; profiler.el ends here
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 1825098a55e..745320b6eb2 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -5218,11 +5218,11 @@ Return nil if no body was found."
;; correctly highlight a with_clause that spans multiple lines.
(list (concat "\\<\\(goto\\|raise\\|use\\|with\\)"
"[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W")
- '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
+ '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t))
;;
;; Goto tags.
- '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face)
+ '("<<\\(\\sw+\\)>>" 1 font-lock-constant-face)
;; Highlight based-numbers (R. Reagan <robin-reply@reagans.org>)
(list "\\([0-9]+#[0-9a-fA-F_]+#\\)" '(1 font-lock-constant-face t))
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 97fcb6874dd..3561105e59d 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -74,6 +74,7 @@ so that it is considered safe, see `enable-local-variables'.")
The second subexpression should match the bug reference (usually a number)."
:type 'string
:safe 'stringp
+ :version "24.3" ; previously defconst
:group 'bug-reference)
(defun bug-reference-set-overlay-properties ()
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index f5dedf0cd59..09fba380f15 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -748,12 +748,10 @@ Faces `compilation-error-face', `compilation-warning-face',
(defvar compilation-leave-directory-face 'font-lock-builtin-face
"Face name to use for leaving directory messages.")
-
-
;; Used for compatibility with the old compile.el.
(defvar compilation-parse-errors-function nil)
-(make-obsolete 'compilation-parse-errors-function
- 'compilation-error-regexp-alist "24.1")
+(make-obsolete-variable 'compilation-parse-errors-function
+ 'compilation-error-regexp-alist "24.1")
(defcustom compilation-auto-jump-to-first-error nil
"If non-nil, automatically jump to the first error during compilation."
@@ -1499,24 +1497,6 @@ Otherwise, construct a buffer name from NAME-OF-MODE."
(t
(concat "*" (downcase name-of-mode) "*"))))
-;; This is a rough emulation of the old hack, until the transition to new
-;; compile is complete.
-(defun compile-internal (command error-message
- &optional _name-of-mode parser
- error-regexp-alist name-function
- _enter-regexp-alist _leave-regexp-alist
- file-regexp-alist _nomessage-regexp-alist
- _no-async highlight-regexp _local-map)
- (if parser
- (error "Compile now works very differently, see `compilation-error-regexp-alist'"))
- (let ((compilation-error-regexp-alist
- (append file-regexp-alist (or error-regexp-alist
- compilation-error-regexp-alist)))
- (compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?"
- "\\1" error-message)))
- (compilation-start command nil name-function highlight-regexp)))
-(make-obsolete 'compile-internal 'compilation-start "22.1")
-
(defcustom compilation-always-kill nil
"If t, always kill a running compilation process before starting a new one.
If nil, ask to kill it."
@@ -1556,20 +1536,20 @@ Returns the compilation buffer created."
(get-buffer-create
(compilation-buffer-name name-of-mode mode name-function)))
(let ((comp-proc (get-buffer-process (current-buffer))))
- (if comp-proc
- (if (or (not (eq (process-status comp-proc) 'run))
- compilation-always-kill
- (yes-or-no-p
- (format "A %s process is running; kill it? "
- name-of-mode)))
- (condition-case ()
- (progn
- (interrupt-process comp-proc)
- (sit-for 1)
- (delete-process comp-proc))
- (error nil))
- (error "Cannot have two processes in `%s' at once"
- (buffer-name)))))
+ (if comp-proc
+ (if (or (not (eq (process-status comp-proc) 'run))
+ (eq (process-query-on-exit-flag comp-proc) nil)
+ (yes-or-no-p
+ (format "A %s process is running; kill it? "
+ name-of-mode)))
+ (condition-case ()
+ (progn
+ (interrupt-process comp-proc)
+ (sit-for 1)
+ (delete-process comp-proc))
+ (error nil))
+ (error "Cannot have two processes in `%s' at once"
+ (buffer-name)))))
;; first transfer directory from where M-x compile was called
(setq default-directory thisdir)
;; Make compilation buffer read-only. The filter can still write it.
@@ -1624,7 +1604,7 @@ Returns the compilation buffer created."
(let ((process-environment
(append
compilation-environment
- (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
+ (if (if (boundp 'system-uses-terminfo);`If' for compiler warning.
system-uses-terminfo)
(list "TERM=dumb" "TERMCAP="
(format "COLUMNS=%d" (window-width)))
@@ -1674,13 +1654,20 @@ Returns the compilation buffer created."
nil `("-c" ,command))))
(start-file-process-shell-command (downcase mode-name)
outbuf command))))
- ;; Make the buffer's mode line show process state.
- (setq mode-line-process
- '(:propertize ":%s" face compilation-mode-line-run))
- (set-process-sentinel proc 'compilation-sentinel)
- (unless (eq mode t)
- ;; Keep the comint filter, since it's needed for proper handling
- ;; of the prompts.
+ ;; Make the buffer's mode line show process state.
+ (setq mode-line-process
+ '(:propertize ":%s" face compilation-mode-line-run))
+
+ ;; Set the process as killable without query by default.
+ ;; This allows us to start a new compilation without
+ ;; getting prompted.
+ (when compilation-always-kill
+ (set-process-query-on-exit-flag proc nil))
+
+ (set-process-sentinel proc 'compilation-sentinel)
+ (unless (eq mode t)
+ ;; Keep the comint filter, since it's needed for proper
+ ;; handling of the prompts.
(set-process-filter proc 'compilation-filter))
;; Use (point-max) here so that output comes in
;; after the initial text,
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index 9ea71ad36f5..becbcb7a3de 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -191,13 +191,7 @@ if ARG is omitted or nil."
(if font-lock-mode (font-lock-fontify-buffer)))
;;;###autoload
-(defun turn-on-cwarn-mode ()
- "Turn on CWarn mode.
-
-This function is designed to be added to hooks, for example:
- (add-hook 'c-mode-hook 'turn-on-cwarn-mode)"
- (cwarn-mode 1))
-(make-obsolete 'turn-on-cwarn-mode 'cwarn-mode "24.1")
+(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1")
;;}}}
;;{{{ Help functions
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 10d5fdf9c64..26d4a399c2d 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -768,6 +768,7 @@ line number outside the file being compiled."
The value may also be a list of two elements where the second
element specifies the face for the bitmap."
:group 'flymake
+ :version "24.3"
:type 'symbol)
(defcustom flymake-warning-bitmap 'question-mark
@@ -775,6 +776,7 @@ element specifies the face for the bitmap."
The value may also be a list of two elements where the second
element specifies the face for the bitmap."
:group 'flymake
+ :version "24.3"
:type 'symbol)
(defcustom flymake-fringe-indicator-position 'left-fringe
@@ -782,6 +784,7 @@ element specifies the face for the bitmap."
The value can be nil, left-fringe or right-fringe.
Fringe indicators are disabled if nil."
:group 'flymake
+ :version "24.3"
:type '(choice (const left-fringe)
(const right-fringe)
(const :tag "No fringe indicators" nil)))
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index a6ae42f86b1..c056b0f4e26 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -817,11 +817,11 @@ substitution string. Note dynamic scoping of variables.")
(defun grep-read-regexp ()
"Read regexp arg for interactive grep."
(let ((default (grep-tag-default)))
- (read-string
+ (read-regexp
(concat "Search for"
(if (and default (> (length default) 0))
(format " (default \"%s\"): " default) ": "))
- nil 'grep-regexp-history default)))
+ default 'grep-regexp-history)))
(defun grep-read-files (regexp)
"Read files arg for interactive grep."
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 4b77c6dab1a..7bddbff9596 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -329,16 +329,23 @@ that form should be displayed.")
"Prepend (var value) pair to hide-ifdef-env."
(setq hide-ifdef-env (cons (cons var value) hide-ifdef-env)))
+(declare-function semantic-c-hideif-lookup "semantic/bovine/c" (var))
+(declare-function semantic-c-hideif-defined "semantic/bovine/c" (var))
(defun hif-lookup (var)
- ;; (message "hif-lookup %s" var)
- (let ((val (assoc var hide-ifdef-env)))
- (if val
- (cdr val)
- hif-undefined-symbol)))
+ (or (when (bound-and-true-p semantic-c-takeover-hideif)
+ (semantic-c-hideif-lookup var))
+ (let ((val (assoc var hide-ifdef-env)))
+ (if val
+ (cdr val)
+ hif-undefined-symbol))))
(defun hif-defined (var)
- (if (assoc var hide-ifdef-env) 1 0))
+ (cond
+ ((bound-and-true-p semantic-c-takeover-hideif)
+ (semantic-c-hideif-defined var))
+ ((assoc var hide-ifdef-env) 1)
+ (t 0)))
;;===%%SF%% evaluation (End) ===
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 08d1461c008..0abd4daf61b 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -2170,7 +2170,7 @@ args of an executive .run, .rnew or .compile."
;; CWD might have changed, resync, to set default directory
(idlwave-shell-resync-dirs)
(let ((comint-file-name-chars idlwave-shell-file-name-chars))
- (comint-filename-completion)))
+ (comint-dynamic-complete-filename)))
(defun idlwave-shell-executive-command ()
"Return the name of the current executive command, if any."
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 9b634328fa7..e58fb2b3eab 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -1151,7 +1151,7 @@ As a user, you should not set this to t.")
(common-blocks
'("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?"
(1 font-lock-keyword-face) ; "common"
- (2 font-lock-reference-face nil t) ; block name
+ (2 font-lock-constant-face nil t) ; block name
("[ \t]*\\(\\sw+\\)[ ,]*"
;; Start with point after block name and comma
(goto-char (match-end 0)) ; needed for XEmacs, could be nil
@@ -1169,20 +1169,20 @@ As a user, you should not set this to t.")
;; Labels
(label
- '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-reference-face)))
+ '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face)))
;; The goto statement and its label
(goto
'("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)"
(1 font-lock-keyword-face)
- (2 font-lock-reference-face)))
+ (2 font-lock-constant-face)))
;; Tags in structure definitions. Note that this definition
;; actually collides with labels, so we have to use the same
;; face. It also matches named subscript ranges,
;; e.g. vec{bottom:top]. No good way around this.
(structtag
- '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-reference-face)))
+ '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-constant-face)))
;; Structure names
(structname
@@ -1195,7 +1195,7 @@ As a user, you should not set this to t.")
;; fontification. Slow, use it only in fancy fontification.
(keyword-parameters
'("\\(,\\|[a-zA-Z0-9_](\\)[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\([ \t]*\\(;.*\\)?\n\\)*[ \t]*\\)?\\(/[a-zA-Z_]\\sw*\\|[a-zA-Z_]\\sw*[ \t]*=\\)"
- (6 font-lock-reference-face)))
+ (6 font-lock-constant-face)))
;; System variables start with a bang.
(system-variables
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index 401970b2ce8..f2578c14066 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -69,9 +69,8 @@
:group 'lisp
:version "22.1")
-;;;###autoload
(defcustom inferior-lisp-filter-regexp
- (purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'")
+ "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'"
"What not to save on inferior Lisp's input history.
Input matching this regexp is not saved on the input history in Inferior Lisp
mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
@@ -137,14 +136,12 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
(define-key inferior-lisp-mode-map "\C-cv"
'lisp-show-variable-documentation))
-;;;###autoload
-(defcustom inferior-lisp-program (purecopy "lisp")
+(defcustom inferior-lisp-program "lisp"
"Program name for invoking an inferior Lisp in Inferior Lisp mode."
:type 'string
:group 'inferior-lisp)
-;;;###autoload
-(defcustom inferior-lisp-load-command (purecopy "(load \"%s\")\n")
+(defcustom inferior-lisp-load-command "(load \"%s\")\n"
"Format-string for building a Lisp expression to load a file.
This format string should use `%s' to substitute a file name
and should result in a Lisp expression that will command the inferior Lisp
@@ -155,8 +152,7 @@ but it works only in Common Lisp."
:type 'string
:group 'inferior-lisp)
-;;;###autoload
-(defcustom inferior-lisp-prompt (purecopy "^[^> \n]*>+:? *")
+(defcustom inferior-lisp-prompt "^[^> \n]*>+:? *"
"Regexp to recognize prompts in the Inferior Lisp mode.
Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl,
and franz. This variable is used to initialize `comint-prompt-regexp' in the
@@ -207,7 +203,6 @@ one process, this does the right thing. If you run multiple
processes, you can change `inferior-lisp-buffer' to another process
buffer with \\[set-variable].")
-;;;###autoload
(defvar inferior-lisp-mode-hook '()
"Hook for customizing Inferior Lisp mode.")
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 33d43cb3d5a..99df94d3805 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -2110,7 +2110,7 @@ Argument BOUND is a buffer position limiting searching."
(if (eq prolog-system 'mercury)
(list
(prolog-make-keywords-regexp prolog-mode-specificators-i t)
- 0 'font-lock-reference-face)))
+ 0 'font-lock-constant-face)))
(directives
(if (eq prolog-system 'mercury)
(list
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index bf52eff8f9a..a8fc11f71c0 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -213,9 +213,9 @@ If nil, use `temporary-file-directory'."
;; - 8bit characters (warning face)
;; Multiline strings are not supported. Strings with nested brackets are.
(defconst ps-mode-font-lock-keywords-1
- '(("\\`%!PS.*" . font-lock-reference-face)
+ '(("\\`%!PS.*" . font-lock-constant-face)
("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$"
- . font-lock-reference-face)
+ . font-lock-constant-face)
(ps-mode-match-string-or-comment
(1 font-lock-comment-face nil t)
(2 font-lock-string-face nil t))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index ffc6c1ac885..ffb2e66ca9d 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -497,52 +497,63 @@ The type returned can be `comment', `string' or `paren'."
(1 font-lock-variable-name-face nil nil))))
(defconst python-syntax-propertize-function
- ;; Make outer chars of matching triple-quote sequences into generic
- ;; string delimiters. Fixme: Is there a better way?
- ;; First avoid a sequence preceded by an odd number of backslashes.
(syntax-propertize-rules
- (;; ¡Backrefs don't work in syntax-propertize-rules!
- (concat "\\(?:\\([RUru]\\)[Rr]?\\|^\\|[^\\]\\(?:\\\\.\\)*\\)" ;Prefix.
- "\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)")
- (3 (ignore (python-quote-syntax))))))
-
-(defun python-quote-syntax ()
- "Put `syntax-table' property correctly on triple quote.
-Used for syntactic keywords. N is the match number (1, 2 or 3)."
- ;; Given a triple quote, we have to check the context to know
- ;; whether this is an opening or closing triple or whether it's
- ;; quoted anyhow, and should be ignored. (For that we need to do
- ;; the same job as `syntax-ppss' to be correct and it seems to be OK
- ;; to use it here despite initial worries.) We also have to sort
- ;; out a possible prefix -- well, we don't _have_ to, but I think it
- ;; should be treated as part of the string.
-
- ;; Test cases:
- ;; ur"""ar""" x='"' # """
- ;; x = ''' """ ' a
- ;; '''
- ;; x '"""' x """ \"""" x
- (save-excursion
- (goto-char (match-beginning 0))
- (let ((syntax (save-match-data (syntax-ppss))))
- (cond
- ((eq t (nth 3 syntax)) ; after unclosed fence
- ;; Consider property for the last char if in a fenced string.
- (goto-char (nth 8 syntax)) ; fence position
- (skip-chars-forward "uUrR") ; skip any prefix
- ;; Is it a matching sequence?
- (if (eq (char-after) (char-after (match-beginning 2)))
- (put-text-property (match-beginning 3) (match-end 3)
- 'syntax-table (string-to-syntax "|"))))
- ((match-end 1)
- ;; Consider property for initial char, accounting for prefixes.
- (put-text-property (match-beginning 1) (match-end 1)
- 'syntax-table (string-to-syntax "|")))
- (t
- ;; Consider property for initial char, accounting for prefixes.
- (put-text-property (match-beginning 2) (match-end 2)
- 'syntax-table (string-to-syntax "|"))))
- )))
+ ((rx
+ (and
+ ;; Match even number of backslashes.
+ (or (not (any ?\\ ?\' ?\")) point
+ ;; Quotes might be preceded by a escaped quote.
+ (and (or (not (any ?\\)) point) ?\\
+ (* ?\\ ?\\) (any ?\' ?\")))
+ (* ?\\ ?\\)
+ ;; Match single or triple quotes of any kind.
+ (group (or "\"" "\"\"\"" "'" "'''"))))
+ (0 (ignore (python-syntax-stringify))))))
+
+(defsubst python-syntax-count-quotes (quote-char &optional point limit)
+ "Count number of quotes around point (max is 3).
+QUOTE-CHAR is the quote char to count. Optional argument POINT is
+the point where scan starts (defaults to current point) and LIMIT
+is used to limit the scan."
+ (let ((i 0))
+ (while (and (< i 3)
+ (or (not limit) (< (+ point i) limit))
+ (eq (char-after (+ point i)) quote-char))
+ (incf i))
+ i))
+
+(defun python-syntax-stringify ()
+ "Put `syntax-table' property correctly on single/triple quotes."
+ (let* ((num-quotes (length (match-string-no-properties 1)))
+ (ppss (prog2
+ (backward-char num-quotes)
+ (syntax-ppss)
+ (forward-char num-quotes)))
+ (string-start (and (not (nth 4 ppss)) (nth 8 ppss)))
+ (quote-starting-pos (- (point) num-quotes))
+ (quote-ending-pos (point))
+ (num-closing-quotes
+ (and string-start
+ (python-syntax-count-quotes
+ (char-before) string-start quote-starting-pos))))
+ (cond ((and string-start (= num-closing-quotes 0))
+ ;; This set of quotes doesn't match the string starting
+ ;; kind. Do nothing.
+ nil)
+ ((not string-start)
+ ;; This set of quotes delimit the start of a string.
+ (put-text-property quote-starting-pos (1+ quote-starting-pos)
+ 'syntax-table (string-to-syntax "|")))
+ ((= num-quotes num-closing-quotes)
+ ;; This set of quotes delimit the end of a string.
+ (put-text-property (1- quote-ending-pos) quote-ending-pos
+ 'syntax-table (string-to-syntax "|")))
+ ((> num-quotes num-closing-quotes)
+ ;; This may only happen whenever a triple quote is closing
+ ;; a single quoted string. Add string delimiter syntax to
+ ;; all three quotes.
+ (put-text-property quote-starting-pos quote-ending-pos
+ 'syntax-table (string-to-syntax "|"))))))
(defvar python-mode-syntax-table
(let ((table (make-syntax-table)))
@@ -665,12 +676,12 @@ START is the buffer position where the sexp starts."
(goto-char (line-beginning-position))
(bobp))
'no-indent)
- ;; Inside a paren
- ((setq start (python-syntax-context 'paren ppss))
- 'inside-paren)
;; Inside string
((setq start (python-syntax-context 'string ppss))
'inside-string)
+ ;; Inside a paren
+ ((setq start (python-syntax-context 'paren ppss))
+ 'inside-paren)
;; After backslash
((setq start (when (not (or (python-syntax-context 'string ppss)
(python-syntax-context 'comment ppss)))
@@ -699,7 +710,7 @@ START is the buffer position where the sexp starts."
;; After normal line
((setq start (save-excursion
(back-to-indentation)
- (python-util-forward-comment -1)
+ (skip-chars-backward (rx (or whitespace ?\n)))
(python-nav-beginning-of-statement)
(point-marker)))
'after-line)
@@ -897,16 +908,27 @@ possible indentation levels and saves it in the variable
`python-indent-levels'. Afterwards it sets the variable
`python-indent-current-level' correctly so offset is equal
to (`nth' `python-indent-current-level' `python-indent-levels')"
- (if (or (and (eq this-command 'indent-for-tab-command)
- (eq last-command this-command))
- force-toggle)
- (if (not (equal python-indent-levels '(0)))
- (python-indent-toggle-levels)
- (python-indent-calculate-levels))
- (python-indent-calculate-levels))
- (beginning-of-line)
- (delete-horizontal-space)
- (indent-to (nth python-indent-current-level python-indent-levels))
+ (or
+ (and (or (and (eq this-command 'indent-for-tab-command)
+ (eq last-command this-command))
+ force-toggle)
+ (not (equal python-indent-levels '(0)))
+ (or (python-indent-toggle-levels) t))
+ (python-indent-calculate-levels))
+ (let* ((starting-pos (point-marker))
+ (indent-ending-position
+ (+ (line-beginning-position) (current-indentation)))
+ (follow-indentation-p
+ (or (bolp)
+ (and (<= (line-beginning-position) starting-pos)
+ (>= indent-ending-position starting-pos))))
+ (next-indent (nth python-indent-current-level python-indent-levels)))
+ (unless (= next-indent (current-indentation))
+ (beginning-of-line)
+ (delete-horizontal-space)
+ (indent-to next-indent)
+ (goto-char starting-pos))
+ (and follow-indentation-p (back-to-indentation)))
(python-info-closing-block-message))
(defun python-indent-line-function ()
@@ -951,7 +973,16 @@ Called from a program, START and END specify the region to indent."
(back-to-indentation)
(setq word (current-word))
(forward-line 1)
- (when word
+ (when (and word
+ ;; Don't mess with strings, unless it's the
+ ;; enclosing set of quotes.
+ (or (not (python-syntax-context 'string))
+ (eq
+ (syntax-after
+ (+ (1- (point))
+ (current-indentation)
+ (python-syntax-count-quotes (char-after) (point))))
+ (string-to-syntax "|"))))
(beginning-of-line)
(delete-horizontal-space)
(indent-to (python-indent-calculate-indentation)))))
@@ -1621,6 +1652,8 @@ uniqueness for different types of configurations."
OUTPUT is a string with the contents of the buffer."
(ansi-color-filter-apply output))
+(defvar python-shell--parent-buffer nil)
+
(define-derived-mode inferior-python-mode comint-mode "Inferior Python"
"Major mode for Python inferior process.
Runs a Python interpreter as a subprocess of Emacs, with Python
@@ -1643,12 +1676,14 @@ initialization of the interpreter via `python-shell-setup-codes'
variable.
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
- (set-syntax-table python-mode-syntax-table)
- (setq mode-line-process '(":%s"))
+ (and python-shell--parent-buffer
+ (python-util-clone-local-variables python-shell--parent-buffer))
(setq comint-prompt-regexp (format "^\\(?:%s\\|%s\\|%s\\)"
python-shell-prompt-regexp
python-shell-prompt-block-regexp
python-shell-prompt-pdb-regexp))
+ (set-syntax-table python-mode-syntax-table)
+ (setq mode-line-process '(":%s"))
(make-local-variable 'comint-output-filter-functions)
(add-hook 'comint-output-filter-functions
'python-comint-output-filter-function)
@@ -1694,11 +1729,10 @@ killed."
(let* ((cmdlist (split-string-and-unquote cmd))
(buffer (apply #'make-comint-in-buffer proc-name proc-buffer-name
(car cmdlist) nil (cdr cmdlist)))
- (current-buffer (current-buffer))
+ (python-shell--parent-buffer (current-buffer))
(process (get-buffer-process buffer)))
(with-current-buffer buffer
- (inferior-python-mode)
- (python-util-clone-local-variables current-buffer))
+ (inferior-python-mode))
(accept-process-output process)
(and pop (pop-to-buffer buffer t))
(and internal (set-process-query-on-exit-flag process nil))))
@@ -1839,31 +1873,60 @@ When MSG is non-nil messages the first line of STRING."
(string-match "\n[ \t].*\n?$" string))
(comint-send-string process "\n")))))
+(defvar python-shell-output-filter-in-progress nil)
+(defvar python-shell-output-filter-buffer nil)
+
+(defun python-shell-output-filter (string)
+ "Filter used in `python-shell-send-string-no-output' to grab output.
+STRING is the output received to this point from the process.
+This filter saves received output from the process in
+`python-shell-output-filter-buffer' and stops receiving it after
+detecting a prompt at the end of the buffer."
+ (setq
+ string (ansi-color-filter-apply string)
+ python-shell-output-filter-buffer
+ (concat python-shell-output-filter-buffer string))
+ (when (string-match
+ (format "\n\\(?:%s\\|%s\\|%s\\)$"
+ python-shell-prompt-regexp
+ python-shell-prompt-block-regexp
+ python-shell-prompt-pdb-regexp)
+ python-shell-output-filter-buffer)
+ ;; Output ends when `python-shell-output-filter-buffer' contains
+ ;; the prompt attached at the end of it.
+ (setq python-shell-output-filter-in-progress nil
+ python-shell-output-filter-buffer
+ (substring python-shell-output-filter-buffer
+ 0 (match-beginning 0)))
+ (when (and (> (length python-shell-prompt-output-regexp) 0)
+ (string-match (concat "^" python-shell-prompt-output-regexp)
+ python-shell-output-filter-buffer))
+ ;; Some shells, like iPython might append a prompt before the
+ ;; output, clean that.
+ (setq python-shell-output-filter-buffer
+ (substring python-shell-output-filter-buffer (match-end 0)))))
+ "")
+
(defun python-shell-send-string-no-output (string &optional process msg)
"Send STRING to PROCESS and inhibit output.
When MSG is non-nil messages the first line of STRING. Return
the output."
- (let* ((output-buffer "")
- (process (or process (python-shell-get-or-create-process)))
- (comint-preoutput-filter-functions
- (append comint-preoutput-filter-functions
- '(ansi-color-filter-apply
- (lambda (string)
- (setq output-buffer (concat output-buffer string))
- ""))))
- (inhibit-quit t))
+ (let ((process (or process (python-shell-get-or-create-process)))
+ (comint-preoutput-filter-functions
+ '(python-shell-output-filter))
+ (python-shell-output-filter-in-progress t)
+ (inhibit-quit t))
(or
(with-local-quit
(python-shell-send-string string process msg)
- (accept-process-output process)
- (replace-regexp-in-string
- (if (> (length python-shell-prompt-output-regexp) 0)
- (format "\n*%s$\\|^%s\\|\n$"
- python-shell-prompt-regexp
- (or python-shell-prompt-output-regexp ""))
- (format "\n*$\\|^%s\\|\n$"
- python-shell-prompt-regexp))
- "" output-buffer))
+ (while python-shell-output-filter-in-progress
+ ;; `python-shell-output-filter' takes care of setting
+ ;; `python-shell-output-filter-in-progress' to NIL after it
+ ;; detects end of output.
+ (accept-process-output process))
+ (prog1
+ python-shell-output-filter-buffer
+ (setq python-shell-output-filter-buffer nil)))
(with-current-buffer (process-buffer process)
(comint-interrupt-subjob)))))
@@ -1892,19 +1955,18 @@ Returns the output. See `python-shell-send-string-no-output'."
(defun python-shell-send-buffer (&optional arg)
"Send the entire buffer to inferior Python process.
-
-With prefix ARG include lines surrounded by \"if __name__ == '__main__':\""
+With prefix ARG allow execution of code inside blocks delimited
+by \"if __name__== '__main__':\""
(interactive "P")
(save-restriction
(widen)
- (python-shell-send-region
- (point-min)
- (or (and
- (not arg)
- (save-excursion
- (re-search-forward (python-rx if-name-main) nil t))
- (match-beginning 0))
- (point-max)))))
+ (let ((str (buffer-substring (point-min) (point-max))))
+ (and
+ (not arg)
+ (setq str (replace-regexp-in-string
+ (python-rx if-name-main)
+ "if __name__ == '__main__ ':" str)))
+ (python-shell-send-string str))))
(defun python-shell-send-defun (arg)
"Send the current defun to inferior Python process.
@@ -2232,32 +2294,100 @@ inferior python process is updated properly."
This is the function used by `python-fill-paragraph-function' to
fill comments."
:type 'symbol
- :group 'python
- :safe 'symbolp)
+ :group 'python)
(defcustom python-fill-string-function 'python-fill-string
"Function to fill strings.
This is the function used by `python-fill-paragraph-function' to
fill strings."
:type 'symbol
- :group 'python
- :safe 'symbolp)
+ :group 'python)
(defcustom python-fill-decorator-function 'python-fill-decorator
"Function to fill decorators.
This is the function used by `python-fill-paragraph-function' to
fill decorators."
:type 'symbol
- :group 'python
- :safe 'symbolp)
+ :group 'python)
(defcustom python-fill-paren-function 'python-fill-paren
"Function to fill parens.
This is the function used by `python-fill-paragraph-function' to
fill parens."
:type 'symbol
+ :group 'python)
+
+(defcustom python-fill-docstring-style 'pep-257
+ "Style used to fill docstrings.
+This affects `python-fill-string' behavior with regards to
+triple quotes positioning.
+
+Possible values are DJANGO, ONETWO, PEP-257, PEP-257-NN,
+SYMMETRIC, and NIL. A value of NIL won't care about quotes
+position and will treat docstrings a normal string, any other
+value may result in one of the following docstring styles:
+
+DJANGO:
+
+ \"\"\"
+ Process foo, return bar.
+ \"\"\"
+
+ \"\"\"
+ Process foo, return bar.
+
+ If processing fails throw ProcessingError.
+ \"\"\"
+
+ONETWO:
+
+ \"\"\"Process foo, return bar.\"\"\"
+
+ \"\"\"
+ Process foo, return bar.
+
+ If processing fails throw ProcessingError.
+
+ \"\"\"
+
+PEP-257:
+
+ \"\"\"Process foo, return bar.\"\"\"
+
+ \"\"\"Process foo, return bar.
+
+ If processing fails throw ProcessingError.
+
+ \"\"\"
+
+PEP-257-NN:
+
+ \"\"\"Process foo, return bar.\"\"\"
+
+ \"\"\"Process foo, return bar.
+
+ If processing fails throw ProcessingError.
+ \"\"\"
+
+SYMMETRIC:
+
+ \"\"\"Process foo, return bar.\"\"\"
+
+ \"\"\"
+ Process foo, return bar.
+
+ If processing fails throw ProcessingError.
+ \"\"\""
+ :type '(choice
+ (const :tag "Don't format docstrings" nil)
+ (const :tag "Django's coding standards style." django)
+ (const :tag "One newline and start and Two at end style." onetwo)
+ (const :tag "PEP-257 with 2 newlines at end of string." pep-257)
+ (const :tag "PEP-257 with 1 newline at end of string." pep-257-nn)
+ (const :tag "Symmetric style." symmetric))
:group 'python
- :safe 'symbolp)
+ :safe (lambda (val)
+ (memq val '(django onetwo pep-257 pep-257-nn symmetric nil))))
(defun python-fill-paragraph-function (&optional justify)
"`fill-paragraph-function' handling multi-line strings and possibly comments.
@@ -2267,18 +2397,19 @@ the string's indentation.
Optional argument JUSTIFY defines if the paragraph should be justified."
(interactive "P")
(save-excursion
- (back-to-indentation)
(cond
;; Comments
- ((funcall python-fill-comment-function justify))
+ ((python-syntax-context 'comment)
+ (funcall python-fill-comment-function justify))
;; Strings/Docstrings
- ((save-excursion (skip-chars-forward "\"'uUrR")
- (python-syntax-context 'string))
+ ((save-excursion (or (python-syntax-context 'string)
+ (equal (string-to-syntax "|")
+ (syntax-after (point)))))
(funcall python-fill-string-function justify))
;; Decorators
((equal (char-after (save-excursion
(back-to-indentation)
- (point-marker))) ?@)
+ (point))) ?@)
(funcall python-fill-decorator-function justify))
;; Parens
((or (python-syntax-context 'paren)
@@ -2297,43 +2428,72 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
(defun python-fill-string (&optional justify)
"String fill function for `python-fill-paragraph-function'.
JUSTIFY should be used (if applicable) as in `fill-paragraph'."
- (let ((marker (point-marker))
- (string-start-marker
- (progn
- (skip-chars-forward "\"'uUrR")
- (goto-char (python-syntax-context 'string))
- (skip-chars-forward "\"'uUrR")
- (point-marker)))
- (reg-start (line-beginning-position))
- (string-end-marker
- (progn
- (while (python-syntax-context 'string)
- (goto-char (1+ (point-marker))))
- (skip-chars-backward "\"'")
- (point-marker)))
- (reg-end (line-end-position))
- (fill-paragraph-function))
+ (let* ((marker (point-marker))
+ (str-start-pos
+ (let ((m (make-marker)))
+ (setf (marker-position m)
+ (or (python-syntax-context 'string)
+ (and (equal (string-to-syntax "|")
+ (syntax-after (point)))
+ (point)))) m))
+ (num-quotes (python-syntax-count-quotes
+ (char-after str-start-pos) str-start-pos))
+ (str-end-pos
+ (save-excursion
+ (goto-char (+ str-start-pos num-quotes))
+ (or (re-search-forward (rx (syntax string-delimiter)) nil t)
+ (goto-char (point-max)))
+ (point-marker)))
+ (multi-line-p
+ ;; Docstring styles may vary for oneliners and multi-liners.
+ (> (count-matches "\n" str-start-pos str-end-pos) 0))
+ (delimiters-style
+ (case python-fill-docstring-style
+ ;; delimiters-style is a cons cell with the form
+ ;; (START-NEWLINES . END-NEWLINES). When any of the sexps
+ ;; is NIL means to not add any newlines for start or end
+ ;; of docstring. See `python-fill-docstring-style' for a
+ ;; graphic idea of each style.
+ (django (cons 1 1))
+ (onetwo (and multi-line-p (cons 1 2)))
+ (pep-257 (and multi-line-p (cons nil 2)))
+ (pep-257-nn (and multi-line-p (cons nil 1)))
+ (symmetric (and multi-line-p (cons 1 1)))))
+ (docstring-p (save-excursion
+ ;; Consider docstrings those strings which
+ ;; start on a line by themselves.
+ (python-nav-beginning-of-statement)
+ (and (= (point) str-start-pos))))
+ (fill-paragraph-function))
(save-restriction
- (narrow-to-region reg-start reg-end)
- (save-excursion
- (goto-char string-start-marker)
- (delete-region (point-marker) (progn
- (skip-syntax-forward "> ")
- (point-marker)))
- (goto-char string-end-marker)
- (delete-region (point-marker) (progn
- (skip-syntax-backward "> ")
- (point-marker)))
- (save-excursion
- (goto-char marker)
- (fill-paragraph justify))
- ;; If there is a newline in the docstring lets put triple
- ;; quote in it's own line to follow pep 8
- (when (save-excursion
- (re-search-backward "\n" string-start-marker t))
- (newline)
- (newline-and-indent))
- (fill-paragraph justify)))) t)
+ (narrow-to-region str-start-pos str-end-pos)
+ (fill-paragraph justify))
+ (save-excursion
+ (when (and docstring-p python-fill-docstring-style)
+ ;; Add the number of newlines indicated by the selected style
+ ;; at the start of the docstring.
+ (goto-char (+ str-start-pos num-quotes))
+ (delete-region (point) (progn
+ (skip-syntax-forward "> ")
+ (point)))
+ (and (car delimiters-style)
+ (or (newline (car delimiters-style)) t)
+ ;; Indent only if a newline is added.
+ (indent-according-to-mode))
+ ;; Add the number of newlines indicated by the selected style
+ ;; at the end of the docstring.
+ (goto-char (if (not (= str-end-pos (point-max)))
+ (- str-end-pos num-quotes)
+ str-end-pos))
+ (delete-region (point) (progn
+ (skip-syntax-backward "> ")
+ (point)))
+ (and (cdr delimiters-style)
+ ;; Add newlines only if string ends.
+ (not (= str-end-pos (point-max)))
+ (or (newline (cdr delimiters-style)) t)
+ ;; Again indent only if a newline is added.
+ (indent-according-to-mode))))) t)
(defun python-fill-decorator (&optional justify)
"Decorator fill function for `python-fill-paragraph-function'.
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 77ec8084ea2..84cf7308d75 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -1112,8 +1112,9 @@ See `add-log-current-defun-function'."
(goto-char end)
(when (eq (char-before) ?\})
(delete-char -1)
- (skip-chars-backward " \t")
- (when (not (bolp))
+ (when (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp)))
(insert "\n"))
(insert "end")
(setq end-marker (point-marker))
@@ -1137,16 +1138,35 @@ See `add-log-current-defun-function'."
t)))
(defun ruby-do-end-to-brace (orig end)
- (goto-char (- end 3))
- (when (looking-at ruby-block-end-re)
- (delete-char 3)
- (insert "}")
- (goto-char orig)
- (delete-char 2)
- (insert "{")
- (if (looking-at "\\s +|")
- (delete-char (- (match-end 0) (match-beginning 0) 1)))
- t))
+ (let (beg-marker end-marker beg-pos end-pos)
+ (goto-char (- end 3))
+ (when (looking-at ruby-block-end-re)
+ (delete-char 3)
+ (setq end-marker (point-marker))
+ (insert "}")
+ (goto-char orig)
+ (delete-char 2)
+ (insert "{")
+ (setq beg-marker (point-marker))
+ (when (looking-at "\\s +|")
+ (delete-char (- (match-end 0) (match-beginning 0) 1))
+ (forward-char)
+ (re-search-forward "|" (line-end-position) t))
+ (save-excursion
+ (skip-chars-forward " \t\n\r")
+ (setq beg-pos (point))
+ (goto-char end-marker)
+ (skip-chars-backward " \t\n\r")
+ (setq end-pos (point)))
+ (when (or
+ (< end-pos beg-pos)
+ (and (= (line-number-at-pos beg-pos) (line-number-at-pos end-pos))
+ (< (+ (current-column) (- end-pos beg-pos) 2) fill-column)))
+ (just-one-space -1)
+ (goto-char end-marker)
+ (just-one-space -1))
+ (goto-char beg-marker)
+ t)))
(defun ruby-toggle-block ()
"Toggle block type from do-end to braces or back.
@@ -1547,7 +1567,7 @@ See `font-lock-syntax-table'.")
2 font-lock-variable-name-face)
;; symbols
'("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
- 2 font-lock-reference-face)
+ 2 font-lock-constant-face)
;; variables
'("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W"
1 font-lock-variable-name-face)
@@ -1556,7 +1576,7 @@ See `font-lock-syntax-table'.")
;; constants
'("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)"
2 font-lock-type-face)
- '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-reference-face)
+ '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face)
;; expression expansion
'(ruby-match-expression-expansion
0 font-lock-variable-name-face t)
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index b4d550bcee0..06ded5fb53d 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1767,7 +1767,9 @@ Does not preserve point."
(defcustom sh-indent-after-continuation t
"If non-nil, try to make sure text is indented after a line continuation."
- :type 'boolean)
+ :version "24.3"
+ :type 'boolean
+ :group 'sh-indentation)
(defun sh-smie--continuation-start-indent ()
"Return the initial indentation of a continued line.
@@ -4079,11 +4081,10 @@ option followed by a colon `:' if the option accepts an argument."
(defun sh-maybe-here-document (arg)
"Insert self. Without prefix, following unquoted `<' inserts here document.
The document is bounded by `sh-here-document-word'."
+ (declare (obsolete sh-electric-here-document-mode "24.3"))
(interactive "*P")
(self-insert-command (prefix-numeric-value arg))
(or arg (sh--maybe-here-document)))
-(make-obsolete 'sh--maybe-here-document
- 'sh-electric-here-document-mode "24.3")
(defun sh--maybe-here-document ()
(or (not (looking-back "[^<]<<"))
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index f1ab01fd07f..c82566ca5b6 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -104,7 +104,6 @@
(eval-when-compile
(require 'imenu)
- (require 'outline)
(require 'dabbrev)
(require 'add-log))
@@ -544,6 +543,9 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'."
;; The mode itself.
;;
+(defvar outline-regexp)
+(defvar outline-level)
+
;;;###autoload
(define-derived-mode tcl-mode prog-mode "Tcl"
"Major mode for editing Tcl code.
diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el
index 31f2fc1fe31..a2f71ff2ab8 100644
--- a/lisp/progmodes/vera-mode.el
+++ b/lisp/progmodes/vera-mode.el
@@ -587,12 +587,6 @@ Key bindings:
;;; Font locking
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; XEmacs compatibility
-(when (featurep 'xemacs)
- (require 'font-lock)
- (copy-face 'font-lock-reference-face 'font-lock-constant-face)
- (copy-face 'font-lock-preprocessor-face 'font-lock-builtin-face))
-
(defun vera-font-lock-match-item (limit)
"Match, and move over, any declaration item after point.
Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'."
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 835d548c19f..6ffe88f721e 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -123,9 +123,9 @@
;;; Code:
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "800"
+(defconst verilog-mode-version (substring "$$Revision: 820 $$" 12 -3)
"Version of this Verilog mode.")
-(defconst verilog-mode-release-date "2012-04-23-GNU"
+(defconst verilog-mode-release-date (substring "$$Date: 2012-09-17 20:43:10 -0400 (Mon, 17 Sep 2012) $$" 8 -3)
"Release date of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -1127,10 +1127,11 @@ won't merge conflict."
:type 'integer)
(put 'verilog-auto-inst-column 'safe-local-variable 'integerp)
-(defcustom verilog-auto-inst-interfaced-ports t
+(defcustom verilog-auto-inst-interfaced-ports nil
"Non-nil means include interfaced ports in AUTOINST expansions."
:group 'verilog-mode-auto
- :type 'boolean)
+ :type 'boolean
+ :version "24.3")
(put 'verilog-auto-inst-interfaced-ports 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-input-ignore-regexp nil
@@ -1158,6 +1159,7 @@ See the \\[verilog-faq] for examples on using this."
"Non-nil means report warning if an AUTO_TEMPLATE line is not used.
This feature is not supported before Emacs 21.1 or XEmacs 21.4."
:group 'verilog-mode-auto
+ :version "24.3"
:type 'boolean)
(put 'verilog-auto-template-warn-unused 'safe-local-variable 'verilog-booleanp)
@@ -1229,11 +1231,13 @@ For example, \"_t$\" matches typedefs named with _t, as in the C language."
(defcustom verilog-before-save-font-hook nil
"Hook run before `verilog-save-font-mods' removes highlighting."
:group 'verilog-mode-auto
+ :version "24.3"
:type 'hook)
(defcustom verilog-after-save-font-hook nil
"Hook run after `verilog-save-font-mods' restores highlighting."
:group 'verilog-mode-auto
+ :version "24.3"
:type 'hook)
(defvar verilog-imenu-generic-expression
@@ -1431,12 +1435,18 @@ If set will become buffer local.")
:help "Help on AUTOARG - declaring module port list"]
["AUTOASCIIENUM" (describe-function 'verilog-auto-ascii-enum)
:help "Help on AUTOASCIIENUM - creating ASCII for enumerations"]
+ ["AUTOASSIGNMODPORT" (describe-function 'verilog-auto-assign-modport)
+ :help "Help on AUTOASSIGNMODPORT - creating assignments to/from modports"]
["AUTOINOUTCOMP" (describe-function 'verilog-auto-inout-comp)
:help "Help on AUTOINOUTCOMP - copying complemented i/o from another file"]
["AUTOINOUTIN" (describe-function 'verilog-auto-inout-in)
- :help "Help on AUTOINOUTCOMP - copying i/o from another file as all inputs"]
+ :help "Help on AUTOINOUTIN - copying i/o from another file as all inputs"]
+ ["AUTOINOUTMODPORT" (describe-function 'verilog-auto-inout-modport)
+ :help "Help on AUTOINOUTMODPORT - copying i/o from an interface modport"]
["AUTOINOUTMODULE" (describe-function 'verilog-auto-inout-module)
:help "Help on AUTOINOUTMODULE - copying i/o from another file"]
+ ["AUTOINOUTPARAM" (describe-function 'verilog-auto-inout-param)
+ :help "Help on AUTOINOUTPARAM - copying parameters from another file"]
["AUTOINSERTLISP" (describe-function 'verilog-auto-insert-lisp)
:help "Help on AUTOINSERTLISP - insert text from a lisp function"]
["AUTOINOUT" (describe-function 'verilog-auto-inout)
@@ -1706,12 +1716,19 @@ This speeds up complicated regexp matches."
;;(verilog-re-search-backward-substr "-end" "get-end-of" nil t) ;;-end (test bait)
(defun verilog-delete-trailing-whitespace ()
- "Delete trailing spaces or tabs, but not newlines nor linefeeds."
+ "Delete trailing spaces or tabs, but not newlines nor linefeeds.
+Also add missing final newline.
+
+To call this from the command line, see \\[verilog-batch-diff-auto].
+
+To call on \\[verilog-auto], set `verilog-auto-delete-trailing-whitespace'."
;; Similar to `delete-trailing-whitespace' but that's not present in XEmacs
(save-excursion
(goto-char (point-min))
(while (re-search-forward "[ \t]+$" nil t) ;; Not syntactic WS as no formfeed
- (replace-match "" nil nil))))
+ (replace-match "" nil nil))
+ (goto-char (point-max))
+ (unless (bolp) (insert "\n"))))
(defvar compile-command)
@@ -5128,6 +5145,15 @@ with \\[verilog-delete-auto] on all command-line files, and saves the buffers."
(error "Use verilog-batch-delete-auto only with --batch")) ;; Otherwise we'd mess up buffer modes
(verilog-batch-execute-func `verilog-delete-auto))
+(defun verilog-batch-delete-trailing-whitespace ()
+ "For use with --batch, perform whitespace deletion as a stand-alone tool.
+This sets up the appropriate Verilog mode environment, removes
+whitespace with \\[verilog-delete-trailing-whitespace] on all
+command-line files, and saves the buffers."
+ (unless noninteractive
+ (error "Use verilog-batch-delete-trailing-whitespace only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (verilog-batch-execute-func `verilog-delete-trailing-whitespace))
+
(defun verilog-batch-diff-auto ()
"For use with --batch, perform automatic differences as a stand-alone tool.
This sets up the appropriate Verilog mode environment, expand automatics
@@ -7479,6 +7505,19 @@ See also `verilog-sk-header' for an alternative format."
(defsubst verilog-alw-get-uses-delayed (sigs)
(aref sigs 0))
+(defsubst verilog-modport-new (name clockings decls)
+ (list name clockings decls))
+(defsubst verilog-modport-name (sig)
+ (car sig))
+(defsubst verilog-modport-clockings (sig)
+ (nth 1 sig)) ;; Returns list of names
+(defsubst verilog-modport-clockings-add (sig val)
+ (setcar (nthcdr 1 sig) (cons val (nth 1 sig))))
+(defsubst verilog-modport-decls (sig)
+ (nth 2 sig)) ;; Returns verilog-decls-* structure
+(defsubst verilog-modport-decls-set (sig val)
+ (setcar (nthcdr 2 sig) val))
+
(defsubst verilog-modi-new (name fob pt type)
(vector name fob pt type))
(defsubst verilog-modi-name (modi)
@@ -7496,8 +7535,15 @@ See also `verilog-sk-header' for an alternative format."
;; Signal reading for given module
;; Note these all take modi's - as returned from verilog-modi-current
-(defsubst verilog-decls-new (out inout in vars unuseds assigns consts gparams interfaces)
- (vector out inout in vars unuseds assigns consts gparams interfaces))
+(defsubst verilog-decls-new (out inout in vars modports assigns consts gparams interfaces)
+ (vector out inout in vars modports assigns consts gparams interfaces))
+(defsubst verilog-decls-append (a b)
+ (cond ((not a) b) ((not b) a)
+ (t (vector (append (aref a 0) (aref b 0)) (append (aref a 1) (aref b 1))
+ (append (aref a 2) (aref b 2)) (append (aref a 3) (aref b 3))
+ (append (aref a 4) (aref b 4)) (append (aref a 5) (aref b 5))
+ (append (aref a 6) (aref b 6)) (append (aref a 7) (aref b 7))
+ (append (aref a 8) (aref b 8))))))
(defsubst verilog-decls-get-outputs (decls)
(aref decls 0))
(defsubst verilog-decls-get-inouts (decls)
@@ -7506,8 +7552,8 @@ See also `verilog-sk-header' for an alternative format."
(aref decls 2))
(defsubst verilog-decls-get-vars (decls)
(aref decls 3))
-;;(defsubst verilog-decls-get-unused (decls)
-;; (aref decls 4))
+(defsubst verilog-decls-get-modports (decls) ;; Also for clocking blocks; contains another verilog-decls struct
+ (aref decls 4)) ;; Returns verilog-modport* structure
(defsubst verilog-decls-get-assigns (decls)
(aref decls 5))
(defsubst verilog-decls-get-consts (decls)
@@ -7517,6 +7563,7 @@ See also `verilog-sk-header' for an alternative format."
(defsubst verilog-decls-get-interfaces (decls)
(aref decls 8))
+
(defsubst verilog-subdecls-new (out inout in intf intfd)
(vector out inout in intf intfd))
(defsubst verilog-subdecls-get-outputs (subdecls)
@@ -7535,6 +7582,36 @@ See also `verilog-sk-header' for an alternative format."
(mapcar (lambda (name) (verilog-sig-new name nil nil nil nil nil nil nil nil))
signame-list))
+(defun verilog-signals-in (in-list not-list)
+ "Return list of signals in IN-LIST that are also in NOT-LIST.
+Also remove any duplicates in IN-LIST.
+Signals must be in standard (base vector) form."
+ ;; This function is hot, so implemented as O(1)
+ (cond ((eval-when-compile (fboundp 'make-hash-table))
+ (let ((ht (make-hash-table :test 'equal :rehash-size 4.0))
+ (ht-not (make-hash-table :test 'equal :rehash-size 4.0))
+ out-list)
+ (while not-list
+ (puthash (car (car not-list)) t ht-not)
+ (setq not-list (cdr not-list)))
+ (while in-list
+ (when (and (gethash (verilog-sig-name (car in-list)) ht-not)
+ (not (gethash (verilog-sig-name (car in-list)) ht)))
+ (setq out-list (cons (car in-list) out-list))
+ (puthash (verilog-sig-name (car in-list)) t ht))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))
+ ;; Slower Fallback if no hash tables (pre Emacs 21.1/XEmacs 21.4)
+ (t
+ (let (out-list)
+ (while in-list
+ (if (and (assoc (verilog-sig-name (car in-list)) not-list)
+ (not (assoc (verilog-sig-name (car in-list)) out-list)))
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))))
+;;(verilog-signals-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("C" "")))
+
(defun verilog-signals-not-in (in-list not-list)
"Return list of signals in IN-LIST that aren't also in NOT-LIST.
Also remove any duplicates in IN-LIST.
@@ -7556,8 +7633,8 @@ Signals must be in standard (base vector) form."
(t
(let (out-list)
(while in-list
- (if (not (or (assoc (verilog-sig-name (car in-list)) not-list)
- (assoc (verilog-sig-name (car in-list)) out-list)))
+ (if (and (not (assoc (verilog-sig-name (car in-list)) not-list))
+ (not (assoc (verilog-sig-name (car in-list)) out-list)))
(setq out-list (cons (car in-list) out-list)))
(setq in-list (cdr in-list)))
(nreverse out-list)))))
@@ -7702,30 +7779,35 @@ Tieoff value uses `verilog-active-low-regexp' and
;; Dumping
;;
-(defun verilog-decls-princ (decls)
+(defun verilog-decls-princ (decls &optional header prefix)
"For debug, dump the `verilog-read-decls' structure DECLS."
- (verilog-signals-princ (verilog-decls-get-outputs decls)
- "Outputs:\n" " ")
- (verilog-signals-princ (verilog-decls-get-inouts decls)
- "Inout:\n" " ")
- (verilog-signals-princ (verilog-decls-get-inputs decls)
- "Inputs:\n" " ")
- (verilog-signals-princ (verilog-decls-get-vars decls)
- "Vars:\n" " ")
- (verilog-signals-princ (verilog-decls-get-assigns decls)
- "Assigns:\n" " ")
- (verilog-signals-princ (verilog-decls-get-consts decls)
- "Consts:\n" " ")
- (verilog-signals-princ (verilog-decls-get-gparams decls)
- "Gparams:\n" " ")
- (verilog-signals-princ (verilog-decls-get-interfaces decls)
- "Interfaces:\n" " ")
- (princ "\n"))
+ (when decls
+ (if header (princ header))
+ (setq prefix (or prefix ""))
+ (verilog-signals-princ (verilog-decls-get-outputs decls)
+ (concat prefix "Outputs:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-inouts decls)
+ (concat prefix "Inout:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-inputs decls)
+ (concat prefix "Inputs:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-vars decls)
+ (concat prefix "Vars:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-assigns decls)
+ (concat prefix "Assigns:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-consts decls)
+ (concat prefix "Consts:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-gparams decls)
+ (concat prefix "Gparams:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-interfaces decls)
+ (concat prefix "Interfaces:\n") (concat prefix " "))
+ (verilog-modport-princ (verilog-decls-get-modports decls)
+ (concat prefix "Modports:\n") (concat prefix " "))
+ (princ "\n")))
(defun verilog-signals-princ (signals &optional header prefix)
"For debug, dump internal SIGNALS structures, with HEADER and PREFIX."
(when signals
- (princ header)
+ (if header (princ header))
(while signals
(let ((sig (car signals)))
(setq signals (cdr signals))
@@ -7741,6 +7823,21 @@ Tieoff value uses `verilog-active-low-regexp' and
(princ " modp=") (princ (verilog-sig-modport sig))
(princ "\n")))))
+(defun verilog-modport-princ (modports &optional header prefix)
+ "For debug, dump internal MODPORT structures, with HEADER and PREFIX."
+ (when modports
+ (if header (princ header))
+ (while modports
+ (let ((sig (car modports)))
+ (setq modports (cdr modports))
+ (princ prefix)
+ (princ "\"") (princ (verilog-modport-name sig)) (princ "\"")
+ (princ " clockings=") (princ (verilog-modport-clockings sig))
+ (princ "\n")
+ (verilog-decls-princ (verilog-modport-decls sig)
+ (concat prefix " syms:\n")
+ (concat prefix " "))))))
+
;;
;; Port/Wire/Etc Reading
;;
@@ -7851,11 +7948,12 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
Return an array of [outputs inouts inputs wire reg assign const]."
(let ((end-mod-point (or (verilog-get-end-of-defun t) (point-max)))
(functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t)
- in-modport ptype ign-prop
+ in-modport in-clocking ptype ign-prop
sigs-in sigs-out sigs-inout sigs-var sigs-assign sigs-const
- sigs-gparam sigs-intf
+ sigs-gparam sigs-intf sigs-modports
vec expect-signal keywd newsig rvalue enum io signed typedefed multidim
- modport)
+ modport
+ varstack tmp)
(save-excursion
(verilog-beg-of-defun-quick)
(setq sigs-const (verilog-read-auto-constants (point) end-mod-point))
@@ -7881,6 +7979,17 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(or (re-search-forward "[^\\]\"" nil t) ;; don't forward-char first, since we look for a non backslash first
(error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point))))
((eq ?\; (following-char))
+ (when (and in-modport (not (eq in-modport t))) ;; end of a modport declaration
+ (verilog-modport-decls-set
+ in-modport
+ (verilog-decls-new sigs-out sigs-inout sigs-in
+ nil nil nil nil nil nil))
+ ;; Pop from varstack to restore state to pre-clocking
+ (setq tmp (car varstack)
+ varstack (cdr varstack)
+ sigs-out (aref tmp 0)
+ sigs-inout (aref tmp 1)
+ sigs-in (aref tmp 2)))
(setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil
v2kargs-ok nil in-modport nil ign-prop nil)
(forward-char 1))
@@ -7974,15 +8083,17 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(setq signed keywd))
((member keywd '("assert" "assume" "cover" "expect" "restrict"))
(setq ign-prop t))
- ((member keywd '("class" "clocking" "covergroup" "function"
+ ((member keywd '("class" "covergroup" "function"
"property" "randsequence" "sequence" "task"))
(unless ign-prop
(setq functask (1+ functask))))
- ((member keywd '("endclass" "endclocking" "endgroup" "endfunction"
+ ((member keywd '("endclass" "endgroup" "endfunction"
"endproperty" "endsequence" "endtask"))
(setq functask (1- functask)))
((equal keywd "modport")
(setq in-modport t))
+ ((equal keywd "clocking")
+ (setq in-clocking t))
((equal keywd "type")
(setq ptype t))
;; Ifdef? Ignore name of define
@@ -8008,11 +8119,47 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(goto-char (match-end 0))
(when (not rvalue)
(setq expect-signal nil)))
+ ;; "modport <keywd>"
+ ((and (eq in-modport t)
+ (not (member keywd verilog-keywords)))
+ (setq in-modport (verilog-modport-new keywd nil nil))
+ (setq sigs-modports (cons in-modport sigs-modports))
+ ;; Push old sig values to stack and point to new signal list
+ (setq varstack (cons (vector sigs-out sigs-inout sigs-in)
+ varstack))
+ (setq sigs-in nil sigs-inout nil sigs-out nil))
+ ;; "modport x (clocking <keywd>)"
+ ((and in-modport in-clocking)
+ (verilog-modport-clockings-add in-modport keywd)
+ (setq in-clocking nil))
+ ;; endclocking
+ ((and in-clocking
+ (equal keywd "endclocking"))
+ (unless (eq in-clocking t)
+ (verilog-modport-decls-set
+ in-clocking
+ (verilog-decls-new sigs-out sigs-inout sigs-in
+ nil nil nil nil nil nil))
+ ;; Pop from varstack to restore state to pre-clocking
+ (setq tmp (car varstack)
+ varstack (cdr varstack)
+ sigs-out (aref tmp 0)
+ sigs-inout (aref tmp 1)
+ sigs-in (aref tmp 2)))
+ (setq in-clocking nil))
+ ;; "clocking <keywd>"
+ ((and (eq in-clocking t)
+ (not (member keywd verilog-keywords)))
+ (setq in-clocking (verilog-modport-new keywd nil nil))
+ (setq sigs-modports (cons in-clocking sigs-modports))
+ ;; Push old sig values to stack and point to new signal list
+ (setq varstack (cons (vector sigs-out sigs-inout sigs-in)
+ varstack))
+ (setq sigs-in nil sigs-inout nil sigs-out nil))
;; New signal, maybe?
((and expect-signal
(not rvalue)
(eq functask 0)
- (not in-modport)
(not (member keywd verilog-keywords)))
;; Add new signal to expect-signal's variable
(setq newsig (verilog-sig-new keywd vec nil nil enum signed typedefed multidim modport))
@@ -8022,15 +8169,17 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(forward-char 1)))
(skip-syntax-forward " "))
;; Return arguments
- (verilog-decls-new (nreverse sigs-out)
- (nreverse sigs-inout)
- (nreverse sigs-in)
- (nreverse sigs-var)
- nil
- (nreverse sigs-assign)
- (nreverse sigs-const)
- (nreverse sigs-gparam)
- (nreverse sigs-intf)))))
+ (setq tmp (verilog-decls-new (nreverse sigs-out)
+ (nreverse sigs-inout)
+ (nreverse sigs-in)
+ (nreverse sigs-var)
+ (nreverse sigs-modports)
+ (nreverse sigs-assign)
+ (nreverse sigs-const)
+ (nreverse sigs-gparam)
+ (nreverse sigs-intf)))
+ ;;(if dbg (verilog-decls-princ tmp))
+ tmp)))
(defvar verilog-read-sub-decls-in-interfaced nil
"For `verilog-read-sub-decls', process next signal as under interfaced block.")
@@ -9352,12 +9501,12 @@ Return modi if successful, else print message unless IGNORE-ERROR is true."
;;(message "verilog-modi-lookup: HIT %S" modi)
modi)
;; Miss
- (t (let* ((realmod (verilog-symbol-detick module t))
- (orig-filenames (verilog-module-filenames realmod current))
+ (t (let* ((realname (verilog-symbol-detick module t))
+ (orig-filenames (verilog-module-filenames realname current))
(filenames orig-filenames)
mif)
(while (and filenames (not mif))
- (if (not (setq mif (verilog-module-inside-filename-p realmod (car filenames))))
+ (if (not (setq mif (verilog-module-inside-filename-p realname (car filenames))))
(setq filenames (cdr filenames))))
;; mif has correct form to become later elements of modi
(cond (mif (setq modi mif))
@@ -9365,8 +9514,8 @@ Return modi if successful, else print message unless IGNORE-ERROR is true."
(or ignore-error
(error (concat (verilog-point-text)
": Can't locate " module " module definition"
- (if (not (equal module realmod))
- (concat " (Expanded macro to " realmod ")")
+ (if (not (equal module realname))
+ (concat " (Expanded macro to " realname ")")
"")
"\n Check the verilog-library-directories variable."
"\n I looked in (if not listed, doesn't exist):\n\t"
@@ -9465,6 +9614,45 @@ and invalidating the cache."
(progn ,@body)))
+(defun verilog-modi-modport-lookup-one (modi name &optional ignore-error)
+ "Given a MODI, return the declarations related to the given modport NAME."
+ ;; Recursive routine - see below
+ (let* ((realname (verilog-symbol-detick name t))
+ (modport (assoc name (verilog-decls-get-modports (verilog-modi-get-decls modi)))))
+ (or modport ignore-error
+ (error (concat (verilog-point-text)
+ ": Can't locate " name " modport definition"
+ (if (not (equal name realname))
+ (concat " (Expanded macro to " realname ")")
+ ""))))
+ (let* ((decls (verilog-modport-decls modport))
+ (clks (verilog-modport-clockings modport)))
+ ;; Now expand any clocking's
+ (while clks
+ (setq decls (verilog-decls-append
+ decls
+ (verilog-modi-modport-lookup-one modi (car clks) ignore-error)))
+ (setq clks (cdr clks)))
+ decls)))
+
+(defun verilog-modi-modport-lookup (modi name-re &optional ignore-error)
+ "Given a MODI, return the declarations related to the given modport NAME-RE.
+If the modport points to any clocking blocks, expand the signals to include
+those clocking block's signals."
+ ;; Recursive routine - see below
+ (let* ((mod-decls (verilog-modi-get-decls modi))
+ (clks (verilog-decls-get-modports mod-decls))
+ (name-re (concat "^" name-re "$"))
+ (decls (verilog-decls-new nil nil nil nil nil nil nil nil nil)))
+ ;; Pull in all modports
+ (while clks
+ (when (string-match name-re (verilog-modport-name (car clks)))
+ (setq decls (verilog-decls-append
+ decls
+ (verilog-modi-modport-lookup-one modi (verilog-modport-name (car clks)) ignore-error))))
+ (setq clks (cdr clks)))
+ decls))
+
(defun verilog-signals-matching-enum (in-list enum)
"Return all signals in IN-LIST matching the given ENUM."
(let (out-list)
@@ -9544,6 +9732,13 @@ if non-nil."
(verilog-decls-get-inouts decls)
(verilog-decls-get-inputs decls)))
+(defun verilog-decls-get-iovars (decls)
+ (append
+ (verilog-decls-get-vars decls)
+ (verilog-decls-get-outputs decls)
+ (verilog-decls-get-inouts decls)
+ (verilog-decls-get-inputs decls)))
+
(defsubst verilog-modi-cache-add-outputs (modi sig-list)
(verilog-modi-cache-add modi 'verilog-read-decls 0 sig-list))
(defsubst verilog-modi-cache-add-inouts (modi sig-list)
@@ -9552,6 +9747,8 @@ if non-nil."
(verilog-modi-cache-add modi 'verilog-read-decls 2 sig-list))
(defsubst verilog-modi-cache-add-vars (modi sig-list)
(verilog-modi-cache-add modi 'verilog-read-decls 3 sig-list))
+(defsubst verilog-modi-cache-add-gparams (modi sig-list)
+ (verilog-modi-cache-add modi 'verilog-read-decls 7 sig-list))
;;
@@ -9608,6 +9805,8 @@ When MODI is non-null, also add to modi-cache, for tracking."
(when verilog-auto-declare-nettype
(verilog-modi-cache-add-vars modi sigs)))
((equal direction "interface"))
+ ((equal direction "parameter")
+ (verilog-modi-cache-add-gparams modi sigs))
(t
(error "Unsupported verilog-insert-definition direction: %s" direction))))
(or dont-sort
@@ -9654,6 +9853,11 @@ Presumes that any newlines end a list element."
stuff (cdr stuff)))))
;;(let ((indent-pt 10)) (verilog-insert-indent "hello\n" "addon" "there\n"))
+(defun verilog-forward-or-insert-line ()
+ "Move forward a line, unless at EOB, then insert a newline."
+ (if (eobp) (insert "\n")
+ (forward-line)))
+
(defun verilog-repair-open-comma ()
"Insert comma if previous argument is other than an open parenthesis or endif."
;; We can't just search backward for ) as it might be inside another expression.
@@ -9741,6 +9945,17 @@ This repairs those mis-inserted by an AUTOARG."
"\\([])}:*+-]\\)")
out)
(setq out (replace-match "\\1\\2\\3" nil nil out)))
+ (while (string-match
+ (concat "\\([[({:*+-]\\)" ; - must be last
+ "\\$clog2\\s *(\\<\\([0-9]+\\))"
+ "\\([])}:*+-]\\)")
+ out)
+ (setq out (replace-match
+ (concat
+ (match-string 1 out)
+ (int-to-string (verilog-clog2 (string-to-number (match-string 2 out))))
+ (match-string 3 out))
+ nil nil out)))
;; For precedence do * before +/-
(while (string-match
(concat "\\([[({:*+-]\\)"
@@ -9777,6 +9992,7 @@ This repairs those mis-inserted by an AUTOARG."
post)
nil nil out)) )))
out)))
+
;;(verilog-simplify-range-expression "[1:3]") ;; 1
;;(verilog-simplify-range-expression "[(1):3]") ;; 1
;;(verilog-simplify-range-expression "[(((16)+1)+1+(1+1))]") ;;20
@@ -9785,6 +10001,14 @@ This repairs those mis-inserted by an AUTOARG."
;;(verilog-simplify-range-expression "[(FOO*4+1-1)]") ;; FOO*4+0
;;(verilog-simplify-range-expression "[(func(BAR))]") ;; func(BAR)
;;(verilog-simplify-range-expression "[FOO-1+1-1+1]") ;; FOO-0
+;;(verilog-simplify-range-expression "[$clog2(2)]") ;; 1
+;;(verilog-simplify-range-expression "[$clog2(7)]") ;; 3
+
+(defun verilog-clog2 (value)
+ "Compute $clog2 - ceiling log2 of VALUE."
+ (if (< value 1)
+ 0
+ (ceiling (/ (log value) (log 2)))))
(defun verilog-typedef-name-p (variable-name)
"Return true if the VARIABLE-NAME is a type definition."
@@ -10348,6 +10572,86 @@ Avoid declaring ports manually, as it makes code harder to maintain."
(insert "\n"))
(indent-to verilog-indent-level-declaration))))
+(defun verilog-auto-assign-modport ()
+ "Expand AUTOASSIGNMODPORT statements, as part of \\[verilog-auto].
+Take input/output/inout statements from the specified interface
+and modport and use to build assignments into the modport, for
+making verification modules that connect to UVM interfaces.
+
+ The first parameter is the name of an interface.
+
+ The second parameter is a regexp of modports to read from in
+ that interface.
+
+ The third parameter is the instance name to use to dot reference into.
+
+ The optional fourth parameter is a regular expression, and only
+ signals matching the regular expression will be included.
+
+Limitations:
+
+ Interface names must be resolvable to filenames. See `verilog-auto-inst'.
+
+ Inouts are not supported, as assignments must be unidirectional.
+
+ If a signal is part of the interface header and in both a
+ modport and the interface itself, it will not be listed. (As
+ this would result in a syntax error when the connections are
+ made.)
+
+See the example in `verilog-auto-inout-modport'."
+ (save-excursion
+ (let* ((params (verilog-read-auto-params 3 4))
+ (submod (nth 0 params))
+ (modport-re (nth 1 params))
+ (inst-name (nth 2 params))
+ (regexp (nth 3 params))
+ direction-re submodi) ;; direction argument not supported until requested
+ ;; Lookup position, etc of co-module
+ ;; Note this may raise an error
+ (when (setq submodi (verilog-modi-lookup submod t))
+ (let* ((indent-pt (current-indentation))
+ (modi (verilog-modi-current))
+ (submoddecls (verilog-modi-get-decls submodi))
+ (submodportdecls (verilog-modi-modport-lookup submodi modport-re))
+ (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (verilog-decls-get-vars submoddecls)
+ (verilog-signals-not-in
+ (verilog-decls-get-inputs submodportdecls)
+ (verilog-decls-get-ports submoddecls))))
+ (sig-list-o (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (verilog-decls-get-vars submoddecls)
+ (verilog-signals-not-in
+ (verilog-decls-get-outputs submodportdecls)
+ (verilog-decls-get-ports submoddecls)))))
+ (forward-line 1)
+ (setq sig-list-i (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-i regexp)
+ "input" direction-re))
+ sig-list-o (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-o regexp)
+ "output" direction-re)))
+ (setq sig-list-i (sort (copy-alist sig-list-i) `verilog-signals-sort-compare))
+ (setq sig-list-o (sort (copy-alist sig-list-o) `verilog-signals-sort-compare))
+ (when (or sig-list-i sig-list-o)
+ (verilog-insert-indent "// Beginning of automatic assignments from modport\n")
+ ;; Don't sort them so an upper AUTOINST will match the main module
+ (let ((sigs sig-list-o))
+ (while sigs
+ (verilog-insert-indent "assign " (verilog-sig-name (car sigs))
+ " = " inst-name
+ "." (verilog-sig-name (car sigs)) ";\n")
+ (setq sigs (cdr sigs))))
+ (let ((sigs sig-list-i))
+ (while sigs
+ (verilog-insert-indent "assign " inst-name
+ "." (verilog-sig-name (car sigs))
+ " = " (verilog-sig-name (car sigs)) ";\n")
+ (setq sigs (cdr sigs))))
+ (verilog-insert-indent "// End of automatics\n")))))))
+
(defun verilog-auto-inst-port-map (port-st)
nil)
@@ -11067,8 +11371,8 @@ Typing \\[verilog-auto] will make this into:
(verilog-subdecls-get-interfaced modsubdecls)
(verilog-subdecls-get-outputs modsubdecls)
(verilog-subdecls-get-inouts modsubdecls)))))
- (forward-line 1)
(when sig-list
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n")
(verilog-insert-definition modi sig-list "reg" indent-pt nil)
(verilog-insert-indent "// End of automatics\n")))))
@@ -11122,8 +11426,8 @@ Typing \\[verilog-auto] will make this into:
(verilog-subdecls-get-inouts modsubdecls))
(append (verilog-decls-get-signals moddecls)
(verilog-decls-get-assigns moddecls))))))
- (forward-line 1)
(when sig-list
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n")
(verilog-insert-definition modi sig-list "reg" indent-pt nil)
(verilog-insert-indent "// End of automatics\n")))))
@@ -11210,8 +11514,8 @@ Typing \\[verilog-auto] will make this into:
(append (verilog-subdecls-get-outputs modsubdecls)
(verilog-subdecls-get-inouts modsubdecls))
(verilog-decls-get-signals moddecls)))))
- (forward-line 1)
(when sig-list
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n")
(verilog-insert-definition modi sig-list "wire" indent-pt nil)
(verilog-insert-indent "// End of automatics\n")
@@ -11221,7 +11525,7 @@ Typing \\[verilog-auto] will make this into:
;; syntax-ppss which is broken when change hooks are disabled.
))))
-(defun verilog-auto-output (&optional with-params)
+(defun verilog-auto-output ()
"Expand AUTOOUTPUT statements, as part of \\[verilog-auto].
Make output statements for any output signal from an /*AUTOINST*/ that
isn't an input to another AUTOINST. This is useful for modules which
@@ -11273,8 +11577,8 @@ same expansion will result from only extracting outputs starting with ov:
(save-excursion
;; Point must be at insertion point.
(let* ((indent-pt (current-indentation))
- (regexp (and with-params
- (nth 0 (verilog-read-auto-params 1))))
+ (params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
(v2k (verilog-in-paren-quick))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
@@ -11290,7 +11594,7 @@ same expansion will result from only extracting outputs starting with ov:
sig-list regexp)))
(setq sig-list (verilog-signals-not-matching-regexp
sig-list verilog-auto-output-ignore-regexp))
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(when v2k (verilog-repair-open-comma))
(when sig-list
(verilog-insert-indent "// Beginning of automatic outputs (from unused autoinst outputs)\n")
@@ -11340,7 +11644,7 @@ Typing \\[verilog-auto] will make this into:
(verilog-signals-not-in
(verilog-decls-get-signals moddecls)
(verilog-decls-get-ports moddecls)))))
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(when v2k (verilog-repair-open-comma))
(when sig-list
(verilog-insert-indent "// Beginning of automatic outputs (every signal)\n")
@@ -11348,7 +11652,7 @@ Typing \\[verilog-auto] will make this into:
(verilog-insert-indent "// End of automatics\n"))
(when v2k (verilog-repair-close-comma)))))
-(defun verilog-auto-input (&optional with-params)
+(defun verilog-auto-input ()
"Expand AUTOINPUT statements, as part of \\[verilog-auto].
Make input statements for any input signal into an /*AUTOINST*/ that
isn't declared elsewhere inside the module. This is useful for modules which
@@ -11399,8 +11703,8 @@ same expansion will result from only extracting inputs starting with i:
/*AUTOINPUT(\"^i\")*/"
(save-excursion
(let* ((indent-pt (current-indentation))
- (regexp (and with-params
- (nth 0 (verilog-read-auto-params 1))))
+ (params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
(v2k (verilog-in-paren-quick))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
@@ -11420,7 +11724,7 @@ same expansion will result from only extracting inputs starting with i:
sig-list regexp)))
(setq sig-list (verilog-signals-not-matching-regexp
sig-list verilog-auto-input-ignore-regexp))
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(when v2k (verilog-repair-open-comma))
(when sig-list
(verilog-insert-indent "// Beginning of automatic inputs (from unused autoinst inputs)\n")
@@ -11428,7 +11732,7 @@ same expansion will result from only extracting inputs starting with i:
(verilog-insert-indent "// End of automatics\n"))
(when v2k (verilog-repair-close-comma)))))
-(defun verilog-auto-inout (&optional with-params)
+(defun verilog-auto-inout ()
"Expand AUTOINOUT statements, as part of \\[verilog-auto].
Make inout statements for any inout signal in an /*AUTOINST*/ that
isn't declared elsewhere inside the module.
@@ -11479,8 +11783,8 @@ same expansion will result from only extracting inouts starting with i:
(save-excursion
;; Point must be at insertion point.
(let* ((indent-pt (current-indentation))
- (regexp (and with-params
- (nth 0 (verilog-read-auto-params 1))))
+ (params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
(v2k (verilog-in-paren-quick))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
@@ -11497,7 +11801,7 @@ same expansion will result from only extracting inouts starting with i:
sig-list regexp)))
(setq sig-list (verilog-signals-not-matching-regexp
sig-list verilog-auto-inout-ignore-regexp))
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(when v2k (verilog-repair-open-comma))
(when sig-list
(verilog-insert-indent "// Beginning of automatic inouts (from unused autoinst inouts)\n")
@@ -11739,6 +12043,225 @@ same expansion will result from only extracting signals starting with i:
/*AUTOINOUTCOMP(\"ExampMain\",\"^i\")*/"
(verilog-auto-inout-module nil t))
+(defun verilog-auto-inout-param ()
+ "Expand AUTOINOUTPARAM statements, as part of \\[verilog-auto].
+Take input/output/inout statements from the specified module and insert
+into the current module. This is useful for making null templates and
+shell modules which need to have identical I/O with another module.
+Any I/O which are already defined in this module will not be redefined.
+For the complement of this function, see `verilog-auto-inout-comp',
+and to make monitors with all inputs, see `verilog-auto-inout-in'.
+
+Limitations:
+ If placed inside the parenthesis of a module declaration, it creates
+ Verilog 2001 style, else uses Verilog 1995 style.
+
+ Concatenation and outputting partial buses is not supported.
+
+ Module names must be resolvable to filenames. See `verilog-auto-inst'.
+
+ Signals are not inserted in the same order as in the original module,
+ though they will appear to be in the same order to an AUTOINST
+ instantiating either module.
+
+ Signals declared as \"output reg\" or \"output wire\" etc will
+ lose the wire/reg declaration so that shell modules may
+ generate those outputs differently. However, \"output logic\"
+ is propagated.
+
+An example:
+
+ module ExampShell (/*AUTOARG*/);
+ /*AUTOINOUTMODULE(\"ExampMain\")*/
+ endmodule
+
+ module ExampMain (i,o,io);
+ input i;
+ output o;
+ inout io;
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ExampShell (/*AUTOARG*/i,o,io);
+ /*AUTOINOUTMODULE(\"ExampMain\")*/
+ // Beginning of automatic in/out/inouts (from specific module)
+ output o;
+ inout io;
+ input i;
+ // End of automatics
+ endmodule
+
+You may also provide an optional regular expression, in which case only
+signals matching the regular expression will be included. For example the
+same expansion will result from only extracting signals starting with i:
+
+ /*AUTOINOUTMODULE(\"ExampMain\",\"^i\")*/
+
+You may also provide an optional second regular expression, in
+which case only signals which have that pin direction and data
+type will be included. This matches against everything before
+the signal name in the declaration, for example against
+\"input\" (single bit), \"output logic\" (direction and type) or
+\"output [1:0]\" (direction and implicit type). You also
+probably want to skip spaces in your regexp.
+
+For example, the below will result in matching the output \"o\"
+against the previous example's module:
+
+ /*AUTOINOUTMODULE(\"ExampMain\",\"\",\"^output.*\")*/
+
+You may also provide an optional third regular expression, in
+which case any parameter names that match the given regexp will
+be included. Including parameters is off by default. To include
+all signals and parameters, use:
+
+ /*AUTOINOUTMODULE(\"ExampMain\",\".*\",\".*\",\".*\")*/"
+ (save-excursion
+ (let* ((params (verilog-read-auto-params 1 2))
+ (submod (nth 0 params))
+ (regexp (nth 1 params))
+ submodi)
+ ;; Lookup position, etc of co-module
+ ;; Note this may raise an error
+ (when (setq submodi (verilog-modi-lookup submod t))
+ (let* ((indent-pt (current-indentation))
+ (v2k (verilog-in-paren-quick))
+ (modi (verilog-modi-current))
+ (moddecls (verilog-modi-get-decls modi))
+ (submoddecls (verilog-modi-get-decls submodi))
+ (sig-list-p (verilog-signals-not-in
+ (verilog-decls-get-gparams submoddecls)
+ (append (verilog-decls-get-gparams moddecls)))))
+ (forward-line 1)
+ (setq sig-list-p (verilog-signals-matching-regexp sig-list-p regexp))
+ (when v2k (verilog-repair-open-comma))
+ (when sig-list-p
+ (verilog-insert-indent "// Beginning of automatic parameters (from specific module)\n")
+ ;; Don't sort them so an upper AUTOINST will match the main module
+ (verilog-insert-definition modi sig-list-p "parameter" indent-pt v2k t)
+ (verilog-insert-indent "// End of automatics\n"))
+ (when v2k (verilog-repair-close-comma)))))))
+
+(defun verilog-auto-inout-modport ()
+ "Expand AUTOINOUTMODPORT statements, as part of \\[verilog-auto].
+Take input/output/inout statements from the specified interface
+and modport and insert into the current module. This is useful
+for making verification modules that connect to UVM interfaces.
+
+ The first parameter is the name of an interface.
+
+ The second parameter is a regexp of modports to read from in
+ that interface.
+
+ The optional third parameter is a regular expression, and only
+ signals matching the regular expression will be included.
+
+Limitations:
+ If placed inside the parenthesis of a module declaration, it creates
+ Verilog 2001 style, else uses Verilog 1995 style.
+
+ Interface names must be resolvable to filenames. See `verilog-auto-inst'.
+
+As with other autos, any inputs/outputs declared in the module
+will suppress the AUTO from redeclaring an input/output by
+the same name.
+
+An example:
+
+ interface ExampIf
+ ( input logic clk );
+ logic req_val;
+ logic [7:0] req_dat;
+ clocking mon_clkblk @(posedge clk);
+ input req_val;
+ input req_dat;
+ endclocking
+ modport mp(clocking mon_clkblk);
+ endinterface
+
+ module ExampMain
+ ( input clk,
+ /*AUTOINOUTMODPORT(\"ExampIf\" \"mp\")*/
+ // Beginning of automatic in/out/inouts (from modport)
+ input [7:0] req_dat,
+ input req_val
+ // End of automatics
+ );
+ /*AUTOASSIGNMODPORT(\"ExampIf\" \"mp\")*/
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ ...
+ module ExampMain
+ ( input clk,
+ /*AUTOINOUTMODPORT(\"ExampIf\" \"mp\")*/
+ // Beginning of automatic in/out/inouts (from modport)
+ input req_dat,
+ input req_val
+ // End of automatics
+ );
+
+If the modport is part of a UVM monitor/driver class, this
+creates a wrapper module that may be used to instantiate the
+driver/monitor using AUTOINST in the testbench."
+ (save-excursion
+ (let* ((params (verilog-read-auto-params 2 3))
+ (submod (nth 0 params))
+ (modport-re (nth 1 params))
+ (regexp (nth 2 params))
+ direction-re submodi) ;; direction argument not supported until requested
+ ;; Lookup position, etc of co-module
+ ;; Note this may raise an error
+ (when (setq submodi (verilog-modi-lookup submod t))
+ (let* ((indent-pt (current-indentation))
+ (v2k (verilog-in-paren-quick))
+ (modi (verilog-modi-current))
+ (moddecls (verilog-modi-get-decls modi))
+ (submoddecls (verilog-modi-get-decls submodi))
+ (submodportdecls (verilog-modi-modport-lookup submodi modport-re))
+ (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (verilog-decls-get-vars submoddecls)
+ (verilog-signals-not-in
+ (verilog-decls-get-inputs submodportdecls)
+ (append (verilog-decls-get-ports submoddecls)
+ (verilog-decls-get-ports moddecls)))))
+ (sig-list-o (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (verilog-decls-get-vars submoddecls)
+ (verilog-signals-not-in
+ (verilog-decls-get-outputs submodportdecls)
+ (append (verilog-decls-get-ports submoddecls)
+ (verilog-decls-get-ports moddecls)))))
+ (sig-list-io (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (verilog-decls-get-vars submoddecls)
+ (verilog-signals-not-in
+ (verilog-decls-get-inouts submodportdecls)
+ (append (verilog-decls-get-ports submoddecls)
+ (verilog-decls-get-ports moddecls))))))
+ (forward-line 1)
+ (setq sig-list-i (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-i regexp)
+ "input" direction-re))
+ sig-list-o (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-o regexp)
+ "output" direction-re))
+ sig-list-io (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-io regexp)
+ "inout" direction-re)))
+ (when v2k (verilog-repair-open-comma))
+ (when (or sig-list-i sig-list-o sig-list-io)
+ (verilog-insert-indent "// Beginning of automatic in/out/inouts (from modport)\n")
+ ;; Don't sort them so an upper AUTOINST will match the main module
+ (verilog-insert-definition modi sig-list-o "output" indent-pt v2k t)
+ (verilog-insert-definition modi sig-list-io "inout" indent-pt v2k t)
+ (verilog-insert-definition modi sig-list-i "input" indent-pt v2k t)
+ (verilog-insert-indent "// End of automatics\n"))
+ (when v2k (verilog-repair-close-comma)))))))
+
(defun verilog-auto-insert-lisp ()
"Expand AUTOINSERTLISP statements, as part of \\[verilog-auto].
The Lisp code provided is called, and the Lisp code calls
@@ -11789,7 +12312,7 @@ text:
(backward-sexp 1) ;; Inside comment
(point))) ;; Beginning paren
(cmd (buffer-substring-no-properties cmd-beg-pt cmd-end-pt)))
- (forward-line 1)
+ (verilog-forward-or-insert-line)
;; Some commands don't move point (like insert-file) so we always
;; add the begin/end comments, then delete it if not needed
(verilog-insert-indent "// Beginning of automatic insert lisp\n")
@@ -12042,6 +12565,7 @@ value's width is generated.
An example of making a stub for another module:
module ExampStub (/*AUTOINST*/);
+ /*AUTOINOUTPARAM(\"Foo\")*/
/*AUTOINOUTMODULE(\"Foo\")*/
/*AUTOTIEOFF*/
// verilator lint_off UNUSED
@@ -12054,6 +12578,7 @@ An example of making a stub for another module:
Typing \\[verilog-auto] will make this into:
module ExampStub (/*AUTOINST*/...);
+ /*AUTOINOUTPARAM(\"Foo\")*/
/*AUTOINOUTMODULE(\"Foo\")*/
// Beginning of autotieoff
output [2:0] foo;
@@ -12084,7 +12609,7 @@ Typing \\[verilog-auto] will make this into:
(setq sig-list (verilog-signals-not-matching-regexp
sig-list verilog-auto-tieoff-ignore-regexp))
(when sig-list
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n")
(setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare))
(verilog-modi-cache-add-vars modi sig-list) ; Before we trash list
@@ -12161,7 +12686,7 @@ defines the regular expression will be undefed."
;; Insert
(setq defs (sort defs 'string<))
(when defs
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic undefs\n")
(while defs
(verilog-insert-indent "`undef " (car defs) "\n")
@@ -12198,6 +12723,7 @@ You can add signals you do not want included in AUTOUNUSED with
An example of making a stub for another module:
module ExampStub (/*AUTOINST*/);
+ /*AUTOINOUTPARAM(\"Examp\")*/
/*AUTOINOUTMODULE(\"Examp\")*/
/*AUTOTIEOFF*/
// verilator lint_off UNUSED
@@ -12236,7 +12762,7 @@ Typing \\[verilog-auto] will make this into:
(setq sig-list (verilog-signals-not-matching-regexp
sig-list verilog-auto-unused-ignore-regexp))
(when sig-list
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic unused inputs\n")
(setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare))
(while sig-list
@@ -12335,10 +12861,7 @@ Typing \\[verilog-auto] will make this into:
;;
(sig-list-consts (append (verilog-decls-get-consts moddecls)
(verilog-decls-get-gparams moddecls)))
- (sig-list-all (append (verilog-decls-get-vars moddecls)
- (verilog-decls-get-outputs moddecls)
- (verilog-decls-get-inouts moddecls)
- (verilog-decls-get-inputs moddecls)))
+ (sig-list-all (verilog-decls-get-iovars moddecls))
;;
(undecode-sig (or (assoc undecode-name sig-list-all)
(error "%s: Signal %s not found in design" (verilog-point-text) undecode-name)))
@@ -12371,7 +12894,7 @@ Typing \\[verilog-auto] will make this into:
elim-regexp)))
tmp-sigs (cdr tmp-sigs))))
;;
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic ASCII enum decoding\n")
(let ((decode-sig-list (list (list ascii-name (format "[%d:0]" (- (* ascii-chars 8) 1))
(concat "Decode of " undecode-name) nil nil))))
@@ -12506,9 +13029,12 @@ Or check if AUTOs have the same expansion
Using \\[describe-function], see also:
`verilog-auto-arg' for AUTOARG module instantiations
`verilog-auto-ascii-enum' for AUTOASCIIENUM enumeration decoding
+ `verilog-auto-assign-modport' for AUTOASSIGNMODPORT assignment to/from modport
`verilog-auto-inout-comp' for AUTOINOUTCOMP copy complemented i/o
`verilog-auto-inout-in' for AUTOINOUTIN inputs for all i/o
+ `verilog-auto-inout-modport' for AUTOINOUTMODPORT i/o from an interface modport
`verilog-auto-inout-module' for AUTOINOUTMODULE copying i/o from elsewhere
+ `verilog-auto-inout-param' for AUTOINOUTPARAM copying params from elsewhere
`verilog-auto-inout' for AUTOINOUT making hierarchy inouts
`verilog-auto-input' for AUTOINPUT making hierarchy inputs
`verilog-auto-insert-lisp' for AUTOINSERTLISP insert code from lisp function
@@ -12598,27 +13124,24 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense)
(verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset)
;; Must be done before autoin/out as creates a reg
- (verilog-auto-re-search-do "/\\*AUTOASCIIENUM([^)]*)\\*/" 'verilog-auto-ascii-enum)
+ (verilog-auto-re-search-do "/\\*AUTOASCIIENUM(.*?)\\*/" 'verilog-auto-ascii-enum)
;;
;; first in/outs from other files
- (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE([^)]*)\\*/" 'verilog-auto-inout-module)
- (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP([^)]*)\\*/" 'verilog-auto-inout-comp)
- (verilog-auto-re-search-do "/\\*AUTOINOUTIN([^)]*)\\*/" 'verilog-auto-inout-in)
+ (verilog-auto-re-search-do "/\\*AUTOINOUTMODPORT(.*?)\\*/" 'verilog-auto-inout-modport)
+ (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE(.*?)\\*/" 'verilog-auto-inout-module)
+ (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP(.*?)\\*/" 'verilog-auto-inout-comp)
+ (verilog-auto-re-search-do "/\\*AUTOINOUTIN(.*?)\\*/" 'verilog-auto-inout-in)
+ (verilog-auto-re-search-do "/\\*AUTOINOUTPARAM(.*?)\\*/" 'verilog-auto-inout-param)
;; next in/outs which need previous sucked inputs first
- (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((\"[^\"]*\")\\)\\*/"
- (lambda () (verilog-auto-output t)))
- (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\*/" 'verilog-auto-output)
- (verilog-auto-re-search-do "/\\*AUTOINPUT\\((\"[^\"]*\")\\)\\*/"
- (lambda () (verilog-auto-input t)))
- (verilog-auto-re-search-do "/\\*AUTOINPUT\\*/" 'verilog-auto-input)
- (verilog-auto-re-search-do "/\\*AUTOINOUT\\((\"[^\"]*\")\\)\\*/"
- (lambda () (verilog-auto-inout t)))
- (verilog-auto-re-search-do "/\\*AUTOINOUT\\*/" 'verilog-auto-inout)
+ (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((.*?)\\)?\\*/" 'verilog-auto-output)
+ (verilog-auto-re-search-do "/\\*AUTOINPUT\\((.*?)\\)?\\*/" 'verilog-auto-input)
+ (verilog-auto-re-search-do "/\\*AUTOINOUT\\((.*?)\\)?\\*/" 'verilog-auto-inout)
;; Then tie off those in/outs
(verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff)
;; These can be anywhere after AUTOINSERTLISP
- (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((\"[^\"]*\")\\)?\\*/" 'verilog-auto-undef)
+ (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((.*?)\\)?\\*/" 'verilog-auto-undef)
;; Wires/regs must be after inputs/outputs
+ (verilog-auto-re-search-do "/\\*AUTOASSIGNMODPORT(.*?)\\*/" 'verilog-auto-assign-modport)
(verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic)
(verilog-auto-re-search-do "/\\*AUTOWIRE\\*/" 'verilog-auto-wire)
(verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg)
@@ -12696,7 +13219,7 @@ Wilson Snyder (wsnyder@wsnyder.org)."
;;
;; Place the templates into Verilog Mode. They may be inserted under any key.
;; C-c C-t will be the default. If you use templates a lot, you
-;; may want to consider moving the binding to another key in your .emacs
+;; may want to consider moving the binding to another key in your init
;; file.
;;
;; Note \C-c and letter are reserved for users
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 0ca3439dd60..6ad7d3b168a 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -483,6 +483,7 @@ with other user Makefiles."
:type '(list (string :tag "Compile entire design")
(string :tag "Clean entire design ")
(string :tag "Create design library"))
+ :version "24.3"
:group 'vhdl-compile)
(defcustom vhdl-makefile-generation-hook nil
@@ -772,6 +773,7 @@ index, the record field or array index is included with the record name in
the sensitivity list (e.g. \"in1(0)\", \"in2.f0\").
Otherwise, only the record name is included (e.g. \"in1\", \"in2\")."
:type 'boolean
+ :version "24.3"
:group 'vhdl-style)
(defgroup vhdl-naming nil
@@ -1849,6 +1851,7 @@ Otherwise, comment lines are indented like the preceding code line.
Indenting comment lines like the following code line gives nicer indentation
when comments precede the code that they refer to."
:type 'boolean
+ :version "24.3"
:group 'vhdl-misc)
(defcustom vhdl-word-completion-case-sensitive nil
@@ -12522,6 +12525,7 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}."
(defun vhdl-line-expand (&optional prefix-arg)
"Hippie-expand current line."
(interactive "P")
+ (require 'hippie-exp)
(let ((case-fold-search t) (case-replace nil)
(hippie-expand-try-functions-list
'(try-expand-line try-expand-line-all-buffers)))
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 02340425dfa..4819149bdf6 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -234,9 +234,7 @@ It creates the Imenu index for the buffer, if necessary."
(error "Error in which-func-update: %S" info))))))
;;;###autoload
-(defun which-func-mode (&optional arg)
- (which-function-mode arg))
-(make-obsolete 'which-func-mode 'which-function-mode "24.1")
+(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1")
(defvar which-func-update-timer nil)
diff --git a/lisp/register.el b/lisp/register.el
index fb35a26a653..7c2d9337fa2 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -382,6 +382,7 @@ START and END are buffer positions indicating what to append."
register (cond ((not reg) text)
((stringp reg) (concat reg separator text))
(t (error "Register does not contain text")))))
+ (setq deactivate-mark t)
(cond (delete-flag
(delete-region start end))
((called-interactively-p 'interactive)
@@ -400,6 +401,7 @@ START and END are buffer positions indicating what to prepend."
register (cond ((not reg) text)
((stringp reg) (concat text separator reg))
(t (error "Register does not contain text")))))
+ (setq deactivate-mark t)
(cond (delete-flag
(delete-region start end))
((called-interactively-p 'interactive)
diff --git a/lisp/repeat.el b/lisp/repeat.el
index e577c461bc5..e38442a434b 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -193,9 +193,9 @@ this function is always whether the value of `this-command' would've been
;;;###autoload
(defun repeat (repeat-arg)
"Repeat most recently executed command.
-With prefix arg, apply new prefix arg to that command; otherwise,
-use the prefix arg that was used before (if any).
-This command is like the `.' command in the vi editor.
+If REPEAT-ARG is non-nil (interactively, with a prefix argument),
+supply a prefix argument to that command. Otherwise, give the
+command the same prefix argument it was given before, if any.
If this command is invoked by a multi-character key sequence, it
can then be repeated by repeating the final character of that
diff --git a/lisp/replace.el b/lisp/replace.el
index 001f7d1a78d..e714015fccf 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -62,6 +62,10 @@ no default value.")
(defvar query-replace-interactive nil
"Non-nil means `query-replace' uses the last search string.
That becomes the \"string to replace\".")
+(make-obsolete-variable 'query-replace-interactive
+ "use `M-n' to pull the last incremental search string
+to the minibuffer that reads the string to replace, or invoke replacements
+from Isearch by using a key sequence like `C-s C-s M-%'." "24.3")
(defcustom query-replace-from-history-variable 'query-replace-history
"History list to use for the FROM argument of `query-replace' commands.
@@ -128,20 +132,22 @@ wants to replace FROM with TO."
(if query-replace-interactive
(car (if regexp-flag regexp-search-ring search-ring))
(let* ((history-add-new-input nil)
+ (prompt
+ (if query-replace-defaults
+ (format "%s (default %s -> %s): " prompt
+ (query-replace-descr (car query-replace-defaults))
+ (query-replace-descr (cdr query-replace-defaults)))
+ (format "%s: " prompt)))
(from
;; The save-excursion here is in case the user marks and copies
;; a region in order to specify the minibuffer input.
;; That should not clobber the region for the query-replace itself.
(save-excursion
- (read-from-minibuffer
- (if query-replace-defaults
- (format "%s (default %s -> %s): " prompt
- (query-replace-descr (car query-replace-defaults))
- (query-replace-descr (cdr query-replace-defaults)))
- (format "%s: " prompt))
- nil nil nil
- query-replace-from-history-variable
- nil t))))
+ (if regexp-flag
+ (read-regexp prompt nil query-replace-from-history-variable)
+ (read-from-minibuffer
+ prompt nil nil nil query-replace-from-history-variable
+ (car (if regexp-flag regexp-search-ring search-ring)) t)))))
(if (and (zerop (length from)) query-replace-defaults)
(cons (car query-replace-defaults)
(query-replace-compile-replacement
@@ -230,9 +236,11 @@ what to do with it. For directions, type \\[help-command] at that time.
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
-If `query-replace-interactive' is non-nil, the last incremental search
-string is used as FROM-STRING--you don't have to specify it with the
-minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search string to the minibuffer
+that reads FROM-STRING, or invoke replacements from
+incremental search with a key sequence like `C-s C-s M-%'
+to use its current search string as the string to replace.
Matching is independent of case if `case-fold-search' is non-nil and
FROM-STRING has no uppercase letters. Replacement transfers the case
@@ -278,9 +286,11 @@ what to do with it. For directions, type \\[help-command] at that time.
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the
-minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search regexp to the minibuffer
+that reads REGEXP, or invoke replacements from
+incremental search with a key sequence like `C-M-s C-M-s C-M-%'
+to use its current search regexp as the regexp to replace.
Matching is independent of case if `case-fold-search' is non-nil and
REGEXP has no uppercase letters. Replacement transfers the case
@@ -363,9 +373,9 @@ In interactive use, `\\#' in itself stands for `replace-count'.
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the
-minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search regexp to the minibuffer
+that reads REGEXP.
Preserves case in each replacement if `case-replace' and `case-fold-search'
are non-nil and REGEXP has no uppercase letters.
@@ -377,35 +387,33 @@ regexp in `search-whitespace-regexp'.
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches that are surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on."
+ (declare (obsolete "use the `\\,' feature of `query-replace-regexp'
+for interactive calls, and `search-forward-regexp'/`replace-match'
+for Lisp calls." "22.1"))
(interactive
(progn
- (barf-if-buffer-read-only)
- (let* ((from
- ;; Let-bind the history var to disable the "foo -> bar" default.
- ;; Maybe we shouldn't disable this default, but for now I'll
- ;; leave it off. --Stef
- (let ((query-replace-to-history-variable nil))
- (query-replace-read-from "Query replace regexp" t)))
- (to (list (read-from-minibuffer
- (format "Query replace regexp %s with eval: "
- (query-replace-descr from))
- nil nil t query-replace-to-history-variable from t))))
- ;; We make TO a list because replace-match-string-symbols requires one,
- ;; and the user might enter a single token.
- (replace-match-string-symbols to)
- (list from (car to) current-prefix-arg
- (if (and transient-mark-mode mark-active)
- (region-beginning))
- (if (and transient-mark-mode mark-active)
- (region-end))))))
+ (barf-if-buffer-read-only)
+ (let* ((from
+ ;; Let-bind the history var to disable the "foo -> bar"
+ ;; default. Maybe we shouldn't disable this default, but
+ ;; for now I'll leave it off. --Stef
+ (let ((query-replace-to-history-variable nil))
+ (query-replace-read-from "Query replace regexp" t)))
+ (to (list (read-from-minibuffer
+ (format "Query replace regexp %s with eval: "
+ (query-replace-descr from))
+ nil nil t query-replace-to-history-variable from t))))
+ ;; We make TO a list because replace-match-string-symbols requires one,
+ ;; and the user might enter a single token.
+ (replace-match-string-symbols to)
+ (list from (car to) current-prefix-arg
+ (if (and transient-mark-mode mark-active)
+ (region-beginning))
+ (if (and transient-mark-mode mark-active)
+ (region-end))))))
(perform-replace regexp (cons 'replace-eval-replacement to-expr)
t 'literal delimited nil nil start end))
-(make-obsolete 'query-replace-regexp-eval
- "for interactive use, use the special `\\,' feature of
-`query-replace-regexp' instead. Non-interactively, a loop
-using `search-forward-regexp' and `replace-match' is preferred." "22.1")
-
(defun map-query-replace-regexp (regexp to-strings &optional n start end)
"Replace some matches for REGEXP with various strings, in rotation.
The second argument TO-STRINGS contains the replacement strings, separated
@@ -418,19 +426,16 @@ of the region. Otherwise, operate from point to the end of the buffer.
Non-interactively, TO-STRINGS may be a list of replacement strings.
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search regexp to the minibuffer
+that reads REGEXP.
A prefix argument N says to use each replacement string N times
before rotating to the next.
Fourth and fifth arg START and END specify the region to operate on."
(interactive
- (let* ((from (if query-replace-interactive
- (car regexp-search-ring)
- (read-from-minibuffer "Map query replace (regexp): "
- nil nil nil
- query-replace-from-history-variable
- nil t)))
+ (let* ((from (read-regexp "Map query replace (regexp): " nil
+ query-replace-from-history-variable))
(to (read-from-minibuffer
(format "Query replace %s with (space-separated strings): "
(query-replace-descr from))
@@ -476,9 +481,9 @@ Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on.
-If `query-replace-interactive' is non-nil, the last incremental search
-string is used as FROM-STRING--you don't have to specify it with the
-minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search string to the minibuffer
+that reads FROM-STRING.
This function is usually the wrong thing to use in a Lisp program.
What you probably want is a loop like this:
@@ -541,8 +546,9 @@ When using those Lisp features interactively in the replacement
text, TO-STRING is actually made a list instead of a string.
Use \\[repeat-complex-command] after this command for details.
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search regexp to the minibuffer
+that reads REGEXP.
This function is usually the wrong thing to use in a Lisp program.
What you probably want is a loop like this:
@@ -574,38 +580,47 @@ of `history-length', which see.")
(defvar occur-collect-regexp-history '("\\1")
"History of regexp for occur's collect operation")
-(defun read-regexp (prompt &optional default-value)
- "Read regexp as a string using the regexp history and some useful defaults.
-Prompt for a regular expression with PROMPT (without a colon and
-space) in the minibuffer. The optional argument DEFAULT-VALUE
-provides the value to display in the minibuffer prompt that is
-returned if the user just types RET.
-Values available via M-n are the string at point, the last isearch
-regexp, the last isearch string, and the last replacement regexp."
- (let* ((defaults
- (list (regexp-quote
- (or (funcall (or find-tag-default-function
- (get major-mode 'find-tag-default-function)
- 'find-tag-default))
- ""))
- (car regexp-search-ring)
- (regexp-quote (or (car search-ring) ""))
- (car (symbol-value
- query-replace-from-history-variable))))
+(defun read-regexp (prompt &optional defaults history)
+ "Read and return a regular expression as a string.
+When PROMPT doesn't end with a colon and space, it adds a final \": \".
+If DEFAULTS is non-nil, it displays the first default in the prompt.
+
+Non-nil optional arg DEFAULTS is a string or a list of strings that
+are prepended to a list of standard default values, which include the
+string at point, the last isearch regexp, the last isearch string, and
+the last replacement regexp.
+
+Non-nil HISTORY is a symbol to use for the history list.
+If HISTORY is nil, `regexp-history' is used."
+ (let* ((default (if (consp defaults) (car defaults) defaults))
+ (defaults
+ (append
+ (if (listp defaults) defaults (list defaults))
+ (list (regexp-quote
+ (or (funcall (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default))
+ ""))
+ (car regexp-search-ring)
+ (regexp-quote (or (car search-ring) ""))
+ (car (symbol-value
+ query-replace-from-history-variable)))))
(defaults (delete-dups (delq nil (delete "" defaults))))
- ;; Don't add automatically the car of defaults for empty input
+ ;; Do not automatically add default to the history for empty input.
(history-add-new-input nil)
- (input
- (read-from-minibuffer
- (if default-value
- (format "%s (default %s): " prompt
- (query-replace-descr default-value))
- (format "%s: " prompt))
- nil nil nil 'regexp-history defaults t)))
+ (input (read-from-minibuffer
+ (cond ((string-match-p ":[ \t]*\\'" prompt)
+ prompt)
+ (default
+ (format "%s (default %s): " prompt
+ (query-replace-descr default)))
+ (t
+ (format "%s: " prompt)))
+ nil nil nil (or history 'regexp-history) defaults t)))
(if (equal input "")
- (or default-value input)
+ (or default input)
(prog1 input
- (add-to-history 'regexp-history input)))))
+ (add-to-history (or history 'regexp-history) input)))))
(defalias 'delete-non-matching-lines 'keep-lines)
@@ -1130,9 +1145,9 @@ which means to discard all text properties."
"\\&"
;; Get the regexp for collection pattern.
(let ((default (car occur-collect-regexp-history)))
- (read-string
+ (read-regexp
(format "Regexp to collect (default %s): " default)
- nil 'occur-collect-regexp-history default)))
+ default 'occur-collect-regexp-history)))
;; Otherwise normal occur takes numerical prefix argument.
(when current-prefix-arg
(prefix-numeric-value current-prefix-arg))))))
@@ -1219,14 +1234,10 @@ See also `multi-occur'."
(cons
(let* ((default (car regexp-history))
(input
- (read-from-minibuffer
+ (read-regexp
(if current-prefix-arg
"List lines in buffers whose names match regexp: "
- "List lines in buffers whose filenames match regexp: ")
- nil
- nil
- nil
- 'regexp-history)))
+ "List lines in buffers whose filenames match regexp: "))))
(if (equal input "")
default
input))
diff --git a/lisp/savehist.el b/lisp/savehist.el
index 215314d7053..cca958ff0a1 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -209,6 +209,7 @@ histories, which is probably undesirable."
If `savehist-file' is in the old format that doesn't record
the value of `savehist-minibuffer-history-variables', that
value is deducted from the contents of the file."
+ (declare (obsolete savehist-mode "22.1"))
(savehist-mode 1)
;; Old versions of savehist distributed with XEmacs didn't save
;; savehist-minibuffer-history-variables. If that variable is nil
@@ -225,7 +226,6 @@ value is deducted from the contents of the file."
;; Collect VAR, i.e. (nth form 1).
(push (nth 1 form) vars))
vars)))))
-(make-obsolete 'savehist-load 'savehist-mode "22.1")
(defun savehist-install ()
"Hook savehist into Emacs.
diff --git a/lisp/server.el b/lisp/server.el
index 32cecd508b5..7a356a90378 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -101,7 +101,12 @@
(defcustom server-host nil
"The name or IP address to use as host address of the server process.
-If set, the server accepts remote connections; otherwise it is local."
+If set, the server accepts remote connections; otherwise it is local.
+
+DO NOT give this a non-nil value unless you know what you are
+doing! On unsecured networks, accepting remote connections is
+very dangerous, because server-client communication (including
+session authentication) is not encrypted."
:group 'server
:type '(choice
(string :tag "Name or IP address")
@@ -140,12 +145,12 @@ directory residing in a NTFS partition instead."
(defcustom server-auth-key nil
"Server authentication key.
+This is only used if `server-use-tcp' is non-nil.
Normally, the authentication key is randomly generated when the
-server starts, which guarantees some level of security. It is
-recommended to leave it that way. Using a long-lived shared key
-will decrease security (especially since the key is transmitted as
-plain text).
+server starts. It is recommended to leave it that way. Using a
+long-lived shared key will decrease security (especially since
+the key is transmitted as plain-text).
In some situations however, it can be difficult to share randomly
generated passwords with remote hosts (eg. no shared directory),
@@ -153,11 +158,13 @@ so you can set the key with this variable and then copy the
server file to the remote host (with possible changes to IP
address and/or port if that applies).
-The key must consist of 64 ASCII printable characters except for
-space (this means characters from ! to ~; or from code 33 to 126).
+Note that the usual security risks of using the server over
+remote TCP, arising from the fact that client-server
+communications are unencrypted, still apply.
-You can use \\[server-generate-key] to get a random authentication
-key."
+The key must consist of 64 ASCII printable characters except for
+space (this means characters from ! to ~; or from code 33 to
+126). You can use \\[server-generate-key] to get a random key."
:group 'server
:type '(choice
(const :tag "Random" nil)
diff --git a/lisp/simple.el b/lisp/simple.el
index 6e37700b912..aed945d6e13 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -606,7 +606,7 @@ buffer if the variable `delete-trailing-lines' is non-nil."
(when (and (not end)
delete-trailing-lines
;; Really the end of buffer.
- (save-restriction (widen) (eobp))
+ (= (point-max) (1+ (buffer-size)))
(<= (skip-chars-backward "\n") -2))
(delete-region (1+ (point)) end-marker))
(set-marker end-marker nil))))
@@ -1855,9 +1855,13 @@ as an argument limits undo to changes within the current region."
;; another undo command will find the undo history empty
;; and will get another error. To begin undoing the undos,
;; you must type some other command.
- (let ((modified (buffer-modified-p))
- (recent-save (recent-auto-save-p))
- message)
+ (let* ((modified (buffer-modified-p))
+ ;; For an indirect buffer, look in the base buffer for the
+ ;; auto-save data.
+ (base-buffer (or (buffer-base-buffer) (current-buffer)))
+ (recent-save (with-current-buffer base-buffer
+ (recent-auto-save-p)))
+ message)
;; If we get an error in undo-start,
;; the next command should not be a "consecutive undo".
;; So set `this-command' to something other than `undo'.
@@ -1935,7 +1939,8 @@ as an argument limits undo to changes within the current region."
;; Record what the current undo list says,
;; so the next command can tell if the buffer was modified in between.
(and modified (not (buffer-modified-p))
- (delete-auto-save-file-if-necessary recent-save))
+ (with-current-buffer base-buffer
+ (delete-auto-save-file-if-necessary recent-save)))
;; Display a message announcing success.
(if message
(message "%s" message))))
@@ -2599,8 +2604,6 @@ is encoded using coding-system specified by `process-coding-system-alist',
falling back to `default-process-coding-system' if no match for COMMAND
is found in `process-coding-system-alist'.
-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'.
@@ -2608,34 +2611,34 @@ 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.
+`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
+appears at the end of the output. If there is no output, or if
+output is inserted in the current buffer, the buffer `*Shell
+Command Output*' is deleted.
+
+Optional fourth arg OUTPUT-BUFFER specifies where to put the
+command's output. If the value is a buffer or buffer name, put
+the output there. Any other value, including nil, means to
+insert the output in the current buffer. In either case, the
+output is inserted after point (leaving mark after it).
+
+Optional fifth arg REPLACE, if non-nil, means to 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."
+Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer
+or buffer name to which to direct the command's standard error
+output. If nil, error output is mingled with regular output.
+When called interactively, `shell-command-default-error-buffer'
+is used for ERROR-BUFFER.
+
+Optional seventh arg DISPLAY-ERROR-BUFFER, if non-nil, means to
+display the error buffer if there were any errors. When called
+interactively, this is t."
(interactive (let (string)
(unless (mark)
(error "The mark is not set now, so there is no region"))
@@ -6377,9 +6380,8 @@ With prefix argument N, move N items (negative N means move backward)."
(point))))
(defun choose-completion-delete-max-match (string)
+ (declare (obsolete choose-completion-guess-base-position "23.2"))
(delete-region (choose-completion-guess-base-position string) (point)))
-(make-obsolete 'choose-completion-delete-max-match
- 'choose-completion-guess-base-position "23.2")
(defvar choose-completion-string-functions nil
"Functions that may override the normal insertion of a completion choice.
@@ -6968,7 +6970,7 @@ positive, otherwise make it writable. If buffer is read-only
and `view-read-only' is non-nil, enter view mode.
Do not call this from a Lisp program unless you really intend to
-do the same thing as the \\[toggle-read-only] command, including
+do the same thing as the \\[read-only-mode] command, including
possibly enabling or disabling View mode. Also, note that this
command works by setting the variable `buffer-read-only', which
does not affect read-only regions caused by text properties. To
diff --git a/lisp/startup.el b/lisp/startup.el
index a0122c74555..bd75abe5b35 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -43,7 +43,10 @@
If the value is nil and `inhibit-startup-screen' is nil, show the
startup screen. If the value is a string, visit the specified file
or directory using `find-file'. If t, open the `*scratch*'
-buffer."
+buffer.
+
+A string value also causes emacsclient to open the specified file
+or directory when no target file is specified."
:type '(choice
(const :tag "Startup screen" nil)
(directory :tag "Directory" :value "~/")
@@ -216,8 +219,8 @@ and VALUE is the value which is given to that frame parameter
("-fn" 1 x-handle-switch font)
("-font" 1 x-handle-switch font)
("-ib" 1 x-handle-numeric-switch internal-border-width)
- ;;("-g" . x-handle-geometry)
- ;;("-geometry" . x-handle-geometry)
+ ("-g" 1 x-handle-geometry)
+ ("-geometry" 1 x-handle-geometry)
("-fg" 1 x-handle-switch foreground-color)
("-foreground" 1 x-handle-switch foreground-color)
("-bg" 1 x-handle-switch background-color)
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 62a8528f25d..9a3a7608d2b 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -212,13 +212,14 @@ static char * stroke_xpm[] = {
:link '(emacs-commentary-link "strokes")
:group 'mouse)
+(define-obsolete-variable-alias 'strokes-modeline-string 'strokes-lighter
+ "24.3")
+
(defcustom strokes-lighter " Strokes"
"Mode line identifier for Strokes mode."
:type 'string
:group 'strokes)
-(define-obsolete-variable-alias 'strokes-modeline-string 'strokes-lighter "24.3")
-
(defcustom strokes-character ?@
"Character used when drawing strokes in the strokes buffer.
\(The default is `@', which works well.\)"
diff --git a/lisp/subr.el b/lisp/subr.el
index e9b85ff1f38..ec2d16e6529 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -271,16 +271,23 @@ the return value (nil if RESULT is omitted).
,@(cdr (cdr spec))))))
(defmacro declare (&rest _specs)
- "Do not evaluate any arguments and return nil.
-Treated as a declaration when used at the right place in a
-`defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)"
+ "Do not evaluate any arguments, and return nil.
+If a `declare' form appears as the first form in the body of a
+`defun' or `defmacro' form, SPECS specifies various additional
+information about the function or macro; these go into effect
+during the evaluation of the `defun' or `defmacro' form.
+
+The possible values of SPECS are specified by
+`defun-declarations-alist' and `macro-declarations-alist'."
;; FIXME: edebug spec should pay attention to defun-declarations-alist.
nil)
))
(defmacro ignore-errors (&rest body)
"Execute BODY; if an error occurs, return nil.
-Otherwise, return result of last form in BODY."
+Otherwise, return result of last form in BODY.
+See also `with-demoted-errors' that does something similar
+without silencing all errors."
(declare (debug t) (indent 0))
`(condition-case nil (progn ,@body) (error nil)))
@@ -459,18 +466,18 @@ If TEST is omitted or nil, `equal' is used."
(setq tail (cdr tail)))
value))
-(make-obsolete 'assoc-ignore-case 'assoc-string "22.1")
(defun assoc-ignore-case (key alist)
"Like `assoc', but ignores differences in case and text representation.
KEY must be a string. Upper-case and lower-case letters are treated as equal.
Unibyte strings are converted to multibyte for comparison."
+ (declare (obsolete assoc-string "22.1"))
(assoc-string key alist t))
-(make-obsolete 'assoc-ignore-representation 'assoc-string "22.1")
(defun assoc-ignore-representation (key alist)
"Like `assoc', but ignores differences in text representation.
KEY must be a string.
Unibyte strings are converted to multibyte for comparison."
+ (declare (obsolete assoc-string "22.1"))
(assoc-string key alist nil))
(defun member-ignore-case (elt list)
@@ -1177,12 +1184,13 @@ be a list of the form returned by `event-start' and `event-end'."
"Mocklisp-compatibility insert function.
Like the function `insert' except that any argument that is a number
is converted into a string by expressing it in decimal."
+ (declare (obsolete insert "22.1"))
(dolist (el args)
(insert (if (integerp el) (number-to-string el) el))))
-(make-obsolete 'insert-string 'insert "22.1")
-(defun makehash (&optional test) (make-hash-table :test (or test 'eql)))
-(make-obsolete 'makehash 'make-hash-table "22.1")
+(defun makehash (&optional test)
+ (declare (obsolete make-hash-table "22.1"))
+ (make-hash-table :test (or test 'eql)))
;; These are used by VM and some old programs
(defalias 'focus-frame 'ignore "")
@@ -1248,11 +1256,6 @@ is converted into a string by expressing it in decimal."
(make-obsolete 'process-filter-multibyte-p nil "23.1")
(make-obsolete 'set-process-filter-multibyte nil "23.1")
-(make-obsolete-variable
- 'mode-line-inverse-video
- "use the appropriate faces instead."
- "21.1")
-
;; Lisp manual only updated in 22.1.
(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
"before 19.34")
@@ -1909,8 +1912,8 @@ This function is called directly from the C code."
"Read the following input sexp, and run it whenever FILE is loaded.
This makes or adds to an entry on `after-load-alist'.
FILE should be the name of a library, with no directory name."
+ (declare (obsolete eval-after-load "23.2"))
(eval-after-load file (read)))
-(make-obsolete 'eval-next-after-load `eval-after-load "23.2")
(defun display-delayed-warnings ()
"Display delayed warnings from `delayed-warnings-list'.
@@ -2140,6 +2143,15 @@ any other non-digit terminates the character code and is then used as input."))
(setq first nil))
code))
+(defvar read-passwd-map
+ ;; BEWARE: `defconst' would purecopy it, breaking the sharing with
+ ;; minibuffer-local-map along the way!
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570
+ map)
+ "Keymap used while reading passwords.")
+
(defun read-passwd (prompt &optional confirm default)
"Read a password, prompting with PROMPT, and return it.
If optional CONFIRM is non-nil, read the password twice to make sure.
@@ -2176,7 +2188,10 @@ by doing (clear-string STRING)."
(lambda ()
(setq minibuf (current-buffer))
;; Turn off electricity.
- (set (make-local-variable 'post-self-insert-hook) nil)
+ (setq-local post-self-insert-hook nil)
+ (setq-local buffer-undo-list t)
+ (setq-local select-active-regions nil)
+ (use-local-map read-passwd-map)
(add-hook 'after-change-functions hide-chars-fun nil 'local))
(unwind-protect
(let ((enable-recursive-minibuffers t))
@@ -3136,6 +3151,45 @@ in which case `save-window-excursion' cannot help."
(unwind-protect (progn ,@body)
(set-window-configuration ,c)))))
+(defun temp-output-buffer-show (buffer)
+ "Internal function for `with-output-to-temp-buffer'."
+ (with-current-buffer buffer
+ (set-buffer-modified-p nil)
+ (goto-char (point-min)))
+
+ (if temp-buffer-show-function
+ (funcall temp-buffer-show-function buffer)
+ (with-current-buffer buffer
+ (let* ((window
+ (let ((window-combination-limit
+ ;; When `window-combination-limit' equals
+ ;; `temp-buffer' or `temp-buffer-resize' and
+ ;; `temp-buffer-resize-mode' is enabled in this
+ ;; buffer bind it to t so resizing steals space
+ ;; preferably from the window that was split.
+ (if (or (eq window-combination-limit 'temp-buffer)
+ (and (eq window-combination-limit
+ 'temp-buffer-resize)
+ temp-buffer-resize-mode))
+ t
+ window-combination-limit)))
+ (display-buffer buffer)))
+ (frame (and window (window-frame window))))
+ (when window
+ (unless (eq frame (selected-frame))
+ (make-frame-visible frame))
+ (setq minibuffer-scroll-window window)
+ (set-window-hscroll window 0)
+ ;; Don't try this with NOFORCE non-nil!
+ (set-window-start window (point-min) t)
+ ;; This should not be necessary.
+ (set-window-point window (point-min))
+ ;; Run `temp-buffer-show-hook', with the chosen window selected.
+ (with-selected-window window
+ (run-hooks 'temp-buffer-show-hook))))))
+ ;; Return nil.
+ nil)
+
(defmacro with-output-to-temp-buffer (bufname &rest body)
"Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
@@ -3181,7 +3235,7 @@ if it uses `temp-buffer-show-function'."
(run-hooks 'temp-buffer-setup-hook)))))
(standard-output ,buf))
(prog1 (progn ,@body)
- (internal-temp-output-buffer-show ,buf)))))
+ (temp-output-buffer-show ,buf)))))
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 9cd69d84250..2622a8215b8 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -518,12 +518,13 @@ MODE should be an integer which is a file mode value."
(progress-reporter-done progress-reporter)
(message "Warning: premature EOF parsing tar file"))
(goto-char (point-min))
- (let ((inhibit-read-only t)
+ (let ((buffer-file-truename nil) ; avoid changing dir mtime by lock_file
+ (inhibit-read-only t)
(total-summaries
(mapconcat 'tar-header-block-summarize tar-parse-info "\n")))
- (insert total-summaries "\n"))
- (goto-char (point-min))
- (restore-buffer-modified-p modified)))
+ (insert total-summaries "\n")
+ (goto-char (point-min))
+ (restore-buffer-modified-p modified))))
(defvar tar-mode-map
(let ((map (make-keymap)))
diff --git a/lisp/term.el b/lisp/term.el
index d5f35006357..7567bd38f5a 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -994,7 +994,10 @@ is buffer-local."
(setq term-ansi-current-reverse nil)
(setq term-ansi-current-color 0)
(setq term-ansi-current-invisible nil)
- (setq term-ansi-face-already-done t)
+ ;; Stefan thought this should be t, but could not remember why.
+ ;; Setting it to t seems to cause bug#11785. Setting it to nil
+ ;; again to see if there are other consequences...
+ (setq term-ansi-face-already-done nil)
(setq term-ansi-current-bg-color 0))
(define-derived-mode term-mode fundamental-mode "Term"
@@ -4048,6 +4051,7 @@ Returns `partial' if completed as far as possible with the completion matches.
Returns `listed' if a completion listing was shown.
See also `term-dynamic-complete-filename'."
+ (declare (obsolete completion-in-region "23.2"))
(let* ((completion-ignore-case nil)
(candidates (mapcar (function (lambda (x) (list x))) candidates))
(completions (all-completions stub candidates)))
@@ -4081,8 +4085,6 @@ See also `term-dynamic-complete-filename'."
(t
(message "Partially completed")
'partial)))))))
-(make-obsolete 'term-dynamic-simple-complete 'completion-in-region "23.2")
-
(defun term-dynamic-list-filename-completions ()
"List in help buffer possible completions of the filename at point."
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index b46c31afdeb..e31362b8313 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -448,10 +448,21 @@ Lines are highlighted according to `ns-input-line'."
;; nsterm.m
(declare-function ns-read-file-name "nsfns.m"
- (prompt &optional dir isLoad init))
+ (prompt &optional dir mustmatch init dir_only_p))
;;;; File handling.
+(defun x-file-dialog (prompt dir default_filename mustmatch only_dir_p)
+"Read file name, prompting with PROMPT in directory DIR.
+Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
+selection box, if specified. If MUSTMATCH is non-nil, the returned file
+or directory must exist.
+
+This function is only defined on NS, MS Windows, and X Windows with the
+Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored.
+Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories."
+ (ns-read-file-name prompt dir mustmatch default_filename only_dir_p))
+
(defun ns-open-file-using-panel ()
"Pop up open-file panel, and load the result in a buffer."
(interactive)
@@ -622,8 +633,9 @@ This function has been overloaded in Nextstep.")
`ns-input-fontsize' of new font."
(interactive)
(modify-frame-parameters (selected-frame)
- (list (cons 'font ns-input-font)
- (cons 'fontsize ns-input-fontsize)))
+ (list (cons 'fontsize ns-input-fontsize)))
+ (modify-frame-parameters (selected-frame)
+ (list (cons 'font ns-input-font)))
(set-frame-font ns-input-font))
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 31656918fad..e0d93b68056 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1002,6 +1002,7 @@ See `bibtex-generate-autokey' for details."
("\\\\`\\|\\\\'\\|\\\\\\^\\|\\\\~\\|\\\\=\\|\\\\\\.\\|\\\\u\\|\\\\v\\|\\\\H\\|\\\\t\\|\\\\c\\|\\\\d\\|\\\\b" . "")
;; braces, quotes, concatenation.
("[`'\"{}#]" . "")
+ ("\\\\-" . "") ; \- ->
;; spaces
("\\\\?[ \t\n]+\\|~" . " "))
"Alist of (OLD-REGEXP . NEW-STRING) pairs.
@@ -4893,21 +4894,22 @@ If mark is active reformat entries in region, if not in whole buffer."
(if use-previous-options
bibtex-reformat-previous-options
(setq bibtex-reformat-previous-options
- (mapcar (lambda (option)
- (if (y-or-n-p (car option)) (cdr option)))
- `(("Realign entries (recommended)? " . 'realign)
- ("Remove empty optional and alternative fields? " . 'opts-or-alts)
- ("Remove delimiters around pure numerical fields? " . 'numerical-fields)
- (,(concat (if bibtex-comma-after-last-field "Insert" "Remove")
- " comma at end of entry? ") . 'last-comma)
- ("Replace double page dashes by single ones? " . 'page-dashes)
- ("Delete whitespace at the beginning and end of fields? " . 'whitespace)
- ("Inherit booktitle? " . 'inherit-booktitle)
- ("Force delimiters? " . 'delimiters)
- ("Unify case of entry types and field names? " . 'unify-case)
- ("Enclose parts of field entries by braces? " . 'braces)
- ("Replace parts of field entries by string constants? " . 'strings)
- ("Sort fields? " . 'sort-fields))))))
+ (delq nil
+ (mapcar (lambda (option)
+ (if (y-or-n-p (car option)) (cdr option)))
+ `(("Realign entries (recommended)? " . realign)
+ ("Remove empty optional and alternative fields? " . opts-or-alts)
+ ("Remove delimiters around pure numerical fields? " . numerical-fields)
+ (,(concat (if bibtex-comma-after-last-field "Insert" "Remove")
+ " comma at end of entry? ") . last-comma)
+ ("Replace double page dashes by single ones? " . page-dashes)
+ ("Delete whitespace at the beginning and end of fields? " . whitespace)
+ ("Inherit booktitle? " . inherit-booktitle)
+ ("Force delimiters? " . delimiters)
+ ("Unify case of entry types and field names? " . unify-case)
+ ("Enclose parts of field entries by braces? " . braces)
+ ("Replace parts of field entries by string constants? " . strings)
+ ("Sort fields? " . sort-fields)))))))
;; Do not include required-fields because `bibtex-reformat'
;; cannot handle the error messages of `bibtex-format-entry'.
;; Use `bibtex-validate' to check for required fields.
diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el
index 3a875f0dfa3..72013c5b241 100644
--- a/lisp/textmodes/reftex-auc.el
+++ b/lisp/textmodes/reftex-auc.el
@@ -4,8 +4,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -27,21 +25,21 @@
;;; Code:
(eval-when-compile (require 'cl))
-(provide 'reftex-auc)
+
(require 'reftex)
-;;;
-
-(declare-function TeX-argument-insert "ext:tex" (name optional &optional prefix))
-(declare-function TeX-argument-prompt "ext:tex" (optional prompt default &optional complete))
-(declare-function multi-prompt "ext:multi-prompt"
- (separator
- unique prompt table
- &optional mp-predicate require-match initial history))
-(declare-function LaTeX-add-index-entries "ext:tex" (&rest entries) t)
+
+(declare-function TeX-argument-prompt "ext:tex"
+ (optional prompt default &optional complete))
+(declare-function TeX-argument-insert "ext:tex"
+ (name optional &optional prefix))
(declare-function LaTeX-add-labels "ext:tex" (&rest entries) t)
+(declare-function LaTeX-add-index-entries "ext:tex" (&rest entries) t)
(declare-function LaTeX-bibitem-list "ext:tex" () t)
(declare-function LaTeX-index-entry-list "ext:tex" () t)
(declare-function LaTeX-label-list "ext:tex" () t)
+(declare-function multi-prompt "ext:multi-prompt"
+ (separator unique prompt table &optional
+ mp-predicate require-match initial history))
(defun reftex-plug-flag (which)
;; Tell if a certain flag is set in reftex-plug-into-AUCTeX
@@ -76,14 +74,15 @@ What is being used depends upon `reftex-plug-into-AUCTeX'."
(let (items)
(cond
((and (not definition) (reftex-plug-flag 3))
- (setq items (list (or (reftex-citation t) ""))))
+ (setq items (or (reftex-citation t) (list ""))))
(t
(setq prompt (concat (if optional "(Optional) " "")
(if prompt prompt "Add key")
" (default none): "))
(setq items (multi-prompt "," t prompt (LaTeX-bibitem-list)))))
(apply 'LaTeX-add-bibitems items)
- (TeX-argument-insert (mapconcat 'identity items ",") optional)))
+ (TeX-argument-insert (mapconcat 'identity items reftex-cite-key-separator)
+ optional)))
(defun reftex-arg-index-tag (optional &optional prompt &rest args)
@@ -223,4 +222,6 @@ of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See
(defun reftex-notice-new-section ()
(reftex-notice-new 1 'force))
+(provide 'reftex-auc)
+
;;; reftex-auc.el ends here
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 31001c78e54..52fa6dbf9d2 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -4,8 +4,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -129,9 +127,10 @@
(let* ((re
(if item
- (concat "\\\\bibitem\\(\\[[^]]*\\]\\)?{" (regexp-quote key) "}")
- (concat "@[a-zA-Z]+[ \t\n\r]*[{(][ \t\n\r]*" (regexp-quote key)
- "[, \t\r\n}]")))
+ (concat "\\\\bibitem[ \t]*\\(\\[[^]]*\\]\\)?[ \t]*{"
+ (regexp-quote key) "}")
+ (concat "@\\(?:\\w\\|\\s_\\)+[ \t\n\r]*[{(][ \t\n\r]*"
+ (regexp-quote key) "[, \t\r\n}]")))
(buffer-conf (current-buffer))
file buf pos oldpos)
@@ -229,7 +228,13 @@
buffer (not reftex-keep-temporary-buffers))))
(if (not buffer1)
(message "No such BibTeX file %s (ignored)" buffer)
- (message "Scanning bibliography database %s" buffer1))
+ (message "Scanning bibliography database %s" buffer1)
+ (unless (verify-visited-file-modtime buffer1)
+ (when (y-or-n-p
+ (format "File %s changed on disk. Reread from disk? "
+ (file-name-nondirectory
+ (buffer-file-name buffer1))))
+ (with-current-buffer buffer1 (revert-buffer t t)))))
(set-buffer buffer1)
(reftex-with-special-syntax-for-bib
@@ -238,8 +243,8 @@
(while (re-search-forward first-re nil t)
(catch 'search-again
(setq key-point (point))
- (unless (re-search-backward
- "\\(\\`\\|[\n\r]\\)[ \t]*@\\([a-zA-Z]+\\)[ \t\n\r]*[{(]" nil t)
+ (unless (re-search-backward "\\(\\`\\|[\n\r]\\)[ \t]*\
+@\\(\\(?:\\w\\|\\s_\\)+\\)[ \t\n\r]*[{(]" nil t)
(throw 'search-again nil))
(setq start-point (point))
(goto-char (match-end 0))
@@ -451,7 +456,8 @@
(setq names (replace-match " " nil t names)))
(split-string names "\n")))
-(defun reftex-parse-bibtex-entry (entry &optional from to)
+(defun reftex-parse-bibtex-entry (entry &optional from to raw)
+ ; if RAW is non-nil, keep double quotes/curly braces delimiting fields
(let (alist key start field)
(save-excursion
(save-restriction
@@ -463,41 +469,56 @@
(erase-buffer)
(insert entry))
(widen)
- (narrow-to-region from to))
+ (if (and from to) (narrow-to-region from to)))
(goto-char (point-min))
- (if (re-search-forward
- "@\\(\\w+\\)[ \t\n\r]*[{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t)
+ (if (re-search-forward "@\\(\\(?:\\w\\|\\s_\\)+\\)[ \t\n\r]*\
+\[{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t)
(setq alist
(list
(cons "&type" (downcase (reftex-match-string 1)))
(cons "&key" (reftex-match-string 2)))))
- (while (re-search-forward "\\(\\w+\\)[ \t\n\r]*=[ \t\n\r]*" nil t)
+ (while (re-search-forward "\\(\\(?:\\w\\|-\\)+\\)[ \t\n\r]*=[ \t\n\r]*"
+ nil t)
(setq key (downcase (reftex-match-string 1)))
(cond
((= (following-char) ?{)
- (forward-char 1)
- (setq start (point))
- (condition-case nil
- (up-list 1)
- (error nil)))
+ (cond
+ (raw
+ (setq start (point))
+ (forward-char 1))
+ (t
+ (forward-char 1)
+ (setq start (point))
+ (condition-case nil
+ (up-list 1)
+ (error nil)))))
((= (following-char) ?\")
- (forward-char 1)
- (setq start (point))
+ (cond
+ (raw
+ (setq start (point))
+ (forward-char 1))
+ (t
+ (forward-char 1)
+ (setq start (point))))
(while (and (search-forward "\"" nil t)
(= ?\\ (char-after (- (point) 2))))))
(t
(setq start (point))
(re-search-forward "[ \t]*[\n\r,}]" nil 1)))
- (setq field (buffer-substring-no-properties start (1- (point))))
+ ;; extract field value, ignore trailing comma if in RAW mode
+ (let ((stop (if (and raw (not (= (char-after (1- (point))) ?,)))
+ (point)
+ (1- (point))) ))
+ (setq field (buffer-substring-no-properties start stop)))
;; remove extra whitespace
(while (string-match "[\n\t\r]\\|[ \t][ \t]+" field)
(setq field (replace-match " " nil t field)))
;; remove leading garbage
- (if (string-match "^[ \t{]+" field)
+ (if (string-match (if raw "^[ \t]+" "^[ \t{]+") field)
(setq field (replace-match "" nil t field)))
;; remove trailing garbage
- (if (string-match "[ \t}]+$" field)
+ (if (string-match (if raw "[ \t]+$" "[ \t}]+$") field)
(setq field (replace-match "" nil t field)))
(push (cons key field) alist))))
alist))
@@ -542,10 +563,7 @@
(t ""))))
(setq authors (reftex-truncate authors 30 t t))
(when (reftex-use-fonts)
- (put-text-property 0 (length key) 'face
- (reftex-verified-face reftex-label-face
- 'font-lock-constant-face
- 'font-lock-reference-face)
+ (put-text-property 0 (length key) 'face reftex-label-face
key)
(put-text-property 0 (length authors) 'face reftex-bib-author-face
authors)
@@ -641,15 +659,13 @@ While entering the regexp, completion on knows citation keys is possible.
(insert-entries selected-entries)
entry string cite-view)
- (when (stringp selected-entries)
- (error selected-entries))
(unless selected-entries (error "Quit"))
(if (stringp selected-entries)
;; Nonexistent entry
- (setq selected-entries nil
- insert-entries (list (list selected-entries
- (cons "&key" selected-entries))))
+ (setq insert-entries (list (list selected-entries
+ (cons "&key" selected-entries)))
+ selected-entries nil)
;; It makes sense to compute the cite-view strings.
(setq cite-view t))
@@ -657,7 +673,8 @@ While entering the regexp, completion on knows citation keys is possible.
;; All keys go into a single command - we need to trick a little
;; FIXME: Unfortunately, this means that commenting does not work right.
(pop selected-entries)
- (let ((concat-keys (mapconcat 'car selected-entries ",")))
+ (let ((concat-keys (mapconcat 'car selected-entries
+ reftex-cite-key-separator)))
(setq insert-entries
(list (list concat-keys (cons "&key" concat-keys))))))
@@ -678,8 +695,9 @@ While entering the regexp, completion on knows citation keys is possible.
(equal arg '(4))))
(let ((start 0) (nth 0) value)
(while (setq start (string-match "\\[\\]" string start))
- (setq value (read-string (format "Optional argument %d: "
- (setq nth (1+ nth)))))
+ (setq value (save-match-data
+ (read-string (format "Optional argument %d: "
+ (setq nth (1+ nth))))))
(setq string (replace-match (concat "[" value "]") t t string))
(setq start (1+ start)))))
;; Should we cleanup empty optional arguments?
@@ -728,7 +746,7 @@ While entering the regexp, completion on knows citation keys is possible.
(forward-char 1)))
;; Return the citation key
- (car (car selected-entries))))
+ (mapcar 'car selected-entries)))
(defun reftex-figure-out-cite-format (arg &optional no-insert format-key)
;; Check if there is already a cite command at point and change cite format
@@ -747,9 +765,13 @@ While entering the regexp, completion on knows citation keys is possible.
(if (or (not arg) (not (listp arg)))
(setq format
(concat
- (if (member (preceding-char) '(?\{ ?,)) "" ",")
+ (if (member (preceding-char) '(?\{ ?,))
+ ""
+ reftex-cite-key-separator)
"%l"
- (if (member (following-char) '(?\} ?,)) "" ",")))
+ (if (member (following-char) '(?\} ?,))
+ ""
+ reftex-cite-key-separator)))
(setq format "%l")))
(t
;; Figure out the correct format
@@ -1117,7 +1139,7 @@ While entering the regexp, completion on knows citation keys is possible.
(save-restriction
(widen)
(goto-char (point-min))
- (while (re-search-forward "^[^%\n\r]*\\\\\\(bibentry\\|[a-zA-Z]*cite[a-zA-Z]*\\)\\(\\[[^\\]]*\\]\\)?{\\([^}]+\\)}" nil t)
+ (while (re-search-forward "\\(?:^\\|\\=\\)[^%\n\r]*?\\\\\\(bibentry\\|[a-zA-Z]*cite[a-zA-Z]*\\)\\(\\[[^\\]]*\\]\\)?{\\([^}]+\\)}" nil t)
(setq kk (match-string-no-properties 3))
(while (string-match "%.*\n?" kk)
(setq kk (replace-match "" t t kk)))
@@ -1128,18 +1150,35 @@ While entering the regexp, completion on knows citation keys is possible.
(reftex-kill-temporary-buffers)
keys))
+(defun reftex-get-string-refs (alist)
+ "Return a list of BibTeX @string references that appear as values in ALIST."
+ (reftex-remove-if (lambda (x) (string-match "^\\([\"{]\\|[0-9]+$\\)" x))
+ ;; get list of values, discard keys
+ (mapcar 'cdr
+ ;; remove &key and &type entries
+ (reftex-remove-if (lambda (pair)
+ (string-match "^&" (car pair)))
+ alist))))
+
(defun reftex-create-bibtex-file (bibfile)
"Create a new BibTeX database file with all entries referenced in document.
-The command prompts for a filename and writes the collected entries to
-that file. Only entries referenced in the current document with
-any \\cite-like macros are used.
-The sequence in the new file is the same as it was in the old database."
+The command prompts for a filename and writes the collected
+entries to that file. Only entries referenced in the current
+document with any \\cite-like macros are used. The sequence in
+the new file is the same as it was in the old database.
+
+Entries referenced from other entries must appear after all
+referencing entries.
+
+You can define strings to be used as header or footer for the
+created files in the variables `reftex-create-bibtex-header' or
+`reftex-create-bibtex-footer' respectively."
(interactive "FNew BibTeX file: ")
(let ((keys (reftex-all-used-citation-keys))
(files (reftex-get-bibfile-list))
- file key entries beg end entry)
+ file key entries beg end entry string-keys string-entries)
(save-current-buffer
- (while (setq file (pop files))
+ (dolist (file files)
(set-buffer (reftex-get-file-buffer-force file 'mark))
(reftex-with-special-syntax-for-bib
(save-excursion
@@ -1159,14 +1198,54 @@ The sequence in the new file is the same as it was in the old database."
(when (member key keys)
(setq entry (buffer-substring beg end)
entries (cons entry entries)
- keys (delete key keys)))))))))
+ keys (delete key keys))
+
+ ;; check for crossref entries
+ (let* ((attr-list (reftex-parse-bibtex-entry nil beg end))
+ (xref-key (cdr (assoc "crossref" attr-list))))
+ (if xref-key (pushnew xref-key keys)))
+ ;; check for string references
+ (let* ((raw-fields (reftex-parse-bibtex-entry nil beg end t))
+ (string-fields (reftex-get-string-refs raw-fields)))
+ (dolist (skey string-fields)
+ (unless (member skey string-keys)
+ (push skey string-keys)))))))))))
+ ;; second pass: grab @string references
+ (if string-keys
+ (save-current-buffer
+ (dolist (file files)
+ (set-buffer (reftex-get-file-buffer-force file 'mark))
+ (reftex-with-special-syntax-for-bib
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*@[Ss][Tt][Rr][Ii][Nn][Gg][ \t]*{[ \t]*\\([^ \t\r\n]+\\)"
+ nil t)
+ (setq key (match-string 1)
+ beg (match-beginning 0)
+ end (progn
+ (goto-char (match-beginning 1))
+ (condition-case nil
+ (up-list 1)
+ (error (goto-char (match-end 0))))
+ (point)))
+ (when (member key string-keys)
+ (setq entry (buffer-substring beg end)
+ string-entries (cons entry string-entries)
+ string-keys (delete key string-keys))))))))))
(find-file-other-window bibfile)
(if (> (buffer-size) 0)
(unless (yes-or-no-p
(format "Overwrite non-empty file %s? " bibfile))
(error "Abort")))
(erase-buffer)
+ (if reftex-create-bibtex-header (insert reftex-create-bibtex-header "\n\n"))
+ (insert (mapconcat 'identity (reverse string-entries) "\n\n"))
+ (if string-entries (insert "\n\n\n"))
(insert (mapconcat 'identity (reverse entries) "\n\n"))
+ (if reftex-create-bibtex-footer (insert "\n\n" reftex-create-bibtex-footer))
(goto-char (point-min))
(save-buffer)
(message "%d entries extracted and copied to new database"
diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el
index b1e426c5566..7d102e5a802 100644
--- a/lisp/textmodes/reftex-dcr.el
+++ b/lisp/textmodes/reftex-dcr.el
@@ -4,8 +4,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -27,10 +25,10 @@
;;; Code:
(eval-when-compile (require 'cl))
-(provide 'reftex-dcr)
-(provide 'reftex-vcr)
+
+(declare-function bibtex-beginning-of-entry "bibtex" ())
+
(require 'reftex)
-;;;
(defun reftex-view-crossref (&optional arg auto-how fail-quietly)
"View cross reference of macro at point. Point must be on the KEY
@@ -229,6 +227,7 @@ If it is a \\cite, show the BibTeX database entry.
If there is no such macro at point, search forward to find one.
With argument, actually select the window showing the cross reference."
(interactive "e")
+ ;; Make sure the referencing macro stays visible in the original window.
(mouse-set-point ev)
(reftex-view-crossref current-prefix-arg))
@@ -348,15 +347,14 @@ will display info in the echo area."
(message "Automatic display of crossref information was turned on")))
(defun reftex-start-itimer-once ()
- (and (featurep 'xemacs) reftex-mode
+ (and (featurep 'xemacs)
+ reftex-mode
(not (itimer-live-p reftex-auto-view-crossref-timer))
(setq reftex-auto-view-crossref-timer
(start-itimer "RefTeX Idle Timer"
'reftex-view-crossref-when-idle
reftex-idle-time nil t))))
-(declare-function bibtex-beginning-of-entry "bibtex" ())
-
(defun reftex-view-crossref-from-bibtex (&optional arg)
"View location in a LaTeX document which cites the BibTeX entry at point.
Since BibTeX files can be used by many LaTeX documents, this function
@@ -481,4 +479,6 @@ Calling this function several times find successive citation locations."
(move-marker reftex-global-search-marker nil)
(error "All files processed"))))
+(provide 'reftex-dcr)
+
;;; reftex-dcr.el ends here
diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el
index d836bbb6cb8..ebe0aae73f8 100644
--- a/lisp/textmodes/reftex-global.el
+++ b/lisp/textmodes/reftex-global.el
@@ -4,8 +4,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -407,7 +405,7 @@ Also checks if buffers visiting the files are in read-only mode."
(when flist
(if wrapp
(unless isearch-forward
- (setq flist (last flist)))
+ (setq flist (last flist)))
(unless isearch-forward
(setq flist (reverse flist)))
(while (not (string= (car flist) cb))
@@ -437,7 +435,8 @@ With no argument, this command toggles
(with-current-buffer crt-buf
(when reftex-mode
(if (boundp 'multi-isearch-next-buffer-function)
- (set (make-local-variable 'multi-isearch-next-buffer-function)
+ (set (make-local-variable
+ 'multi-isearch-next-buffer-function)
'reftex-isearch-switch-to-next-file)
(set (make-local-variable 'isearch-wrap-function)
'reftex-isearch-wrap-function)
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index 2d395fe3df2..5b884dd8480 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -4,8 +4,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -27,9 +25,9 @@
;;; Code:
(eval-when-compile (require 'cl))
-(provide 'reftex-index)
+(declare-function texmathp "ext:texmathp" ())
+
(require 'reftex)
-;;;
;; START remove for XEmacs release
(defvar mark-active)
@@ -37,8 +35,6 @@
(defvar TeX-master)
;; END remove for XEmacs release
-(declare-function texmathp "ext:texmathp" ())
-
(defun reftex-index-selection-or-word (&optional arg phrase)
"Put selection or the word near point into the default index macro.
This uses the information in `reftex-index-default-macro' to make an index
@@ -52,9 +48,7 @@ which is part of AUCTeX, the string is first processed with the
(interactive "P")
(let* ((use-default (not (equal arg '(16)))) ; check for double prefix
;; check if we have an active selection
- (active (if (featurep 'xemacs)
- (and zmacs-regions (region-exists-p)) ; XEmacs
- (and transient-mark-mode mark-active))) ; Emacs
+ (active (reftex-region-active-p))
(beg (if active
(region-beginning)
(save-excursion
@@ -585,9 +579,7 @@ SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help
(if (memq reftex-highlight-selection '(mouse both))
reftex-mouse-selected-face
nil))
- (index-face (reftex-verified-face reftex-label-face
- 'font-lock-constant-face
- 'font-lock-reference-face))
+ (index-face reftex-label-face)
sublist cell from to first-char)
;; Make the sublist and sort it
@@ -1246,7 +1238,11 @@ This gets refreshed in every phrases command.")
map)
"Keymap used for *toc* buffer.")
-
+(defvar reftex-index-phrases-syntax-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\" "." table)
+ table)
+ "Syntax table for RefTeX Index Phrases mode.")
(defun reftex-index-phrase-selection-or-word (arg)
"Add current selection or word at point to the phrases buffer.
@@ -1266,6 +1262,7 @@ You get a chance to edit the entry in the phrases buffer - finish with
"Switch to the phrases buffer, initialize if empty."
(interactive)
(reftex-access-scan-info)
+ (set-marker reftex-index-return-marker (point))
(let* ((master (reftex-TeX-master-file))
(name (concat (file-name-sans-extension master)
reftex-index-phrase-file-extension)))
@@ -1373,6 +1370,7 @@ For more information see the RefTeX User Manual.
Here are all local bindings.
\\{reftex-index-phrases-mode-map}"
+ :syntax-table reftex-index-phrases-syntax-table
(set (make-local-variable 'font-lock-defaults)
reftex-index-phrases-font-lock-defaults)
(easy-menu-add reftex-index-phrases-menu reftex-index-phrases-mode-map)
@@ -2095,5 +2093,6 @@ Does not do a save-excursion."
reftex-index-phrases-macro-data "\n"))))
(reftex-select-with-char prompt help delay)))
+(provide 'reftex-index)
;;; reftex-index.el ends here
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index c6526d1b6ce..791b5d7b945 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -4,8 +4,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -27,7 +25,7 @@
;;; Code:
(eval-when-compile (require 'cl))
-(provide 'reftex-parse)
+
(require 'reftex)
(defmacro reftex-with-special-syntax (&rest body)
@@ -241,8 +239,17 @@ of master file."
((match-end 3)
;; It is a section
- (setq bound (point))
+ ;; Use the beginning as bound and not the end
+ ;; (i.e. (point)) because the section command might
+ ;; be the start of the current environment to be
+ ;; found by `reftex-label-info'.
+ (setq bound (match-beginning 0))
+ ;; The section regexp matches a character at the end
+ ;; we are not interested in. Especially if it is the
+ ;; backslash of a following macro we want to find in
+ ;; the next parsing iteration.
+ (when (eq (char-before) ?\\) (backward-char))
;; Insert in List
(setq toc-entry (reftex-section-info file))
(when toc-entry
@@ -1072,4 +1079,6 @@ of master file."
nrest (- nrest i))))
string))
+(provide 'reftex-parse)
+
;;; reftex-parse.el ends here
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index 1882e7dde56..9b9f1a0f68f 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -4,8 +4,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -27,10 +25,9 @@
;;; Code:
(eval-when-compile (require 'cl))
-(provide 'reftex-ref)
+
(require 'reftex)
(require 'reftex-parse)
-;;;
(defun reftex-label-location (&optional bound)
"Return the environment or macro which determines the label type at point.
@@ -413,27 +410,54 @@ When called with 2 C-u prefix args, disable magic word recognition."
(interactive)
- ;; check for active recursive edits
+ ;; Check for active recursive edits
(reftex-check-recursive-edit)
- ;; Ensure access to scanning info and rescan buffer if prefix are is '(4)
+ ;; Ensure access to scanning info and rescan buffer if prefix is '(4)
(reftex-access-scan-info current-prefix-arg)
- (unless type
- ;; guess type from context
- (if (and reftex-guess-label-type
- (setq type (reftex-guess-label-type)))
- (setq cut (cdr type)
- type (car type))
- (setq type (reftex-query-label-type))))
-
- (let* ((reftex-refstyle
- (cond ((reftex-typekey-check type reftex-vref-is-default) "\\vref")
- ((reftex-typekey-check type reftex-fref-is-default) "\\fref")
- (t "\\ref")))
- (reftex-format-ref-function reftex-format-ref-function)
- (form "\\ref{%s}")
- label labels sep sep1)
+ (let ((reftex-refstyle (when (and (boundp 'reftex-refstyle) reftex-refstyle)
+ reftex-refstyle))
+ (reftex-format-ref-function reftex-format-ref-function)
+ (form "\\ref{%s}")
+ label labels sep sep1 style-alist)
+
+ (unless reftex-refstyle
+ (if reftex-ref-macro-prompt
+ (progn
+ ;; Build a temporary list which handles more easily.
+ (dolist (elt reftex-ref-style-alist)
+ (when (member (car elt) (reftex-ref-style-list))
+ (mapc (lambda (x)
+ (add-to-list 'style-alist (cons (cadr x) (car x)) t))
+ (nth 2 elt))))
+ ;; Prompt the user for the macro.
+ (let ((key (reftex-select-with-char
+ "" (concat "SELECT A REFERENCE FORMAT\n\n"
+ (mapconcat
+ (lambda (x)
+ (format "[%c] %s %s" (car x)
+ (if (> (car x) 31) " " "")
+ (cdr x)))
+ style-alist "\n")))))
+ (setq reftex-refstyle (cdr (assoc key style-alist)))
+ (unless reftex-refstyle
+ (error "No reference macro associated with key `%c'" key))))
+ ;; Get the first macro from `reftex-ref-style-alist' which
+ ;; matches the first entry in the list of active styles.
+ (setq reftex-refstyle
+ (or (caar (nth 2 (assoc (car (reftex-ref-style-list))
+ reftex-ref-style-alist)))
+ ;; Use the first entry in r-r-s-a as a last resort.
+ (caar (nth 2 (car reftex-ref-style-alist)))))))
+
+ (unless type
+ ;; Guess type from context
+ (if (and reftex-guess-label-type
+ (setq type (reftex-guess-label-type)))
+ (setq cut (cdr type)
+ type (car type))
+ (setq type (reftex-query-label-type))))
;; Have the user select a label
(set-marker reftex-select-return-marker (point))
@@ -472,17 +496,13 @@ When called with 2 C-u prefix args, disable magic word recognition."
(member (preceding-char) '(?\ ?\t ?\n ?~)))
(setq form (substring form 1)))
;; do we have a special format?
- (setq reftex-format-ref-function
- (cond
- ((string= reftex-refstyle "\\vref") 'reftex-format-vref)
- ((string= reftex-refstyle "\\fref") 'reftex-format-fref)
- ((string= reftex-refstyle "\\Fref") 'reftex-format-Fref)
- (t reftex-format-ref-function)))
+ (unless (string= reftex-refstyle "\\ref")
+ (setq reftex-format-ref-function 'reftex-format-special))
;; ok, insert the reference
(if sep1 (insert sep1))
(insert
(if reftex-format-ref-function
- (funcall reftex-format-ref-function label form)
+ (funcall reftex-format-ref-function label form reftex-refstyle)
(format form label label)))
;; take out the initial ~ for good
(and (= ?~ (string-to-char form))
@@ -791,34 +811,31 @@ When called with 2 C-u prefix args, disable magic word recognition."
(run-hooks 'reftex-display-copied-context-hook)
(setq buffer-read-only t))))))
-(defun reftex-varioref-vref ()
- "Insert a reference using the `\\vref' macro from the varioref package."
- (interactive)
- (let ((reftex-format-ref-function 'reftex-format-vref))
- (reftex-reference)))
-(defun reftex-fancyref-fref ()
- "Insert a reference using the `\\fref' macro from the fancyref package."
- (interactive)
- (let ((reftex-format-ref-function 'reftex-format-fref)
- ;;(reftex-guess-label-type nil) ;FIXME do we want this????
- )
- (reftex-reference)))
-(defun reftex-fancyref-Fref ()
- "Insert a reference using the `\\Fref' macro from the fancyref package."
- (interactive)
- (let ((reftex-format-ref-function 'reftex-format-Fref)
- ;;(reftex-guess-label-type nil) ;FIXME do we want this????
- )
- (reftex-reference)))
-
-(defun reftex-format-vref (label fmt)
- (while (string-match "\\\\ref{" fmt)
- (setq fmt (replace-match "\\vref{" t t fmt)))
- (format fmt label label))
-(defun reftex-format-Fref (label def-fmt)
- (format "\\Fref{%s}" label))
-(defun reftex-format-fref (label def-fmt)
- (format "\\fref{%s}" label))
+;; Generate functions for direct insertion of specific referencing
+;; macros. The functions are named `reftex-<package>-<macro>',
+;; e.g. `reftex-varioref-vref'.
+(dolist (elt reftex-ref-style-alist)
+ (when (stringp (nth 1 elt))
+ (dolist (item (nth 2 elt))
+ (let ((macro (car item))
+ (package (nth 1 elt)))
+ (eval `(defun ,(intern (format "reftex-%s-%s" package
+ (substring macro 1 (length macro)))) ()
+ ,(format "Insert a reference using the `%s' macro from the %s \
+package.\n\nThis is a generated function."
+ macro package)
+ (interactive)
+ (let ((reftex-refstyle ,macro))
+ (reftex-reference))))))))
+
+(defun reftex-format-special (label fmt refstyle)
+ "Apply selected reference style to format FMT and add LABEL.
+Replace any occurrences of \"\\ref\" with REFSTYLE."
+ ;; Replace instances of \ref in `fmt' with the special reference
+ ;; style selected by the user.
+ (while (string-match "\\(\\\\ref\\)[ \t]*{" fmt)
+ (setq fmt (replace-match refstyle t t fmt 1)))
+ (format fmt label))
(defun reftex-goto-label (&optional other-window)
"Prompt for a label (with completion) and jump to the location of this label.
@@ -847,5 +864,6 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window."
(goto-char where))
(reftex-unhighlight 0)))
+(provide 'reftex-ref)
;;; reftex-ref.el ends here
diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el
index 627dfba0071..68355f9b16f 100644
--- a/lisp/textmodes/reftex-sel.el
+++ b/lisp/textmodes/reftex-sel.el
@@ -4,8 +4,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -27,9 +25,8 @@
;;; Code:
(eval-when-compile (require 'cl))
-(provide 'reftex-sel)
+
(require 'reftex)
-;;;
;; Common bindings in reftex-select-label-mode-map
;; and reftex-select-bib-mode-map.
@@ -86,8 +83,8 @@
(loop for x in
'(("b" . reftex-select-jump-to-previous)
("z" . reftex-select-jump)
- ("v" . reftex-select-toggle-varioref)
- ("V" . reftex-select-toggle-fancyref)
+ ("v" . reftex-select-cycle-ref-style-forward)
+ ("V" . reftex-select-cycle-ref-style-backward)
("m" . reftex-select-mark)
("u" . reftex-select-unmark)
("," . reftex-select-mark-comma)
@@ -245,12 +242,8 @@ During a selection process, these are the local bindings.
(if (memq reftex-highlight-selection '(mouse both))
reftex-mouse-selected-face
nil))
- (label-face (reftex-verified-face reftex-label-face
- 'font-lock-constant-face
- 'font-lock-reference-face))
- (index-face (reftex-verified-face reftex-index-face
- 'font-lock-constant-face
- 'font-lock-reference-face))
+ (label-face reftex-label-face)
+ (index-face reftex-index-face)
all cell text label typekey note comment master-dir-re
prev-inserted offset from to index-tag docstruct-symbol)
@@ -515,6 +508,7 @@ During a selection process, these are the local bindings.
(defvar last-data)
(defvar call-back)
(defvar help-string)
+(defvar reftex-refstyle)
;; The selection commands
@@ -608,23 +602,28 @@ Useful for large TOC's."
(setq reftex-last-follow-point -1)
(setq cb-flag (not cb-flag)))
-(defvar reftex-refstyle) ; from reftex-reference
+(defun reftex-select-cycle-ref-style-internal (&optional reverse)
+ "Cycle through macros used for referencing.
+Cycle in reverse order if optional argument REVERSE is non-nil."
+ (let (list)
+ (dolist (style (reftex-ref-style-list))
+ (mapc (lambda (x) (add-to-list 'list (car x) t))
+ (nth 2 (assoc style reftex-ref-style-alist))))
+ (when reverse
+ (setq list (reverse list)))
+ (setq reftex-refstyle (or (cadr (member reftex-refstyle list)) (car list))))
+ (force-mode-line-update))
-(defun reftex-select-toggle-varioref ()
- "Toggle the macro used for referencing the label between \\ref and \\vref."
+(defun reftex-select-cycle-ref-style-forward ()
+ "Cycle forward through macros used for referencing."
(interactive)
- (if (string= reftex-refstyle "\\ref")
- (setq reftex-refstyle "\\vref")
- (setq reftex-refstyle "\\ref"))
- (force-mode-line-update))
-(defun reftex-select-toggle-fancyref ()
- "Toggle the macro used for referencing the label between \\ref and \\vref."
+ (reftex-select-cycle-ref-style-internal))
+
+(defun reftex-select-cycle-ref-style-backward ()
+ "Cycle backward through macros used for referencing."
(interactive)
- (setq reftex-refstyle
- (cond ((string= reftex-refstyle "\\ref") "\\fref")
- ((string= reftex-refstyle "\\fref") "\\Fref")
- (t "\\ref")))
- (force-mode-line-update))
+ (reftex-select-cycle-ref-style-internal t))
+
(defun reftex-select-show-insertion-point ()
"Show the point from where selection was started in another window."
(interactive)
@@ -725,7 +724,7 @@ Useful for large TOC's."
(if sep
(format "*%c%d* " sep (decf cnt))
(format "*%d* " (decf cnt)))))
- reftex-select-marked)
+ reftex-select-marked)
(message "Entry no longer marked")))
(defun reftex-select-help ()
@@ -735,4 +734,6 @@ Useful for large TOC's."
(princ help-string))
(reftex-enlarge-to-fit "*RefTeX Help*" t))
+(provide 'reftex-sel)
+
;;; reftex-sel.el ends here
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index 519236a3621..4f73322d3f5 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -4,8 +4,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -372,14 +370,14 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(error t)))))
(defun reftex-re-enlarge ()
- ;; Enlarge window to a remembered size.
- (if reftex-toc-split-windows-horizontally
- (enlarge-window-horizontally
- (max 0 (- (or reftex-last-window-width (window-width))
- (window-width))))
- (enlarge-window
- (max 0 (- (or reftex-last-window-height (window-height))
- (window-height))))))
+ "Enlarge window to a remembered size."
+ (let ((count (if reftex-toc-split-windows-horizontally
+ (- (or reftex-last-window-width (window-width))
+ (window-width))
+ (- (or reftex-last-window-height (window-height))
+ (window-height)))))
+ (when (> count 0)
+ (enlarge-window count reftex-toc-split-windows-horizontally))))
(defun reftex-toc-dframe-p (&optional frame error)
;; Check if FRAME is the dedicated TOC frame.
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 3470ef9f3c1..2c1fc972057 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -4,8 +4,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -207,6 +205,11 @@ distribution. Mixed-case symbols are convenience aliases.")
(?p . "(%2a %y\\nocite{%l})")))
(locally "Full info in parenthesis"
"(%2a %y, %j %v, %P, %e: %b, %u, %s %<)")
+ (context
+ "ConTeXt bib module"
+ ((?\C-m . "\\cite[%l]")
+ (?s . "\\cite[][%l]")
+ (?n . "\\nocite[%l]")))
)
"Builtin versions of the citation format.
The following conventions are valid for all alist entries:
@@ -239,7 +242,7 @@ distribution. Mixed-case symbols are convenience aliases.")
"LaTeX label and citation support."
:tag "RefTeX"
:link '(url-link :tag "Home Page"
- "http://staff.science.uva.nl/~dominik/Tools/reftex/")
+ "http://www.gnu.org/software/auctex/reftex.html")
:link '(emacs-commentary-link :tag "Commentary in reftex.el" "reftex.el")
:link '(custom-manual "(reftex)Top")
:prefix "reftex-"
@@ -261,8 +264,8 @@ by whitespace."
(defcustom reftex-max-section-depth 12
"Maximum depth of section levels in document structure.
-Standard LaTeX needs default is 7, but there are packages for which this
-needs to be larger."
+The default in standard LaTeX is 7, but there are packages for
+which this needs to be larger."
:group 'reftex-table-of-contents-browser
:type 'integer)
@@ -329,7 +332,7 @@ recentering will work for any TOC window created during the session.
Value 'frame (the default) means, turn automatic recentering on only while the
dedicated TOC frame does exist, and do the recentering only in that frame. So
-when creating that frame (with \"d\" key in an ordinary TOC window), the
+when creating that frame (with `d' key in an ordinary TOC window), the
automatic recentering is turned on. When the frame gets destroyed, automatic
recentering is turned off again.
@@ -383,8 +386,8 @@ This flag can be toggled from within the *toc* buffer with the `i' key."
(defcustom reftex-toc-confirm-promotion 2
"Non-nil means, promotion/demotion commands first prompt for confirmation.
-When nil, the command is executed immediately. When this is an integer
-N, ask for confirmation only if N or more section commands are going to be
+If nil, the command is executed immediately. If this is an integer N,
+ask for confirmation only if N or more section commands are going to be
changed."
:group 'reftex-table-of-contents-browser
:type '(choice
@@ -408,7 +411,7 @@ This flag can be toggled from within the *toc* buffer with the `f' key."
(defcustom reftex-revisit-to-follow nil
"Non-nil means, follow-mode will revisit files if necessary.
-When nil, follow-mode will be suspended for stuff in unvisited files."
+If nil, follow-mode will be suspended for stuff in unvisited files."
:group 'reftex-table-of-contents-browser
:group 'reftex-referencing-labels
:type 'boolean)
@@ -452,8 +455,8 @@ of options."
(defcustom reftex-label-alist nil
"Alist with information on environments for \\label-\\ref use.
-This docstring is easier to understand after reading the configuration
-examples in `reftex.el'. Looking at the builtin defaults in the constant
+This doc string is easier to understand after reading the configuration
+examples in the manual. Looking at the builtin defaults in the constant
`reftex-label-alist-builtin' may also be instructive.
Set this variable to define additions and changes to the default. The only
@@ -481,12 +484,11 @@ ENV-OR-MACRO
Special names: `section' for section labels, `any' to define a group
which contains all labels.
- This may also be a function to do local parsing and identify point
- to be in a non-standard label environment. The function must take
- an argument BOUND and limit backward searches to this value. It
- should return either nil or a cons cell (FUNCTION . POSITION) with
- the function symbol and the position where the special environment
- starts. See the Info documentation for an example.
+ This may also be a function to do local parsing and identify point to
+ be in a non-standard label environment. The function must take an
+ argument BOUND and limit backward searches to this value. It should
+ return either nil or the position where the special environment starts.
+ See the Info documentation for an example.
Finally this may also be nil if the entry is only meant to change
some settings associated with the type indicator character (see below).
@@ -500,7 +502,7 @@ TYPE-KEY
`equation' and `eqnarray').
If the type indicator is nil and the macro has a label argument {*},
the macro defines neutral labels just like \\label. In this case
- the reminder of this entry is ignored.
+ the remainder of this entry is ignored.
LABEL-PREFIX
Label prefix string, like \"tab:\".
@@ -516,8 +518,8 @@ LABEL-PREFIX
Example: In a file `intro.tex', \"eq:%f:\" will become \"eq:intro:\").
REFERENCE-FORMAT
- Format string for reference insert in buffer. `%s' will be replaced by
- the label.
+ Format string for reference insertion in buffer. `%s' will be replaced
+ by the label.
When the format starts with `~', the `~' will only be inserted if
there is not already a whitespace before point.
@@ -533,7 +535,7 @@ CONTEXT-METHOD
- If an integer, use the nth argument of the macro. As a special case,
1000 means to get text after the last macro argument.
- If a string, use as regexp to search *backward* from the label. Context
- is then the text following the end of the match. E.g. putting this to
+ is then the text following the end of the match. E.g. setting this to
\"\\\\\\\\caption[[{]\" will use the caption in a figure or table
environment.
\"\\\\\\\\begin{eqnarray}\\\\|\\\\\\\\\\\\\\\\\" works for eqnarrays.
@@ -755,8 +757,7 @@ And here is the setup for RefTeX:
3. Tell RefTeX to use this function
- (setq reftex-special-environment-functions '(my-detect-linguex-list))
-"
+ (setq reftex-special-environment-functions '(my-detect-linguex-list))"
:group 'reftex-defining-label-environments
:type 'hook)
@@ -820,11 +821,13 @@ RefTeX's default function uses the variable `reftex-derive-label-parameters'."
:type 'symbol)
(defcustom reftex-translate-to-ascii-function 'reftex-latin1-to-ascii
- "Filter function which will process a context string before it is used
-to derive a label from it. The intended application is to convert ISO or
-Mule characters into something valid in labels. The default function
-removes the accents from Latin-1 characters. X-Symbol (>=2.6) sets this
-variable to the much more general `x-symbol-translate-to-ascii'."
+ "Filter function to convert a string to ASCII.
+The function is used to process a context string before it is
+used to derive a label from it. The intended application is to
+convert ISO or Mule characters into something valid in labels.
+The default function removes the accents from Latin-1 characters.
+X-Symbol (>=2.6) sets this variable to the much more general
+`x-symbol-translate-to-ascii'."
:group 'reftex-making-and-inserting-labels
:type 'symbol)
@@ -947,28 +950,82 @@ This is used to string together whole reference sets, like
:group 'reftex-referencing-labels
:type '(repeat (cons (character) (string))))
+(defcustom reftex-ref-style-alist
+ '(("Default" t
+ (("\\ref" ?\C-m) ("\\pageref" ?p)))
+ ("Varioref" "varioref"
+ (("\\vref" ?v) ("\\vpageref" ?g) ("\\Vref" ?V) ("\\Ref" ?R)))
+ ("Fancyref" "fancyref"
+ (("\\fref" ?f) ("\\Fref" ?F)))
+ ("Hyperref" "hyperref"
+ (("\\autoref" ?a) ("\\autopageref" ?u))))
+ "Alist of reference styles.
+Each element is a list of the style name, the name of the LaTeX
+package associated with the style or t for any package, and an
+alist of macros where the first entry of each item is the
+reference macro and the second a key for selecting the macro when
+the macro type is being prompted for. (See also
+`reftex-ref-macro-prompt'.) The keys, represented as characters,
+have to be unique."
+ :group 'reftex-referencing-labels
+ :version "24.3"
+ :type '(alist :key-type (string :tag "Style name")
+ :value-type (group (choice :tag "Package"
+ (const :tag "Any package" t)
+ (string :tag "Name"))
+ (repeat :tag "Macros"
+ (group (string :tag "Macro")
+ (character :tag "Key"))))))
+
+(defcustom reftex-ref-macro-prompt t
+ "If non-nil, `reftex-reference' prompts for the reference macro."
+ :group 'reftex-referencing-labels
+ :version "24.3"
+ :type 'boolean)
+
(defcustom reftex-vref-is-default nil
- "Non-nil means, the varioref macro \\vref is used as default.
-In the selection buffer, the `v' key toggles the reference macro between
-`\\ref' and `\\vref'. The value of this variable determines the default
-which is active when entering the selection process.
-Instead of nil or t, this may also be a string of type letters indicating
-the label types for which it should be true."
+ "Non-nil means, the varioref reference style is used as default.
+The value of this variable determines the default which is active
+when entering the selection process. Instead of nil or t, this
+may also be a string of type letters indicating the label types
+for which it should be true.
+
+This variable is obsolete, use `reftex-ref-style-default-list'
+instead."
:group 'reftex-referencing-labels
:type `(choice :tag "\\vref is default macro" ,@reftex-tmp))
;;;###autoload(put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
(defcustom reftex-fref-is-default nil
- "Non-nil means, the fancyref macro \\fref is used as default.
-In the selection buffer, the `V' key toggles the reference macro between
-`\\ref', `\\fref' and `\\Fref'. The value of this variable determines
-the default which is active when entering the selection process.
-Instead of nil or t, this may also be a string of type letters indicating
-the label types for which it should be true."
+ "Non-nil means, the fancyref reference style is used as default.
+The value of this variable determines the default which is active
+when entering the selection process. Instead of nil or t, this
+may also be a string of type letters indicating the label types
+for which it should be true.
+
+This variable is obsolete, use `reftex-ref-style-default-list'
+instead."
:group 'reftex-referencing-labels
:type `(choice :tag "\\fref is default macro" ,@reftex-tmp))
;;;###autoload(put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
+(defcustom reftex-ref-style-default-list '("Default")
+ "List of reference styles to be activated by default.
+The order is significant and controls the order in which macros
+can be cycled in the buffer for selecting a label. The entries
+in the list have to match the respective reference style names
+used in the variable `reftex-ref-style-alist'."
+ :group 'reftex-referencing-labels
+ :version "24.3"
+ :type `(set ,@(mapcar (lambda (x) (list 'const (car x)))
+ reftex-ref-style-alist)))
+
+;; Compatibility with obsolete variables.
+(when reftex-vref-is-default
+ (add-to-list 'reftex-ref-style-default-list "Varioref"))
+(when reftex-fref-is-default
+ (add-to-list 'reftex-ref-style-default-list "Fancyref"))
+
(defcustom reftex-level-indent 2
"Number of spaces to be used for indentation per section level."
:group 'reftex-referencing-labels
@@ -987,19 +1044,22 @@ a label type. If you set this variable to nil, RefTeX will always prompt."
(defcustom reftex-format-ref-function nil
"Function which produces the string to insert as a reference.
-Normally should be nil, because the format to insert a reference can
-already be specified in `reftex-label-alist'.
-This hook also is used by the special commands to insert `\\vref' and `\\fref'
-references, so even if you set this, your setting will be ignored by
-the special commands.
-The function will be called with two arguments, the LABEL and the DEFAULT
-FORMAT, which normally is `~\\ref{%s}'. The function should return the
-string to insert into the buffer."
+Normally should be nil, because the format to insert a reference
+can already be specified in `reftex-label-alist'.
+
+This hook also is used by the special commands to insert
+e.g. `\\vref' and `\\fref' references, so even if you set this,
+your setting will be ignored by the special commands.
+
+The function will be called with three arguments, the LABEL, the
+DEFAULT FORMAT, which normally is `~\\ref{%s}' and the REFERENCE
+STYLE. The function should return the string to insert into the
+buffer."
:group 'reftex-referencing-labels
- :type 'function)
+ :type '(choice (const nil) function))
(defcustom reftex-select-label-mode-hook nil
- "Mode hook for reftex-select-label-mode."
+ "Mode hook for `reftex-select-label-mode'."
:group 'reftex-referencing-labels
:type 'hook)
@@ -1009,7 +1069,8 @@ string to insert into the buffer."
"Support for referencing bibliographic data with BibTeX."
:group 'reftex)
-(defcustom reftex-bibliography-commands '("bibliography" "nobibliography")
+(defcustom reftex-bibliography-commands
+ '("bibliography" "nobibliography" "setupbibtex\\[.*?database=")
"LaTeX commands which specify the BibTeX databases to use with the document."
:group 'reftex-citation-support
:type '(repeat string))
@@ -1114,7 +1175,7 @@ E.g.: (setq reftex-cite-format 'natbib)"
(defcustom reftex-cite-prompt-optional-args 'maybe
"Non-nil means, prompt for empty optional arguments in cite macros.
-When an entry in `reftex-cite-format' ist given with square brackets to
+When an entry in `reftex-cite-format' is given with square brackets to
indicate optional arguments (for example \\cite[][]{%l}), RefTeX can
prompt for values. Possible values are:
@@ -1189,13 +1250,31 @@ The function will be called with two arguments, the CITATION KEY and the
DEFAULT FORMAT, which is taken from `reftex-cite-format'. The function
should return the string to insert into the buffer."
:group 'reftex-citation-support
- :type 'function)
+ :type '(choice (const nil) function))
(defcustom reftex-select-bib-mode-hook nil
"Mode hook for reftex-select-bib-mode."
:group 'reftex-citation-support
:type 'hook)
+(defcustom reftex-cite-key-separator ","
+ "String to be used for separating several keys in a \\cite macro."
+ :group 'reftex-citation-support
+ :version "24.3"
+ :type 'string)
+
+(defcustom reftex-create-bibtex-header nil
+ "Header to insert in BibTeX files generated by RefTeX."
+ :group 'reftex-citation-support
+ :version "24.3"
+ :type '(choice (const :tag "No header" nil) string))
+
+(defcustom reftex-create-bibtex-footer nil
+ "Footer to insert in BibTeX files generated by RefTeX."
+ :group 'reftex-citation-support
+ :version "24.3"
+ :type '(choice (const :tag "No footer" nil) string))
+
;; Index Support Configuration
(defgroup reftex-index-support nil
@@ -1223,7 +1302,9 @@ These correspond to the makeindex keywords LEVEL ENCAP ACTUAL QUOTE ESCAPE."
(string :tag "ESCAPE char ")))
(defcustom reftex-index-macros nil
- "Macros which define index entries. The structure is
+ "Macros which define index entries.
+
+The structure is
\(MACRO INDEX-TAG KEY PREFIX EXCLUDE REPEAT)
@@ -1456,7 +1537,7 @@ This flag can be toggled from within the *Index* buffer with the `f' key."
This is used when `reftex-view-crossref' is called with point in an
argument of a macro. Note that crossref viewing for citations,
references (both ways) and index entries is hard-coded. This variable
-is only to configure additional structures for which crossreference
+is only to configure additional structures for which cross-reference
viewing can be useful. Each entry has the structure
\(MACRO-RE SEARCH-RE HIGHLIGHT).
@@ -1499,15 +1580,17 @@ entries and for BibTeX database files with live associated buffers."
:type 'boolean)
(defcustom reftex-cache-cite-echo t
- "Non-nil means, the information displayed in the echo area for cite macros
-is cached and even saved along with the parsing information. The cache
-survives document scans. In order to clear it, use M-x reftex-reset-mode."
+ "Non-nil means, echoed information for cite macros is cached.
+The information displayed in the echo area for cite macros is
+cached and even saved along with the parsing information. The
+cache survives document scans. In order to clear it, use M-x
+reftex-reset-mode <RET>."
:group 'reftex-viewing-cross-references
:type 'boolean)
(defcustom reftex-display-copied-context-hook nil
- "Normal Hook which is run before context is displayed anywhere. Designed
-for X-Symbol, but may have other uses as well."
+ "Normal hook which is run before context is displayed anywhere.
+Designed for X-Symbol, but may have other uses as well."
:group 'reftex-viewing-cross-references
:group 'reftex-referencing-labels
:type 'hook)
@@ -1690,7 +1773,7 @@ The file MASTER.rel in the same directory as MASTER.tex is used to save the
information. When this variable is t,
- accessing the parsing information for the first time in an editing session
will read that file (if available) instead of parsing the document.
-- exiting Emacs or killing a buffer in reftex-mode will cause a new version
+- exiting Emacs or killing a buffer in `reftex-mode' will cause a new version
of the file to be written."
:group 'reftex-optimizations-for-large-documents
:type 'boolean)
@@ -1855,22 +1938,13 @@ symbol indicating in what context the hook is called."
(defcustom reftex-extra-bindings nil
"Non-nil means, make additional key bindings on startup.
-These extra bindings are located in the
-`reftex-extra-bindings-map' map, bound to
-`reftex-extra-bindings-prefix'."
- :group 'reftex-miscellaneous-configurations
- :type 'boolean)
-
-;; below, default is C-c C-y because it is free in LaTeX mode.
-(defcustom reftex-extra-bindings-prefix "\C-c\C-y"
- "When `reftex-extra-bindings' is set to non-nil, use extra
-bindings with this prefix bound to `reftex-extra-bindings-map'."
+These extra bindings are located in the users `C-c letter' map."
:group 'reftex-miscellaneous-configurations
:type 'boolean)
(defcustom reftex-plug-into-AUCTeX nil
"Plug-in flags for AUCTeX interface.
-This variable is a list of 4 boolean flags. When a flag is non-nil,
+This variable is a list of 5 boolean flags. When a flag is non-nil,
RefTeX will
- supply labels in new sections and environments (flag 1)
@@ -1900,8 +1974,7 @@ may require a restart of Emacs in order to become effective."
(boolean :tag "supply argument for macros like `\\label' ")
(boolean :tag "supply argument for macros like `\\ref' ")
(boolean :tag "supply argument for macros like `\\cite' ")
- (boolean :tag "supply argument for macros like `\\index' ")
- )))
+ (boolean :tag "supply argument for macros like `\\index' "))))
(defcustom reftex-allow-detached-macro-args nil
"Non-nil means, allow arguments of macros to be detached by whitespace.
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index 8584c496a97..bdee0fcf1d4 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -3,7 +3,6 @@
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
;; Keywords: tex
;; This file is part of GNU Emacs.
@@ -21,10 +20,8 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;---------------------------------------------------------------------------
-;;
;;; Commentary:
-;;
+
;; RefTeX is a minor mode with distinct support for \ref, \label, \cite,
;; and \index commands in (multi-file) LaTeX documents.
;; - A table of contents provides easy access to any part of a document.
@@ -34,243 +31,23 @@
;; - Text phrases can be collected in a file, for later global indexing.
;; - The index preview buffer helps to check and edit index entries.
;;
-;;
-;; INSTALLATION
-;; ------------
-;;
-;; - If this file is part of an X/Emacs distribution, it is installed.
-;; - For XEmacs 21.x, you need to install the RefTeX plug-in package
-;; available from the XEmacs distribution sites.
-;; - If you have downloaded this file from the maintainers webpage, follow
-;; the instructions in the INSTALL file of the distribution.
-;;
-;; To turn RefTeX Mode on and off in a buffer, use `M-x reftex-mode'.
-;;
-;; To turn on RefTeX Mode for all LaTeX files, add the following lines
-;; to your init file:
-;;
-;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; AUCTeX LaTeX mode
-;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; Emacs latex mode
-;;
-;;
-;; DOCUMENTATION
-;; -------------
-;;
-;; See below for a short summary of how to use RefTeX.
-;;
-;; There is an extensive texinfo document describing RefTeX in detail.
+;; There is an extensive Texinfo document describing RefTeX in detail.
;; One way to view this documentation is `M-x reftex-info RET'.
;;
;; The documentation in various formats is also available at
;;
-;; http://zon.astro.uva.nl/~dominik/Tools/
-;;
-;;---------------------------------------------------------------------------
-;;
-;; Introduction
-;; ************
-;;
-;; RefTeX is a specialized package for support of labels, references,
-;; citations, and the index in LaTeX. RefTeX wraps itself round 4 LaTeX
-;; macros: `\label', `\ref', `\cite', and `\index'. Using these macros
-;; usually requires looking up different parts of the document and
-;; searching through BibTeX database files. RefTeX automates these
-;; time-consuming tasks almost entirely. It also provides functions to
-;; display the structure of a document and to move around in this
-;; structure quickly.
-;;
-;; *Note Imprint::, for information about who to contact for help, bug
-;; reports or suggestions.
-;;
-;; Environment
-;; ===========
-;;
-;; RefTeX needs to access all files which are part of a multifile
-;; document, and the BibTeX database files requested by the
-;; `\bibliography' command. To find these files, RefTeX will require a
-;; search path, i.e. a list of directories to check. Normally this list
-;; is stored in the environment variables `TEXINPUTS' and `BIBINPUTS'
-;; which are also used by RefTeX. However, on some systems these
-;; variables do not contain the full search path. If RefTeX does not work
-;; for you because it cannot find some files, read *Note Finding Files::.
-;;
-;; Entering RefTeX Mode
-;; ====================
-;;
-;; To turn RefTeX Mode on and off in a particular buffer, use `M-x
-;; reftex-mode'. To turn on RefTeX Mode for all LaTeX files, add the
-;; following lines to your init file:
-;;
-;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode
-;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode
-;;
-;; RefTeX in a Nutshell
-;; ====================
-;;
-;; 1. Table of Contents
-;; Typing `C-c =' (`reftex-toc') will show a table of contents of the
-;; document. This buffer can display sections, labels and index
-;; entries defined in the document. From the buffer, you can jump
-;; quickly to every part of your document. Press `?' to get help.
-;;
-;; 2. Labels and References
-;; RefTeX helps to create unique labels and to find the correct key
-;; for references quickly. It distinguishes labels for different
-;; environments, knows about all standard environments (and many
-;; others), and can be configured to recognize any additional labeled
-;; environments you have defined yourself (variable
-;; `reftex-label-alist').
-;;
-;; * Creating Labels
-;; Type `C-c (' (`reftex-label') to insert a label at point.
-;; RefTeX will either
-;; - derive a label from context (default for section labels)
-;; - prompt for a label string (default for figures and
-;; tables) or
-;; - insert a simple label made of a prefix and a number (all
-;; other environments)
-;;
-;; Which labels are created how is configurable with the variable
-;; `reftex-insert-label-flags'.
-;;
-;; * Referencing Labels
-;; To make a reference, type `C-c )' (`reftex-reference'). This
-;; shows an outline of the document with all labels of a certain
-;; type (figure, equation,...) and some label context.
-;; Selecting a label inserts a `\ref{LABEL}' macro into the
-;; original buffer.
-;;
-;; 3. Citations
-;; Typing `C-c [' (`reftex-citation') will let you specify a regular
-;; expression to search in current BibTeX database files (as
-;; specified in the `\bibliography' command) and pull out a list of
-;; matches for you to choose from. The list is _formatted_ and
-;; sorted. The selected article is referenced as `\cite{KEY}' (see
-;; the variable `reftex-cite-format' if you want to insert different
-;; macros).
-;;
-;; 4. Index Support
-;; RefTeX helps to enter index entries. It also compiles all entries
-;; into an alphabetically sorted `*Index*' buffer which you can use
-;; to check and edit the entries. RefTeX knows about the standard
-;; index macros and can be configured to recognize any additional
-;; macros you have defined (`reftex-index-macros'). Multiple indices
-;; are supported.
-;;
-;; * Creating Index Entries
-;; To index the current selection or the word at point, type
-;; `C-c /' (`reftex-index-selection-or-word'). The default macro
-;; `reftex-index-default-macro' will be used. For a more
-;; complex entry type `C-c <' (`reftex-index'), select any of
-;; the index macros and enter the arguments with completion.
-;;
-;; * The Index Phrases File (Delayed Indexing)
-;; Type `C-c \' (`reftex-index-phrase-selection-or-word') to add
-;; the current word or selection to a special _index phrase
-;; file_. RefTeX can later search the document for occurrences
-;; of these phrases and let you interactively index the matches.
-;;
-;; * Displaying and Editing the Index
-;; To display the compiled index in a special buffer, type `C-c
-;; >' (`reftex-display-index'). From that buffer you can check
-;; and edit all entries.
-;;
-;; 5. Viewing Cross-References
-;; When point is on the KEY argument of a cross-referencing macro
-;; (`\label', `\ref', `\cite', `\bibitem', `\index', and variations)
-;; or inside a BibTeX database entry, you can press `C-c &'
-;; (`reftex-view-crossref') to display corresponding locations in the
-;; document and associated BibTeX database files.
-;; When the enclosing macro is `\cite' or `\ref' and no other message
-;; occupies the echo area, information about the citation or label
-;; will automatically be displayed in the echo area.
-;;
-;; 6. Multifile Documents
-;; Multifile Documents are fully supported. The included files must
-;; have a file variable `TeX-master' or `tex-main-file' pointing to
-;; the master file. RefTeX provides cross-referencing information
-;; from all parts of the document, and across document borders
-;; (`xr.sty').
-;;
-;; 7. Document Parsing
-;; RefTeX needs to parse the document in order to find labels and
-;; other information. It does it automatically once and updates its
-;; list internally when `reftex-label' and `reftex-index' are used.
-;; To enforce reparsing, call any of the commands described above
-;; with a raw `C-u' prefix, or press the `r' key in the label
-;; selection buffer, the table of contents buffer, or the index
-;; buffer.
-;;
-;; 8. AUCTeX
-;; If your major LaTeX mode is AUCTeX, RefTeX can cooperate with it
-;; (see variable `reftex-plug-into-AUCTeX'). AUCTeX contains style
-;; files which trigger appropriate settings in RefTeX, so that for
-;; many of the popular LaTeX packages no additional customizations
-;; will be necessary.
-;;
-;; 9. Useful Settings
-;; To make RefTeX faster for large documents, try these:
-;; (setq reftex-enable-partial-scans t)
-;; (setq reftex-save-parse-info t)
-;; (setq reftex-use-multiple-selection-buffers t)
-;;
-;; To integrate with AUCTeX, use
-;; (setq reftex-plug-into-AUCTeX t)
-;;
-;; To make your own LaTeX macro definitions known to RefTeX,
-;; customize the variables
-;; `reftex-label-alist' (for label macros/environments)
-;; `reftex-section-levels' (for sectioning commands)
-;; `reftex-cite-format' (for `\cite'-like macros)
-;; `reftex-index-macros' (for `\index'-like macros)
-;; `reftex-index-default-macro' (to set the default macro)
-;; If you have a large number of macros defined, you may want to write
-;; an AUCTeX style file to support them with both AUCTeX and RefTeX.
-;;
-;; 10. Where Next?
-;; Go ahead and use RefTeX. Use its menus until you have picked up
-;; the key bindings. For an overview of what you can do in each of
-;; the different special buffers, press `?'. Read the manual if you
-;; get stuck, of if you are curious what else might be available.
-;; The first part of the manual explains in a tutorial way how to use
-;; and customize RefTeX. The second part is a command and variable
-;; reference.
-;;
-;;---------------------------------------------------------------------------
-;;
-;; AUTHOR
-;; ======
-;;
-;; Carsten Dominik <dominik@science.uva.nl>
-;;
-;; with contributions from Stephen Eglen
+;; http://www.gnu.org/software/auctex/manual/reftex.index.html
;;
;; RefTeX is bundled with Emacs and available as a plug-in package for
;; XEmacs 21.x. If you need to install it yourself, you can find a
;; distribution at
;;
-;; http://zon.astro.uva.nl/~dominik/Tools/
+;; http://www.gnu.org/software/auctex/reftex.html
;;
-;; THANKS TO:
-;; ---------
-;; Thanks to the people on the Net who have used RefTeX and helped
-;; developing it with their reports. In particular thanks to
-;;
-;; Fran Burstall, Alastair Burt, Soren Dayton, Stephen Eglen,
-;; Karl Eichwalder, Peter Galbraith, Dieter Kraft, Kai Grossjohann,
-;; Frank Harrell, Adrian Lanz, Rory Molinari, Stefan Monnier,
-;; Laurent Mugnier, Sudeep Kumar Palat, Daniel Polani, Robin Socha,
-;; Richard Stanton, Allan Strand, Jan Vroonhof, Christoph Wedler,
-;; Alan Williams.
-;;
-;; Finally thanks to Uwe Bolick who first got me (some years ago) into
-;; supporting LaTeX labels and references with an editor (which was
-;; MicroEmacs at the time).
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;;;;;
-
+;; RefTeX was written by Carsten Dominik <dominik@science.uva.nl> with
+;; contributions from Stephen Eglen. It is currently maintained by
+;; the AUCTeX project.
+
;;; Code:
(eval-when-compile (require 'cl))
@@ -289,52 +66,13 @@
(set symbol value)))
-;;; =========================================================================
-;;;
-;;; Configuration variables
-
+;; Configuration variables
(require 'reftex-vars)
-;;; =========================================================================
-;;;
-;;; Define the formal stuff for a minor mode named RefTeX.
-;;;
-
-(defconst reftex-version "RefTeX version 4.31"
- "Version string for RefTeX.")
-
-(defvar reftex-mode-map (make-sparse-keymap)
- "Keymap for RefTeX mode.")
-
-(defvar reftex-mode-menu nil)
-(defvar reftex-syntax-table nil)
-(defvar reftex-syntax-table-for-bib nil)
-
-(unless reftex-syntax-table
- (setq reftex-syntax-table (copy-syntax-table))
- (modify-syntax-entry ?\( "." reftex-syntax-table)
- (modify-syntax-entry ?\) "." reftex-syntax-table))
-
-(unless reftex-syntax-table-for-bib
- (setq reftex-syntax-table-for-bib
- (copy-syntax-table reftex-syntax-table))
- (modify-syntax-entry ?\' "." reftex-syntax-table-for-bib)
- (modify-syntax-entry ?\" "." reftex-syntax-table-for-bib)
- (modify-syntax-entry ?\[ "." reftex-syntax-table-for-bib)
- (modify-syntax-entry ?\] "." reftex-syntax-table-for-bib))
-
-;; The following definitions are out of place, but I need them here
-;; to make the compilation of reftex-mode not complain.
-(defvar reftex-auto-view-crossref-timer nil
- "The timer used for auto-view-crossref.")
-(defvar reftex-toc-auto-recenter-timer nil
- "The idle timer used to recenter the toc window.")
-
-;;; =========================================================================
-;;;
-;;; Parser functions
+;;; Autoloads
+;; Parser functions
(autoload 'reftex-parse-one "reftex-parse"
"Re-parse this file." t)
(autoload 'reftex-parse-all "reftex-parse"
@@ -358,11 +96,7 @@
(autoload 'reftex-ensure-index-support "reftex-parse")
(autoload 'reftex-everything-regexp "reftex-parse")
-
-;;; =========================================================================
-;;;
-;;; Labels and References
-
+;; Labels and References
(autoload 'reftex-label-location "reftex-ref")
(autoload 'reftex-label-info-update "reftex-ref")
(autoload 'reftex-label-info "reftex-ref")
@@ -381,10 +115,7 @@
(autoload 'reftex-goto-label "reftex-ref"
"Prompt for label name and go to that location." t)
-;;; =========================================================================
-;;;
-;;; Table of contents
-
+;; Table of contents
(autoload 'reftex-toc "reftex-toc"
"Show the table of contents for the current document." t)
(autoload 'reftex-toc-recenter "reftex-toc"
@@ -392,10 +123,7 @@
(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc"
"Toggle automatic recentering of TOC window." t)
-;;; =========================================================================
-;;;
-;;; BibTeX citations.
-
+;; BibTeX citations.
(autoload 'reftex-citep "reftex-cite")
(autoload 'reftex-citet "reftex-cite")
(autoload 'reftex-make-cite-echo-string "reftex-cite")
@@ -409,10 +137,7 @@
(autoload 'reftex-bib-or-thebib "reftex-cite")
(autoload 'reftex-create-bibtex-file "reftex-cite")
-;;; =========================================================================
-;;;
-;;; Selection
-
+;; Selection
(autoload 'reftex-select-label-mode "reftex-sel")
(autoload 'reftex-select-bib-mode "reftex-sel")
(autoload 'reftex-find-start-point "reftex-sel")
@@ -420,11 +145,7 @@
(autoload 'reftex-get-offset "reftex-sel")
(autoload 'reftex-select-item "reftex-sel")
-
-;;; =========================================================================
-;;;
-;;; Index support
-
+;; Index support
(autoload 'reftex-index "reftex-index"
"Query for an index macro and insert it along with its arguments." t)
(autoload 'reftex-index-selection-or-word "reftex-index"
@@ -442,11 +163,7 @@
(autoload 'reftex-index-show-entry "reftex-index")
(autoload 'reftex-index-select-tag "reftex-index")
-
-;;; =========================================================================
-;;;
-;;; View cross references
-
+;; View cross references
(autoload 'reftex-view-crossref "reftex-dcr"
"View cross reference of \\ref or \\cite macro at point." t)
(autoload 'reftex-mouse-view-crossref "reftex-dcr"
@@ -455,11 +172,7 @@
(autoload 'reftex-view-crossref-from-bibtex "reftex-dcr"
"View location in a LaTeX document which cites the BibTeX entry at point." t)
-
-;;; =========================================================================
-;;;
-;;; Operations on entire Multifile documents
-
+;; Operations on entire Multifile documents
(autoload 'reftex-create-tags-file "reftex-global"
"Create TAGS file by running `etags' on the current document." t)
(autoload 'reftex-grep-document "reftex-global"
@@ -477,11 +190,7 @@
(autoload 'reftex-save-all-document-buffers "reftex-global"
"Save all documents associated with the current document." t)
-
-;;; =========================================================================
-;;;
-;;; AUCTeX Interface
-
+;; AUCTeX Interface
(autoload 'reftex-arg-label "reftex-auc")
(autoload 'reftex-arg-cite "reftex-auc")
(autoload 'reftex-arg-index-tag "reftex-auc")
@@ -494,6 +203,41 @@
(autoload 'reftex-add-section-levels "reftex-auc")
(autoload 'reftex-notice-new-section "reftex-auc")
+
+;;; =========================================================================
+;;;
+;;; Define the formal stuff for a minor mode named RefTeX.
+;;;
+
+(defconst reftex-version emacs-version
+ "Version string for RefTeX.")
+
+(defvar reftex-mode-map (make-sparse-keymap)
+ "Keymap for RefTeX mode.")
+
+(defvar reftex-mode-menu nil)
+(defvar reftex-syntax-table nil)
+(defvar reftex-syntax-table-for-bib nil)
+
+(unless reftex-syntax-table
+ (setq reftex-syntax-table (copy-syntax-table))
+ (modify-syntax-entry ?\( "." reftex-syntax-table)
+ (modify-syntax-entry ?\) "." reftex-syntax-table))
+
+(unless reftex-syntax-table-for-bib
+ (setq reftex-syntax-table-for-bib (copy-syntax-table))
+ (modify-syntax-entry ?\' "." reftex-syntax-table-for-bib)
+ (modify-syntax-entry ?\" "." reftex-syntax-table-for-bib)
+ (modify-syntax-entry ?\[ "." reftex-syntax-table-for-bib)
+ (modify-syntax-entry ?\] "." reftex-syntax-table-for-bib))
+
+;; The following definitions are out of place, but I need them here
+;; to make the compilation of reftex-mode not complain.
+(defvar reftex-auto-view-crossref-timer nil
+ "The timer used for auto-view-crossref.")
+(defvar reftex-toc-auto-recenter-timer nil
+ "The idle timer used to recenter the toc window.")
+
;;;###autoload
(defun turn-on-reftex ()
"Turn on RefTeX mode."
@@ -503,13 +247,7 @@
(put 'reftex-mode :menu-tag "RefTeX Mode")
;;;###autoload
(define-minor-mode reftex-mode
- "Toggle RefTeX mode.
-With a prefix argument ARG, enable RefTeX mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-RefTeX mode is a buffer-local minor mode with distinct support
-for \\label, \\ref and \\cite in LaTeX.
+ "Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX.
\\<reftex-mode-map>A Table of Contents of the entire (multifile) document with browsing
capabilities is available with `\\[reftex-toc]'.
@@ -559,8 +297,7 @@ on the menu bar.
(modify-syntax-entry ?\( "." reftex-syntax-table)
(modify-syntax-entry ?\) "." reftex-syntax-table)
- (setq reftex-syntax-table-for-bib
- (copy-syntax-table reftex-syntax-table))
+ (setq reftex-syntax-table-for-bib (copy-syntax-table))
(modify-syntax-entry ?\' "." reftex-syntax-table-for-bib)
(modify-syntax-entry ?\" "." reftex-syntax-table-for-bib)
(modify-syntax-entry ?\[ "." reftex-syntax-table-for-bib)
@@ -635,16 +372,15 @@ on the menu bar.
(incf reftex-multifile-index))
(defun reftex-tie-multifile-symbols ()
- ;; Tie the buffer-local symbols to globals connected with the master file.
- ;; If the symbols for the current master file do not exist, they are created.
-
+ "Tie the buffer-local symbols to globals connected with the master file.
+If the symbols for the current master file do not exist, they are created."
(let* ((master (file-truename (reftex-TeX-master-file)))
(index (assoc master reftex-master-index-list))
(symlist reftex-multifile-symbols)
symbol symname newflag)
;; Find the correct index.
(if index
- ;; symbols do exist
+ ;; Symbols do exist
(setq index (cdr index))
;; Get a new index and add info to the alist.
(setq index (reftex-next-multifile-index)
@@ -661,13 +397,15 @@ on the menu bar.
;; Initialize if new symbols.
(when newflag
(set (symbol-value symbol) nil)
- (put (symbol-value symbol) 'reftex-index-macros-style '(default))))
+ (put (symbol-value symbol) 'reftex-index-macros-style '(default))
+ (put (symbol-value symbol) 'reftex-ref-style-list
+ reftex-ref-style-default-list)))
;; Return t if the symbols did already exist, nil when we've made them.
(not newflag)))
(defun reftex-untie-multifile-symbols ()
- ;; Remove ties from multifile symbols, so that next use makes new ones.
+ "Remove ties from multifile symbols, so that next use makes new ones."
(let ((symlist reftex-multifile-symbols)
(symbol nil))
(while symlist
@@ -761,7 +499,7 @@ for details.
This function makes it possible to support RefTeX from AUCTeX style files.
The entries in ENTRY-LIST will be processed after the user settings in
`reftex-index-entries', and before the defaults. Any changes made to
-`reftex-label-alist-style' will raise a flag to the effect that
+`reftex-index-macros-style' will raise a flag to the effect that
the label information is recompiled on next use."
(unless reftex-docstruct-symbol
(reftex-tie-multifile-symbols))
@@ -783,6 +521,52 @@ the label information is recompiled on next use."
(when changed
(put reftex-docstruct-symbol 'reftex-index-macros-style list)))))
+(defun reftex-ref-style-activate (style)
+ "Activate the referencing style STYLE."
+ (reftex-ref-style-toggle style 'activate))
+
+(defun reftex-ref-style-toggle (style &optional action)
+ "Activate or deactivate the referencing style STYLE.
+With the optional argument ACTION a certain action can be forced.
+The symbol `activate' will activate the style and `deactivate'
+will deactivate it."
+ (unless reftex-docstruct-symbol
+ (reftex-tie-multifile-symbols))
+ (when (and reftex-docstruct-symbol
+ (symbolp reftex-docstruct-symbol))
+ (let ((list (get reftex-docstruct-symbol 'reftex-ref-style-list))
+ changed)
+ (cond ((eq action 'activate)
+ (unless (member style list)
+ (setq reftex-tables-dirty t
+ changed t)
+ (add-to-list 'list style t)))
+ ((eq action 'deactivate)
+ (when (member style list)
+ (setq reftex-tables-dirty t
+ changed t)
+ (delete style list)))
+ (t
+ (if (member style list)
+ (delete style list)
+ (add-to-list 'list style t))
+ (setq reftex-tables-dirty t
+ changed t)))
+ (when changed
+ (put reftex-docstruct-symbol 'reftex-ref-style-list list)))))
+
+(defun reftex-ref-style-list ()
+ "Return the list of referencing styles to be active at the moment."
+ ;; Initialize the value of `reftex-ref-style-list' and tie it to the
+ ;; docstruct symbol if necessary.
+ (unless reftex-docstruct-symbol
+ (reftex-tie-multifile-symbols))
+ (if (and reftex-docstruct-symbol
+ (symbolp reftex-docstruct-symbol)
+ (get reftex-docstruct-symbol 'reftex-ref-style-list))
+ (get reftex-docstruct-symbol 'reftex-ref-style-list)
+ reftex-ref-style-default-list))
+
;;; =========================================================================
;;;
;;; Functions to compile the tables, reset the mode etc.
@@ -1282,8 +1066,8 @@ This enforces rescanning the buffer on next use."
;; Calculate the regular expressions
(let* (
; (wbol "\\(\\`\\|[\n\r]\\)[ \t]*")
- (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because
- ;;; because match number are hard coded
+ (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because
+ ; match numbers are hard coded
(label-re (concat "\\(?:"
;; Normal \label{...}
"\\\\label{\\([^}]*\\)}"
@@ -1299,10 +1083,16 @@ This enforces rescanning the buffer on next use."
reftex-include-file-commands "\\|")
"\\)[{ \t]+\\([^} \t\n\r]+\\)"))
(section-re
+ ;; Including `\' as a character to be matched at the end
+ ;; of the regexp will allow stuff like
+ ;; \begin{foo}\label{bar} to be matched. This will make
+ ;; the parser to advance one char too much. Therefore
+ ;; `reftex-parse-from-file' will step one char back if a
+ ;; section is found.
(concat wbol "\\\\\\("
(mapconcat (lambda (x) (regexp-quote (car x)))
reftex-section-levels-all "\\|")
- "\\)\\*?\\(\\[[^]]*\\]\\)?[[{ \t\r\n]"))
+ "\\)\\*?\\(\\[[^]]*\\]\\)?[[{ \t\r\n\\]"))
(appendix-re (concat wbol "\\(\\\\appendix\\)"))
(macro-re
(if macros-with-labels
@@ -1780,9 +1570,18 @@ When DIE is non-nil, throw an error if file not found."
"In unfinished selection process. Finish, or abort with \\[abort-recursive-edit]"))))
(defun reftex-in-comment ()
+ "Return non-nil if point is in a comment."
(save-excursion
- (skip-chars-backward "^%\n\r")
- (eq (preceding-char) ?%)))
+ (save-match-data
+ (let ((pos (point)))
+ (beginning-of-line)
+ (re-search-forward
+ (or comment-start-skip
+ ;; The parser may open files in fundamental mode if
+ ;; `reftex-initialize-temporary-buffers' is nil, so here
+ ;; is a default suitable for plain TeX and LaTeX.
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(%+[ \t]*\\)")
+ pos t)))))
(defun reftex-no-props (string)
;; Return STRING with all text properties removed
@@ -1996,6 +1795,7 @@ When DIE is non-nil, throw an error if file not found."
(condition-case nil (scroll-down) (error nil))
(message "%s" prompt))
(t (message "")
+ (reftex-kill-buffer "*RefTeX Select*")
(throw 'exit char)))
(setq char (read-char-exclusive)))))))
@@ -2123,25 +1923,95 @@ When DIE is non-nil, throw an error if file not found."
(setq list (cdr list)))
(nreverse rtn)))
-(defun reftex-uniquify (list)
- ;; Return a list of all elements in LIST, but each only once, keeping order
- (let (new elm)
- (while list
- (setq elm (pop list))
- (unless (member elm new)
- (push elm new)))
- (nreverse new)))
-
-(defun reftex-uniquify-by-car (alist &optional keep-list)
+(defun reftex-uniquify (list &optional sort)
+ ;; Return a list of all strings in LIST, but each only once, keeping order
+ ;; unless SORT is set (faster!).
+ (setq list (copy-sequence list))
+ (if sort
+ (progn
+ (setq list (sort list 'string<))
+ (let ((p list))
+ (while (cdr p)
+ (if (string= (car p) (car (cdr p)))
+ (setcdr p (cdr (cdr p)))
+ (setq p (cdr p)))))
+ list)
+ (let ((p list) lst elt)
+ ;; push all sublists into lst in reverse(!) order
+ (while p
+ (push p lst)
+ (setq p (cdr p)))
+ ;; sort all sublists
+ (setq lst (sort lst (lambda (x1 x2) (string< (car x1) (car x2)))))
+ (while (cdr lst)
+ (setq elt (car (car lst)))
+ ;; for equal elements in the sorted sublist, replace the
+ ;; last(!) original list member with nil
+ (when (string= elt (car (cadr lst)))
+ (setcar (pop lst) nil)
+ (while (and (cdr lst) (string= elt (car (cadr lst))))
+ (setcar (pop lst) nil)))
+ (pop lst)))
+ ;; weed out all nils and return.
+ (delq nil list)))
+
+(defun reftex-uniquify-by-car (alist &optional keep-list sort)
;; Return a list of all elements in ALIST, but each car only once.
;; Elements of KEEP-LIST are not removed even if duplicate.
- (let (new elm)
- (while alist
- (setq elm (pop alist))
- (if (or (member (car elm) keep-list)
- (not (assoc (car elm) new)))
- (push elm new)))
- (nreverse new)))
+ ;; The order is kept unless SORT is set (faster!).
+ (setq keep-list (sort (copy-sequence keep-list) #'string<)
+ alist (copy-sequence alist))
+ (if sort
+ (let (lst elt)
+ (setq alist (sort alist (lambda(a b) (string< (car a) (car b)))))
+ (setq lst alist)
+ (while (cdr lst)
+ (setq elt (car (car lst)))
+ (when (string= elt (car (cadr lst)))
+ (while (and keep-list (string< (car keep-list) elt))
+ (pop keep-list))
+ (if (and keep-list (string= elt (car keep-list)))
+ (progn
+ (pop lst)
+ (while (and (cdr lst)
+ (string= elt (car (cadr lst))))
+ (pop lst)))
+ (setcdr lst (cdr (cdr lst)))
+ (while (and (cdr lst)
+ (string= elt (car (cadr lst))))
+ (setcdr lst (cdr (cdr lst))))))
+ (pop lst))
+ alist)
+ (let ((p alist) lst elt)
+ (while p
+ (push p lst)
+ (setq p (cdr p)))
+ (setq lst (sort lst (lambda(a b) (string< (car (car a))
+ (car (car b))))))
+ (while (cdr lst)
+ (setq elt (car (car (car lst))))
+ (when (string= elt (car (car (cadr lst))))
+ (while (and keep-list (string< (car keep-list) elt))
+ (pop keep-list))
+ (if (and keep-list (string= elt (car keep-list)))
+ (progn
+ (pop lst)
+ (while (and (cdr lst)
+ (string= elt (car (car (cadr lst)))))
+ (pop lst)))
+ (setcar (pop lst) nil)
+ (while (and (cdr lst)
+ (string= elt (car (car (cadr lst)))))
+ (setcar (pop lst) nil))))
+ (pop lst)))
+ (delq nil alist)))
+
+(defun reftex-remove-if (predicate list)
+ "Nondestructively remove all items from LIST which satisfy PREDICATE."
+ (let (result)
+ (dolist (elt list (nreverse result))
+ (unless (funcall predicate elt)
+ (push elt result)))))
(defun reftex-abbreviate-title (string)
(reftex-convert-string string "[-~ \t\n\r,;]" nil t t
@@ -2243,6 +2113,7 @@ IGNORE-WORDS List of words which should be removed from the string."
((= (length text) 0) (make-string 1 ?\ ))
(t text)))
+
;;; =========================================================================
;;;
;;; Fontification and Highlighting
@@ -2311,9 +2182,7 @@ IGNORE-WORDS List of words which should be removed from the string."
;; Return the first valid face in FACES, or nil if none is valid.
;; Also, when finding a nil element in FACES, return nil. This
;; function is just a safety net to catch name changes of builtin
- ;; fonts. Currently it is only used for reftex-label-face, which has
- ;; as default font-lock-reference-face, which was recently renamed
- ;; to font-lock-constant-face.
+ ;; fonts. Currently it is only used for reftex-label-face.
(let (face)
(catch 'exit
(while (setq face (pop faces))
@@ -2392,28 +2261,20 @@ IGNORE-WORDS List of words which should be removed from the string."
"bibtex"
'(define-key bibtex-mode-map "\C-c&" 'reftex-view-crossref-from-bibtex))
-;; If the user requests so, she can have a few more bindings:
;; For most of these commands there are already bindings in place.
;; Setting `reftex-extra-bindings' really is only there to spare users
;; the hassle of defining bindings in the user space themselves. This
;; is why they violate the key binding recommendations.
-(defvar reftex-extra-bindings-map
- (let ((map (make-sparse-keymap)))
- (define-key map "t" 'reftex-toc)
- (define-key map "l" 'reftex-label)
- (define-key map "r" 'reftex-reference)
- (define-key map "c" 'reftex-citation)
- (define-key map "v" 'reftex-view-crossref)
- (define-key map "g" 'reftex-grep-document)
- (define-key map "s" 'reftex-search-document)
- map)
- "Reftex extra bindings map")
-
(when reftex-extra-bindings
- (define-key reftex-mode-map
- reftex-extra-bindings-prefix
- reftex-extra-bindings-map))
-
+ (loop for x in
+ '(("\C-ct" . reftex-toc)
+ ("\C-cl" . reftex-label)
+ ("\C-cr" . reftex-reference)
+ ("\C-cc" . reftex-citation)
+ ("\C-cv" . reftex-view-crossref)
+ ("\C-cg" . reftex-grep-document)
+ ("\C-cs" . reftex-search-document))
+ do (define-key reftex-mode-map (car x) (cdr x))))
;;; =========================================================================
;;;
@@ -2490,21 +2351,22 @@ IGNORE-WORDS List of words which should be removed from the string."
:style radio :selected (eq reftex-auto-view-crossref 'window)]
"--"
"MISC"
- ["AUC TeX Interface" reftex-toggle-plug-into-AUCTeX
+ ["AUCTeX Interface" reftex-toggle-plug-into-AUCTeX
:style toggle :selected reftex-plug-into-AUCTeX]
["isearch whole document" reftex-isearch-minor-mode
:style toggle :selected reftex-isearch-minor-mode])
("Reference Style"
- ["Default" (setq reftex-vref-is-default nil
- reftex-fref-is-default nil)
- :style radio :selected (not (or reftex-vref-is-default
- reftex-fref-is-default))]
- ["Varioref" (setq reftex-vref-is-default t
- reftex-fref-is-default nil)
- :style radio :selected reftex-vref-is-default]
- ["Fancyref" (setq reftex-fref-is-default t
- reftex-vref-is-default nil)
- :style radio :selected reftex-fref-is-default])
+ ,@(let (list item)
+ (dolist (elt reftex-ref-style-alist)
+ (setq elt (car elt)
+ item (vector
+ elt
+ `(reftex-ref-style-toggle ,elt)
+ :style 'toggle
+ :selected `(member ,elt (reftex-ref-style-list))))
+ (unless (member item list)
+ (add-to-list 'list item t)))
+ list))
("Citation Style"
,@(mapcar
(lambda (x)
@@ -2570,6 +2432,9 @@ IGNORE-WORDS List of words which should be removed from the string."
(message "\"Ref\"-menu now contains full customization menu"))
(error "Cannot expand menu (outdated version of cus-edit.el)")))
+
+;;; Misc
+
(defun reftex-show-commentary ()
"Use the finder to view the file documentation from `reftex.el'."
(interactive)
@@ -2581,6 +2446,36 @@ With optional NODE, go directly to that node."
(interactive)
(info (format "(reftex)%s" (or node ""))))
+(defun reftex-report-bug ()
+ "Report a bug in RefTeX.
+
+Don't hesitate to report any problems or inaccurate documentation.
+
+If you don't have setup sending mail from (X)Emacs, please copy the
+output buffer into your mail program, as it gives us important
+information about your RefTeX version and configuration."
+ (interactive)
+ (require 'reporter)
+ (let ((reporter-prompt-for-summary-p "Bug report subject: "))
+ (reporter-submit-bug-report
+ "bug-auctex@gnu.org"
+ reftex-version
+ (list 'window-system
+ 'reftex-plug-into-AUCTeX)
+ nil nil
+ "Remember to cover the basics, that is, what you expected to happen and
+what in fact did happen.
+
+Check if the bug is reproducible with an up-to-date version of
+RefTeX available from http://www.gnu.org/software/auctex/.
+
+If the bug is triggered by a specific \(La\)TeX file, you should try
+to produce a minimal sample file showing the problem and include it
+in your report.
+
+Your bug report will be posted to the AUCTeX bug reporting list.
+------------------------------------------------------------------------")))
+
;;; Install the kill-buffer and kill-emacs hooks ------------------------------
(add-hook 'kill-buffer-hook 'reftex-kill-buffer-hook)
@@ -2596,6 +2491,4 @@ With optional NODE, go directly to that node."
(setq reftex-tables-dirty t) ; in case this file is evaluated by hand
(provide 'reftex)
-;;;============================================================================
-
;;; reftex.el ends here
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index e2647a98770..b0adb35f768 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -103,11 +103,55 @@
;;; Code:
+;; FIXME: Check through major mode conventions again.
+
;; FIXME: Add proper ";;;###autoload" comments.
;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*-
;; lexical-binding: t -*-" in the first line.
+;; FIXME: Use `testcover'.
+
+;; FIXME: The adornment classification often called `ado' should be a
+;; `defstruct'.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Support for `testcover'
+
+(when (and (boundp 'testcover-1value-functions)
+ (boundp 'testcover-compose-functions))
+ ;; Below `lambda' is used in a loop with varying parameters and is thus not
+ ;; 1valued.
+ (setq testcover-1value-functions
+ (delq 'lambda testcover-1value-functions))
+ (add-to-list 'testcover-compose-functions 'lambda))
+
+(defun rst-testcover-defcustom ()
+ "Remove all customized variables from `testcover-module-constants'.
+This seems to be a bug in `testcover': `defcustom' variables are
+considered constants. Revert it with this function after each `defcustom'."
+ (when (boundp 'testcover-module-constants)
+ (setq testcover-module-constants
+ (delq nil
+ (mapcar
+ (lambda (sym)
+ (if (not (plist-member (symbol-plist sym) 'standard-value))
+ sym))
+ testcover-module-constants)))))
+
+(defun rst-testcover-add-compose (fun)
+ "Add FUN to `testcover-compose-functions'."
+ (when (boundp 'testcover-compose-functions)
+ (add-to-list 'testcover-compose-functions fun)))
+
+(defun rst-testcover-add-1value (fun)
+ "Add FUN to `testcover-1value-functions'."
+ (when (boundp 'testcover-1value-functions)
+ (add-to-list 'testcover-1value-functions fun)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Common Lisp stuff
+
;; Only use of macros is allowed - may be replaced by `cl-lib' some time.
(eval-when-compile
(require 'cl))
@@ -160,6 +204,7 @@ Comparison done with `equal'."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Versions
+;; testcover: ok.
(defun rst-extract-version (delim-re head-re re tail-re var &optional default)
"Extract the version from a variable according to the given regexes.
Return the version after regex DELIM-RE and HEAD-RE matching RE
@@ -173,7 +218,7 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
;; Use CVSHeader to really get information from CVS and not other version
;; control systems.
(defconst rst-cvs-header
- "$CVSHeader: sm/rst_el/rst.el,v 1.301 2012-07-30 19:29:46 stefan Exp $")
+ "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.6 2012-10-07 13:05:50 stefan Exp $")
(defconst rst-cvs-rev
(rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+"
" .*" rst-cvs-header "0.0")
@@ -187,22 +232,22 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
;; Use LastChanged... to really get information from SVN.
(defconst rst-svn-rev
(rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " "
- "$LastChangedRevision: 7490 $")
+ "$LastChangedRevision: 7515 $")
"The SVN revision of this file.
SVN revision is the upstream (docutils) revision.")
(defconst rst-svn-timestamp
(rst-extract-version "\\$" "LastChangedDate: " ".+?+" " "
- "$LastChangedDate: 2012-07-30 21:29:33 +0200 (Mon, 30 Jul 2012) $")
+ "$LastChangedDate: 2012-09-20 23:28:53 +0200 (Thu, 20 Sep 2012) $")
"The SVN time stamp of this file.")
;; Maintained by the release process.
(defconst rst-official-version
(rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
- "%OfficialVersion: 1.3.1 %")
+ "%OfficialVersion: 1.4.0 %")
"Official version of the package.")
(defconst rst-official-cvs-rev
(rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
- "%Revision: 1.301 %")
+ "%Revision: 1.327 %")
"CVS revision of this file in the official version.")
(defconst rst-version
@@ -221,6 +266,7 @@ in parentheses follows the development revision and the time stamp.")
("1.2.1" . "24.3")
("1.3.0" . "24.3")
("1.3.1" . "24.3")
+ ("1.4.0" . "24.3")
))
(unless (assoc rst-official-version rst-package-emacs-version-alist)
@@ -483,6 +529,8 @@ argument list for `rst-re'.")
(defvar rst-re-alist) ; Forward declare to use it in `rst-re'.
;; FIXME: Use `sregex` or `rx` instead of re-inventing the wheel.
+(rst-testcover-add-compose 'rst-re)
+;; testcover: ok.
(defun rst-re (&rest args)
"Interpret ARGS as regular expressions and return a regex string.
Each element of ARGS may be one of the following:
@@ -556,6 +604,7 @@ After interpretation of ARGS the results are concatenated as for
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mode definition
+;; testcover: ok.
(defun rst-define-key (keymap key def &rest deprecated)
"Bind like `define-key' but add deprecated key definitions.
KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key
@@ -734,6 +783,7 @@ This inherits from Text mode.")
The hook for `text-mode' is run before this one."
:group 'rst
:type '(hook))
+(rst-testcover-defcustom)
;; Pull in variable definitions silencing byte-compiler.
(require 'newcomment)
@@ -799,6 +849,12 @@ highlighting.
(set (make-local-variable 'uncomment-region-function)
'rst-uncomment-region)
+ ;; Imenu and which function.
+ ;; FIXME: Check documentation of `which-function' for alternative ways to
+ ;; determine the current function name.
+ (set (make-local-variable 'imenu-create-index-function)
+ 'rst-imenu-create-index)
+
;; Font lock.
(set (make-local-variable 'font-lock-defaults)
'(rst-font-lock-keywords
@@ -911,7 +967,7 @@ for modes derived from Text mode, like Mail mode."
:version "21.1")
(define-obsolete-variable-alias
- 'rst-preferred-decorations 'rst-preferred-adornments "1.0.0")
+ 'rst-preferred-decorations 'rst-preferred-adornments "rst 1.0.0")
(defcustom rst-preferred-adornments '((?= over-and-under 1)
(?= simple 0)
(?- simple 0)
@@ -949,6 +1005,7 @@ file."
(const :tag "Underline only" simple))
(integer :tag "Indentation for overline and underline type"
:value 0))))
+(rst-testcover-defcustom)
(defcustom rst-default-indent 1
"Number of characters to indent the section title.
@@ -958,7 +1015,7 @@ from a simple adornment style to a over-and-under adornment
style."
:group 'rst-adjust
:type '(integer))
-
+(rst-testcover-defcustom)
(defun rst-compare-adornments (ado1 ado2)
"Compare adornments.
@@ -979,7 +1036,8 @@ not found."
(setq cur (cdr cur)))
cur))
-
+;; testcover: FIXME: Test with `rst-preferred-adornments' == nil. Add test
+;; `rst-adjust-no-preference'.
(defun rst-suggest-new-adornment (allados &optional prev)
"Suggest a new, different adornment from all that have been seen.
@@ -1032,7 +1090,7 @@ requested adornment."
len)
;; Fixup whitespace at the beginning and end of the line.
- (if (or (null indent) (eq style 'simple))
+ (if (or (null indent) (eq style 'simple)) ;; testcover: ok.
(setq indent 0))
(beginning-of-line)
(delete-horizontal-space)
@@ -1046,7 +1104,8 @@ requested adornment."
;; Remove previous line if it is an adornment.
(save-excursion
- (forward-line -1)
+ (forward-line -1) ;; testcover: FIXME: Doesn't work when in first line
+ ;; of buffer.
(if (and (looking-at (rst-re 'ado-beg-2-1))
;; Avoid removing the underline of a title right above us.
(save-excursion (forward-line -1)
@@ -1055,7 +1114,8 @@ requested adornment."
;; Remove following line if it is an adornment.
(save-excursion
- (forward-line +1)
+ (forward-line +1) ;; testcover: FIXME: Doesn't work when in last line
+ ;; of buffer.
(if (looking-at (rst-re 'ado-beg-2-1))
(rst-delete-entire-line))
;; Add a newline if we're at the end of the buffer, for the subsequence
@@ -1071,13 +1131,14 @@ requested adornment."
(insert (make-string len char))))
;; Insert underline.
- (forward-line +1)
+ (1value ;; Line has been inserted above.
+ (forward-line +1))
(open-line 1)
(insert (make-string len char))
- (forward-line +1)
- (goto-char marker)
- ))
+ (1value ;; Line has been inserted above.
+ (forward-line +1))
+ (goto-char marker)))
(defun rst-classify-adornment (adornment end)
"Classify adornment for section titles and transitions.
@@ -1104,11 +1165,14 @@ Return nil if no syntactically valid adornment is found."
(ado-re (rst-re ado-ch 'adorep3-hlp))
(end-pnt (point))
(beg-pnt (progn
- (forward-line 0)
+ (1value ;; No lines may be left to move.
+ (forward-line 0))
(point)))
(nxt-emp ; Next line nonexistent or empty
(save-excursion
(or (not (zerop (forward-line 1)))
+ ;; testcover: FIXME: Add test classifying at the end of
+ ;; buffer.
(looking-at (rst-re 'lin-end)))))
(prv-emp ; Previous line nonexistent or empty
(save-excursion
@@ -1117,7 +1181,9 @@ Return nil if no syntactically valid adornment is found."
(ttl-blw ; Title found below starting here.
(save-excursion
(and
- (zerop (forward-line 1))
+ (zerop (forward-line 1)) ;; testcover: FIXME: Add test
+ ;; classifying at the end of
+ ;; buffer.
(looking-at (rst-re 'ttl-beg))
(point))))
(ttl-abv ; Title found above starting here.
@@ -1129,7 +1195,9 @@ Return nil if no syntactically valid adornment is found."
(und-fnd ; Matching underline found starting here.
(save-excursion
(and ttl-blw
- (zerop (forward-line 2))
+ (zerop (forward-line 2)) ;; testcover: FIXME: Add test
+ ;; classifying at the end of
+ ;; buffer.
(looking-at (rst-re ado-re 'lin-end))
(point))))
(ovr-fnd ; Matching overline found starting here.
@@ -1174,8 +1242,8 @@ Return nil if no syntactically valid adornment is found."
(setq key nil)))
(if key
(list key
- (or beg-ovr beg-txt beg-und)
- (or end-und end-txt end-ovr)
+ (or beg-ovr beg-txt)
+ (or end-und end-txt)
beg-ovr end-ovr beg-txt end-txt beg-und end-und)))))))
(defun rst-find-title-line ()
@@ -1193,7 +1261,8 @@ in the first element. If there is no adornment around the title
CHARACTER is also nil and match groups for overline and underline
are nil."
(save-excursion
- (forward-line 0)
+ (1value ;; No lines may be left to move.
+ (forward-line 0))
(let ((orig-pnt (point))
(orig-end (line-end-position)))
(cond
@@ -1253,6 +1322,7 @@ t when no section adornments were found. Value depends on
`rst-all-sections'.")
(make-variable-buffer-local 'rst-section-hierarchy)
+(rst-testcover-add-1value 'rst-reset-section-caches)
(defun rst-reset-section-caches ()
"Reset all section cache variables.
Should be called by interactive functions which deal with sections."
@@ -1354,9 +1424,7 @@ Return a list of the previous and next adornments."
(if (and cur (caar cur))
(setq next (if (= curline (caar cur)) (cdr cur) cur)))
- (mapcar 'cdar (list prev next))
- ))
-
+ (mapcar 'cdar (list prev next))))
(defun rst-adornment-complete-p (ado)
"Return true if the adornment ADO around point is complete."
@@ -1369,8 +1437,7 @@ Return a list of the previous and next adornments."
(let* ((char (car ado))
(style (cadr ado))
(indent (caddr ado))
- (endcol (save-excursion (end-of-line) (current-column)))
- )
+ (endcol (save-excursion (end-of-line) (current-column))))
(if char
(let ((exps (rst-re "^" char (format "\\{%d\\}" (+ endcol indent)) "$")))
(and
@@ -1380,9 +1447,7 @@ Return a list of the previous and next adornments."
(or (not (eq style 'over-and-under))
(save-excursion (forward-line -1)
(beginning-of-line)
- (looking-at exps))))
- ))
- ))
+ (looking-at exps))))))))
(defun rst-get-next-adornment
@@ -1414,8 +1479,7 @@ REVERSE-DIRECTION is used to reverse the cycling order."
cur))
;; If not found, take the first of all adornments.
- suggestion
- )))
+ suggestion)))
;; FIXME: A line "``/`` full" is not accepted as a section title.
@@ -1456,7 +1520,7 @@ b. a negative numerical argument, which generally inverts the
(reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0)))
(toggle-style (and pfxarg (not reverse-direction))))
- (if (rst-portable-mark-active-p)
+ (if (use-region-p)
;; Adjust adornments within region.
(rst-promote-region (and pfxarg t))
;; Adjust adornment around point.
@@ -1466,15 +1530,14 @@ b. a negative numerical argument, which generally inverts the
(run-hooks 'rst-adjust-hook)
;; Make sure to reset the cursor position properly after we're done.
- (goto-char origpt)
-
- ))
+ (goto-char origpt)))
(defcustom rst-adjust-hook nil
"Hooks to be run after running `rst-adjust'."
:group 'rst-adjust
:type '(hook)
:package-version '(rst . "1.1.0"))
+(rst-testcover-defcustom)
(defcustom rst-new-adornment-down nil
"Controls level of new adornment for section headers."
@@ -1483,6 +1546,7 @@ b. a negative numerical argument, which generally inverts the
(const :tag "Same level as previous one" nil)
(const :tag "One level down relative to the previous one" t))
:package-version '(rst . "1.1.0"))
+(rst-testcover-defcustom)
(defun rst-adjust-adornment (pfxarg)
"Call `rst-adjust-adornment-work' interactively.
@@ -1741,8 +1805,7 @@ hierarchy is similar to that used by `rst-adjust-adornment-work'."
(region-begin-line (line-number-at-pos (region-beginning)))
(region-end-line (line-number-at-pos (region-end)))
- marker-list
- )
+ marker-list)
;; Skip the markers that come before the region beginning.
(while (and cur (< (caar cur) region-begin-line))
@@ -1771,8 +1834,7 @@ hierarchy is similar to that used by `rst-adjust-adornment-work'."
;; Clear marker to avoid slowing down the editing after we're done.
(set-marker (car p) nil))
- (setq deactivate-mark nil)
- )))
+ (setq deactivate-mark nil))))
@@ -1792,9 +1854,7 @@ in ADORNMENTS."
(apply 'rst-update-section x)
(goto-char (point-max))
(insert "\n")
- (incf level)
- ))
- )))
+ (incf level))))))
(defun rst-straighten-adornments ()
"Redo all the adornments in the current buffer.
@@ -1822,10 +1882,7 @@ in order to adapt it to our preferred style."
(apply 'rst-update-section (nth (car lm) rst-preferred-adornments))
;; Reset the marker to avoid slowing down editing until it gets GC'ed.
- (set-marker (cdr lm) nil)
- )
- )))
-
+ (set-marker (cdr lm) nil)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1906,7 +1963,7 @@ and the column of the point."
(looking-at pfx-re)))))) ; ...pfx at same level.
(push (cons (point) (current-column))
pfx))
- (forward-line 1)) )
+ (forward-line 1)))
(nreverse pfx)))
(defun rst-insert-list-pos (newitem)
@@ -2005,6 +2062,7 @@ starting item, for example 'e' for 'A)' style. The position is also arranged by
:tag (char-to-string char) char))
rst-bullets)))
:package-version '(rst . "1.1.0"))
+(rst-testcover-defcustom)
(defun rst-insert-list-continue (curitem prefer-roman)
"Insert a list item with list start CURITEM including its indentation level.
@@ -2123,130 +2181,112 @@ adjust. If bullets are found on levels beyond the
;; Table of contents
;; =================
-(defun rst-get-stripped-line ()
- "Return the line at cursor, stripped from whitespace."
- (re-search-forward (rst-re "\\S .*\\S ") (line-end-position))
- (buffer-substring-no-properties (match-beginning 0)
- (match-end 0)) )
-
+;; FIXME: Return value should be a `defstruct'.
(defun rst-section-tree ()
- "Get the hierarchical tree of section titles.
-
-Returns a hierarchical tree of the sections titles in the
-document. This can be used to generate a table of contents for
-the document. The top node will always be a nil node, with the
-top level titles as children (there may potentially be more than
-one).
-
-Each section title consists in a cons of the stripped title
-string and a marker to the section in the original text document.
-
-If there are missing section levels, the section titles are
-inserted automatically, and the title string is set to nil, and
-the marker set to the first non-nil child of itself.
-Conceptually, the nil nodes--i.e.\ those which have no title--are
-to be considered as being the same line as their first non-nil
-child. This has advantages later in processing the graph."
-
+ "Return the hierarchical tree of section titles.
+A tree entry looks like ((TITLE MARKER) CHILD...). TITLE is the
+stripped text of the section title. MARKER is a marker for the
+beginning of the title text. For the top node or a missing
+section level node TITLE is nil and MARKER points to the title
+text of the first child. Each CHILD is another tree entry. The
+CHILD list may be empty."
(let ((hier (rst-get-hierarchy))
- (levels (make-hash-table :test 'equal :size 10))
- lines)
+ (ch-sty2level (make-hash-table :test 'equal :size 10))
+ lev-ttl-mrk-l)
(let ((lev 0))
(dolist (ado hier)
;; Compare just the character and indent in the hash table.
- (puthash (cons (car ado) (cadr ado)) lev levels)
+ (puthash (cons (car ado) (cadr ado)) lev ch-sty2level)
(incf lev)))
- ;; Create a list of lines that contains (text, level, marker) for each
- ;; adornment.
+ ;; Create a list that contains (LEVEL TITLE MARKER) for each adornment.
(save-excursion
- (setq lines
+ (setq lev-ttl-mrk-l
(mapcar (lambda (ado)
(goto-char (point-min))
- (forward-line (1- (car ado)))
- (list (gethash (cons (cadr ado) (caddr ado)) levels)
- (rst-get-stripped-line)
- (progn
- (beginning-of-line 1)
- (point-marker))))
+ (1value ;; This should really succeed.
+ (forward-line (1- (car ado))))
+ (list (gethash (cons (cadr ado) (caddr ado)) ch-sty2level)
+ ;; Get title.
+ (save-excursion
+ (if (re-search-forward
+ (rst-re "\\S .*\\S ") (line-end-position) t)
+ (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0))
+ ""))
+ (point-marker)))
(rst-find-all-adornments))))
- (let ((lcontnr (cons nil lines)))
- (rst-section-tree-rec lcontnr -1))))
-
-
-(defun rst-section-tree-rec (ados lev)
- "Recursive guts of the section tree construction.
-ADOS is a cons cell whose cdr is the remaining list of
-adornments, and we change it as we consume them. LEV is
-the current level of that node. This function returns a
-pair of the subtree that was built. This treats the ADOS
-list destructively."
-
- (let ((nado (cadr ados))
- node
- children)
-
- ;; If the next adornment matches our level.
- (when (and nado (= (car nado) lev))
- ;; Pop the next adornment and create the current node with it.
- (setcdr ados (cddr ados))
- (setq node (cdr nado)) )
- ;; Else we let the node title/marker be unset.
-
- ;; Build the child nodes.
- (while (and (cdr ados) (> (caadr ados) lev))
- (setq children
- (cons (rst-section-tree-rec ados (1+ lev))
- children)))
+ (cdr (rst-section-tree-rec lev-ttl-mrk-l -1))))
+
+;; FIXME: Return value should be a `defstruct'.
+(defun rst-section-tree-rec (remaining lev)
+ "Process the first entry of REMAINING expected to be on level LEV.
+REMAINING is the remaining list of adornments consisting
+of (LEVEL TITLE MARKER) entries.
+
+Return (UNPROCESSED (TITLE MARKER) CHILD...) for the first entry
+of REMAINING where TITLE is nil if the expected level is not
+matched. UNPROCESSED is the list of still unprocessed entries.
+Each CHILD is a child of this entry in the same format but
+without UNPROCESSED."
+ (let ((cur (car remaining))
+ (unprocessed remaining)
+ ttl-mrk children)
+ ;; If the current adornment matches expected level.
+ (when (and cur (= (car cur) lev))
+ ;; Consume the current entry and create the current node with it.
+ (setq unprocessed (cdr remaining))
+ (setq ttl-mrk (cdr cur)))
+
+ ;; Build the child nodes as long as they have deeper level.
+ (while (and unprocessed (> (caar unprocessed) lev))
+ (let ((rem-children (rst-section-tree-rec unprocessed (1+ lev))))
+ (setq children (cons (cdr rem-children) children))
+ (setq unprocessed (car rem-children))))
(setq children (reverse children))
- ;; If node is still unset, we use the marker of the first child.
- (when (eq node nil)
- (setq node (cons nil (cdaar children))))
-
- ;; Return this node with its children.
- (cons node children)
- ))
-
-
-(defun rst-section-tree-point (node &optional point)
- "Find tree node at point.
-Given a computed and valid section tree in NODE and a point
-POINT (default being the current point in the current buffer),
-find and return the node within the section tree where the cursor
-lives.
-
-Return values: a pair of (parent path, container subtree).
-The parent path is simply a list of the nodes above the
-container subtree node that we're returning."
-
- (let (path outtree)
-
- (let* ((curpoint (or point (point))))
-
- ;; Check if we are before the current node.
- (if (and (cadar node) (>= curpoint (cadar node)))
-
- ;; Iterate all the children, looking for one that might contain the
- ;; current section.
- (let ((curnode (cdr node))
- last)
-
- (while (and curnode (>= curpoint (cadaar curnode)))
- (setq last curnode
- curnode (cdr curnode)))
-
- (if last
- (let ((sub (rst-section-tree-point (car last) curpoint)))
- (setq path (car sub)
- outtree (cdr sub)))
- (setq outtree node))
-
- )))
- (cons (cons (car node) path) outtree)
- ))
-
+ (cons unprocessed
+ (cons (or ttl-mrk
+ ;; Node on this level missing - use nil as text and the
+ ;; marker of the first child.
+ (cons nil (cdaar children)))
+ children))))
+
+(defun rst-section-tree-point (tree &optional point)
+ "Return section containing POINT by returning the closest node in TREE.
+TREE is a section tree as returned by `rst-section-tree'
+consisting of (NODE CHILD...) entries. POINT defaults to the
+current point. A NODE must have the structure (IGNORED MARKER
+...).
+
+Return (PATH NODE CHILD...). NODE is the node where POINT is in
+if any. PATH is a list of nodes from the top of the tree down to
+and including NODE. List of CHILD are the children of NODE if
+any."
+ (setq point (or point (point)))
+ (let ((cur (car tree))
+ (children (cdr tree)))
+ ;; Point behind current node?
+ (if (and (cadr cur) (>= point (cadr cur)))
+ ;; Iterate all the children, looking for one that might contain the
+ ;; current section.
+ (let (found)
+ (while (and children (>= point (cadaar children)))
+ (setq found children
+ children (cdr children)))
+ (if found
+ ;; Found section containing point in children.
+ (let ((sub (rst-section-tree-point (car found) point)))
+ ;; Extend path with current node and return NODE CHILD... from
+ ;; sub.
+ (cons (cons cur (car sub)) (cdr sub)))
+ ;; Point in this section: Start a new path with current node and
+ ;; return current NODE CHILD...
+ (cons (list cur) tree)))
+ ;; Current node behind point: start a new path with current node and
+ ;; no NODE CHILD...
+ (list (list cur)))))
(defgroup rst-toc nil
"Settings for reStructuredText table of contents."
@@ -2257,6 +2297,7 @@ container subtree node that we're returning."
"Indentation for table-of-contents display.
Also used for formatting insertion, when numbering is disabled."
:group 'rst-toc)
+(rst-testcover-defcustom)
(defcustom rst-toc-insert-style 'fixed
"Insertion style for table-of-contents.
@@ -2267,10 +2308,12 @@ indentation style:
- aligned: numbering, titles aligned under each other
- listed: numbering, with dashes like list items (EXPERIMENTAL)"
:group 'rst-toc)
+(rst-testcover-defcustom)
(defcustom rst-toc-insert-number-separator " "
"Separator that goes between the TOC number and the title."
:group 'rst-toc)
+(rst-testcover-defcustom)
;; This is used to avoid having to change the user's mode.
(defvar rst-toc-insert-click-keymap
@@ -2282,7 +2325,7 @@ indentation style:
(defcustom rst-toc-insert-max-level nil
"If non-nil, maximum depth of the inserted TOC."
:group 'rst-toc)
-
+(rst-testcover-defcustom)
(defun rst-toc-insert (&optional pfxarg)
"Insert a simple text rendering of the table of contents.
@@ -2316,8 +2359,7 @@ The TOC is inserted indented at the current column."
(delete-region init-point (+ init-point (length initial-indent)))
;; Delete the last newline added.
- (delete-char -1)
- )))
+ (delete-char -1))))
(defun rst-toc-insert-node (node level indent pfx)
"Insert tree node NODE in table-of-contents.
@@ -2343,9 +2385,7 @@ level to align."
;; is generated automatically.
(put-text-property b (point) 'mouse-face 'highlight)
(put-text-property b (point) 'rst-toc-target (cadar node))
- (put-text-property b (point) 'keymap rst-toc-insert-click-keymap)
-
- )
+ (put-text-property b (point) 'keymap rst-toc-insert-click-keymap))
(insert "\n")
;; Prepare indent for children.
@@ -2362,9 +2402,7 @@ level to align."
((eq rst-toc-insert-style 'listed)
(concat (substring indent 0 -3)
- (concat (make-string (+ (length pfx) 2) ? ) " - ")))
- ))
- )
+ (concat (make-string (+ (length pfx) 2) ? ) " - "))))))
(if (or (eq rst-toc-insert-max-level nil)
(< level rst-toc-insert-max-level))
@@ -2382,8 +2420,7 @@ level to align."
(if (cdr node)
(setq fmt (format "%%-%dd"
(1+ (floor (log10 (length
- (cdr node))))))))
- ))
+ (cdr node))))))))))
(dolist (child (cdr node))
(rst-toc-insert-node child
@@ -2391,9 +2428,7 @@ level to align."
indent
(if do-child-numbering
(concat pfx (format fmt count)) pfx))
- (incf count)))
-
- )))
+ (incf count))))))
(defun rst-toc-update ()
@@ -2468,8 +2503,7 @@ file-write hook to always make it up-to-date automatically."
;; Add link on lines.
(put-text-property b (point) 'rst-toc-target (cadar node))
- (insert "\n")
- ))
+ (insert "\n")))
(dolist (child (cdr node))
(rst-toc-node child (1+ level))))
@@ -2517,8 +2551,7 @@ brings the cursor in that section."
line
;; Create a temporary buffer.
- (buf (get-buffer-create rst-toc-buffer-name))
- )
+ (buf (get-buffer-create rst-toc-buffer-name)))
(with-current-buffer buf
(let ((inhibit-read-only t))
@@ -2531,8 +2564,7 @@ brings the cursor in that section."
;; Count the lines to our found node.
(let ((linefound (rst-toc-count-lines sectree our-node)))
- (setq line (if (cdr linefound) (car linefound) 0)))
- ))
+ (setq line (if (cdr linefound) (car linefound) 0)))))
(display-buffer buf)
(pop-to-buffer buf)
@@ -2541,8 +2573,7 @@ brings the cursor in that section."
;; Move the cursor near the right section in the TOC.
(goto-char (point-min))
- (forward-line (1- line))
- ))
+ (forward-line (1- line))))
(defun rst-toc-mode-find-section ()
@@ -2644,8 +2675,7 @@ backwards in the file (default is to use 1)."
(curline (line-number-at-pos))
(cur allados)
- (idx 0)
- )
+ (idx 0))
;; Find the index of the "next" adornment w.r.t. to the current line.
(while (and cur (< (caar cur) curline))
@@ -2666,8 +2696,7 @@ backwards in the file (default is to use 1)."
(progn
(goto-char (point-min))
(forward-line (1- (car cur))))
- (if (> offset 0) (goto-char (point-max)) (goto-char (point-min))))
- ))
+ (if (> offset 0) (goto-char (point-max)) (goto-char (point-min))))))
(defun rst-backward-section ()
"Like `rst-forward-section', except move back one title."
@@ -2686,7 +2715,7 @@ for negative COUNT."
(error "Cannot mark zero sections"))
(cond ((and allow-extend
(or (and (eq last-command this-command) (mark t))
- (rst-portable-mark-active-p)))
+ (use-region-p)))
(set-mark
(save-excursion
(goto-char (mark))
@@ -2742,17 +2771,14 @@ of each paragraph only."
(valid (and (= curcol leftcol)
(not (looking-at (rst-re 'lin-end))))
(and (= curcol leftcol)
- (not (looking-at (rst-re 'lin-end)))))
- )
+ (not (looking-at (rst-re 'lin-end))))))
((>= (point) endm))
(if (if ,first-only
(and valid (not previous))
valid)
,body-consequent
- ,body-alternative)
-
- ))))
+ ,body-alternative)))))
;; FIXME: This needs to be refactored. Probably this is simply a function
;; applying BODY rather than a macro.
@@ -2785,13 +2811,10 @@ first of a paragraph."
(,isleftmost (and (not ,isempty)
(= (current-column) ,leftmost))
(and (not ,isempty)
- (= (current-column) ,leftmost)))
- )
+ (= (current-column) ,leftmost))))
((>= (point) endm))
- (progn ,@body)
-
- )))))
+ (progn ,@body))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Indentation
@@ -2812,31 +2835,40 @@ here."
:package-version '(rst . "1.1.0"))
(define-obsolete-variable-alias
- 'rst-shift-basic-offset 'rst-indent-width "1.0.0")
+ 'rst-shift-basic-offset 'rst-indent-width "rst 1.0.0")
(defcustom rst-indent-width 2
"Indentation when there is no more indentation point given."
:group 'rst-indent
:type '(integer))
+(rst-testcover-defcustom)
(defcustom rst-indent-field 3
"Indentation for first line after a field or 0 to always indent for content."
:group 'rst-indent
+ :package-version '(rst . "1.1.0")
:type '(integer))
+(rst-testcover-defcustom)
(defcustom rst-indent-literal-normal 3
"Default indentation for literal block after a markup on an own line."
:group 'rst-indent
+ :package-version '(rst . "1.1.0")
:type '(integer))
+(rst-testcover-defcustom)
(defcustom rst-indent-literal-minimized 2
"Default indentation for literal block after a minimized markup."
:group 'rst-indent
+ :package-version '(rst . "1.1.0")
:type '(integer))
+(rst-testcover-defcustom)
(defcustom rst-indent-comment 3
"Default indentation for first line of a comment."
:group 'rst-indent
+ :package-version '(rst . "1.1.0")
:type '(integer))
+(rst-testcover-defcustom)
;; FIXME: Must consider other tabs:
;; * Line blocks
@@ -3116,8 +3148,7 @@ do all lines instead of just paragraphs."
(let ((ins-string (format "%d. " (incf count))))
(setq last-insert-len (length ins-string))
(insert ins-string))
- (insert (make-string last-insert-len ?\ ))
- )))
+ (insert (make-string last-insert-len ?\ )))))
(defun rst-bullet-list-region (beg end all)
"Add bullets to all the leftmost paragraphs in the given region.
@@ -3127,8 +3158,7 @@ do all lines instead of just paragraphs."
(rst-iterate-leftmost-paragraphs
beg end (not all)
(insert (car rst-preferred-bullets) " ")
- (insert " ")
- ))
+ (insert " ")))
;; FIXME: Does not deal with a varying number of digits appropriately.
;; FIXME: Does not deal with multiple levels independently.
@@ -3143,18 +3173,13 @@ Renumber as necessary. Region is from BEG to END."
(cons (copy-marker (car x))
(cdr x)))
(rst-find-pfx-in-region beg end (rst-re 'itmany-sta-1))))
- (count 1)
- )
+ (count 1))
(save-excursion
(dolist (x items)
(goto-char (car x))
(looking-at (rst-re 'itmany-beg-1))
(replace-match (format "%d." count) nil nil nil 1)
- (incf count)
- ))
- ))
-
-
+ (incf count)))))
;;------------------------------------------------------------------------------
@@ -3202,6 +3227,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-block-face
"customize the face `rst-block' instead."
"24.1")
@@ -3216,6 +3242,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-external-face
"customize the face `rst-external' instead."
"24.1")
@@ -3230,6 +3257,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-definition-face
"customize the face `rst-definition' instead."
"24.1")
@@ -3246,6 +3274,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too."
"Directives and roles."
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-directive-face
"customize the face `rst-directive' instead."
"24.1")
@@ -3260,6 +3289,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-comment-face
"customize the face `rst-comment' instead."
"24.1")
@@ -3274,6 +3304,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-emphasis1-face
"customize the face `rst-emphasis1' instead."
"24.1")
@@ -3287,6 +3318,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too."
"Double emphasis."
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-emphasis2-face
"customize the face `rst-emphasis2' instead."
"24.1")
@@ -3301,6 +3333,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-literal-face
"customize the face `rst-literal' instead."
"24.1")
@@ -3315,6 +3348,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-reference-face
"customize the face `rst-reference' instead."
"24.1")
@@ -3331,113 +3365,64 @@ Region is from RBEG to REND. With PFXARG set the empty lines too."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; FIXME LEVEL-FACE: May be this complicated mechanism should be replaced
-;; simply by a number of customizable faces `rst-header-%d'
-;; which by default are set properly for dark and light
-;; background. Initialization should come from the old
-;; variables if they exist. A maximum level of 6 should
-;; suffice - after that the last level should be repeated.
-;; Only `rst-adornment-faces-alist' is needed outside this
-;; block. Would also fix docutils-Bugs-3479594.
-
-(defgroup rst-faces-defaults nil
- "Values used to generate default faces for section titles on all levels.
-Tweak these if you are content with how section title faces are built in
-general but you do not like the details."
- :group 'rst-faces
- :version "21.1")
-
-(defun rst-set-level-default (sym val)
- "Set custom variable SYM affecting section title text face.
-Recompute the faces. VAL is the value to set."
- (custom-set-default sym val)
- ;; Also defines the faces initially when all values are available.
- (and (boundp 'rst-level-face-max)
- (boundp 'rst-level-face-format-light)
- (boundp 'rst-level-face-base-color)
- (boundp 'rst-level-face-step-light)
- (boundp 'rst-level-face-base-light)
- (fboundp 'rst-define-level-faces)
- (rst-define-level-faces)))
-
-;; Faces for displaying items on several levels. These definitions define
-;; different shades of gray where the lightest one (i.e. least contrasting on a
-;; light background) is used for level 1.
-(defcustom rst-level-face-max 6
- "Maximum depth of levels for which section title faces are defined."
- :group 'rst-faces-defaults
- :type '(integer)
- :set 'rst-set-level-default)
-;; FIXME: It should be possible to give "#RRGGBB" type of color values.
-;; Together with a `rst-level-face-end-light' this could be used for
-;; computing steps.
-;; FIXME: This variable should be combined with `rst-level-face-format-light'
-;; to a single string.
-(defcustom rst-level-face-base-color "grey"
- "Base name of the color for creating background colors in section title faces."
- :group 'rst-faces-defaults
- :type '(string)
- :set 'rst-set-level-default)
-;; FIXME LEVEL-FACE: This needs to be done differently: The faces must specify
-;; how they behave for dark and light background using the
-;; relevant options explained in `defface'.
-(defcustom rst-level-face-base-light
- (if (eq frame-background-mode 'dark)
- 15
- 85)
- "The lightness factor for the base color. This value is used for level 1.
-The default depends on whether the value of `frame-background-mode' is
-`dark' or not."
- :group 'rst-faces-defaults
- :type '(integer)
- :set 'rst-set-level-default)
-(defcustom rst-level-face-format-light "%2d"
- "The format for the lightness factor appended to the base name of the color.
-This value is expanded by `format' with an integer."
- :group 'rst-faces-defaults
- :type '(string)
- :set 'rst-set-level-default)
-;; FIXME LEVEL-FACE: This needs to be done differently: The faces must specify
-;; how they behave for dark and light background using the
-;; relevant options explained in `defface'.
-;; FIXME: Alternatively there could be a customizable variable
-;; `rst-level-face-end-light' which defines the end value and steps are
-;; computed
-(defcustom rst-level-face-step-light
- (if (eq frame-background-mode 'dark)
- 7
- -7)
- "The step width to use for the next color.
-The formula
-
- `rst-level-face-base-light'
- + (`rst-level-face-max' - 1) * `rst-level-face-step-light'
-
-must result in a color level which appended to `rst-level-face-base-color'
-using `rst-level-face-format-light' results in a valid color such as `grey50'.
-This color is used as background for section title text on level
-`rst-level-face-max'."
- :group 'rst-faces-defaults
- :type '(integer)
- :set 'rst-set-level-default)
+(dolist (var '(rst-level-face-max rst-level-face-base-color
+ rst-level-face-base-light
+ rst-level-face-format-light
+ rst-level-face-step-light
+ rst-level-1-face
+ rst-level-2-face
+ rst-level-3-face
+ rst-level-4-face
+ rst-level-5-face
+ rst-level-6-face))
+ (make-obsolete-variable var "customize the faces `rst-level-*' instead."
+ "24.3"))
+
+;; Define faces for the first 6 levels. More levels are possible, however.
+(defface rst-level-1 '((((background light)) (:background "grey85"))
+ (((background dark)) (:background "grey15")))
+ "Default face for section title text at level 1."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-2 '((((background light)) (:background "grey78"))
+ (((background dark)) (:background "grey22")))
+ "Default face for section title text at level 2."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-3 '((((background light)) (:background "grey71"))
+ (((background dark)) (:background "grey29")))
+ "Default face for section title text at level 3."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-4 '((((background light)) (:background "grey64"))
+ (((background dark)) (:background "grey36")))
+ "Default face for section title text at level 4."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-5 '((((background light)) (:background "grey57"))
+ (((background dark)) (:background "grey43")))
+ "Default face for section title text at level 5."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-6 '((((background light)) (:background "grey50"))
+ (((background dark)) (:background "grey50")))
+ "Default face for section title text at level 6."
+ :package-version '(rst . "1.4.0"))
(defcustom rst-adornment-faces-alist
- ;; FIXME LEVEL-FACE: Must be redone if `rst-level-face-max' is changed
- (let ((alist (copy-sequence '((t . rst-transition)
- (nil . rst-adornment))))
- (i 1))
- (while (<= i rst-level-face-max)
- ;; FIXME: why not `push'?
- (nconc alist (list (cons i (intern (format "rst-level-%d-face" i)))))
- (setq i (1+ i)))
- alist)
- "Faces for the various adornment types.
+ '((t . rst-transition)
+ (nil . rst-adornment)
+ (1 . rst-level-1)
+ (2 . rst-level-2)
+ (3 . rst-level-3)
+ (4 . rst-level-4)
+ (5 . rst-level-5)
+ (6 . rst-level-6))
+ "Faces for the various adornment types.
Key is a number (for the section title text of that level
starting with 1), t (for transitions) or nil (for section title
-adornment). If you generally do not like how section title text
-faces are set up tweak here. If the general idea is ok for you
-but you do not like the details check the Rst Faces Defaults
-group."
+adornment). If you need levels beyond 6 you have to define faces
+of your own."
:group 'rst-faces
:type '(alist
:key-type
@@ -3445,32 +3430,8 @@ group."
(integer :tag "Section level")
(const :tag "transitions" t)
(const :tag "section title adornment" nil))
- :value-type (face))
- :set-after '(rst-level-face-max))
-
-(defun rst-define-level-faces ()
- "Define the faces for the section title text faces from the values."
- ;; All variables used here must be checked in `rst-set-level-default'.
- (let ((i 1))
- (while (<= i rst-level-face-max)
- (let ((sym (intern (format "rst-level-%d-face" i)))
- (doc (format "Default face for showing section title text at level %d.
-This symbol is *not* meant for customization but modified if a
-variable of the `rst-faces-defaults' group is customized. Use
-`rst-adornment-faces-alist' for customization instead." i))
- (col (format (concat "%s" rst-level-face-format-light)
- rst-level-face-base-color
- (+ (* (1- i) rst-level-face-step-light)
- rst-level-face-base-light))))
- (make-empty-face sym)
- (set-face-doc-string sym doc)
- (set-face-background sym col)
- (set sym sym)
- (setq i (1+ i))))))
-
-;; FIXME LEVEL-FACE: This is probably superfluous since it is done by the
-;; customization / `rst-set-level-default'.
-(rst-define-level-faces)
+ :value-type (face)))
+(rst-testcover-defcustom)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3663,8 +3624,7 @@ variable of the `rst-faces-defaults' group is customized. Use
;; Indentation is not required for doctest blocks.
(,(rst-re 'lin-beg '(:grp (:alt ">>>" ell-tag)) '(:grp ".+"))
(1 rst-block-face)
- (2 rst-literal-face))
- )
+ (2 rst-literal-face)))
"Keywords to highlight in rst mode.")
(defvar font-lock-beg)
@@ -3974,6 +3934,7 @@ string)) to be used for converting the document."
(string :tag "Options"))))
:group 'rst
:package-version "1.2.0")
+(rst-testcover-defcustom)
;; FIXME: Must be `defcustom`.
(defvar rst-compile-primary-toolset 'html
@@ -3999,11 +3960,8 @@ string)) to be used for converting the document."
(setq prevdir dir)
(setq dir (expand-file-name (file-name-directory
(directory-file-name
- (file-name-directory dir)))))
- )
- (or (and dir (concat dir file-name)) nil)
- )))
-
+ (file-name-directory dir))))))
+ (or (and dir (concat dir file-name)) nil))))
(require 'compile)
@@ -4041,8 +3999,7 @@ select the alternative tool-set."
;; Invoke the compile command.
(if (or compilation-read-command use-alt)
(call-interactively 'compile)
- (compile compile-command))
- ))
+ (compile compile-command))))
(defun rst-compile-alt-toolset ()
"Compile command with the alternative tool-set."
@@ -4097,6 +4054,79 @@ buffer, if the region is not selected."
))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Imenu support.
+
+;; FIXME: Integrate this properly. Consider a key binding.
+
+;; Based on code from Masatake YAMATO <yamato@redhat.com>.
+
+(defun rst-imenu-find-adornments-for-position (adornments pos)
+ "Find adornments cell in ADORNMENTS for position POS."
+ (let ((a nil))
+ (while adornments
+ (if (and (car adornments)
+ (eq (car (car adornments)) pos))
+ (setq a adornments
+ adornments nil)
+ (setq adornments (cdr adornments))))
+ a))
+
+(defun rst-imenu-convert-cell (elt adornments)
+ "Convert a cell ELT in a tree returned from `rst-section-tree' to imenu index.
+ADORNMENTS is used as hint information for conversion."
+ (let* ((kar (car elt))
+ (kdr (cdr elt))
+ (title (car kar)))
+ (if kar
+ (let* ((p (marker-position (cadr kar)))
+ (adornments
+ (rst-imenu-find-adornments-for-position adornments p))
+ (a (car adornments))
+ (adornments (cdr adornments))
+ ;; FIXME: Overline adornment characters need to be in front so
+ ;; they become visible even for long title lines. May be
+ ;; an additional level number is also useful.
+ (title (format "%s%s%s"
+ (make-string (1+ (nth 3 a)) (nth 1 a))
+ title
+ (if (eq (nth 2 a) 'simple)
+ ""
+ (char-to-string (nth 1 a))))))
+ (cons title
+ (if (null kdr)
+ p
+ (cons
+ ;; A bit ugly but this make which-func happy.
+ (cons title p)
+ (mapcar (lambda (elt0)
+ (rst-imenu-convert-cell elt0 adornments))
+ kdr)))))
+ nil)))
+
+;; FIXME: Document title and subtitle need to be handled properly. They should
+;; get an own "Document" top level entry.
+(defun rst-imenu-create-index ()
+ "Create index for imenu.
+Return as described for `imenu--index-alist'."
+ (rst-reset-section-caches)
+ (let ((tree (rst-section-tree))
+ ;; Translate line notation to point notation.
+ (adornments (save-excursion
+ (mapcar (lambda (ln-ado)
+ (cons (progn
+ (goto-char (point-min))
+ (forward-line (1- (car ln-ado)))
+ ;; FIXME: Need to consider
+ ;; `imenu-use-markers' here?
+ (point))
+ (cdr ln-ado)))
+ (rst-find-all-adornments)))))
+ (delete nil (mapcar (lambda (elt)
+ (rst-imenu-convert-cell elt adornments))
+ tree))))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Generic text functions that are more convenient than the defaults.
@@ -4166,8 +4196,7 @@ column is used (fill-column vs. end of previous/next line)."
(cond ((equal last-command 'rst-repeat-last-character)
(if (= curcol fill-column) prevcol fill-column))
(t (save-excursion
- (if (zerop prevcol) fill-column prevcol)))
- )) )
+ (if (zerop prevcol) fill-column prevcol))))))
(end-of-line)
(if (> (current-column) rightmost-column)
;; Shave characters off the end.
@@ -4176,17 +4205,7 @@ column is used (fill-column vs. end of previous/next line)."
(point))
;; Fill with last characters.
(insert-char (preceding-char)
- (- rightmost-column (current-column))))
- ))
-
-
-(defun rst-portable-mark-active-p ()
- "Return non-nil if the mark is active.
-This is a portable function."
- (cond
- ((fboundp 'region-active-p) (region-active-p))
- ((boundp 'transient-mark-mode) (and transient-mark-mode mark-active))
- (t mark-active)))
+ (- rightmost-column (current-column))))))
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 67d7f8c01f9..46c65b25b37 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -34,7 +34,6 @@
(eval-when-compile
(require 'skeleton)
- (require 'outline)
(require 'cl-lib))
(defgroup sgml nil
@@ -1938,6 +1937,10 @@ This takes effect when first loading the library.")
("wbr" . "Enable <br> within <nobr>"))
"Value of `sgml-tag-help' for HTML mode.")
+(defvar outline-regexp)
+(defvar outline-heading-end-regexp)
+(defvar outline-level)
+
;;;###autoload
(define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML")
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 459e884d45d..3d9f88a43c9 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -1,4 +1,4 @@
-;;; table.el --- create and edit WYSIWYG text based embedded tables
+;;; table.el --- create and edit WYSIWYG text based embedded tables -*- lexical-binding: t -*-
;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
@@ -715,28 +715,6 @@ select a character that is unlikely to appear in your document."
:type 'character
:group 'table)
-(defun table-set-table-fixed-width-mode (variable value)
- (if (fboundp variable)
- (funcall variable (if value 1 -1))))
-
-(defun table-initialize-table-fixed-width-mode (variable value)
- (set variable value))
-
-(defcustom table-fixed-width-mode nil
- "Cell width is fixed when this is non-nil.
-Normally it should be nil for allowing automatic cell width expansion
-that widens a cell when it is necessary. When non-nil, typing in a
-cell does not automatically expand the cell width. A word that is too
-long to fit in a cell is chopped into multiple lines. The chopped
-location is indicated by `table-word-continuation-char'. This
-variable's value can be toggled by \\[table-fixed-width-mode] at
-run-time."
- :tag "Fix Cell Width"
- :type 'boolean
- :initialize 'table-initialize-table-fixed-width-mode
- :set 'table-set-table-fixed-width-mode
- :group 'table)
-
(defcustom table-detect-cell-alignment t
"Detect cell contents alignment automatically.
When non-nil cell alignment is automatically determined by the
@@ -1001,14 +979,10 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu
(dabbrev-completion . *table--cell-dabbrev-completion))
"List of cons cells consisting of (ORIGINAL-COMMAND . TABLE-VERSION-OF-THE-COMMAND).")
-(defvar table-command-list nil
+(defvar table-command-list
+ ;; Construct the real contents of the `table-command-list'.
+ (mapcar #'cdr table-command-remap-alist)
"List of commands that override original commands.")
-;; construct the real contents of the `table-command-list'
-(let ((remap-alist table-command-remap-alist))
- (setq table-command-list nil)
- (while remap-alist
- (setq table-command-list (cons (cdar remap-alist) table-command-list))
- (setq remap-alist (cdr remap-alist))))
(defconst table-global-menu
'("Table"
@@ -1241,18 +1215,17 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu
;; Unknown keywords should be quietly ignore so that future extension
;; does not cause a problem in the old implementation. Sigh...
(when (featurep 'xemacs)
- (mapcar
- (defun table--tweak-menu-for-xemacs (menu)
+ (defun table--tweak-menu-for-xemacs (menu)
(cond
((listp menu)
- (mapcar 'table--tweak-menu-for-xemacs menu))
+ (mapcar #'table--tweak-menu-for-xemacs menu))
((vectorp menu)
- (let ((i 0) (len (length menu)))
- (while (< i len)
+ (let ((len (length menu)))
+ (dotimes (i len)
;; replace :help with something harmless.
- (if (eq (aref menu i) :help) (aset menu i :included))
- (setq i (1+ i)))))))
- (list table-global-menu table-cell-menu))
+ (if (eq (aref menu i) :help) (aset menu i :included)))))))
+ (mapcar #'table--tweak-menu-for-xemacs
+ (list table-global-menu table-cell-menu))
(defvar mark-active t))
;; register table menu under global tools menu
@@ -1286,6 +1259,7 @@ current buffer is restored to the original one. The last cache point
coordinate is stored in `table-cell-cache-point-coordinate'. The
original buffer's point is moved to the location that corresponds to
the last cache point coordinate."
+ (declare (debug (body)) (indent 0))
(let ((height-expansion (make-symbol "height-expansion-var-symbol"))
(width-expansion (make-symbol "width-expansion-var-symbol")))
`(let (,height-expansion ,width-expansion)
@@ -1341,14 +1315,9 @@ the last cache point coordinate."
;; set up the update timer unless it is explicitly inhibited.
(unless table-inhibit-update
(table--update-cell)))))
-
-;; for debugging the body form of the macro
-(put 'table-with-cache-buffer 'edebug-form-spec '(body))
-;; for neat presentation use the same indentation as `progn'
-(put 'table-with-cache-buffer 'lisp-indent-function 0)
(if (or (featurep 'xemacs)
(null (fboundp 'font-lock-add-keywords))) nil
- ;; color it as a keyword
+ ;; Color it as a keyword.
(font-lock-add-keywords
'emacs-lisp-mode
'("\\<table-with-cache-buffer\\>")))
@@ -1367,122 +1336,114 @@ the last cache point coordinate."
;;
;; Point Motion Only Group
-(mapc
- (lambda (command)
- (let ((func-symbol (intern (format "*table--cell-%s" command)))
- (doc-string (format "Table remapped function for `%s'." command)))
- (fset func-symbol
- `(lambda
- (&rest args)
- ,doc-string
- (interactive)
- (let ((table-inhibit-update t)
- (deactivate-mark nil))
- (table--finish-delayed-tasks)
- (table-recognize-cell 'force)
- (table-with-cache-buffer
- (call-interactively ',command)
- (setq table-inhibit-auto-fill-paragraph t)))))
- (setq table-command-remap-alist
- (cons (cons command func-symbol)
- table-command-remap-alist))))
- '(move-beginning-of-line
- beginning-of-line
- move-end-of-line
- end-of-line
- beginning-of-buffer
- end-of-buffer
- forward-word
- backward-word
- forward-sentence
- backward-sentence
- forward-paragraph
- backward-paragraph))
+(dolist (command
+ '(move-beginning-of-line
+ beginning-of-line
+ move-end-of-line
+ end-of-line
+ beginning-of-buffer
+ end-of-buffer
+ forward-word
+ backward-word
+ forward-sentence
+ backward-sentence
+ forward-paragraph
+ backward-paragraph))
+ (let ((func-symbol (intern (format "*table--cell-%s" command)))
+ (doc-string (format "Table remapped function for `%s'." command)))
+ (defalias func-symbol
+ `(lambda
+ (&rest args)
+ ,doc-string
+ (interactive)
+ (let ((table-inhibit-update t)
+ (deactivate-mark nil))
+ (table--finish-delayed-tasks)
+ (table-recognize-cell 'force)
+ (table-with-cache-buffer
+ (call-interactively ',command)
+ (setq table-inhibit-auto-fill-paragraph t)))))
+ (push (cons command func-symbol)
+ table-command-remap-alist)))
;; Extraction Group
-(mapc
- (lambda (command)
- (let ((func-symbol (intern (format "*table--cell-%s" command)))
- (doc-string (format "Table remapped function for `%s'." command)))
- (fset func-symbol
- `(lambda
- (&rest args)
- ,doc-string
- (interactive)
- (table--finish-delayed-tasks)
- (table-recognize-cell 'force)
- (table-with-cache-buffer
- (table--remove-cell-properties (point-min) (point-max))
- (table--remove-eol-spaces (point-min) (point-max))
- (call-interactively ',command))
- (table--finish-delayed-tasks)))
- (setq table-command-remap-alist
- (cons (cons command func-symbol)
- table-command-remap-alist))))
- '(kill-region
- kill-ring-save
- delete-region
- copy-region-as-kill
- kill-line
- kill-word
- backward-kill-word
- kill-sentence
- backward-kill-sentence
- kill-paragraph
- backward-kill-paragraph
- kill-sexp
- backward-kill-sexp))
+(dolist (command
+ '(kill-region
+ kill-ring-save
+ delete-region
+ copy-region-as-kill
+ kill-line
+ kill-word
+ backward-kill-word
+ kill-sentence
+ backward-kill-sentence
+ kill-paragraph
+ backward-kill-paragraph
+ kill-sexp
+ backward-kill-sexp))
+ (let ((func-symbol (intern (format "*table--cell-%s" command)))
+ (doc-string (format "Table remapped function for `%s'." command)))
+ (defalias func-symbol
+ `(lambda
+ (&rest args)
+ ,doc-string
+ (interactive)
+ (table--finish-delayed-tasks)
+ (table-recognize-cell 'force)
+ (table-with-cache-buffer
+ (table--remove-cell-properties (point-min) (point-max))
+ (table--remove-eol-spaces (point-min) (point-max))
+ (call-interactively ',command))
+ (table--finish-delayed-tasks)))
+ (push (cons command func-symbol)
+ table-command-remap-alist)))
;; Pasting Group
-(mapc
- (lambda (command)
- (let ((func-symbol (intern (format "*table--cell-%s" command)))
- (doc-string (format "Table remapped function for `%s'." command)))
- (fset func-symbol
- `(lambda
- (&rest args)
- ,doc-string
- (interactive)
- (table--finish-delayed-tasks)
- (table-recognize-cell 'force)
- (table-with-cache-buffer
- (call-interactively ',command)
- (table--untabify (point-min) (point-max))
- (table--fill-region (point-min) (point-max))
- (setq table-inhibit-auto-fill-paragraph t))
- (table--finish-delayed-tasks)))
- (setq table-command-remap-alist
- (cons (cons command func-symbol)
- table-command-remap-alist))))
- '(yank
- clipboard-yank
- yank-clipboard-selection
- insert))
+(dolist (command
+ '(yank
+ clipboard-yank
+ yank-clipboard-selection
+ insert))
+ (let ((func-symbol (intern (format "*table--cell-%s" command)))
+ (doc-string (format "Table remapped function for `%s'." command)))
+ (fset func-symbol
+ `(lambda
+ (&rest args)
+ ,doc-string
+ (interactive)
+ (table--finish-delayed-tasks)
+ (table-recognize-cell 'force)
+ (table-with-cache-buffer
+ (call-interactively ',command)
+ (table--untabify (point-min) (point-max))
+ (table--fill-region (point-min) (point-max))
+ (setq table-inhibit-auto-fill-paragraph t))
+ (table--finish-delayed-tasks)))
+ (push (cons command func-symbol)
+ table-command-remap-alist)))
;; Formatting Group
-(mapc
- (lambda (command)
- (let ((func-symbol (intern (format "*table--cell-%s" command)))
- (doc-string (format "Table remapped function for `%s'." command)))
- (fset func-symbol
- `(lambda
- (&rest args)
- ,doc-string
- (interactive)
- (table--finish-delayed-tasks)
- (table-recognize-cell 'force)
- (table-with-cache-buffer
- (let ((fill-column table-cell-info-width))
- (call-interactively ',command))
- (setq table-inhibit-auto-fill-paragraph t))
- (table--finish-delayed-tasks)))
- (setq table-command-remap-alist
- (cons (cons command func-symbol)
- table-command-remap-alist))))
- '(center-line
- center-region
- center-paragraph
- fill-paragraph))
+(dolist (command
+ '(center-line
+ center-region
+ center-paragraph
+ fill-paragraph))
+ (let ((func-symbol (intern (format "*table--cell-%s" command)))
+ (doc-string (format "Table remapped function for `%s'." command)))
+ (fset func-symbol
+ `(lambda
+ (&rest args)
+ ,doc-string
+ (interactive)
+ (table--finish-delayed-tasks)
+ (table-recognize-cell 'force)
+ (table-with-cache-buffer
+ (let ((fill-column table-cell-info-width))
+ (call-interactively ',command))
+ (setq table-inhibit-auto-fill-paragraph t))
+ (table--finish-delayed-tasks)))
+ (push (cons command func-symbol)
+ table-command-remap-alist)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -2581,7 +2542,7 @@ a negative argument ARG = -N means move forward N cells."
DIRECTION is one of symbols; right, left, above or below."
(interactive
(list
- (let* ((dummy (barf-if-buffer-read-only))
+ (let* ((_ (barf-if-buffer-read-only))
(direction-list
(let* ((tmp (delete nil
(mapcar (lambda (d)
@@ -2605,40 +2566,35 @@ DIRECTION is one of symbols; right, left, above or below."
(table-recognize-cell 'force)
(unless (table--cell-can-span-p direction)
(error "Can't span %s" (symbol-name direction)))
- ;; prepare beginning and ending positions of the border bar to strike through
- (let ((beg (cond
- ((eq direction 'right)
- (save-excursion
- (table--goto-coordinate
+ ;; Prepare beginning and end positions of the border bar to strike through.
+ (let ((beg (save-excursion
+ (table--goto-coordinate
+ (cond
+ ((eq direction 'right)
(cons (car table-cell-info-rb-coordinate)
- (1- (cdr table-cell-info-lu-coordinate))) 'no-extension)))
- ((eq direction 'below)
- (save-excursion
- (table--goto-coordinate
+ (1- (cdr table-cell-info-lu-coordinate))))
+ ((eq direction 'below)
(cons (1- (car table-cell-info-lu-coordinate))
- (1+ (cdr table-cell-info-rb-coordinate))) 'no-extension)))
- (t
- (save-excursion
- (table--goto-coordinate
+ (1+ (cdr table-cell-info-rb-coordinate))))
+ (t
(cons (1- (car table-cell-info-lu-coordinate))
- (1- (cdr table-cell-info-lu-coordinate))) 'no-extension)))))
- (end (cond
- ((eq direction 'left)
- (save-excursion
- (table--goto-coordinate
+ (1- (cdr table-cell-info-lu-coordinate)))))
+ 'no-extension)))
+ (end (save-excursion
+ (table--goto-coordinate
+ (cond
+ ((eq direction 'left)
(cons (car table-cell-info-lu-coordinate)
- (1+ (cdr table-cell-info-rb-coordinate))) 'no-extension)))
- ((eq direction 'above)
- (save-excursion
- (table--goto-coordinate
+ (1+ (cdr table-cell-info-rb-coordinate))))
+ ((eq direction 'above)
(cons (1+ (car table-cell-info-rb-coordinate))
- (1- (cdr table-cell-info-lu-coordinate))) 'no-extension)))
- (t
- (save-excursion
- (table--goto-coordinate
+ (1- (cdr table-cell-info-lu-coordinate))))
+ (t
(cons (1+ (car table-cell-info-rb-coordinate))
- (1+ (cdr table-cell-info-rb-coordinate))) 'no-extension))))))
- ;; replace the bar with blank space while taking care of edges to be border or intersection
+ (1+ (cdr table-cell-info-rb-coordinate)))))
+ 'no-extension))))
+ ;; Replace the bar with blank space while taking care of edges to be border
+ ;; or intersection.
(save-excursion
(goto-char beg)
(if (memq direction '(left right))
@@ -2832,7 +2788,7 @@ Creates a cell on the left and a cell on the right of the current point location
ORIENTATION is a symbol either horizontally or vertically."
(interactive
(list
- (let* ((dummy (barf-if-buffer-read-only))
+ (let* ((_ (barf-if-buffer-read-only))
(completion-ignore-case t)
(default (car table-cell-split-orientation-history)))
(intern (downcase (completing-read
@@ -2852,7 +2808,7 @@ ORIENTATION is a symbol either horizontally or vertically."
WHAT is a symbol 'cell, 'row or 'column. JUSTIFY is a symbol 'left,
'center, 'right, 'top, 'middle, 'bottom or 'none."
(interactive
- (list (let* ((dummy (barf-if-buffer-read-only))
+ (list (let* ((_ (barf-if-buffer-read-only))
(completion-ignore-case t)
(default (car table-target-history)))
(intern (downcase (completing-read
@@ -2910,17 +2866,18 @@ JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
(table--justify-cell-contents justify))))))
;;;###autoload
-(defun table-fixed-width-mode (&optional arg)
- "Toggle fixing width mode.
-In the fixed width mode, typing inside a cell never changes the cell
-width where in the normal mode the cell width expands automatically in
-order to prevent a word being folded into multiple lines."
- (interactive "P")
+(define-minor-mode table-fixed-width-mode
+ "Cell width is fixed when this is non-nil.
+Normally it should be nil for allowing automatic cell width expansion
+that widens a cell when it is necessary. When non-nil, typing in a
+cell does not automatically expand the cell width. A word that is too
+long to fit in a cell is chopped into multiple lines. The chopped
+location is indicated by `table-word-continuation-char'. This
+variable's value can be toggled by \\[table-fixed-width-mode] at
+run-time."
+ :tag "Fix Cell Width"
+ :group 'table
(table--finish-delayed-tasks)
- (setq table-fixed-width-mode
- (if (null arg)
- (not table-fixed-width-mode)
- (> (prefix-numeric-value arg) 0)))
(table--update-cell-face))
;;;###autoload
@@ -3004,7 +2961,7 @@ CALS (DocBook DTD):
URL `http://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751'
"
(interactive
- (let* ((dummy (unless (table--probe-cell) (error "Table not found here")))
+ (let* ((_ (unless (table--probe-cell) (error "Table not found here")))
(completion-ignore-case t)
(default (car table-source-language-history))
(language (downcase (completing-read
@@ -3093,7 +3050,7 @@ CALS (DocBook DTD):
)))
dest-buffer))
-(defun table--generate-source-prologue (dest-buffer language caption col-list row-list)
+(defun table--generate-source-prologue (dest-buffer language caption col-list _row-list)
"Generate and insert source prologue into DEST-BUFFER."
(with-current-buffer dest-buffer
(cond
@@ -3121,7 +3078,7 @@ CALS (DocBook DTD):
(insert (format " <%s valign=\"top\">\n" (table-get-source-info 'row-type))))
)))
-(defun table--generate-source-epilogue (dest-buffer language col-list row-list)
+(defun table--generate-source-epilogue (dest-buffer language _col-list _row-list)
"Generate and insert source epilogue into DEST-BUFFER."
(with-current-buffer dest-buffer
(cond
@@ -3133,14 +3090,12 @@ CALS (DocBook DTD):
(set-marker-insertion-type (table-get-source-info 'colspec-marker) t) ;; insert before
(save-excursion
(goto-char (table-get-source-info 'colspec-marker))
- (mapc
- (lambda (col)
- (insert (format " <colspec colnum=\"%d\" colname=\"c%d\"/>\n" col col)))
- (sort (table-get-source-info 'colnum-list) '<)))
+ (dolist (col (sort (table-get-source-info 'colnum-list) '<))
+ (insert (format " <colspec colnum=\"%d\" colname=\"c%d\"/>\n" col col))))
(insert (format " </%s>\n </tgroup>\n</table>\n" (table-get-source-info 'row-type))))
)))
-(defun table--generate-source-scan-rows (dest-buffer language origin-cell col-list row-list)
+(defun table--generate-source-scan-rows (dest-buffer language _origin-cell col-list row-list)
"Generate and insert source rows into DEST-BUFFER."
(table-put-source-info 'current-row 1)
(while row-list
@@ -3286,7 +3241,7 @@ CALS (DocBook DTD):
"Test if character C is one of the horizontal characters"
(memq c (string-to-list table-cell-horizontal-chars)))
-(defun table--generate-source-scan-lines (dest-buffer language origin-cell tail-cell col-list row-list)
+(defun table--generate-source-scan-lines (dest-buffer _language origin-cell tail-cell col-list row-list)
"Scan the table line by line.
Currently this method is for LaTeX only."
(let* ((lu-coord (table--get-coordinate (car origin-cell)))
@@ -3403,8 +3358,7 @@ Example:
(table-insert 16 8 5 1)
(table-insert-sequence \"@\" 0 1 2 'right)
(table-forward-cell 1)
- (table-insert-sequence \"64\" 0 1 2 'left))
-"
+ (table-insert-sequence \"64\" 0 1 2 'left))"
(interactive
(progn
(barf-if-buffer-read-only)
@@ -3896,36 +3850,34 @@ converts a table into plain text without frames. It is a companion to
(defun table--make-cell-map ()
"Make the table cell keymap if it does not exist yet."
- ;; this is irrelevant to keymap but good place to make sure to be executed
+ ;; This is irrelevant to keymap but good place to make sure to be executed.
(table--update-cell-face)
(unless table-cell-map
- (let ((map (make-sparse-keymap))
- (remap-alist table-command-remap-alist))
- ;; table-command-prefix mode specific bindings
+ (let ((map (make-sparse-keymap)))
+ ;; `table-command-prefix' mode specific bindings.
(if (vectorp table-command-prefix)
- (mapc (lambda (binding)
- (let ((seq (copy-sequence (car binding))))
- (and (vectorp seq)
- (listp (aref seq 0))
- (eq (car (aref seq 0)) 'control)
- (progn
- (aset seq 0 (cadr (aref seq 0)))
- (define-key map (vconcat table-command-prefix seq) (cdr binding))))))
- table-cell-bindings))
- ;; shorthand control bindings
- (mapc (lambda (binding)
- (define-key map (car binding) (cdr binding)))
- table-cell-bindings)
- ;; remap normal commands to table specific version
- (while remap-alist
- (define-key map (vector 'remap (caar remap-alist)) (cdar remap-alist))
- (setq remap-alist (cdr remap-alist)))
+ (dolist (binding table-cell-bindings)
+ (let ((seq (copy-sequence (car binding))))
+ (and (vectorp seq)
+ (listp (aref seq 0))
+ (eq (car (aref seq 0)) 'control)
+ (progn
+ (aset seq 0 (cadr (aref seq 0)))
+ (define-key map (vconcat table-command-prefix seq)
+ (cdr binding)))))))
+ ;; Shorthand control bindings.
+ (dolist (binding table-cell-bindings)
+ (define-key map (car binding) (cdr binding)))
+ ;; Remap normal commands to table specific version.
+ (dolist (remap table-command-remap-alist)
+ (define-key map (vector 'remap (car remap)) (cdr remap)))
;;
(setq table-cell-map map)
(fset 'table-cell-map map)))
- ;; add menu for table cells
+ ;; Add menu for table cells.
(unless table-disable-menu
- (easy-menu-define table-cell-menu-map table-cell-map "Table cell menu" table-cell-menu)
+ (easy-menu-define table-cell-menu-map table-cell-map
+ "Table cell menu" table-cell-menu)
(if (featurep 'xemacs)
(easy-menu-add table-cell-menu)))
(run-hooks 'table-cell-map-hook))
@@ -4092,6 +4044,8 @@ key binding
table-cell-bindings)
(help-print-return-message))))
+(defvar dabbrev-abbrev-char-regexp)
+
(defun *table--cell-dabbrev-expand (arg)
"Table cell version of `dabbrev-expand'."
(interactive "*P")
@@ -4291,38 +4245,16 @@ cache buffer into the designated cell in the table buffer."
(car (table--get-coordinate (cdr (table--horizontal-cell-list nil t))))
(1+ (cdr (table--get-coordinate (cdr (table--vertical-cell-list nil t))))))))
-(defun table-call-interactively (function &optional record-flag keys)
- "Call FUNCTION, or a table version of it if applicable.
-See `call-interactively' for full description of the arguments."
- (let ((table-func (intern-soft (format "*table--cell-%s" function))))
- (call-interactively
- (if (and table-func
- (table--point-in-cell-p))
- table-func
- function) record-flag keys)))
-
-(defun table-funcall (function &rest arguments)
- "Call FUNCTION, or a table version of it if applicable.
-See `funcall' for full description of the arguments."
+(defun table-function (function)
+ ;; FIXME: Apparently unused. There used to be table-funcall, table-apply,
+ ;; and table-call-interactively instead, neither of which seemed to be
+ ;; used either.
+ "Return FUNCTION, or a table version of it if applicable."
(let ((table-func (intern-soft (format "*table--cell-%s" function))))
- (apply
- (if (and table-func
+ (if (and table-func
(table--point-in-cell-p))
table-func
- function)
- arguments)))
-
-(defmacro table-apply (function &rest arguments)
- "Call FUNCTION, or a table version of it if applicable.
-See `apply' for full description of the arguments."
- (let ((table-func (make-symbol "table-func")))
- `(let ((,table-func (intern-soft (format "*table--cell-%s" ,function))))
- (apply
- (if (and ,table-func
- (table--point-in-cell-p))
- ,table-func
- ,function)
- ,@arguments))))
+ function)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -5124,7 +5056,7 @@ Focus only on the corner pattern. Further cell validity check is required."
(throw 'retry-vertical nil))
(t (throw 'retry-horizontal nil)))))))))))))
-(defun table--editable-cell-p (&optional abort-on-error)
+(defun table--editable-cell-p (&optional _abort-on-error)
(and (not buffer-read-only)
(get-text-property (point) 'table-cell)))
@@ -5310,7 +5242,7 @@ instead of the current buffer and returns the OBJECT."
"Put cell's vertical alignment property."
(table--put-property cell 'table-valign valign))
-(defun table--point-entered-cell-function (&optional old-point new-point)
+(defun table--point-entered-cell-function (&optional _old-point _new-point)
"Point has entered a cell.
Refresh the menu bar."
;; Avoid calling point-motion-hooks recursively.
@@ -5322,7 +5254,7 @@ Refresh the menu bar."
(table--warn-incompatibility)
(run-hooks 'table-point-entered-cell-hook))))
-(defun table--point-left-cell-function (&optional old-point new-point)
+(defun table--point-left-cell-function (&optional _old-point _new-point)
"Point has left a cell.
Refresh the menu bar."
;; Avoid calling point-motion-hooks recursively.
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 620a1da633e..062f43be57b 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -860,10 +860,6 @@ START is the position of the \\ and DELIM is the delimiter char."
(set-keymap-parent map text-mode-map)
(tex-define-common-keys map)
(define-key map "\"" 'tex-insert-quote)
- (define-key map "(" 'skeleton-pair-insert-maybe)
- (define-key map "{" 'skeleton-pair-insert-maybe)
- (define-key map "[" 'skeleton-pair-insert-maybe)
- (define-key map "$" 'skeleton-pair-insert-maybe)
(define-key map "\n" 'tex-terminate-paragraph)
(define-key map "\M-\r" 'latex-insert-item)
(define-key map "\C-c}" 'up-list)
@@ -2569,8 +2565,7 @@ line LINE of the window, or centered if LINE is nil."
(if (null tex-shell)
(message "No TeX output buffer")
(setq window (display-buffer tex-shell))
- (save-selected-window
- (select-window window)
+ (with-selected-window window
(bury-buffer tex-shell)
(goto-char (point-max))
(recenter (if linenum
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 30e5390a3e1..301f69f45be 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -80,18 +80,29 @@ Turning on Paragraph-Indent Text mode runs the normal hooks
:abbrev-table nil :syntax-table nil
(paragraph-indent-minor-mode))
-(defun paragraph-indent-minor-mode ()
+(define-minor-mode paragraph-indent-minor-mode
"Minor mode for editing text, with leading spaces starting a paragraph.
In this mode, you do not need blank lines between paragraphs when the
first line of the following paragraph starts with whitespace, as with
`paragraph-indent-text-mode'.
Turning on Paragraph-Indent minor mode runs the normal hook
`paragraph-indent-text-mode-hook'."
- (interactive)
- (set (make-local-variable 'paragraph-start)
- (concat "[ \t\n\f]\\|" paragraph-start))
- (set (make-local-variable 'indent-line-function) 'indent-to-left-margin)
- (run-hooks 'paragraph-indent-text-mode-hook))
+ :initial-value nil
+ ;; Change the definition of a paragraph start.
+ (let ((ps-re "[ \t\n\f]\\|"))
+ (if (eq t (compare-strings ps-re nil nil
+ paragraph-start nil (length ps-re)))
+ (if (not paragraph-indent-minor-mode)
+ (set (make-local-variable 'paragraph-start)
+ (substring paragraph-start (length ps-re))))
+ (if paragraph-indent-minor-mode
+ (set (make-local-variable 'paragraph-start)
+ (concat ps-re paragraph-start)))))
+ ;; Change the indentation function.
+ (if paragraph-indent-minor-mode
+ (set (make-local-variable 'indent-line-function) 'indent-to-left-margin)
+ (if (eq indent-line-function 'indent-to-left-margin)
+ (set (make-local-variable 'indent-line-function) 'indent-region))))
(defalias 'indented-text-mode 'text-mode)
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index 64879e5cfd5..6f76068ea9d 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -765,14 +765,13 @@ Run the Viper tutorial? "))
(funcall 'viper-tutorial 0))
(message "Tutorial aborted by user"))
(message prompt1)))
- (let* ((lang (if arg
- (let ((minibuffer-setup-hook minibuffer-setup-hook))
- (add-hook 'minibuffer-setup-hook
- 'minibuffer-completion-help)
- (read-language-name 'tutorial "Language: " "English"))
- (if (get-language-info current-language-environment 'tutorial)
- current-language-environment
- "English")))
+ (let* ((lang (cond
+ (arg
+ (minibuffer-with-setup-hook #'minibuffer-completion-help
+ (read-language-name 'tutorial "Language: " "English")))
+ ((get-language-info current-language-environment 'tutorial)
+ current-language-environment)
+ (t "English")))
(filename (get-language-info lang 'tutorial))
(tut-buf-name filename)
(old-tut-buf (get-buffer tut-buf-name))
diff --git a/lisp/type-break.el b/lisp/type-break.el
index 8a95508d939..949b3b720a0 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -1,4 +1,4 @@
-;;; type-break.el --- encourage rests from typing at appropriate intervals
+;;; type-break.el --- encourage rests from typing at appropriate intervals -*- lexical-binding: t -*-
;; Copyright (C) 1994-1995, 1997, 2000-2012 Free Software Foundation, Inc.
@@ -69,26 +69,11 @@
:prefix "type-break"
:group 'keyboard)
-;;;###autoload
-(defcustom type-break-mode nil
- "Toggle typing break mode.
-See the docstring for the `type-break-mode' command for more information.
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `type-break-mode'."
- :set (lambda (_symbol value)
- (type-break-mode (if value 1 -1)))
- :initialize 'custom-initialize-default
- :type 'boolean
- :group 'type-break
- :require 'type-break)
-
-;;;###autoload
(defcustom type-break-interval (* 60 60)
"Number of seconds between scheduled typing breaks."
:type 'integer
:group 'type-break)
-;;;###autoload
(defcustom type-break-good-rest-interval (/ type-break-interval 6)
"Number of seconds of idle time considered to be an adequate typing rest.
@@ -98,10 +83,10 @@ rest from typing, then the next typing break is simply rescheduled for later.
If a break is interrupted before this much time elapses, the user will be
asked whether or not really to interrupt the break."
+ :set-after '(type-break-interval)
:type 'integer
:group 'type-break)
-;;;###autoload
(defcustom type-break-good-break-interval nil
"Number of seconds considered to be an adequate explicit typing rest.
@@ -112,7 +97,6 @@ break interruptions when `type-break-good-rest-interval' is nil."
:type 'integer
:group 'type-break)
-;;;###autoload
(defcustom type-break-keystroke-threshold
;; Assuming typing speed is 35wpm (on the average, do you really
;; type more than that in a minute? I spend a lot of time reading mail
@@ -147,6 +131,7 @@ keystroke even though they really require multiple keys to generate them.
The command `type-break-guesstimate-keystroke-threshold' can be used to
guess a reasonably good pair of values for this variable."
+ :set-after '(type-break-interval)
:type 'sexp
:group 'type-break)
@@ -288,7 +273,7 @@ It will be either \"seconds\" or \"keystrokes\".")
;;;###autoload
-(defun type-break-mode (&optional prefix)
+(define-minor-mode type-break-mode
"Enable or disable typing-break mode.
This is a minor mode, but it is global to all buffers by default.
@@ -361,74 +346,61 @@ Finally, a file (named `type-break-file-name') is used to store information
across Emacs sessions. This provides recovery of the break status between
sessions and after a crash. Manual changes to the file may result in
problems."
- (interactive "P")
- (type-break-check-post-command-hook)
+ :lighter type-break-mode-line-format
+ :global t
- (let ((already-enabled type-break-mode))
- (setq type-break-mode (>= (prefix-numeric-value prefix) 0))
+ (type-break-check-post-command-hook)
- (cond
- ((and already-enabled type-break-mode)
- (and (called-interactively-p 'interactive)
- (message "Type Break mode is already enabled")))
- (type-break-mode
- (when type-break-file-name
- (with-current-buffer (find-file-noselect type-break-file-name 'nowarn)
- (setq buffer-save-without-query t)))
-
- (or global-mode-string
- (setq global-mode-string '("")))
- (or (assq 'type-break-mode-line-message-mode
- minor-mode-alist)
- (setq minor-mode-alist
- (cons type-break-mode-line-format
- minor-mode-alist)))
- (type-break-keystroke-reset)
- (type-break-mode-line-countdown-or-break nil)
-
- (setq type-break-time-last-break
- (or (type-break-get-previous-time)
- (current-time)))
-
- ;; schedule according to break time from session file
- (type-break-schedule
- (let (diff)
- (if (and type-break-time-last-break
- (< (setq diff (type-break-time-difference
- type-break-time-last-break
- (current-time)))
- type-break-interval))
- ;; use the file's value
- (progn
- (setq type-break-keystroke-count
- (type-break-get-previous-count))
- ;; file the time, in case it was read from the auto-save file
- (type-break-file-time type-break-interval-start)
- (setq type-break-interval-start type-break-time-last-break)
- (- type-break-interval diff))
- ;; schedule from now
- (setq type-break-interval-start (current-time))
- (type-break-file-time type-break-interval-start)
- type-break-interval))
- type-break-interval-start
- type-break-interval)
-
- (and (called-interactively-p 'interactive)
- (message "Type Break mode is enabled and set")))
- (t
- (type-break-keystroke-reset)
- (type-break-mode-line-countdown-or-break nil)
- (type-break-cancel-schedule)
- (do-auto-save)
- (when type-break-file-name
- (with-current-buffer (find-file-noselect type-break-file-name
- 'nowarn)
- (set-buffer-modified-p nil)
- (unlock-buffer)
- (kill-this-buffer)))
- (and (called-interactively-p 'interactive)
- (message "Type Break mode is disabled")))))
- type-break-mode)
+ (cond
+ ;; ((and already-enabled type-break-mode)
+ ;; (and (called-interactively-p 'interactive)
+ ;; (message "Type Break mode is already enabled")))
+ (type-break-mode
+ (when type-break-file-name
+ (with-current-buffer (find-file-noselect type-break-file-name 'nowarn)
+ (setq buffer-save-without-query t)))
+
+ (or global-mode-string (setq global-mode-string '(""))) ;FIXME: Why?
+ (type-break-keystroke-reset)
+ (type-break-mode-line-countdown-or-break nil)
+
+ (setq type-break-time-last-break
+ (or (type-break-get-previous-time)
+ (current-time)))
+
+ ;; Schedule according to break time from session file.
+ (type-break-schedule
+ (let (diff)
+ (if (and type-break-time-last-break
+ (< (setq diff (type-break-time-difference
+ type-break-time-last-break
+ (current-time)))
+ type-break-interval))
+ ;; Use the file's value.
+ (progn
+ (setq type-break-keystroke-count
+ (type-break-get-previous-count))
+ ;; File the time, in case it was read from the auto-save file.
+ (type-break-file-time type-break-interval-start)
+ (setq type-break-interval-start type-break-time-last-break)
+ (- type-break-interval diff))
+ ;; Schedule from now.
+ (setq type-break-interval-start (current-time))
+ (type-break-file-time type-break-interval-start)
+ type-break-interval))
+ type-break-interval-start
+ type-break-interval))
+ (t
+ (type-break-keystroke-reset)
+ (type-break-mode-line-countdown-or-break nil)
+ (type-break-cancel-schedule)
+ (do-auto-save)
+ (when type-break-file-name
+ (with-current-buffer (find-file-noselect type-break-file-name
+ 'nowarn)
+ (set-buffer-modified-p nil)
+ (unlock-buffer)
+ (kill-this-buffer))))))
(define-minor-mode type-break-mode-line-message-mode
"Toggle warnings about typing breaks in the mode line.
@@ -997,10 +969,11 @@ FRAC should be the inverse of the fractional value; for example, a value of
;; "low" bits and format the time incorrectly.
(defun type-break-time-sum (&rest tmlist)
(let ((sum '(0 0 0)))
- (dolist (tem tmlist sum)
+ (dolist (tem tmlist)
(setq sum (time-add sum (if (integerp tem)
(list (floor tem 65536) (mod tem 65536))
- tem))))))
+ tem))))
+ sum))
(defun type-break-time-stamp (&optional when)
(if (fboundp 'format-time-string)
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index a72f12ccb9b..01248a91cf2 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,29 @@
+2012-10-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url-http.el (url-http-user-agent-string): Leak less info.
+ (url-http, url-http-file-exists-p, url-http-file-readable-p)
+ (url-http-file-attributes, url-http-options, url-https-default-port)
+ (url-https-asynchronous-p): Don't autoload.
+
+2012-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url-handlers.el (url-file-handler): Don't assume any url-FOO function
+ is a good handler for FOO.
+ (url-copy-file, url-file-local-copy, url-insert-file-contents)
+ (url-file-name-completion, url-file-name-all-completions)
+ (url-handlers-create-wrapper): Explicitly register as handler.
+
+2012-09-29 Bastien Guerry <bzg@gnu.org>
+
+ * url-util.el (url-insert-entities-in-string)
+ (url-build-query-string): Fix docstrings.
+
+2012-09-25 Chong Yidong <cyd@gnu.org>
+
+ * url-parse.el (url-recreate-url-attributes):
+ * url-util.el (url-generate-unique-filename): Use declare to mark
+ obsolete.
+
2012-08-14 Stefan Monnier <monnier@iro.umontreal.ca>
* url-http.el (url-http-parse-headers): Re-enable file-name-handlers
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index f731f614d13..796980afbd5 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -137,11 +137,13 @@ like URLs \(Gnus is particularly bad at this\)."
"Function called from the `file-name-handler-alist' routines.
OPERATION is what needs to be done (`file-exists-p', etc). ARGS are
the arguments that would have been passed to OPERATION."
- (let ((fn (or (get operation 'url-file-handlers)
- (intern-soft (format "url-%s" operation))))
+ (let ((fn (get operation 'url-file-handlers))
(val nil)
(hooked nil))
- (if (and fn (fboundp fn))
+ (if (and (not fn) (intern-soft (format "url-%s" operation))
+ (fboundp (intern-soft (format "url-%s" operation))))
+ (error "Missing URL handler mapping for %s" operation))
+ (if fn
(setq hooked t
val (save-match-data (apply fn args)))
(setq hooked nil
@@ -249,6 +251,7 @@ A prefix arg makes KEEP-TIME non-nil."
(mm-save-part-to-file handle newname)
(kill-buffer buffer)
(mm-destroy-parts handle)))
+(put 'copy-file 'url-file-handlers 'url-copy-file)
;;;###autoload
(defun url-file-local-copy (url &rest ignored)
@@ -258,6 +261,7 @@ accessible."
(let ((filename (make-temp-file "url")))
(url-copy-file url filename 'ok-if-already-exists)
filename))
+(put 'file-local-copy 'url-file-handlers 'url-file-local-copy)
(defun url-insert (buffer &optional beg end)
"Insert the body of a URL object.
@@ -300,22 +304,29 @@ They count bytes from the beginning of the body."
;; usual heuristic/rules that we apply to files.
(decode-coding-inserted-region start (point) url visit beg end replace))
(list url (car size-and-charset))))))
+(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
(defun url-file-name-completion (url directory &optional predicate)
(error "Unimplemented"))
+(put 'file-name-completion 'url-file-handlers 'url-file-name-completion)
(defun url-file-name-all-completions (file directory)
(error "Unimplemented"))
+(put 'file-name-all-completions
+ 'url-file-handlers 'url-file-name-all-completions)
;; All other handlers map onto their respective backends.
(defmacro url-handlers-create-wrapper (method args)
- `(defun ,(intern (format "url-%s" method)) ,args
- ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method
- (or (documentation method t) "No original documentation."))
- (setq url (url-generic-parse-url url))
- (when (url-type url)
- (funcall (url-scheme-get-property (url-type url) (quote ,method))
- ,@(remove '&rest (remove '&optional args))))))
+ `(progn
+ (defun ,(intern (format "url-%s" method)) ,args
+ ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method
+ (or (documentation method t) "No original documentation."))
+ (setq url (url-generic-parse-url url))
+ (when (url-type url)
+ (funcall (url-scheme-get-property (url-type url) (quote ,method))
+ ,@(remove '&rest (remove '&optional args)))))
+ (unless (get ',method 'url-file-handlers)
+ (put ',method 'url-file-handlers ',(intern (format "url-%s" method))))))
(url-handlers-create-wrapper file-exists-p (url))
(url-handlers-create-wrapper file-attributes (url &optional id-format))
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 18d28e89f78..85b6efcde0d 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -215,17 +215,11 @@ request.")
(and (listp url-privacy-level)
(memq 'agent url-privacy-level)))
""
- (format "User-Agent: %sURL/%s%s\r\n"
+ (format "User-Agent: %sURL/%s\r\n"
(if url-package-name
(concat url-package-name "/" url-package-version " ")
"")
- url-version
- (cond
- ((and url-os-type url-system-type)
- (concat " (" url-os-type "; " url-system-type ")"))
- ((or url-os-type url-system-type)
- (concat " (" (or url-system-type url-os-type) ")"))
- (t "")))))
+ url-version)))
(defun url-http-create-request (&optional ref-url)
"Create an HTTP request for `url-http-target-url', referred to by REF-URL."
@@ -1153,7 +1147,6 @@ the end of the document."
(when (eq process-buffer (current-buffer))
(goto-char (point-max)))))
-;;;###autoload
(defun url-http (url callback cbargs &optional retry-buffer)
"Retrieve URL via HTTP asynchronously.
URL must be a parsed URL. See `url-generic-parse-url' for details.
@@ -1299,7 +1292,6 @@ previous `url-http' call, which is being re-attempted."
(url-request-data nil))
(url-retrieve-synchronously url)))
-;;;###autoload
(defun url-http-file-exists-p (url)
(let ((status nil)
(exists nil)
@@ -1313,7 +1305,6 @@ previous `url-http' call, which is being re-attempted."
(kill-buffer buffer))
exists))
-;;;###autoload
(defalias 'url-http-file-readable-p 'url-http-file-exists-p)
(defun url-http-head-file-attributes (url &optional id-format)
@@ -1333,13 +1324,11 @@ previous `url-http' call, which is being re-attempted."
(declare-function url-dav-file-attributes "url-dav" (url &optional id-format))
-;;;###autoload
(defun url-http-file-attributes (url &optional id-format)
(if (url-dav-supported-p url)
(url-dav-file-attributes url id-format)
(url-http-head-file-attributes url id-format)))
-;;;###autoload
(defun url-http-options (url)
"Return a property list describing options available for URL.
This list is retrieved using the `OPTIONS' HTTP method.
@@ -1417,9 +1406,7 @@ p3p
;; with url-http.el on systems with 8-character file names.
(require 'tls)
-;;;###autoload
(defconst url-https-default-port 443 "Default HTTPS port.")
-;;;###autoload
(defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
;; FIXME what is the point of this alias being an autoload?
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index 4007d1f35b3..cb61a021251 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -98,6 +98,7 @@ If the specified port number is the default, return nil."
(defun url-recreate-url-attributes (urlobj)
"Recreate the attributes of an URL string from the parsed URLOBJ."
+ (declare (obsolete nil "24.3"))
(when (url-attributes urlobj)
(concat ";"
(mapconcat (lambda (x)
@@ -105,7 +106,6 @@ If the specified port number is the default, return nil."
(concat (car x) "=" (cdr x))
(car x)))
(url-attributes urlobj) ";"))))
-(make-obsolete 'url-recreate-url-attributes nil "24.3")
;;;###autoload
(defun url-generic-parse-url (url)
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index f654830e387..038b7fcf7fe 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -132,8 +132,8 @@ If a list, it is a list of the types of messages to be logged."
(defun url-insert-entities-in-string (string)
"Convert HTML markup-start characters to entity references in STRING.
Also replaces the \" character, so that the result may be safely used as
- an attribute value in a tag. Returns a new string with the result of the
- conversion. Replaces these characters as follows:
+an attribute value in a tag. Returns a new string with the result of the
+conversion. Replaces these characters as follows:
& ==> &amp;
< ==> &lt;
> ==> &gt;
@@ -294,7 +294,7 @@ Given a QUERY in the form:
(key2 val2)
(key3 val1 val2)
(key4)
- (key5 ""))
+ (key5 \"\"))
\(This is the same format as produced by `url-parse-query-string')
@@ -593,6 +593,7 @@ Has a preference for looking backward when not directly on a symbol."
(defun url-generate-unique-filename (&optional fmt)
"Generate a unique filename in `url-temporary-directory'."
+ (declare (obsolete make-temp-file "23.1"))
;; This variable is obsolete, but so is this function.
(let ((tempdir (with-no-warnings url-temporary-directory)))
(if (not fmt)
@@ -614,7 +615,6 @@ Has a preference for looking backward when not directly on a symbol."
(setq x (1+ x)
fname (format fmt (concat base (int-to-string x)))))
(expand-file-name fname tempdir)))))
-(make-obsolete 'url-generate-unique-filename 'make-temp-file "23.1")
(defun url-extract-mime-headers ()
"Set `url-current-mime-headers' in current buffer."
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index fb6f8d4d58b..5a378df6513 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -136,12 +136,10 @@ this variable."
:type 'boolean
:group 'change-log)
-(defcustom add-log-buffer-file-name-function nil
+(defvar add-log-buffer-file-name-function 'buffer-file-name
"If non-nil, function to call to identify the full filename of a buffer.
-This function is called with no argument. If this is nil, the default is to
-use `buffer-file-name'."
- :type '(choice (const nil) function)
- :group 'change-log)
+This function is called with no argument. The default is to
+use `buffer-file-name'.")
(defcustom add-log-file-name-function nil
"If non-nil, function to call to identify the filename for a ChangeLog entry.
@@ -806,9 +804,7 @@ non-nil, otherwise in local time."
(let* ((defun (add-log-current-defun))
(version (and change-log-version-info-enabled
(change-log-version-number-search)))
- (buf-file-name (if add-log-buffer-file-name-function
- (funcall add-log-buffer-file-name-function)
- buffer-file-name))
+ (buf-file-name (funcall add-log-buffer-file-name-function))
(buffer-file (if buf-file-name (expand-file-name buf-file-name)))
(file-name (expand-file-name (find-change-log file-name buffer-file)))
;; Set ITEM to the file name to use in the new item.
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 11ec785b647..0e79c962b47 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -565,11 +565,24 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error."
(goto-char (match-beginning 1))
(beginning-of-line)))
+(defvar diff--auto-refine-data nil)
+
;; Define diff-{hunk,file}-{prev,next}
(easy-mmode-define-navigation
diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view
- (if diff-auto-refine-mode
- (condition-case-unless-debug nil (diff-refine-hunk) (error nil))))
+ (when diff-auto-refine-mode
+ (setq diff--auto-refine-data (cons (current-buffer) (point-marker)))
+ (run-at-time 0.0 nil
+ (lambda ()
+ (when diff--auto-refine-data
+ (let ((buffer (car diff--auto-refine-data))
+ (point (cdr diff--auto-refine-data)))
+ (setq diff--auto-refine-data nil)
+ (with-local-quit
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (goto-char point)
+ (diff-refine-hunk))))))))))
(easy-mmode-define-navigation
diff-file diff-file-header-re "file" diff-end-of-file)
@@ -1317,6 +1330,9 @@ a diff with \\[diff-reverse-direction].
\\{diff-mode-map}"
(set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults)
+ (add-hook 'font-lock-mode-hook
+ (lambda () (remove-overlays nil nil 'diff-mode 'fine))
+ nil 'local)
(set (make-local-variable 'outline-regexp) diff-outline-regexp)
(set (make-local-variable 'imenu-generic-expression)
diff-imenu-generic-expression)
@@ -1390,6 +1406,8 @@ modified lines of the diff."
(set (make-local-variable 'whitespace-style) '(face trailing))
(let ((style (save-excursion
(goto-char (point-min))
+ ;; FIXME: For buffers filled from async processes, this search
+ ;; will simply fail because the buffer is still empty :-(
(when (re-search-forward diff-hunk-header-re nil t)
(goto-char (match-beginning 0))
(diff-hunk-style)))))
@@ -1899,7 +1917,7 @@ For use in `add-log-current-defun-function'."
'((default
:inherit diff-refine-change)
(((class color) (min-colors 88) (background light))
- :background "#ffaaaa")
+ :background "#ffbbbb")
(((class color) (min-colors 88) (background dark))
:background "#aa2222"))
"Face used for removed characters shown by `diff-refine-hunk'."
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index b70b6cd919c..b1c334ddcfc 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -197,7 +197,8 @@ With prefix arg, prompt for diff switches."
ori file))
(diff bak ori switches)))
-(defun diff-latest-backup-file (fn) ; actually belongs into files.el
+;;;###autoload
+(defun diff-latest-backup-file (fn)
"Return the latest existing backup of FILE, or nil."
(let ((handler (find-file-name-handler fn 'diff-latest-backup-file)))
(if handler
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 674688df1c2..65776dfccad 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -753,6 +753,7 @@ to temp files in buffer jobs and when Ediff needs to find fine differences."
"Check the current version against MAJOR and MINOR version numbers.
The comparison uses operator OP, which may be any of: =, >, >=, <, <=.
TYPE-OF-EMACS is either 'xemacs or 'emacs."
+ (declare (obsolete version< "23.1"))
(and (cond ((eq type-of-emacs 'xemacs) (featurep 'xemacs))
((eq type-of-emacs 'emacs) (featurep 'emacs))
(t))
@@ -767,9 +768,6 @@ TYPE-OF-EMACS is either 'xemacs or 'emacs."
(t
(error "%S: Invalid op in ediff-check-version" op)))))
-;; ediff-check-version seems to be totally unused anyway.
-(make-obsolete 'ediff-check-version 'version< "23.1")
-
(defun ediff-color-display-p ()
(condition-case nil
(if (featurep 'xemacs)
@@ -981,7 +979,7 @@ this variable represents.")
(defface ediff-fine-diff-A
(if (featurep 'emacs)
'((((class color) (min-colors 88) (background light))
- :background "#ffaaaa")
+ :background "#ffbbbb")
(((class color) (min-colors 88) (background dark))
:background "#aa2222")
(((class color) (min-colors 16))
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 78a2163f653..86293ade580 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -1907,8 +1907,8 @@ in the specified buffer."
(cond ((eq which-diff 'after) (1+ diff-no))
((eq which-diff 'before) diff-no)
- ((< (abs (count-lines pos (max 1 prev-end)))
- (abs (count-lines pos (max 1 beg))))
+ ((< (abs (count-lines pos (max (point-min) prev-end)))
+ (abs (count-lines pos (max (point-min) beg))))
diff-no) ; choose prev difference
(t
(1+ diff-no))) ; choose next difference
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index eee3f40fd96..d7118ad7970 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -63,13 +63,11 @@
;; Determine which window setup function to use based on current window system.
(defun ediff-choose-window-setup-function-automatically ()
+ (declare (obsolete ediff-setup-windows-default "24.3"))
(if (ediff-window-display-p)
'ediff-setup-windows-multiframe
'ediff-setup-windows-plain))
-(make-obsolete 'ediff-choose-window-setup-function-automatically
- 'ediff-setup-windows-default "24.3")
-
(defcustom ediff-window-setup-function 'ediff-setup-windows-default
"Function called to set up windows.
Ediff provides a choice of three functions:
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index f6942bc538d..0a1bd044125 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -76,18 +76,6 @@ Commands:
Commands must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode,
but can be invoked directly in `fast' mode.")
-(define-obsolete-variable-alias 'emerge-version 'emacs-version "23.2")
-
-(defun emerge-version ()
- "Return string describing the version of Emerge.
-When called interactively, displays the version."
- (interactive)
- (if (called-interactively-p 'interactive)
- (message "Emerge version %s" emacs-version)
- emacs-version))
-
-(make-obsolete 'emerge-version 'emacs-version "23.2")
-
;;; Emerge configuration variables
(defgroup emerge nil
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 7ee000a8aea..3c34a762a1b 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -104,13 +104,7 @@ If 'changed, only request confirmation if the list of files has
:group 'log-edit
:type 'boolean)
-(defvar cvs-commit-buffer-require-final-newline t)
-(make-obsolete-variable 'cvs-commit-buffer-require-final-newline
- 'log-edit-require-final-newline
- "21.1")
-
-(defcustom log-edit-require-final-newline
- cvs-commit-buffer-require-final-newline
+(defcustom log-edit-require-final-newline t
"Enforce a newline at the end of commit log messages.
Enforce it silently if t, query if non-nil and don't do anything if nil."
:group 'log-edit
@@ -154,12 +148,7 @@ can be obtained from `log-edit-files'."
:group 'log-edit
:version "24.1")
-(defvar cvs-changelog-full-paragraphs t)
-(make-obsolete-variable 'cvs-changelog-full-paragraphs
- 'log-edit-changelog-full-paragraphs
- "21.1")
-
-(defvar log-edit-changelog-full-paragraphs cvs-changelog-full-paragraphs
+(defvar log-edit-changelog-full-paragraphs t
"If non-nil, include full ChangeLog paragraphs in the log.
This may be set in the ``local variables'' section of a ChangeLog, to
indicate the policy for that ChangeLog.
@@ -352,16 +341,19 @@ automatically."
(defvar log-edit-font-lock-keywords
;; Copied/inspired by message-font-lock-keywords.
`((log-edit-match-to-eoh
- (,(concat "^\\(\\([[:alpha:]]+\\):\\)" log-edit-header-contents-regexp)
+ (,(concat "^\\(\\([[:alpha:]-]+\\):\\)" log-edit-header-contents-regexp)
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
- (1 (if (assoc (match-string 2) log-edit-headers-alist)
+ (1 (if (assoc-string (match-string 2) log-edit-headers-alist t)
'log-edit-header
'log-edit-unknown-header)
nil lax)
;; From `log-edit-header-contents-regexp':
- (3 (or (cdr (assoc (match-string 2) log-edit-headers-alist))
+ (3 (or (cdr (assoc-string (match-string 2) log-edit-headers-alist t))
'log-edit-header)
- nil lax)))))
+ nil lax))
+ ("^\n"
+ (progn (goto-char (match-end 0)) (1+ (match-end 0))) nil
+ (0 '(:height 0.1 :inverse-video t))))))
(defvar log-edit-font-lock-gnu-style nil
"If non-nil, highlight common failures to follow the GNU coding standards.")
@@ -585,7 +577,7 @@ If you want to abort the commit, simply delete the buffer."
(or (= (point-min) (point-max))
(save-excursion
(goto-char (point-min))
- (while (and (looking-at "^\\([a-zA-Z]+: \\)?$")
+ (while (and (looking-at "^\\([a-zA-Z]+: ?\\)?$")
(zerop (forward-line 1))))
(eobp))))
@@ -818,7 +810,7 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each
change-log-default-name)
;; `find-change-log' uses `change-log-default-name' if set
;; and sets it before exiting, so we need to work around
- ;; that memoizing which is undesired here
+ ;; that memoizing which is undesired here.
(setq change-log-default-name nil)
(find-change-log)))))
(with-current-buffer (find-file-noselect changelog-file-name)
@@ -908,14 +900,44 @@ Rename relative filenames in the ChangeLog entry as FILES."
(insert "\n"))
log-edit-author))
+(defun log-edit-toggle-header (header value)
+ "Toggle a boolean-type header in the current buffer.
+If the value of HEADER is VALUE, clear it. Otherwise, add the
+header if it's not present and set it to VALUE. Then make sure
+there is an empty line after the headers. Return t if toggled
+on, otherwise nil."
+ (let ((val t)
+ (line (concat header ": " value "\n")))
+ (save-excursion
+ (save-restriction
+ (rfc822-goto-eoh)
+ (narrow-to-region (point-min) (point))
+ (goto-char (point-min))
+ (if (re-search-forward (concat "^" header ":"
+ log-edit-header-contents-regexp)
+ nil t)
+ (if (setq val (not (string= (match-string 1) value)))
+ (replace-match line t t)
+ (replace-match "" t t nil 1))
+ (insert line)))
+ (rfc822-goto-eoh)
+ (delete-horizontal-space)
+ (unless (looking-at "\n")
+ (insert "\n")))
+ val))
+
(defun log-edit-extract-headers (headers comment)
"Extract headers from COMMENT to form command line arguments.
-HEADERS should be an alist with elements of the form (HEADER . CMDARG)
-associating header names to the corresponding cmdline option name and the
-result is then a list of the form (MSG CMDARG1 HDRTEXT1 CMDARG2 HDRTEXT2...).
-where MSG is the remaining text from STRING.
-If \"Summary\" is not in HEADERS, then the \"Summary\" header is extracted
-anyway and put back as the first line of MSG."
+HEADERS should be an alist with elements (HEADER . CMDARG)
+or (HEADER . FUNCTION) associating headers to command line
+options and the result is then a list of the form (MSG ARGUMENTS...)
+where MSG is the remaining text from COMMENT.
+FUNCTION should be a function of one argument that takes the
+header value and returns the list of strings to be appended to
+ARGUMENTS. CMDARG will be added to ARGUMENTS followed by the
+header value. If \"Summary\" is not in HEADERS, then the
+\"Summary\" header is extracted anyway and put back as the first
+line of MSG."
(with-temp-buffer
(insert comment)
(rfc822-goto-eoh)
@@ -931,8 +953,10 @@ anyway and put back as the first line of MSG."
nil t)
(if (eq t (cdr header))
(setq summary (match-string 1))
- (push (match-string 1) res)
- (push (or (cdr header) (car header)) res))
+ (if (functionp (cdr header))
+ (setq res (nconc res (funcall (cdr header) (match-string 1))))
+ (push (match-string 1) res)
+ (push (or (cdr header) (car header)) res)))
(replace-match "" t t)))
;; Remove header separator if the header is empty.
(widen)
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index fc65d62c67d..b3c1f8c1343 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -133,14 +133,9 @@ current line. See also `cvs-invert-ignore-marks'"
:group 'pcl-cvs
:type '(boolean))
-(defvar cvs-diff-ignore-marks t)
-(make-obsolete-variable 'cvs-diff-ignore-marks
- 'cvs-invert-ignore-marks
- "21.1")
-
(defcustom cvs-invert-ignore-marks
(let ((l ()))
- (unless (equal cvs-diff-ignore-marks cvs-default-ignore-marks)
+ (unless (equal cvs-default-ignore-marks t)
(push "diff" l))
(when (and cvs-force-dir-tag (not cvs-default-ignore-marks))
(push "tag" l))
@@ -171,11 +166,6 @@ If set to nil, `cvs-mode-add' will always prompt for a message."
:type '(choice (const :tag "Prompt" nil)
(string)))
-(defvar cvs-diff-buffer-name "*cvs-diff*")
-(make-obsolete-variable 'cvs-diff-buffer-name
- 'cvs-buffer-name-alist
- "21.1")
-
(defcustom cvs-find-file-and-jump nil
"Jump to the modified area when finding a file.
If non-nil, `cvs-mode-find-file' will place the cursor at the beginning of
@@ -185,7 +175,7 @@ have no effect."
:type '(boolean))
(defcustom cvs-buffer-name-alist
- '(("diff" cvs-diff-buffer-name diff-mode)
+ '(("diff" "*cvs-diff*" diff-mode)
("status" "*cvs-info*" cvs-status-mode)
("tree" "*cvs-info*" cvs-status-mode)
("message" "*cvs-commit*" nil log-edit)
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 36572640cfc..e863096d587 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -124,7 +124,7 @@ to confuse some users sometimes."
(define-obsolete-face-alias 'cvs-marked-face 'cvs-marked "22.1")
(defface cvs-msg
- '((t (:slant italic)))
+ '((t :slant italic))
"PCL-CVS face used to highlight CVS messages."
:group 'pcl-cvs)
(define-obsolete-face-alias 'cvs-msg-face 'cvs-msg "22.1")
@@ -358,7 +358,7 @@ For use by the cookie package."
;;(MOD-CONFLICT "Not Removed")
(`DEAD "")
(_ (capitalize (symbol-name type)))))
- (face (let ((sym (intern
+ (face (let ((sym (intern-soft
(concat "cvs-fi-"
(downcase (symbol-name type))
"-face"))))
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 659151a31e9..4bc3eaf8c2c 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -60,8 +60,6 @@
;; - rework the displaying of error messages.
;; - allow to flush messages only
;; - allow to protect files like ChangeLog from flushing
-;; - automatically cvs-mode-insert files from find-file-hook
-;; (and don't flush them as long as they are visited)
;; - query the user for cvs-get-marked (for some cmds or if nothing's selected)
;; - don't return the first (resp last) FI if the cursor is before
;; (resp after) it.
@@ -877,7 +875,10 @@ RM-MSGS if non-nil means remove messages."
;; remove entries
(`DEAD nil)
;; handled also?
- (`UP-TO-DATE (not rm-handled))
+ (`UP-TO-DATE
+ (if (find-buffer-visiting (cvs-fileinfo->full-name fi))
+ t
+ (not rm-handled)))
;; keep the rest
(_ (not (run-hook-with-args-until-success
'cvs-cleanup-functions fi))))))
@@ -1617,7 +1618,8 @@ With prefix argument, prompt for cvs flags."
(defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags)
"Diff the selected files against the repository.
This command compares the files in your working area against the
-revision which they are based upon."
+revision which they are based upon.
+See also `cvs-diff-ignore-marks'."
(interactive
(list (cvs-add-branch-prefix
(cvs-add-secondary-branch-prefix
@@ -2435,6 +2437,21 @@ The exact behavior is determined also by `cvs-dired-use-hook'."
(add-hook 'after-save-hook 'cvs-mark-buffer-changed)
+(defun cvs-insert-visited-file ()
+ (let* ((file (expand-file-name buffer-file-name))
+ (version (and (fboundp 'vc-backend)
+ (eq (vc-backend file) 'CVS)
+ (vc-working-revision file))))
+ (when version
+ (save-current-buffer
+ (dolist (cvs-buf (buffer-list))
+ (set-buffer cvs-buf)
+ ;; look for a corresponding pcl-cvs buffer
+ (when (and (eq major-mode 'cvs-mode)
+ (string-prefix-p default-directory file))
+ (cvs-insert-file file)))))))
+
+(add-hook 'find-file-hook 'cvs-insert-visited-file 'append)
(provide 'pcvs)
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index babcf6f1beb..7037b606fe7 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -132,7 +132,7 @@ Used in `smerge-diff-base-mine' and related functions."
'((default
:inherit smerge-refined-change)
(((class color) (min-colors 88) (background light))
- :background "#ffaaaa")
+ :background "#ffbbbb")
(((class color) (min-colors 88) (background dark))
:background "#aa2222")
(t :inverse-video t))
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 1eb33776f6a..74a61548d8b 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -150,12 +150,6 @@ Use the current Bzr root directory as the ROOT argument to
(defconst vc-bzr-admin-branchconf
(concat vc-bzr-admin-dirname "/branch/branch.conf"))
-;;;###autoload (defun vc-bzr-registered (file)
-;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file)
-;;;###autoload (progn
-;;;###autoload (load "vc-bzr")
-;;;###autoload (vc-bzr-registered file))))
-
(defun vc-bzr-root (file)
"Return the root directory of the bzr repository containing FILE."
;; Cache technique copied from vc-arch.el.
@@ -291,6 +285,14 @@ in the repository root directory of FILE."
(message "Falling back on \"slow\" status detection (%S)" err)
(vc-bzr-state file))))))
+;; This is a cheap approximation that is autoloaded. If it finds a
+;; possible match it loads this file and runs the real function.
+;; It requires vc-bzr-admin-checkout-format-file to be autoloaded too.
+;;;###autoload (defun vc-bzr-registered (file)
+;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file)
+;;;###autoload (progn
+;;;###autoload (load "vc-bzr")
+;;;###autoload (vc-bzr-registered file))))
(defun vc-bzr-registered (file)
"Return non-nil if FILE is registered with bzr."
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index ea9ce949ccb..5d7cb366e82 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -608,16 +608,52 @@ The car of the list is the current branch."
(defun vc-git-unregister (file)
(vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
+(declare-function log-edit-mode "log-edit" ())
+(declare-function log-edit-toggle-header "log-edit" (header value))
(declare-function log-edit-extract-headers "log-edit" (headers string))
+(defun vc-git-log-edit-toggle-signoff ()
+ "Toggle whether to add the \"Signed-off-by\" line at the end of
+the commit message."
+ (interactive)
+ (log-edit-toggle-header "Sign-Off" "yes"))
+
+(defun vc-git-log-edit-toggle-amend ()
+ "Toggle whether this will amend the previous commit.
+If toggling on, also insert its message into the buffer."
+ (interactive)
+ (when (log-edit-toggle-header "Amend" "yes")
+ (goto-char (point-max))
+ (unless (bolp) (insert "\n"))
+ (insert (with-output-to-string
+ (vc-git-command
+ standard-output 1 nil
+ "log" "--max-count=1" "--pretty=format:%B" "HEAD")))))
+
+(defvar vc-git-log-edit-mode-map
+ (let ((map (make-sparse-keymap "Git-Log-Edit")))
+ (define-key map "\C-c\C-s" 'vc-git-log-edit-toggle-signoff)
+ (define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend)
+ map))
+
+(define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git"
+ "Major mode for editing Git log messages.
+It is based on `log-edit-mode', and has Git-specific extensions.")
+
(defun vc-git-checkin (files _rev comment)
(let ((coding-system-for-write vc-git-commits-coding-system))
- (apply 'vc-git-command nil 0 files
- (nconc (list "commit" "-m")
- (log-edit-extract-headers '(("Author" . "--author")
- ("Date" . "--date"))
- comment)
- (list "--only" "--")))))
+ (cl-flet ((boolean-arg-fn
+ (argument)
+ (lambda (value) (when (equal value "yes") (list argument)))))
+ (apply 'vc-git-command nil 0 files
+ (nconc (list "commit" "-m")
+ (log-edit-extract-headers
+ `(("Author" . "--author")
+ ("Date" . "--date")
+ ("Amend" . ,(boolean-arg-fn "--amend"))
+ ("Sign-Off" . ,(boolean-arg-fn "--signoff")))
+ comment)
+ (list "--only" "--"))))))
(defun vc-git-find-revision (file rev buffer)
(let* (process-file-side-effects
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 54c33769267..cac3eb559a1 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -34,18 +34,6 @@
;; Customization Variables (the rest is in vc.el)
-(defvar vc-ignore-vc-files nil)
-(make-obsolete-variable 'vc-ignore-vc-files
- "set `vc-handled-backends' to nil to disable VC."
- "21.1")
-
-(defvar vc-master-templates ())
-(make-obsolete-variable 'vc-master-templates
- "to define master templates for a given BACKEND, use
-vc-BACKEND-master-templates. To enable or disable VC for a given
-BACKEND, use `vc-handled-backends'."
- "21.1")
-
(defcustom vc-ignore-dir-regexp
;; Stop SMB, automounter, AFS, and DFS host lookups.
locate-dominating-stop-dir-regexp
@@ -586,16 +574,7 @@ If FILE is not registered, this function always returns nil."
"Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
(let ((sym (vc-make-backend-sym backend 'master-templates)))
(unless (get backend 'vc-templates-grabbed)
- (put backend 'vc-templates-grabbed t)
- (set sym (append (delq nil
- (mapcar
- (lambda (template)
- (and (consp template)
- (eq (cdr template) backend)
- (car template)))
- (with-no-warnings
- vc-master-templates)))
- (symbol-value sym))))
+ (put backend 'vc-templates-grabbed t))
(let ((result (vc-check-master-templates file (symbol-value sym))))
(if (stringp result)
(vc-file-setprop file 'vc-name result)
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index ecd7b826437..baaf0c3a926 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -89,6 +89,9 @@ to use --brief and sets this variable to remember whether it worked."
:type '(choice (const :tag "Work out" nil) (const yes) (const no))
:group 'vc-rcs)
+;; This needs to be autoloaded because vc-rcs-registered uses it (via
+;; vc-default-registered), and vc-hooks needs to be able to check
+;; for a registered backend without loading every backend.
;;;###autoload
(defcustom vc-rcs-master-templates
(purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s"))
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index a34222f7236..c4f6fd10bdb 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -74,6 +74,9 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
:version "24.1" ; no longer consult the obsolete vc-header-alist
:group 'vc-sccs)
+;; This needs to be autoloaded because vc-sccs-registered uses it (via
+;; vc-default-registered), and vc-hooks needs to be able to check
+;; for a registered backend without loading every backend.
;;;###autoload
(defcustom vc-sccs-master-templates
(purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir))
@@ -106,11 +109,10 @@ For a description of possible values, see `vc-check-master-templates'."
;; The autoload cookie below places vc-sccs-registered directly into
;; loaddefs.el, so that vc-sccs.el does not need to be loaded for
-;; every file that is visited. The definition is repeated below
-;; so that Help and etags can find it.
-
-;;;###autoload (defun vc-sccs-registered(f) (vc-default-registered 'SCCS f))
-(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f))
+;; every file that is visited.
+;;;###autoload
+(progn
+(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f)))
(defun vc-sccs-state (file)
"SCCS-specific function to compute the version control state."
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 47800bd4aac..2da721b41d8 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -808,16 +808,6 @@ is sensitive to blank lines."
(string :tag "Comment End")))
:group 'vc)
-(defcustom vc-checkout-carefully (= (user-uid) 0)
- "Non-nil means be extra-careful in checkout.
-Verify that the file really is not locked
-and that its contents match what the repository version says."
- :type 'boolean
- :group 'vc)
-(make-obsolete-variable 'vc-checkout-carefully
- "the corresponding checks are always done now."
- "21.1")
-
;; Variables users don't need to see
@@ -1115,24 +1105,27 @@ For old-style locking-based version control systems, like RCS:
;; Files have local changes
((vc-compatible-state state 'edited)
(let ((ready-for-commit files))
- ;; If files are edited but read-only, give user a chance to correct.
- (dolist (file files)
- ;; If committing a mix of removed and edited files, the
- ;; fileset has state = 'edited. Rather than checking the
- ;; state of each individual file in the fileset, it seems
- ;; simplest to just check if the file exists. Bug#9781.
- (when (and (file-exists-p file) (not (file-writable-p file)))
- ;; Make the file+buffer read-write.
- (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file))
- (error "Aborted"))
- ;; Maybe we somehow lost permissions on the directory.
- (condition-case nil
- (set-file-modes file (logior (file-modes file) 128))
- (error (error "Unable to make file writable")))
- (let ((visited (get-file-buffer file)))
- (when visited
- (with-current-buffer visited
- (read-only-mode -1))))))
+ ;; CVS, SVN and bzr don't care about read-only (bug#9781).
+ ;; RCS does, SCCS might (someone should check...).
+ (when (memq backend '(RCS SCCS))
+ ;; If files are edited but read-only, give user a chance to correct.
+ (dolist (file files)
+ ;; If committing a mix of removed and edited files, the
+ ;; fileset has state = 'edited. Rather than checking the
+ ;; state of each individual file in the fileset, it seems
+ ;; simplest to just check if the file exists. Bug#9781.
+ (when (and (file-exists-p file) (not (file-writable-p file)))
+ ;; Make the file+buffer read-write.
+ (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file))
+ (error "Aborted"))
+ ;; Maybe we somehow lost permissions on the directory.
+ (condition-case nil
+ (set-file-modes file (logior (file-modes file) 128))
+ (error (error "Unable to make file writable")))
+ (let ((visited (get-file-buffer file)))
+ (when visited
+ (with-current-buffer visited
+ (read-only-mode -1)))))))
;; Allow user to revert files with no changes
(save-excursion
(dolist (file files)
@@ -1516,8 +1509,9 @@ to override the value of `vc-diff-switches' and `diff-switches'."
(when (listp switches) switches))))
;; Old def for compatibility with Emacs-21.[123].
-(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff))
-(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1")
+(defmacro vc-diff-switches-list (backend)
+ (declare (obsolete vc-switches "22.1"))
+ `(vc-switches ',backend 'diff))
(defun vc-diff-finish (buffer messages)
;; The empty sync output case has already been handled, so the only
diff --git a/lisp/view.el b/lisp/view.el
index 41cb9752288..7ed42bf7ddc 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -513,6 +513,7 @@ that can be added see the RETURN-TO-ALIST argument of the
function `view-mode-exit'. If `view-return-to-alist' contains an
entry for the selected window, purge that entry from
`view-return-to-alist' before adding ITEM."
+ (declare (obsolete "this function has no effect." "24.1"))
(with-current-buffer buffer
(when view-return-to-alist
(let* ((list view-return-to-alist)
@@ -535,7 +536,6 @@ entry for the selected window, purge that entry from
(when item
(setq view-return-to-alist
(cons item view-return-to-alist)))))
-(make-obsolete 'view-return-to-alist-update "this function has no effect." "24.1")
;;;###autoload
(defun view-mode-enter (&optional quit-restore exit-action)
diff --git a/lisp/window.el b/lisp/window.el
index fccb68bd94a..f9761366b62 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -28,6 +28,35 @@
;;; Code:
+(defun internal--before-save-selected-window ()
+ (cons (selected-window)
+ ;; We save and restore all frames' selected windows, because
+ ;; `select-window' can change the frame-selected-window of
+ ;; whatever frame that window is in. Each text terminal's
+ ;; top-frame is preserved by putting it last in the list.
+ (apply #'append
+ (mapcar (lambda (terminal)
+ (let ((frames (frames-on-display-list terminal))
+ (top-frame (tty-top-frame terminal))
+ alist)
+ (if top-frame
+ (setq frames
+ (cons top-frame
+ (delq top-frame frames))))
+ (dolist (f frames)
+ (push (cons f (frame-selected-window f))
+ alist))
+ alist))
+ (terminal-list)))))
+
+(defun internal--after-save-selected-window (state)
+ (dolist (elt (cdr state))
+ (and (frame-live-p (car elt))
+ (window-live-p (cdr elt))
+ (set-frame-selected-window (car elt) (cdr elt) 'norecord)))
+ (when (window-live-p (car state))
+ (select-window (car state) 'norecord)))
+
(defmacro save-selected-window (&rest body)
"Execute BODY, then select the previously selected window.
The value returned is the value of the last form in BODY.
@@ -44,34 +73,11 @@ its normal operation could make a different buffer current. The
order of recently selected windows and the buffer list ordering
are not altered by this macro (unless they are altered in BODY)."
(declare (indent 0) (debug t))
- `(let ((save-selected-window-window (selected-window))
- ;; We save and restore all frames' selected windows, because
- ;; `select-window' can change the frame-selected-window of
- ;; whatever frame that window is in. Each text terminal's
- ;; top-frame is preserved by putting it last in the list.
- (save-selected-window-alist
- (apply 'append
- (mapcar (lambda (terminal)
- (let ((frames (frames-on-display-list terminal))
- (top-frame (tty-top-frame terminal))
- alist)
- (if top-frame
- (setq frames
- (cons top-frame
- (delq top-frame frames))))
- (dolist (f frames)
- (push (cons f (frame-selected-window f))
- alist))))
- (terminal-list)))))
+ `(let ((save-selected-window--state (internal--before-save-selected-window)))
(save-current-buffer
(unwind-protect
(progn ,@body)
- (dolist (elt save-selected-window-alist)
- (and (frame-live-p (car elt))
- (window-live-p (cdr elt))
- (set-frame-selected-window (car elt) (cdr elt) 'norecord)))
- (when (window-live-p save-selected-window-window)
- (select-window save-selected-window-window 'norecord))))))
+ (internal--after-save-selected-window save-selected-window--state)))))
(defvar temp-buffer-window-setup-hook nil
"Normal hook run by `with-temp-buffer-window' before buffer display.
@@ -84,7 +90,7 @@ This hook is run by `with-temp-buffer-window' with the buffer
displayed and current and its window selected.")
(defun temp-buffer-window-setup (buffer-or-name)
- "Set up temporary buffer specified by BUFFER-OR-NAME
+ "Set up temporary buffer specified by BUFFER-OR-NAME.
Return the buffer."
(let ((old-dir default-directory)
(buffer (get-buffer-create buffer-or-name)))
@@ -111,7 +117,19 @@ to `display-buffer'."
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(goto-char (point-min))
- (when (setq window (display-buffer buffer action))
+ (when (let ((window-combination-limit
+ ;; When `window-combination-limit' equals
+ ;; `temp-buffer' or `temp-buffer-resize' and
+ ;; `temp-buffer-resize-mode' is enabled in this
+ ;; buffer bind it to t so resizing steals space
+ ;; preferably from the window that was split.
+ (if (or (eq window-combination-limit 'temp-buffer)
+ (and (eq window-combination-limit
+ 'temp-buffer-resize)
+ temp-buffer-resize-mode))
+ t
+ window-combination-limit)))
+ (setq window (display-buffer buffer action)))
(setq frame (window-frame window))
(unless (eq frame (selected-frame))
(raise-frame frame))
@@ -496,7 +514,7 @@ failed."
(window-make-atom (window-parent window))
;; Display BUFFER in NEW and return NEW.
(window--display-buffer
- buffer new 'window display-buffer-mark-dedicated))))
+ buffer new 'window alist display-buffer-mark-dedicated))))
(defun window--atom-check-1 (window)
"Subroutine of `window--atom-check'."
@@ -665,12 +683,6 @@ The new window automatically becomes the \"major\" side window on
SIDE. Return the new window, nil if its creation window failed."
(let* ((root (frame-root-window))
(left-or-right (memq side '(left right)))
- (size (or (assq 'size alist)
- (/ (window-total-size (frame-root-window) left-or-right)
- ;; By default use a fourth of the size of the
- ;; frame's root window. This has to be made
- ;; customizable via ALIST.
- 4)))
(major (window--major-side-window side))
(selected-window (selected-window))
(on-side (cond
@@ -682,7 +694,7 @@ SIDE. Return the new window, nil if its creation window failed."
;; parent window unless needed.
(window-combination-resize 'side)
(window-combination-limit nil)
- (new (split-window major (- size) on-side))
+ (new (split-window major nil on-side))
fun)
(when new
;; Initialize `window-side' parameter of new window to SIDE.
@@ -693,8 +705,22 @@ SIDE. Return the new window, nil if its creation window failed."
;; the new window is deleted, a side window on the opposite side
;; does not get resized.
(set-window-parameter new 'delete-window 'delete-side-window)
+ ;; Auto-adjust height/width of new window unless a size has been
+ ;; explicitly requested.
+ (unless (if left-or-right
+ (cdr (assq 'window-width alist))
+ (cdr (assq 'window-height alist)))
+ (setq alist
+ (cons
+ (cons
+ (if left-or-right 'window-width 'window-height)
+ (/ (window-total-size (frame-root-window) left-or-right)
+ ;; By default use a fourth of the size of the
+ ;; frame's root window.
+ 4))
+ alist)))
;; Install BUFFER in new window and return NEW.
- (window--display-buffer buffer new 'window 'side))))
+ (window--display-buffer buffer new 'window alist 'side))))
(defun delete-side-window (window)
"Delete side window WINDOW."
@@ -802,7 +828,7 @@ following symbols can be used:
;; ALIST (or, better, avoided in the "other" functions).
(or (and this-window
;; Reuse `this-window'.
- (window--display-buffer buffer this-window 'reuse 'side))
+ (window--display-buffer buffer this-window 'reuse alist 'side))
(and (or (not max-slots) (< slots max-slots))
(or (and next-window
;; Make new window before `next-window'.
@@ -827,13 +853,14 @@ following symbols can be used:
window 'delete-window 'delete-side-window)
window)))
(set-window-parameter window 'window-slot slot)
- (window--display-buffer buffer window 'window 'side))
+ (window--display-buffer buffer window 'window alist 'side))
(and best-window
;; Reuse `best-window'.
(progn
;; Give best-window the new slot value.
(set-window-parameter best-window 'window-slot slot)
- (window--display-buffer buffer best-window 'reuse 'side)))))))))
+ (window--display-buffer
+ buffer best-window 'reuse alist 'side)))))))))
(defun window--side-check (&optional frame)
"Check the side window configuration of FRAME.
@@ -891,7 +918,7 @@ of all windows on FRAME to nil."
(if right (throw 'reset t) (setq right t)))
((eq side 'bottom)
(if bottom (throw 'reset t) (setq bottom t)))
- (t
+ (t
(throw 'reset t))))
frame t))
;; If there's a side window, there must be at least one
@@ -2067,9 +2094,9 @@ preferably only resize windows adjacent to EDGE.
Return the symbol `normalized' if new normal sizes have been
already set by this routine."
(let* ((first (window-child parent))
- (sub first)
+ (last (window-last-child parent))
(parent-total (+ (window-total-size parent horizontal) delta))
- best-window best-value)
+ sub best-window best-value)
(if (and edge (memq trail '(before after))
(progn
@@ -2113,7 +2140,7 @@ already set by this routine."
;; normal sizes have been already set.
'normalized)
;; Resize all windows proportionally.
- (setq sub first)
+ (setq sub last)
(while sub
(cond
((or (window--resize-child-windows-skip-p sub)
@@ -2142,14 +2169,14 @@ already set by this routine."
parent-total)
(window-normal-size sub horizontal)))))
- (setq sub (window-right sub)))
+ (setq sub (window-left sub)))
(cond
((< delta 0)
;; Shrink windows by delta.
(setq best-window t)
(while (and best-window (not (zerop delta)))
- (setq sub first)
+ (setq sub last)
(setq best-window nil)
(setq best-value most-negative-fixnum)
(while sub
@@ -2159,7 +2186,7 @@ already set by this routine."
(setq best-window sub)
(setq best-value (cdr (window-new-normal sub))))
- (setq sub (window-right sub)))
+ (setq sub (window-left sub)))
(when best-window
(setq delta (1+ delta)))
@@ -2176,7 +2203,7 @@ already set by this routine."
;; Enlarge windows by delta.
(setq best-window t)
(while (and best-window (not (zerop delta)))
- (setq sub first)
+ (setq sub last)
(setq best-window nil)
(setq best-value most-positive-fixnum)
(while sub
@@ -2185,7 +2212,7 @@ already set by this routine."
(setq best-window sub)
(setq best-value (window-new-normal sub)))
- (setq sub (window-right sub)))
+ (setq sub (window-left sub)))
(when best-window
(setq delta (1- delta)))
@@ -2197,7 +2224,7 @@ already set by this routine."
(window-normal-size best-window horizontal))))))
(when best-window
- (setq sub first)
+ (setq sub last)
(while sub
(when (or (consp (window-new-normal sub))
(numberp (window-new-normal sub)))
@@ -2215,7 +2242,7 @@ already set by this routine."
;; recursively even if it's size does not change.
(window--resize-this-window
sub delta horizontal ignore nil trail edge))))
- (setq sub (window-right sub)))))))
+ (setq sub (window-left sub)))))))
(defun window--resize-siblings (window delta &optional horizontal ignore trail edge)
"Resize other windows when WINDOW is resized vertically by DELTA lines.
@@ -2394,27 +2421,33 @@ Return the number of lines that were recovered.
This function is only called by the minibuffer window resizing
routines. It resizes windows proportionally and never deletes
any windows."
- (when (numberp delta)
- (let (ignore)
- (cond
- ((< delta 0)
- (setq delta (window-sizable window delta)))
- ((> delta 0)
- (unless (window-sizable window delta)
- (setq ignore t))))
-
- (window--resize-reset (window-frame window))
- ;; Ideally, we would resize just the last window in a combination
- ;; but that's not feasible for the following reason: If we grow
- ;; the minibuffer window and the last window cannot be shrunk any
- ;; more, we shrink another window instead. But if we then shrink
- ;; the minibuffer window again, the last window might get enlarged
- ;; and the state after shrinking is not the state before growing.
- ;; So, in practice, we'd need a history variable to record how to
- ;; proceed. But I'm not sure how such a variable could work with
- ;; repeated minibuffer window growing steps.
- (window--resize-this-window window delta nil ignore t)
- delta)))
+ (let ((frame (window-frame window))
+ ignore)
+ (cond
+ ((not (numberp delta))
+ (setq delta 0))
+ ((zerop delta))
+ ((< delta 0)
+ (setq delta (window-sizable window delta))
+ (window--resize-reset frame)
+ ;; When shrinking the root window, emulate an edge drag in order
+ ;; to not resize other windows if we can avoid it (Bug#12419).
+ (window--resize-this-window
+ window delta nil ignore t 'before
+ (+ (window-top-line window) (window-total-size window)))
+ ;; Don't record new normal sizes to make sure that shrinking back
+ ;; proportionally works as intended.
+ (walk-window-tree
+ (lambda (window) (set-window-new-normal window 'ignore)) frame t))
+ ((> delta 0)
+ (window--resize-reset frame)
+ (unless (window-sizable window delta)
+ (setq ignore t))
+ ;; When growing the root window, resize proportionally. This
+ ;; should give windows back their original sizes (hopefully).
+ (window--resize-this-window window delta nil ignore t)))
+ ;; Return the possibly adjusted DELTA.
+ delta))
(defun adjust-window-trailing-edge (window delta &optional horizontal)
"Move WINDOW's bottom edge by DELTA lines.
@@ -3678,9 +3711,8 @@ frame. The selected window is not changed by this function."
(parent (window-parent window))
(function (window-parameter window 'split-window))
(window-side (window-parameter window 'window-side))
- ;; Rebind `window-combination-limit' and
- ;; `window-combination-resize' since in some cases we may have
- ;; to override their value.
+ ;; Rebind the following two variables since in some cases we
+ ;; have to override their value.
(window-combination-limit window-combination-limit)
(window-combination-resize window-combination-resize)
atom-root)
@@ -3738,7 +3770,7 @@ frame. The selected window is not changed by this function."
(and window-combination-resize
(or (window-parameter window 'window-side)
(not (eq window-combination-resize 'side)))
- (not window-combination-limit)
+ (not (eq window-combination-limit t))
;; Resize makes sense in iso-combinations only.
(window-combined-p window horizontal)))
;; `old-size' is the current size of WINDOW.
@@ -3818,7 +3850,7 @@ frame. The selected window is not changed by this function."
;; Make new-parent non-nil if we need a new parent window;
;; either because we want to nest or because WINDOW is not
;; iso-combined.
- (or window-combination-limit
+ (or (eq window-combination-limit t)
(not (window-combined-p window horizontal))))
(setq new-normal
;; Make new-normal the normal size of the new window.
@@ -5060,18 +5092,30 @@ split."
(with-selected-window window
(split-window-below))))))))
-(defun window--try-to-split-window (window)
+(defun window--try-to-split-window (window &optional alist)
"Try to split WINDOW.
Return value returned by `split-window-preferred-function' if it
represents a live window, nil otherwise."
(and (window-live-p window)
(not (frame-parameter (window-frame window) 'unsplittable))
- (let ((new-window
- ;; Since `split-window-preferred-function' might
- ;; throw an error use `condition-case'.
- (condition-case nil
- (funcall split-window-preferred-function window)
- (error nil))))
+ (let* ((window-combination-limit
+ ;; When `window-combination-limit' equals
+ ;; `display-buffer' or equals `resize-window' and a
+ ;; `window-height' or `window-width' alist entry are
+ ;; present, bind it to t so resizing steals space
+ ;; preferably from the window that was split.
+ (if (or (eq window-combination-limit 'display-buffer)
+ (and (eq window-combination-limit 'window-size)
+ (or (cdr (assq 'window-height alist))
+ (cdr (assq 'window-width alist)))))
+ t
+ window-combination-limit))
+ (new-window
+ ;; Since `split-window-preferred-function' might
+ ;; throw an error use `condition-case'.
+ (condition-case nil
+ (funcall split-window-preferred-function window)
+ (error nil))))
(and (window-live-p new-window) new-window))))
(defun window--frame-usable-p (frame)
@@ -5120,7 +5164,7 @@ is higher than WINDOW."
(/ (- (window-total-height window) (window-total-height)) 2))
(error nil))))
-(defun window--display-buffer (buffer window type &optional dedicated)
+(defun window--display-buffer (buffer window type &optional alist dedicated)
"Display BUFFER in WINDOW and make its frame visible.
TYPE must be one of the symbols `reuse', `window' or `frame' and
is passed unaltered to `display-buffer-record-window'. Set
@@ -5135,6 +5179,58 @@ BUFFER and WINDOW are live."
(set-window-dedicated-p window dedicated))
(when (memq type '(window frame))
(set-window-prev-buffers window nil)))
+ (let ((parameter (window-parameter window 'quit-restore))
+ (height (cdr (assq 'window-height alist)))
+ (width (cdr (assq 'window-width alist))))
+ (when (or (memq type '(window frame))
+ (and (eq (car parameter) 'same)
+ (memq (nth 1 parameter) '(window frame))))
+ ;; Adjust height of new window or frame.
+ (cond
+ ((not height))
+ ((numberp height)
+ (let* ((new-height
+ (if (integerp height)
+ height
+ (round
+ (* (window-total-size (frame-root-window window))
+ height))))
+ (delta (- new-height (window-total-size window))))
+ (cond
+ ((and (window--resizable-p window delta nil 'safe)
+ (window-combined-p window))
+ (window-resize window delta nil 'safe))
+ ((or (eq type 'frame)
+ (and (eq (car parameter) 'same)
+ (eq (nth 1 parameter) 'frame)))
+ (set-frame-height
+ (window-frame window)
+ (+ (frame-height (window-frame window)) delta))))))
+ ((functionp height)
+ (ignore-errors (funcall height window))))
+ ;; Adjust width of a window or frame.
+ (cond
+ ((not width))
+ ((numberp width)
+ (let* ((new-width
+ (if (integerp width)
+ width
+ (round
+ (* (window-total-size (frame-root-window window) t)
+ width))))
+ (delta (- new-width (window-total-size window t))))
+ (cond
+ ((and (window--resizable-p window delta t 'safe)
+ (window-combined-p window t))
+ (window-resize window delta t 'safe))
+ ((or (eq type 'frame)
+ (and (eq (car parameter) 'same)
+ (eq (nth 1 parameter) 'frame)))
+ (set-frame-width
+ (window-frame window)
+ (+ (frame-width (window-frame window)) delta))))))
+ ((functionp width)
+ (ignore-errors (funcall width window))))))
window))
(defun window--maybe-raise-frame (frame)
@@ -5376,7 +5472,7 @@ selected window."
(unless (or (cdr (assq 'inhibit-same-window alist))
(window-minibuffer-p)
(window-dedicated-p))
- (window--display-buffer buffer (selected-window) 'reuse)))
+ (window--display-buffer buffer (selected-window) 'reuse alist)))
(defun display-buffer--maybe-same-window (buffer alist)
"Conditionally display BUFFER in the selected window.
@@ -5424,7 +5520,7 @@ that frame."
(get-buffer-window-list buffer 'nomini
frames))))))
(when (window-live-p window)
- (prog1 (window--display-buffer buffer window 'reuse)
+ (prog1 (window--display-buffer buffer window 'reuse alist)
(unless (cdr (assq 'inhibit-switch-frame alist))
(window--maybe-raise-frame (window-frame window)))))))
@@ -5461,8 +5557,8 @@ new frame."
(when (and fun
(setq frame (funcall fun))
(setq window (frame-selected-window frame)))
- (prog1 (window--display-buffer buffer window
- 'frame display-buffer-mark-dedicated)
+ (prog1 (window--display-buffer
+ buffer window 'frame alist display-buffer-mark-dedicated)
(unless (cdr (assq 'inhibit-switch-frame alist))
(window--maybe-raise-frame frame))))))
@@ -5487,11 +5583,11 @@ raising the frame."
(not (frame-parameter frame 'unsplittable))))
;; Attempt to split largest or least recently used window.
(setq window (or (window--try-to-split-window
- (get-largest-window frame t))
+ (get-largest-window frame t) alist)
(window--try-to-split-window
- (get-lru-window frame t)))))
- (prog1 (window--display-buffer buffer window
- 'window display-buffer-mark-dedicated)
+ (get-lru-window frame t) alist))))
+ (prog1 (window--display-buffer
+ buffer window 'window alist display-buffer-mark-dedicated)
(unless (cdr (assq 'inhibit-switch-frame alist))
(window--maybe-raise-frame (window-frame window)))))))
@@ -5510,19 +5606,42 @@ again with `display-buffer-pop-up-window'."
(and pop-up-windows
(display-buffer-pop-up-window buffer alist))))
-(defun display-buffer-below-selected (buffer _alist)
+(defun display-buffer-below-selected (buffer alist)
"Try displaying BUFFER in a window below the selected window.
This either splits the selected window or reuses the window below
the selected one."
(let (window)
(or (and (not (frame-parameter nil 'unsplittable))
- (setq window (window--try-to-split-window (selected-window)))
+ (setq window (window--try-to-split-window (selected-window) alist))
(window--display-buffer
- buffer window 'window display-buffer-mark-dedicated))
+ buffer window 'window alist display-buffer-mark-dedicated))
(and (setq window (window-in-direction 'below))
(not (window-dedicated-p window))
(window--display-buffer
- buffer window 'reuse display-buffer-mark-dedicated)))))
+ buffer window 'reuse alist display-buffer-mark-dedicated)))))
+
+(defun display-buffer-at-bottom (buffer alist)
+ "Try displaying BUFFER in a window at the bottom of the selected frame.
+This either splits the window at the bottom of the frame or the
+frame's root window, or reuses an existing window at the bottom
+of the selected frame."
+ (let (bottom-window window)
+ (walk-window-tree (lambda (window) (setq bottom-window window)))
+ (or (and (not (frame-parameter nil 'unsplittable))
+ (setq window (window--try-to-split-window bottom-window alist))
+ (window--display-buffer
+ buffer window 'window alist display-buffer-mark-dedicated))
+ (and (not (frame-parameter nil 'unsplittable))
+ (setq window
+ (condition-case nil
+ (split-window (frame-root-window))
+ (error nil)))
+ (window--display-buffer
+ buffer window 'window alist display-buffer-mark-dedicated))
+ (and (setq window bottom-window)
+ (not (window-dedicated-p window))
+ (window--display-buffer
+ buffer window 'reuse alist display-buffer-mark-dedicated)))))
(defun display-buffer-in-previous-window (buffer alist)
"Display BUFFER in a window previously showing it.
@@ -5578,7 +5697,7 @@ above, even if that window never showed BUFFER before."
(setq best-window window)))
;; Return best or second best window found.
(when (setq window (or best-window second-best-window))
- (window--display-buffer buffer window 'reuse))))
+ (window--display-buffer buffer window 'reuse alist))))
(defun display-buffer-use-some-window (buffer alist)
"Display BUFFER in an existing window.
@@ -5606,7 +5725,7 @@ that frame."
(get-largest-window 0 not-this-window))))
(when (window-live-p window)
(prog1
- (window--display-buffer buffer window 'reuse)
+ (window--display-buffer buffer window 'reuse alist)
(window--even-window-heights window)
(unless (cdr (assq 'inhibit-switch-frame alist))
(window--maybe-raise-frame (window-frame window)))))))
@@ -5876,6 +5995,97 @@ WINDOW must be a live window and defaults to the selected one."
window))))
;;; Resizing buffers to fit their contents exactly.
+(defcustom fit-frame-to-buffer nil
+ "Non-nil means `fit-window-to-buffer' can resize frames.
+A frame can be resized if and only if its root window is a live
+window. The height of the root window is subject to the values
+of `fit-frame-to-buffer-max-height' and `window-min-height'."
+ :type 'boolean
+ :version "24.2"
+ :group 'help)
+
+(defcustom fit-frame-to-buffer-bottom-margin 4
+ "Bottom margin for `fit-frame-to-buffer'.
+This is the number of lines `fit-frame-to-buffer' leaves free at the
+bottom of the display in order to not obscure the system task bar."
+ :type 'integer
+ :version "24.2"
+ :group 'windows)
+
+(defun fit-frame-to-buffer (&optional frame max-height min-height)
+ "Adjust height of FRAME to display its buffer's contents exactly.
+FRAME can be any live frame and defaults to the selected one.
+
+Optional argument MAX-HEIGHT specifies the maximum height of
+FRAME and defaults to the height of the display below the current
+top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN.
+Optional argument MIN-HEIGHT specifies the minimum height of
+FRAME."
+ (interactive)
+ (setq frame (window-normalize-frame frame))
+ (let* ((root (frame-root-window frame))
+ (frame-min-height
+ (+ (- (frame-height frame) (window-total-size root))
+ window-min-height))
+ (frame-top (frame-parameter frame 'top))
+ (top (if (consp frame-top)
+ (funcall (car frame-top) (cadr frame-top))
+ frame-top))
+ (frame-max-height
+ (- (/ (- (x-display-pixel-height frame) top)
+ (frame-char-height frame))
+ fit-frame-to-buffer-bottom-margin))
+ (compensate 0)
+ delta)
+ (when (and (window-live-p root) (not (window-size-fixed-p root)))
+ (with-selected-window root
+ (cond
+ ((not max-height)
+ (setq max-height frame-max-height))
+ ((numberp max-height)
+ (setq max-height (min max-height frame-max-height)))
+ (t
+ (error "%s is an invalid maximum height" max-height)))
+ (cond
+ ((not min-height)
+ (setq min-height frame-min-height))
+ ((numberp min-height)
+ (setq min-height (min min-height frame-min-height)))
+ (t
+ (error "%s is an invalid minimum height" min-height)))
+ ;; When tool-bar-mode is enabled and we have just created a new
+ ;; frame, reserve lines for toolbar resizing. This is needed
+ ;; because for reasons unknown to me Emacs (1) reserves one line
+ ;; for the toolbar when making the initial frame and toolbars
+ ;; are enabled, and (2) later adds the remaining lines needed.
+ ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a
+ ;; system that behaves differently.
+ (let ((quit-restore (window-parameter root 'quit-restore))
+ (lines (tool-bar-lines-needed frame)))
+ (when (and quit-restore (eq (car quit-restore) 'frame)
+ (not (zerop lines)))
+ (setq compensate (1- lines))))
+ (message "%s" compensate)
+ (setq delta
+ ;; Always count a final newline - we don't do any
+ ;; post-processing, so let's play safe.
+ (+ (count-screen-lines nil nil t)
+ (- (window-body-size))
+ compensate)))
+ ;; Move away from final newline.
+ (when (and (eobp) (bolp) (not (bobp)))
+ (set-window-point root (line-beginning-position 0)))
+ (set-window-start root (point-min))
+ (set-window-vscroll root 0)
+ (condition-case nil
+ (set-frame-height
+ frame
+ (min (max (+ (frame-height frame) delta)
+ min-height)
+ max-height))
+ (error (setq delta nil))))
+ delta))
+
(defun fit-window-to-buffer (&optional window max-height min-height)
"Adjust height of WINDOW to display its buffer's contents exactly.
WINDOW must be a live window and defaults to the selected one.
@@ -5896,9 +6106,12 @@ _all_ lines of its buffer you might not see the first lines when
WINDOW was scrolled."
(interactive)
(setq window (window-normalize-window window t))
- ;; Can't resize a full height or fixed-size window.
- (unless (or (window-size-fixed-p window)
- (window-full-height-p window))
+ (cond
+ ((window-size-fixed-p window))
+ ((window-full-height-p window)
+ (when fit-frame-to-buffer
+ (fit-frame-to-buffer (window-frame window))))
+ (t
(with-selected-window window
(let* ((height (window-total-size))
(min-height
@@ -5914,7 +6127,7 @@ WINDOW was scrolled."
;; Can't get larger than height of frame.
(min max-height
(window-total-size (frame-root-window window)))
- ;, Don't delete other windows.
+ ;; Don't delete other windows.
(+ height (window-max-delta nil nil window))))
;; Make `desired-height' the height necessary to show
;; all of WINDOW's buffer, constrained by MIN-HEIGHT
@@ -5977,89 +6190,7 @@ WINDOW was scrolled."
(window-resize window 1 nil window)
(setq desired-height (1+ desired-height)))))
(error (setq delta nil)))
- delta))))
-
-(defcustom fit-frame-to-buffer-bottom-margin 4
- "Bottom margin for `fit-frame-to-buffer'.
-This is the number of lines `fit-frame-to-buffer' leaves free at the
-bottom of the display in order to not obscure the system task bar."
- :type 'integer
- :version "24.2"
- :group 'windows)
-
-(defun fit-frame-to-buffer (&optional frame max-height min-height)
- "Adjust height of FRAME to display its buffer's contents exactly.
-FRAME can be any live frame and defaults to the selected one.
-
-Optional argument MAX-HEIGHT specifies the maximum height of
-FRAME and defaults to the height of the display below the current
-top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN.
-Optional argument MIN-HEIGHT specifies the minimum height of
-FRAME."
- (interactive)
- (setq frame (window-normalize-frame frame))
- (let* ((root (frame-root-window frame))
- (frame-min-height
- (+ (- (frame-height frame) (window-total-size root))
- window-min-height))
- (frame-top (frame-parameter frame 'top))
- (top (if (consp frame-top)
- (funcall (car frame-top) (cadr frame-top))
- frame-top))
- (frame-max-height
- (- (/ (- (x-display-pixel-height frame) top)
- (frame-char-height frame))
- fit-frame-to-buffer-bottom-margin))
- (compensate 0)
- delta)
- (when (and (window-live-p root) (not (window-size-fixed-p root)))
- (with-selected-window root
- (cond
- ((not max-height)
- (setq max-height frame-max-height))
- ((numberp max-height)
- (setq max-height (min max-height frame-max-height)))
- (t
- (error "%s is an invalid maximum height" max-height)))
- (cond
- ((not min-height)
- (setq min-height frame-min-height))
- ((numberp min-height)
- (setq min-height (min min-height frame-min-height)))
- (t
- (error "%s is an invalid minimum height" min-height)))
- ;; When tool-bar-mode is enabled and we have just created a new
- ;; frame, reserve lines for toolbar resizing. This is needed
- ;; because for reasons unknown to me Emacs (1) reserves one line
- ;; for the toolbar when making the initial frame and toolbars
- ;; are enabled, and (2) later adds the remaining lines needed.
- ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a
- ;; system that behaves differently.
- (let ((quit-restore (window-parameter root 'quit-restore))
- (lines (tool-bar-lines-needed frame)))
- (when (and quit-restore (eq (car quit-restore) 'frame)
- (not (zerop lines)))
- (setq compensate (1- lines))))
- (message "%s" compensate)
- (setq delta
- ;; Always count a final newline - we don't do any
- ;; post-processing, so let's play safe.
- (+ (count-screen-lines nil nil t)
- (- (window-body-size))
- compensate)))
- ;; Move away from final newline.
- (when (and (eobp) (bolp) (not (bobp)))
- (set-window-point root (line-beginning-position 0)))
- (set-window-start root (point-min))
- (set-window-vscroll root 0)
- (condition-case nil
- (set-frame-height
- frame
- (min (max (+ (frame-height frame) delta)
- min-height)
- max-height))
- (error (setq delta nil))))
- delta))
+ delta)))))
(defun window-safely-shrinkable-p (&optional window)
"Return t if WINDOW can be shrunk without shrinking other windows.
diff --git a/lisp/winner.el b/lisp/winner.el
index d808a54a10e..65b3d30a80c 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -63,19 +63,8 @@
"Restoring window configurations."
:group 'windows)
-;;;###autoload
-(defcustom winner-mode nil
- "Toggle Winner mode.
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `winner-mode'."
- :set #'(lambda (symbol value) (funcall symbol (or value 0)))
- :initialize 'custom-initialize-default
- :type 'boolean
- :group 'winner
- :require 'winner)
-
(defcustom winner-dont-bind-my-keys nil
- "If non-nil: Do not use `winner-mode-map' in Winner mode."
+ "Non-nil means do not bind keys in Winner mode."
:type 'boolean
:group 'winner)
@@ -85,15 +74,13 @@ use either \\[customize] or the function `winner-mode'."
:group 'winner)
(defcustom winner-boring-buffers '("*Completions*")
- "`winner-undo' will not restore windows displaying any of these buffers.
+ "List of buffer names whose windows `winner-undo' will not restore.
You may want to include buffer names such as *Help*, *Apropos*,
*Buffer List*, *info* and *Compile-Log*."
:type '(repeat string)
:group 'winner)
-
-
;;;; Saving old configurations (internal variables and subroutines)
@@ -337,19 +324,23 @@ You may want to include buffer names such as *Help*, *Apropos*,
;;;; Winner mode (a minor mode)
(defcustom winner-mode-hook nil
- "Functions to run whenever Winner mode is turned on."
+ "Functions to run whenever Winner mode is turned on or off."
:type 'hook
:group 'winner)
-(defcustom winner-mode-leave-hook nil
+(define-obsolete-variable-alias 'winner-mode-leave-hook
+ 'winner-mode-off-hook "24.3")
+
+(defcustom winner-mode-off-hook nil
"Functions to run whenever Winner mode is turned off."
:type 'hook
:group 'winner)
(defvar winner-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [(control c) left] 'winner-undo)
- (define-key map [(control c) right] 'winner-redo)
+ (unless winner-dont-bind-my-keys
+ (define-key map [(control c) left] 'winner-undo)
+ (define-key map [(control c) right] 'winner-redo))
map)
"Keymap for Winner mode.")
@@ -364,37 +355,21 @@ You may want to include buffer names such as *Help*, *Apropos*,
;;;###autoload
-(defun winner-mode (&optional arg)
- "Toggle Winner mode.
-With arg, turn Winner mode on if and only if arg is positive."
- (interactive "P")
- (let ((on-p (if arg (> (prefix-numeric-value arg) 0)
- (not winner-mode))))
- (cond
- ;; Turn mode on
- (on-p
- (setq winner-mode t)
- (cond
- ((winner-hook-installed-p)
- (add-hook 'window-configuration-change-hook 'winner-change-fun)
- (add-hook 'post-command-hook 'winner-save-old-configurations))
- (t (add-hook 'post-command-hook 'winner-save-conditionally)))
- (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally)
- (setq winner-modified-list (frame-list))
- (winner-save-old-configurations)
- (run-hooks 'winner-mode-hook)
- (when (called-interactively-p 'interactive)
- (message "Winner mode enabled")))
- ;; Turn mode off
- (winner-mode
- (setq winner-mode nil)
- (remove-hook 'window-configuration-change-hook 'winner-change-fun)
- (remove-hook 'post-command-hook 'winner-save-old-configurations)
- (remove-hook 'post-command-hook 'winner-save-conditionally)
- (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally)
- (run-hooks 'winner-mode-leave-hook)
- (when (called-interactively-p 'interactive)
- (message "Winner mode disabled"))))))
+(define-minor-mode winner-mode nil :global t ; let d-m-m make the doc
+ (if winner-mode
+ (progn
+ (if (winner-hook-installed-p)
+ (progn
+ (add-hook 'window-configuration-change-hook 'winner-change-fun)
+ (add-hook 'post-command-hook 'winner-save-old-configurations))
+ (add-hook 'post-command-hook 'winner-save-conditionally))
+ (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally)
+ (setq winner-modified-list (frame-list))
+ (winner-save-old-configurations))
+ (remove-hook 'window-configuration-change-hook 'winner-change-fun)
+ (remove-hook 'post-command-hook 'winner-save-old-configurations)
+ (remove-hook 'post-command-hook 'winner-save-conditionally)
+ (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally)))
;; Inspired by undo (simple.el)
@@ -461,12 +436,5 @@ In other words, \"undo\" changes in window configuration."
(message "Winner undid undo")))
(t (error "Previous command was not a `winner-undo'"))))
-;;; To be evaluated when the package is loaded:
-
-(unless (or (assq 'winner-mode minor-mode-map-alist)
- winner-dont-bind-my-keys)
- (push (cons 'winner-mode winner-mode-map)
- minor-mode-map-alist))
-
(provide 'winner)
;;; winner.el ends here